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