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