-- RouteImpl1.Mesa

-- used to be Route1.Mesa

DIRECTORY
  Disp: TYPE USING [Print],
  IO: TYPE USING [CR, ROPE, TAB],
  PL: TYPE USING [BlessString, GetSpecialNodes, Insert, LengthList, LSTNode,
  	LSTNodeRecord, NewNail, Node, NodeRecord, RErr, rLST, rSTR, SN, Symbol, Z],
  PString: TYPE USING [ConvertStream, CopyStream, EmptyS, Item, MakeInteger,
  	MakeNUM, NewStream, Stream, SubStream, SubString, SubStringStream],
  Rope: TYPE USING [Concat, FromChar, Length, ROPE],
  Route: TYPE USING [];

RouteImpl1: CEDAR PROGRAM IMPORTS D2: Disp, P:PL, S: PString, Rope  EXPORTS Route  = {
OPEN P, Rope, IO;
--
N: ZONE = P.Z;

Node: TYPE = PL.Node;
LSTNode: TYPE = PL.LSTNode;
LSTNodeRecord: TYPE = PL.LSTNodeRecord;
NodeRecord: TYPE = PL.NodeRecord;
Symbol: TYPE = PL.Symbol;
Stream: TYPE = PString.Stream;
String: TYPE = ROPE;
--
Fail,MTSt: Node;
Nail: LSTNode;

Route1Setup: PUBLIC PROC = {
[] ← P.Insert["chop",[,,ZARY[ChopRoutine]]];
[] ← P.Insert["conc",[,,ZARY[ConcRoutine]]];
[] ← P.Insert["differ",[,,ZARY[DifferRoutine]]];
[] ← P.Insert["display",[,,ZARY[DisplayRoutine]]];
[] ← P.Insert["divide",[,,ZARY[DivideRoutine]]];
[] ← P.Insert["ident",[,,ZARY[IdentRoutine]]];
[] ← P.Insert["islist",[,,ZARY[IsListRoutine]]];
[] ← P.Insert["isnull",[,,ZARY[IsNullRoutine]]];
[] ← P.Insert["isstring",[,,ZARY[IsStringRoutine]]];
[] ← P.Insert["length",[,,ZARY[LengthRoutine]]];
[] ← P.Insert["lines",[,,ZARY[LinesRoutine]]];
-- pattern routines
[] ← P.Insert["word",[,,PFUNC[WordRoutine]]];
[] ← P.Insert["thing",[,,PFUNC[ThingRoutine]]];
[] ← P.Insert["integer",[,,PFUNC[IntegerRoutine]]];
[] ← P.Insert["number",[,,PFUNC[NumberRoutine]]];
[] ← P.Insert["item",[,,PFUNC[ItemRoutine]]];
[] ← P.Insert["digit",[,,PFUNC[DigitRoutine]]];
[] ← P.Insert["smallletter",[,,PFUNC[SmallLetterRoutine]]];
[] ← P.Insert["bigletter",[,,PFUNC[BigLetterRoutine]]];
[] ← P.Insert["micas",[,,PFUNC[MicasRoutine]]];
[] ← P.Insert["letter",[,,PFUNC[LetterRoutine]]];
[] ← P.Insert["space",[,,PFUNC[SpaceRoutine]]];
[] ← P.Insert["len",[,,PFUNC1[LenRoutine]]];
[] ← P.Insert["blanks",[,,PFUNC1[BlanksRoutine]]];

};

ChopRoutine: PROC[input: Node] RETURNS[ans:Node] = {
-- zary
WITH input SELECT FROM x: rSTR => 
{ns: PString.Stream ← S.NewStream[x.str];
pn: LSTNode ← P.NewNail[];
ans ← pn;
WHILE ~S.EmptyS[ns] DO
      c:CHARACTER;
      [c, ns] ← S.Item[ns];
      pn↑ ← [TRUE,LST[P.SN[FromChar[c]],P.NewNail[]]];
      pn ← pn.listtail;
      ENDLOOP;
}
ENDCASE => P.RErr["Input to chop must be a string"];
};

ConcRoutine: PROC[n1: Node] RETURNS[ans:Node] = {
-- zary
-- take a list and squish all its elements to return a single string.
-- No punctuation or delimeters are added
WITH n1 SELECT FROM x: rLST =>
{t: rLST ← x;
as: String ← "";
WHILE t.listhead # NIL DO
      WITH t.listhead SELECT FROM
	s: rSTR => as ← Rope.Concat[as,s.str];
	ENDCASE => P.RErr["conc expects a list of strings"];
      t ← t.listtail;
      ENDLOOP;
ans ← P.SN[as]};
ENDCASE => ERROR P.RErr["conc expects a list."];
};

DifferRoutine: PROC[node: Node] RETURNS[ans:Node] = {
s1,s2: PString.Stream;
WITH node SELECT FROM l: rLST =>
{ IF l.listhead=NIL OR P.LengthList[l.listtail] ~= 1 THEN
		P.RErr["differ expects a list of length 2"];
WITH l.listhead SELECT FROM x1: rSTR =>
WITH l.listtail.listhead SELECT FROM x2: rSTR =>
{s1 ← S.NewStream[x1.str];
s2 ← S.NewStream[x2.str];
WHILE ~S.EmptyS[s1] AND ~S.EmptyS[s1] DO
	c1, c2: CHARACTER;
	[c1, s1] ← S.Item[s1];
	[c2, s2] ← S.Item[s2];
	IF c1#c2 THEN EXIT;
      ENDLOOP;
ans ← N.NEW[NodeRecord←[TRUE,
	LST[P.SN[S.ConvertStream[s1]],
	    N.NEW[LSTNodeRecord←[TRUE,
			LST[P.SN[S.ConvertStream[s2]],
				Nail]]]]]]};
ENDCASE => P.RErr["Differ expects both list elements to be strings"];
ENDCASE => P.RErr["Differ expects both list elements to be strings"];
};
ENDCASE => P.RErr["differ expects a list of length 2"]};

DisplayRoutine: PROC[n1: Node] RETURNS[Node] = {
-- zary
D2.Print[n1];
RETURN[n1];
};

DivideRoutine: PROC[n: Node] RETURNS[res:Node] = {
-- zary
WITH n SELECT FROM l: rLST =>
{ IF l.listhead=NIL OR P.LengthList[l.listtail] ~= 1 THEN P.RErr["Divide expects a list of length 2"];
{a: LONG INTEGER = S.MakeInteger[P.BlessString[l.listhead]];
b: LONG INTEGER = S.MakeInteger[P.BlessString[l.listtail.listhead]];
i: LONG INTEGER = a/b;
j: LONG INTEGER = a - (i*b);
RETURN[N.NEW[NodeRecord←
	[TRUE, LST[P.SN[S.MakeNUM[i]],
	N.NEW[LSTNodeRecord← [TRUE,LST[P.SN[S.MakeNUM[j]],Nail]]]]]]];
}};
ENDCASE => P.RErr["Divide expects a list of length 2"];
};

IdentRoutine: PROC[n1: Node] RETURNS[Node] = {
-- zary
RETURN[n1];
};

IsListRoutine: PROC[n: Node] RETURNS[Node] = {
-- zary
RETURN[IF n.Type = LST THEN n ELSE Fail];
};

IsNullRoutine: PROC[list: Node] RETURNS[Node] = {
-- zary
RETURN[WITH list SELECT FROM
	x: rLST => IF x.listhead=NIL THEN list ELSE Fail,
	ENDCASE =>  Fail];
};

IsStringRoutine: PROC[n: Node] RETURNS[Node] = {
-- zary
RETURN[WITH n SELECT FROM
	x: rSTR => n,
	ENDCASE =>  Fail];
};

LengthRoutine: PROC[n1: Node] RETURNS[ans:Node] = {
-- zary
WITH n1 SELECT FROM
	x: rSTR =>{
      RETURN[P.SN[S.MakeNUM[Length[x.str]]]];
      };
	x: rLST => RETURN[P.SN[S.MakeNUM[P.LengthList[x]]]];
	ENDCASE => P.RErr["Can only take length of strings and lists"];
};

LinesRoutine: PROC[input: Node] RETURNS[ans:Node] = {
-- zary
WITH input SELECT FROM x: rSTR =>
{
s: PString.Stream ← S.NewStream[x.str];
pans: LSTNode ← P.NewNail[];
ans ← pans;
WHILE ~S.EmptyS[s] DO
      i: CARDINAL ← 0;
      a: PString.Stream ← S.CopyStream[s];
      WHILE ~S.EmptyS[s] DO
	   c: CHARACTER;
	   i ← i + 1;
	   [c,s] ← S.Item[s];
	   IF c=CR THEN EXIT;
	   ENDLOOP;
      pans↑ ← [TRUE, LST[P.SN[S.SubStringStream[a,0,i]],P.NewNail[]]];
      pans ← pans.listtail;
      ENDLOOP};
ENDCASE => P.RErr["Lines expects a string as input"];};

-- Pattern Procedures

WordRoutine: PROC[n:Stream] RETURNS[ans: Node, ns: Stream] = {
c: CHARACTER;
a: LONG INTEGER ← 0;
ns ← n;
DO
      IF S.EmptyS[n] THEN EXIT;
      c ← S.SubStream[n, 0];
      IF c NOT IN ['A..'Z] AND c NOT IN ['a..'z] THEN EXIT;
      [,n] ← S.Item[n];
      a ← a + 1;
      ENDLOOP;
IF a=0 THEN ans ← Fail ELSE {ans ← P.SN[S.SubString[S.ConvertStream[ns],0,a]]; ns ← n};
};

ThingRoutine: PROC[n:Stream] RETURNS[ans: Node, ns: Stream] = {
s: ROPE ← S.ConvertStream[n];
c: CHARACTER;
a: LONG INTEGER ← 0;
ns ← n;
DO
      IF S.EmptyS[n] THEN EXIT;
      c ← S.SubStream[n, 0];
      IF c NOT IN ['A..'Z] AND c NOT IN ['a..'z] AND c NOT IN ['0..'9] THEN EXIT;
      [,n] ← S.Item[n];
      a ← a + 1;
      ENDLOOP;
IF a=0 THEN ans ← Fail ELSE {ans ← P.SN[S.SubString[s,0,a]]; ns ← n};
};

IntegerRoutine: PROC[n:Stream] RETURNS[ans: Node, ns: Stream] = {
c: CHARACTER;
s: ROPE ← S.ConvertStream[n];
sign: BOOLEAN ← FALSE;
a: LONG INTEGER ← 0;
ns ← n;
c ← S.SubStream[n, 0];
IF c = '-  OR c='+ THEN { sign←TRUE; a ← a + 1; [] ← S.Item[n] };
DO
      IF S.EmptyS[n] THEN EXIT;
      c ← S.SubStream[n, 0];
      IF c  NOT IN ['0..'9] THEN EXIT;
      [,n] ← S.Item[n];
      a ← a + 1;
      ENDLOOP;
IF a=0 OR sign AND a=1 THEN ans ← Fail ELSE {ans ← P.SN[S.SubString[s,0,a]]; ns ← n};
};

NumberRoutine: PROC[n:Stream] RETURNS[ans: Node, ns: Stream] = {
per: BOOLEAN ← FALSE;
c: CHARACTER;
s: ROPE ← S.ConvertStream[n];
sign: BOOLEAN ← FALSE;
a: LONG INTEGER ← 0;
ns ← n;
c ← S.SubStream[n, 0];
IF c = '-  OR c='+ THEN { sign←TRUE; a ← a + 1; [] ← S.Item[n] };
DO
      IF S.EmptyS[n] THEN EXIT;
      c ← S.SubStream[n, 0];
      IF c  NOT IN ['0..'9] AND (c ~= '. OR (c = '. AND per))THEN EXIT;
      per ← per OR c = '.;
      [,n] ← S.Item[n];
      a ← a + 1;
      ENDLOOP;
IF a=0 OR (sign OR per) AND a=1 THEN ans ← Fail ELSE {ans ← P.SN[S.SubString[s,0,a]]; ns ← n};
};

ItemRoutine: PROC[n:Stream] RETURNS[ans: Node, ns: Stream] = {
per: BOOLEAN ← FALSE;
c: CHARACTER;
s: ROPE ← S.ConvertStream[n];
sign: BOOLEAN ← FALSE;
a: LONG INTEGER ← 0;
ns ← n;
c ← S.SubStream[n, 0];
IF c = '-  OR c='+ THEN { sign←TRUE; a ← a + 1; [] ← S.Item[n] };
DO
      IF S.EmptyS[n] THEN EXIT;
      c ← S.SubStream[n, 0];
      IF c  NOT IN ['0..'9] AND c NOT IN ['a..'z] AND c NOT IN ['A..'Z] AND (c ~= '. OR (c = '. AND per))THEN EXIT;
      per ← per OR c = '.;
      [] ← S.Item[n];
      a ← a + 1;
      ENDLOOP;
IF a=0 OR sign AND a=1 THEN ans ← Fail ELSE {ans ← P.SN[S.SubString[s,0,a]]; ns ← n};
};

SpaceRoutine: PROC[string:Stream] RETURNS[ans: Node, ns: Stream] = {
c: CHARACTER;
c ← S.SubStream[string,0];
IF c = '  OR c = TAB THEN {
      ans ← P.SN[S.SubStringStream[string,0,1]];
      [,ns] ← S.Item[string];
      }
ELSE {ans ← Fail; ns ← string};
};

DigitRoutine: PROC[string:Stream] RETURNS[ans: Node, ns: Stream] = {
c: CHARACTER;
c ← S.SubStream[string,0];
IF c IN ['0..'9] THEN {
      ans ← P.SN[S.SubStringStream[string,0,1]];
      [,ns] ← S.Item[string];
      }
ELSE {ans ← Fail; ns ← string};
};

SmallLetterRoutine: PROC[string:Stream] RETURNS[ans: Node, ns: Stream] = {
c: CHARACTER;
c ← S.SubStream[string,0];
IF c IN ['a..'z] THEN {
      ans ← P.SN[S.SubStringStream[string,0,1]];
      [,ns] ← S.Item[string];
      }
ELSE {ans ← Fail; ns ← string};
};

BigLetterRoutine: PROC[string:Stream] RETURNS[ans: Node, ns: Stream] = {
c: CHARACTER;
c ← S.SubStream[string,0];
IF c IN ['A..'Z] THEN {
      ans ← P.SN[S.SubStringStream[string,0,1]];
      [,ns] ← S.Item[string];
      }
ELSE {ans ← Fail; ns ← string};
};

LetterRoutine: PROC[string:Stream] RETURNS[ans: Node, ns: Stream] = {
c: CHARACTER;
c ← S.SubStream[string,0];
IF c IN ['A..'Z] OR c IN ['a..'z] THEN {
      ans ← P.SN[S.SubStringStream[string,0,1]];
      [,ns] ← S.Item[string];
      }
ELSE {ans ← Fail; ns ← string};
};

Size: ARRAY CHARACTER OF INTEGER;

MicasRoutine: PROC[string:Stream] RETURNS[ans: Node, ns: Stream] = {
c: CHARACTER;
IF S.EmptyS[string] THEN RETURN[Fail,string];
[c, ns] ← S.Item[string];
RETURN[P.SN[S.MakeNUM[Size[c]]], ns];
};

LenRoutine: PROC[string: Stream,count: Node] RETURNS[ans: Node, ns: Stream] = {
s: ROPE = S.ConvertStream[string];
-- len(n) skips n chars
n,m: LONG INTEGER;
ns ← string;
m ← n ← S.MakeInteger[P.BlessString[count]];
WHILE n > 0 DO
      IF S.EmptyS[string] THEN EXIT;
      [,string] ← S.Item[string];
      n ← n - 1;
      ENDLOOP;
IF n > 0 THEN ans ← Fail
ELSE {ans ← P.SN[S.SubString[s,0,m]]; ns ← string};
};


BlanksRoutine: PROC[string: Stream,count: Node] RETURNS[ans: Node, ns: Stream] = {
s: ROPE = S.ConvertStream[string];
-- blanks(n) skips n blanks, fails otherwise
n,m: LONG INTEGER;
ns ← string;
m ← n ← S.MakeInteger[P.BlessString[count]];
WHILE n > 0 DO
      IF S.EmptyS[string] THEN EXIT;
      IF S.SubStream[string, 0] ~= '  THEN EXIT;
      [,string] ← S.Item[string];
      n ← n - 1;
      ENDLOOP;
IF n > 0 THEN ans ← Fail
ELSE {ans ← P.SN[S.SubString[s,0,m]]; ns ← string};
};

c: CHARACTER;


FOR c IN CHARACTER DO Size[c] ← 351 ENDLOOP;
Size[' ] ← 132 ;
Size['e] ← 165 ;
Size['t] ← 112 ;
Size['a] ← 165 ;
Size['n] ← 198 ;
Size['s] ← 132 ;
Size['r] ← 132 ;
Size['o] ← 185 ;
Size['i] ← 99 ;
Size['m] ← 298 ;
Size['p] ← 198 ;
Size['d] ← 198 ;
Size['h] ← 198 ;
Size['l] ← 99 ;
Size['u] ← 198 ;
Size['g] ← 179 ;
Size['c] ← 152 ;
Size['f] ← 119 ;
Size['w] ← 251 ;
Size['v] ← 179 ;
Size['b] ← 198 ;
Size['j] ← 99 ;
Size['k] ← 185 ;
Size['y] ← 179 ;
Size['x] ← 179 ;
Size['q] ← 198 ;
Size['z] ← 152 ;
Size['.] ← 86 ;
Size['A] ← 265 ;
Size['B] ← 232 ;
Size['C] ← 251 ;
Size['D] ← 284 ;
Size['E] ← 232 ;
Size['F] ← 232 ;
Size['G] ← 298 ;
Size['H] ← 291 ;
Size['I] ← 132 ;
Size['J] ← 152 ;
Size['K] ← 291 ;
Size['L] ← 232 ;
Size['M] ← 344 ;
Size['N] ← 291 ;
Size['O] ← 278 ;
Size['P] ← 212 ;
Size['Q] ← 278 ;
Size['R] ← 265 ;
Size['S] ← 198 ;
Size['T] ← 232 ;
Size['U] ← 284 ;
Size['V] ← 251 ;
Size['W] ← 351 ;
Size['X] ← 265 ;
Size['Y] ← 265 ;
Size['Z] ← 232 ;
Size['!] ← 119 ;
Size['"] ← 179 ;
Size['#] ← 351 ;
Size['$] ← 179 ;
Size['%] ← 265 ;
Size['&] ← 278 ;
Size[''] ← 86 ;
Size['(] ← 119 ;
Size[')] ← 119 ;
Size['*] ← 179 ;
Size['+] ← 351 ;
Size[',] ← 86 ;
Size['-] ← 119 ;
Size['/] ← 179 ;
Size['0] ← 179 ;
Size['1] ← 179 ;
Size['2] ← 179 ;
Size['3] ← 179 ;
Size['4] ← 179 ;
Size['5] ← 179 ;
Size['6] ← 179 ;
Size['7] ← 179 ;
Size['8] ← 179 ;
Size['9] ← 179 ;
Size[':] ← 119 ;
Size[';] ← 119 ;
Size['<] ← 351 ;
Size['=] ← 351 ;
Size['←] ← 351 ;
Size['?] ← 146 ;
Size['@] ← 351 ;
Size['[] ← 99 ;
Size['\\] ← 179 ;
Size[']] ← 99 ;
Size['↑] ← 179 ;
Size['←] ← 265;
Size['{] ← 179;
Size['|] ← 86 ;
Size['}] ← 179 ;
Size['~] ← 265 ;

[Fail,MTSt,Nail] ← P.GetSpecialNodes[];
}.