-- RouteImpl2.Mesa Last Modified On 9-Nov-81 10:33:31 JHM
-- Schmidt February 3, 1983 6:23 pm
-- used to be Route2.Mesa
DIRECTORY
ConvertUnsafe: TYPE USING [AppendRope, ToRope],
Directory: TYPE USING [DeleteFile, GetNext, GetProps],
File: TYPE USING [Capability],
FileIO: TYPE USING[Open],
IO: TYPE USING [CharClass, Close, CR, DEL, GetToken,
Handle, Put, PutChar, PutF, PutFR, rope, ROPE, 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, MakeInteger,
MakeNUM, NewStream, Stream, StringToFile, SubStringStream],
RefText: TYPE USING [ObtainScratch],
Rope: TYPE USING [Concat, Flatten, FromProc, FromRefText, Length, Lower,
ROPE, Upper],
Route: TYPE USING [],
System: TYPE USING [GreenwichMeanTime];
RouteImpl2: CEDAR PROGRAM
IMPORTS FileIO, Rope, RefText, ConvertUnsafe, P:PL, S:PString, IO, Directory
EXPORTS Route = {
OPEN P, Rope, IO;
--
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[Rope.Flatten[t]]];
};
DeleteRoutine: PUBLIC PROC[name: Node] RETURNS[Node] = TRUSTED
{t: STRING = [100];
ConvertUnsafe.AppendRope[t, P.BlessString[name]];
Directory.DeleteFile[t];
RETURN[Nail];
};
DirRoutine: PUBLIC PROC[name: Node] RETURNS[ans: Node] = TRUSTED
{t: STRING = [100];
current: STRING ← [100];
next: STRING ← [100];
tans: LSTNode ← P.NewNail[];
ConvertUnsafe.AppendRope[t, P.BlessString[name]];
ans ← tans;
current.length ← 0;
IF t.length=0 THEN {t.length←1; t[0]← '*}; -- Pilot bug detour
DO
TS: SAFE PROC[t: System.GreenwichMeanTime] RETURNS [Node] = CHECKED {
RETURN[P.SN[IO.PutFR["%t", IO.time[t]]]];
};
r,w,c: System.GreenwichMeanTime;
l: LONG CARDINAL;
cap: File.Capability ← Directory.GetNext[t, current, next];
IF next.length=0 THEN RETURN;
[r,w,c,l,] ← Directory.GetProps[cap, current];
tans↑ ← [TRUE,LST[N.NEW[LSTNodeRecord ← [TRUE,LST[P.SN[ConvertUnsafe.ToRope[next]],
N.NEW[LSTNodeRecord ← [TRUE,LST[TS[r],
N.NEW[LSTNodeRecord ← [TRUE,LST[TS[w],
N.NEW[LSTNodeRecord ← [TRUE,LST[TS[c],
N.NEW[LSTNodeRecord ← [TRUE,LST[P.SN[S.MakeNUM[l]],Nail]]
]]]]]]]]]]]]],
P.NewNail[]]];
tans ← tans.listtail;
{x: STRING = current; current ← next; next ← x};
ENDLOOP;
};
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: BOOLEAN ← FALSE;
X: PROC [c: CHARACTER] RETURNS [IO.CharClass] =
{IF c=DEL THEN {DELseen ← TRUE; P.OS.PutF["XXX\n"]; RETURN[break]}
ELSE IF c=CR THEN RETURN[break]
ELSE RETURN[other]};
t: ROPE;
P.OS.Put[rope[P.BlessString[n1]]];
t ← P.IS.GetToken[X];
RETURN[IF DELseen THEN Fail ELSE P.SN[t]];
};
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: LONG INTEGER;
n: LSTNode ← P.BlessLST[n1];
a ← n.listhead;
max ← S.MakeInteger[P.BlessString[a]];
WHILE n.listhead ~= NIL DO
IF max < (ii ← S.MakeInteger[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: LONG INTEGER;
n: LSTNode ← P.BlessLST[n1];
a ← n.listhead;
min ← S.MakeInteger[P.BlessString[a]];
WHILE n.listhead ~= NIL DO
IF min > (ii ← S.MakeInteger[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.MakeInteger[P.BlessString[n1]]
-S.MakeInteger[P.BlessString[n2]]]]];
};
PlusRoutine: PROC[n: Node] RETURNS[Node] = {
-- zary
n1, n2: Node;
[n1, n2] ← ExtractPair[n];
RETURN[P.SN[S.MakeNUM[S.MakeInteger[P.BlessString[n1]]
+S.MakeInteger[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 ← Rope.Concat[x, 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: LONG INTEGER;
input,sav: PString.Stream;
x: Node;
output,patternString:Rope.ROPE;
match: PROC RETURNS[BOOLEAN] = {
pat: PString.Stream ← S.NewStream[patternString];
inp: PString.Stream ← S.CopyStream[input];
WHILE ~S.EmptyS[inp] DO
pc, ic: CHARACTER;
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 ← Rope.Length[patternString];
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 ←
Rope.Concat[output,
S.SubStringStream[sav,0,k]];
output ← Rope.Concat[output,replacementString];
FOR i: LONG INTEGER 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 ← Rope.Concat[output,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.MakeInteger[P.BlessString[n1]]
*S.MakeInteger[P.BlessString[n2]]]]];
};
ToLowerRoutine: PROC[inputnode: Node] RETURNS[Node] = {
s: ROPE = P.BlessString[inputnode];
input: PString.Stream ← S.NewStream[s];
X: PROC RETURNS [CHAR] = {c: CHAR; [c, input] ← S.Item[input]; RETURN[Rope.Lower[c]]};
RETURN[SN[Rope.FromProc[Rope.Length[s], X]]]
};
ToUpperRoutine: PROC[inputnode: Node] RETURNS[Node] = {
s: ROPE = P.BlessString[inputnode];
input: PString.Stream ← S.NewStream[s];
X: PROC RETURNS [CHAR] = {c: CHAR; [c, input] ← S.Item[input]; RETURN[Rope.Upper[c]]};
RETURN[SN[Rope.FromProc[Rope.Length[s], X]]]};
WriteRoutine: PUBLIC PROC[input,name: Node] RETURNS[Node] = {
-- unary
ns: PString.Stream;
fh: IO.Handle;
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 Rope.Length[P.BlessString[name]] >= 100 THEN P.RErr["File name too long (>100)"];
fh ← FileIO.Open[P.BlessString[name]];
ns ← S.NewStream[P.BlessString[input]];
WHILE ~S.EmptyS[ns] DO
c: CHARACTER;
[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[];
}.