
<<RouteImpl1.Mesa>>
<<Copyright (c) Xerox Corporation, 1982.  All rights reserved.>>
<<last edit by Satterthwaite, April 18, 1986 4:58:21 pm PST>>

<<used to be Route1.Mesa>>

DIRECTORY
Disp: TYPE USING [Print],
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, MakeInt,
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;
<<>>
N: ZONE = P.Z;

Node: TYPE = PL.Node;
LSTNode: TYPE = PL.LSTNode;
LSTNodeRecord: TYPE = PL.LSTNodeRecord;
NodeRecord: TYPE = PL.NodeRecord;
ROPE: TYPE = Rope.ROPE;
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:CHAR;
[c, ns] _ S.Item[ns];
pn^ _ [TRUE,LST[P.SN[Rope.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 _ as.Concat[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: CHAR;
[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: INT = S.MakeInt[P.BlessString[l.listhead]];
b: INT = S.MakeInt[P.BlessString[l.listtail.listhead]];
i: INT = a/b;
j: INT = 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[(x.str).Length]]];
};
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: CHAR;
i _ i + 1;
[c,s] _ S.Item[s];
IF c='\n 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: CHAR;
a: INT _ 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: CHAR;
a: INT _ 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: CHAR;
s: ROPE _ S.ConvertStream[n];
sign: BOOL _ FALSE;
a: INT _ 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: BOOL _ FALSE;
c: CHAR;
s: ROPE _ S.ConvertStream[n];
sign: BOOL _ FALSE;
a: INT _ 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: BOOL _ FALSE;
c: CHAR;
s: ROPE _ S.ConvertStream[n];
sign: BOOL _ FALSE;
a: INT _ 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: CHAR;
c _ S.SubStream[string,0];
IF c = '  OR c = '\t 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: CHAR;
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: CHAR;
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: CHAR;
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: CHAR;
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 CHAR OF INTEGER;

MicasRoutine: PROC[string:Stream] RETURNS[ans: Node, ns: Stream] = {
c: CHAR;
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: INT;
ns _ string;
m _ n _ S.MakeInt[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: INT;
ns _ string;
m _ n _ S.MakeInt[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};
};

FOR c: CHAR IN CHAR 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[];
}.

