[ivy]<Satterthwaite>Poplar>RouteImpl1.Mesa!5

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