-- 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[];
}.