
<<RouteImpl2.Mesa>>
<<Copyright (c) Xerox Corporation, 1983, 1985.  All rights reserved>>
<<Last Modified by Morris,  9-Nov-81 10:33:31 JHM>>
<<Schmidt February 3, 1983 6:23 pm>>
<<Satterthwaite, April 18, 1986 5:01:25 pm PST>>

<<used to be Route2.Mesa>>

DIRECTORY
Ascii: TYPE USING [Lower, Upper],
BasicTime: TYPE USING [GMT],
FS: TYPE USING [Delete, EnumerateForInfo, InfoProc, StreamOpen],
IO: TYPE USING [CharClass, Close, DEL, GetChar, GetToken,
Put, PutChar, PutF, PutFR, rope, STREAM, time],
PL: TYPE USING [BlessLST, BlessString, Dist, Eval, GetSpecialNodes, Insert, Interrupt,
IS, LengthList, LSTNode, LSTNodeRecord, NewNail, Node, OS, RErr, rLST, rSTR, SN,
sSize, Symbol, Z],
PString: TYPE USING [CopyStream, EmptyS, Item, MakeInt,
MakeNUM, NewStream, Stream, StringToFile, SubStringStream],
RefText: TYPE USING [ObtainScratch],
Rope: TYPE USING [Concat, Flatten, FromProc, FromRefText, Length, ROPE],
Route: TYPE USING [];

RouteImpl2: CEDAR PROGRAM 
IMPORTS Ascii, FS, Rope, RefText, P:PL, S:PString, IO 
EXPORTS Route  = {
OPEN P;
<<>>
N: ZONE = P.Z;
Node: TYPE = PL.Node;
LSTNode: TYPE = PL.LSTNode;
LSTNodeRecord: TYPE = PL.LSTNodeRecord;
Symbol: TYPE = PL.Symbol;
Stream: TYPE = PString.Stream;
<<>>
Fail,MTSt: Node;
Nail: LSTNode;

Route2Setup: PUBLIC PROC = {
[] _ P.Insert["cfile",[,,ZARY[CFileRoutine]]];
[] _ P.Insert["delete",[,,ZARY[DeleteRoutine]]];
[] _ P.Insert["dir",[,,ZARY[DirRoutine]]];
[] _ P.Insert["eq",[,,ZARY[EQRoutine]]];
[] _ P.Insert["file",[,,ZARY[FileRoutine]]];
[] _ P.Insert["key",[,,ZARY[KeyRoutine]]];
[] _ P.Insert["listin",[,,ZARY[ListInRoutine]]];
[] _ P.Insert["marry",[,,ZARY[MarryRoutine]]];
[] _ P.Insert["max",[,,ZARY[MaxRoutine]]];
[] _ P.Insert["min",[,,ZARY[MinRoutine]]];
[] _ P.Insert["minus",[,,ZARY[MinusRoutine]]];
[] _ P.Insert["plus",[,,ZARY[PlusRoutine]]];
[] _ P.Insert["reverse",[,,ZARY[ReverseRoutine]]];
[] _ P.Insert["run",[,,ZARY[RunRoutine]]];
[] _ P.Insert["subst",[,,ZARY[SubstRoutine]]];
[] _ P.Insert["times",[,,ZARY[TimesRoutine]]];
[] _ P.Insert["tolower",[,,ZARY[ToLowerRoutine]]];
[] _ P.Insert["toupper",[,,ZARY[ToUpperRoutine]]];
[] _ P.Insert["write",[,,UNARY[WriteRoutine]]];
[] _ P.Insert["zip",[,,ZARY[ZipRoutine]]];
};

CFileRoutine: PUBLIC PROC[name: Node] RETURNS[Node] = {
t: Rope.ROPE = S.StringToFile[P.BlessString[name]];
RETURN[IF t=NIL THEN Fail ELSE P.SN[t.Flatten[]]]
};

DeleteRoutine: PUBLIC PROC[name: Node] RETURNS[Node] = {
FS.Delete[P.BlessString[name]];
RETURN[Nail]
};

DirRoutine: PUBLIC PROC[name: Node] RETURNS[ans: Node] = {
tans: LSTNode _ P.NewNail[];

ForEach: FS.InfoProc = {
TS: SAFE PROC[t: BasicTime.GMT] RETURNS [Node] = CHECKED {
RETURN[P.SN[IO.PutFR["%t", IO.time[t]]]]
};
tans^ _ [TRUE,LST[N.NEW[LSTNodeRecord _ [TRUE,LST[P.SN[fullFName],
<<N.NEW[LSTNodeRecord _ [TRUE,LST[TS[read],>>
<<N.NEW[LSTNodeRecord _ [TRUE,LST[TS[written],>>
N.NEW[LSTNodeRecord _ [TRUE,LST[TS[created],
N.NEW[LSTNodeRecord _ [TRUE,LST[P.SN[S.MakeNUM[bytes]],Nail]]
]]]]]]], --]]]]]],
P.NewNail[]]];
tans _ tans.listtail;
RETURN[TRUE]
};

ans _ tans;
FS.EnumerateForInfo[P.BlessString[name], ForEach]
};

ExtractPair: PUBLIC PROC[n: Node] RETURNS[a: Node, b: Node] = {
t: LSTNode _ P.BlessLST[n];
IF t.listhead = NIL THEN ERROR P.RErr["Empty List given, pair required"];
IF t.listtail.listhead = NIL THEN ERROR P.RErr["Unit List given, pair required"];
IF t.listtail.listtail.listhead # NIL THEN ERROR P.RErr["List too long"];
RETURN[t.listhead, t.listtail.listhead]
};

EQRoutine: PUBLIC PROC[n: Node] RETURNS[Node] =
{a, b: Node;
[a,b] _ ExtractPair[n];
RETURN[IF a=b THEN a ELSE Fail]
};

FileRoutine: PUBLIC PROC[name: Node] RETURNS[Node] =
{t: Rope.ROPE = S.StringToFile[P.BlessString[name]];
RETURN[IF t=NIL THEN Fail ELSE P.SN[t]]
};

KeyRoutine: PUBLIC PROC[n1: Node] RETURNS[Node] = {
DELseen: BOOL _ FALSE;
X: PROC [c: CHAR] RETURNS [IO.CharClass] =
{IF c=IO.DEL THEN {DELseen _ TRUE; P.OS.PutF["XXX\n"]; RETURN[$break]}
ELSE IF c='\n THEN RETURN[$break]
ELSE RETURN[$other]};
token: REF TEXT;
P.OS.Put[IO.rope[P.BlessString[n1]]];
token _ P.IS.GetToken[X, RefText.ObtainScratch[100]].token;        -- size ??
IF token[0]='\n THEN token.length _ 0 ELSE [] _ P.IS.GetChar[];  -- skip break char
RETURN[IF DELseen THEN Fail ELSE P.SN[Rope.FromRefText[token]]]
};

ListInRoutine: PROC[name: Node] RETURNS[ans:Node] = {
<<zary>>
ans _ P.Dist[S.StringToFile[P.BlessString[name]]];
};

MarryRoutine: PROC[node: Node] RETURNS[ans:Node] = {
pans: LSTNode _ P.NewNail[];
x1, x2: Node;
n1, n2: LSTNode;
[x1, x2] _ ExtractPair[node];
n1 _ P.BlessLST[x1];
n2 _ P.BlessLST[x2];
IF P.LengthList[n1] ~= P.LengthList[n2]
THEN P.RErr["marry expects equal length lists"];
ans _ pans;
WHILE n1.listhead ~= NIL AND n2.listhead ~= NIL DO
j: LSTNode _ N.NEW[LSTNodeRecord _ [TRUE,LST[n2.listhead,Nail]]];
j _ N.NEW[LSTNodeRecord _ [TRUE,LST[n1.listhead,j]]];
pans^ _ [TRUE,LST[j,P.NewNail[]]];
pans _ pans.listtail;
n1 _ n1.listtail;
n2 _ n2.listtail;
ENDLOOP;
};

MaxRoutine: PROC[n1: Node] RETURNS[Node] = {
<<zary>>
a:Node;
max,ii: INT;
n: LSTNode _ P.BlessLST[n1];
a _ n.listhead;
max _ S.MakeInt[P.BlessString[a]];
WHILE n.listhead ~= NIL DO
IF max < (ii _ S.MakeInt[P.BlessString[n.listhead]]) THEN {
a _ n.listhead;
max _ ii;
};
n _ n.listtail;
ENDLOOP;
RETURN[a]
};

MinRoutine: PROC[n1: Node] RETURNS[Node] = {
<<zary>>
a:Node;
min,ii: INT;
n: LSTNode _ P.BlessLST[n1];
a _ n.listhead;
min _ S.MakeInt[P.BlessString[a]];
WHILE n.listhead ~= NIL DO
IF min > (ii _ S.MakeInt[P.BlessString[n.listhead]]) THEN {
a _ n.listhead;
min _ ii;
};
n _ n.listtail;
ENDLOOP;
RETURN[a]
};

MinusRoutine: PROC[node: Node] RETURNS[Node] = {
<<zary>>
n1, n2: Node;
[n1, n2] _ ExtractPair[node];
RETURN[P.SN[S.MakeNUM[S.MakeInt[P.BlessString[n1]]
-S.MakeInt[P.BlessString[n2]]]]]
};

PlusRoutine: PROC[n: Node] RETURNS[Node] = {
<<zary>>
n1, n2: Node;
[n1, n2] _ ExtractPair[n];
RETURN[P.SN[S.MakeNUM[S.MakeInt[P.BlessString[n1]]
+S.MakeInt[P.BlessString[n2]]]]]
};

ReverseRoutine: PROC[n: Node] RETURNS[ans:Node] = {
<<zary>>
WITH n SELECT FROM
x: rLST =>
{
w: LSTNode _ P.BlessLST[n];
t: LSTNode _ Nail;
WHILE w.listhead ~= NIL DO
t _ N.NEW[LSTNodeRecord _ [TRUE, LST[w.listhead,t]]];
w _ w.listtail;
ENDLOOP;
ans _ t;
};
x: rSTR => {
s: PString.Stream _ S.NewStream[x.str];
t: Rope.ROPE _ "";
WHILE ~S.EmptyS[s] DO
x: Rope.ROPE;
[x, s] _ Rev[s];
t _ x.Concat[t];
ENDLOOP;
ans _ P.SN[t]
}
ENDCASE => ERROR P.RErr["reverse expects a list or string as input"];
};

Rev: PROC[s: Stream] RETURNS[Rope.ROPE, Stream] = {
wk: REF TEXT;
i,j,k: CARDINAL;
wk _ RefText.ObtainScratch[PL.sSize];
i _ wk.maxLength;
WHILE ~S.EmptyS[s] AND i > 0 DO
i _ i - 1;
[wk[i], s] _ S.Item[s];
ENDLOOP;
k _ 0;
FOR j IN [i..wk.maxLength) DO
wk[k] _ wk[j];
k _ k + 1;
ENDLOOP;
wk.length _ k;
RETURN[Rope.FromRefText[wk], s]
};

RunRoutine: PROC[prog: Node] RETURNS[tt:Node] = {
<<zary>>
RETURN[P.Eval[P.Dist[P.BlessString[prog]],NIL]];
};

SubstRoutine: PROC[inputnode: Node] RETURNS[ans:Node] = {
lenpattern,k: INT;
input,sav: PString.Stream;
x: Node;
output,patternString:Rope.ROPE;

match: PROC RETURNS[BOOL] = {
pat: PString.Stream _ S.NewStream[patternString];
inp: PString.Stream _ S.CopyStream[input];
WHILE ~S.EmptyS[inp] DO
pc, ic: CHAR;
IF S.EmptyS[pat] THEN RETURN[TRUE];
[pc, pat] _ S.Item[pat];
[ic, inp] _ S.Item[inp];
IF pc~=ic THEN RETURN[FALSE];
ENDLOOP;
IF S.EmptyS[pat] AND S.EmptyS[inp]  THEN RETURN[TRUE];
RETURN[FALSE]
};

x _ KeyRoutine[P.SN["replacement string: "]];
IF x.Type = FAIL THEN P.Interrupt;
{replacementString: Rope.ROPE = P.BlessString[x];
x _ KeyRoutine[P.SN["pattern string: "]];
IF x.Type = FAIL THEN P.Interrupt;
patternString _  P.BlessString[x];
sav _ S.NewStream[P.BlessString[inputnode]];
input _ S.NewStream[P.BlessString[inputnode]];
output _ "";
lenpattern _ patternString.Length;
IF lenpattern=0 THEN P.RErr["Pattern must be non-empty"];
k _ 0;
WHILE ~S.EmptyS[input] DO
IF match[] THEN {
IF k > 0 THEN
output _
output.Concat[
S.SubStringStream[sav,0,k]];
output _ output.Concat[replacementString];
FOR i: INT IN [0..lenpattern) DO
[,input] _ S.Item[input];
ENDLOOP;
sav _ S.CopyStream[input];
k _ 0;
}
ELSE {
[,input] _ S.Item[input];
k _ k + 1;
};
ENDLOOP;
IF ~S.EmptyS[sav] THEN
output _ output.Concat[S.SubStringStream[sav,0,k]];
ans _ P.SN[output];
}};

TimesRoutine: PROC[n: Node] RETURNS[Node] = {
<<zary>>
n1, n2: Node;
[n1, n2] _ ExtractPair[n];
RETURN[P.SN[S.MakeNUM[S.MakeInt[P.BlessString[n1]]
*S.MakeInt[P.BlessString[n2]]]]]
};

ToLowerRoutine: PROC[inputnode: Node] RETURNS[Node] = {
s: Rope.ROPE = P.BlessString[inputnode];
input: PString.Stream _ S.NewStream[s];
X: PROC RETURNS [CHAR] = {c: CHAR; [c, input] _ S.Item[input]; RETURN[Ascii.Lower[c]]};
RETURN[SN[Rope.FromProc[s.Length, X]]]
};

ToUpperRoutine: PROC[inputnode: Node] RETURNS[Node] = {
s: Rope.ROPE = P.BlessString[inputnode];
input: PString.Stream _ S.NewStream[s];
X: PROC RETURNS [CHAR] = {c: CHAR; [c, input] _ S.Item[input]; RETURN[Ascii.Upper[c]]};
RETURN[SN[Rope.FromProc[s.Length, X]]]};

WriteRoutine: PUBLIC PROC[input,name: Node] RETURNS[Node] = {
<<unary>>
ns: PString.Stream;
fh: IO.STREAM;
IF input.Type ~= STR THEN P.RErr["Input to write routine must be string"];
IF name.Type ~= STR THEN P.RErr["Filename for write routine must be string"];
IF P.BlessString[name].Length >= 100 THEN P.RErr["File name too long (>100)"];
fh _ FS.StreamOpen[P.BlessString[name], $create];
ns _ S.NewStream[P.BlessString[input]];
WHILE ~S.EmptyS[ns] DO
c: CHAR;
[c, ns] _ S.Item[ns];
fh.PutChar[c];
ENDLOOP;
fh.Close;
fh _ NIL;
RETURN[Nail]
};

ZipRoutine: PROC[node: Node] RETURNS[ans:Node] = {
<<unary>>
pans: LSTNode _ P.NewNail[];
x1, x2: Node;
[x1, x2] _ ExtractPair[node];
{n1: LSTNode _ P.BlessLST[x1];
n2: LSTNode _ P.BlessLST[x2];
WHILE n1.listhead ~= NIL AND n2.listhead ~= NIL DO
pans^ _ [TRUE,LST[n1.listhead,P.NewNail[]]];
pans _ pans.listtail;
pans^ _ [TRUE,LST[n2.listhead,P.NewNail[]]];
pans _ pans.listtail;
n1 _ n1.listtail;
n2 _ n2.listtail;
ENDLOOP;
pans.listtail _ IF n1.listhead = NIL THEN n2 ELSE n1;
}};

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


