-- FUN.mesa,
-- Last edited by Mitchell on December 16, 1982 2:50 pm
-- Last edited by Jim Morris, May 12, 1982 10:28 am
-- Last edited by Bob Hagmann, May 8, 1984 11:14:01 am PDT
DIRECTORY
Ascii USING [Digit, Letter],
IO USING [BreakProc, CR, EndOf, Error, GetInt, GetToken, int, PutF, PutFR, refAny, rope, RIS, SP, STREAM, TAB],
Process USING [Detach],
Rope USING [Equal, Fetch, FromRefText, ROPE],
SafeStorage USING [NarrowRefFault],
ViewerIO USING [CreateViewerStreams];
FUN: CEDAR PROGRAM      --(note 4.1 has been deleted)
IMPORTS Ascii, IO, Process, Rope, SafeStorage, ViewerIO =
BEGIN
ROPE: TYPE = Rope.ROPE;
Exp: TYPE = REF ANY;-- always a REF to one of the following   (note 4.2)
Variable: TYPE = ROPE;
Application: TYPE = REF ApplicationR;
ApplicationR: TYPE = RECORD[rator, rand: Exp];
Lambda: TYPE = REF LambdaR;
LambdaR: TYPE = RECORD[bv: Variable, body: Exp];
Closure: TYPE = REF ClosureR;
ClosureR: TYPE = RECORD[exp: Exp, env: Environment];
Primitive: TYPE = REF PrimitiveR;
PrimitiveR: TYPE = RECORD[p: PROC[Exp, Exp] RETURNS [Exp] , state: Exp];
Environment: TYPE = LIST OF RECORD[var: Variable, val: Exp];
din, dout: IO.STREAM;
FUNError: ERROR = CODE;    --(note 4.3)
NoteError: PROC [msg: ROPE] = BEGIN
-- this procedure always generates the error FUNError.
dout.PutF["\n %g \n\n", IO.rope[msg]];
ERROR FUNError;
END;
-- The FUN lexical analysis and parsing machinery
cToken: ROPE;      --(note 4.4)
rToken: REF TEXT ← NIL ;
Next: PROC = {
IF din.EndOf[ ] THEN cToken ← "#" ELSE {
rToken ← din.GetToken[StTokenProc, rToken].token;
cToken ← Rope.FromRefText[rToken] ;
};
};
StTokenProc: IO.BreakProc = BEGIN  --(note 4.5)
OPEN IO;      --(note 4.6)
RETURN[
IF Ascii.Letter[char] OR Ascii.Digit[char] THEN other
ELSE IF char=SP OR char=CR OR char=TAB
THEN sepr ELSE break];
END;
Id: PROC RETURNS [i: Variable] = BEGIN
IF IsId[cToken] THEN {i ← cToken; Next[ ]}
ELSE NoteError["Input Error: No Id"]
END;
IsId: PROC[x: ROPE] RETURNS [BOOLEAN] = BEGIN
RETURN[Ascii.Digit[x.Fetch[0]] OR Ascii.Letter[x.Fetch[0]]
AND NOT Rope.Equal[x, "let"]
AND NOT Rope.Equal[x, "in"]
AND NOT Rope.Equal[x, "lambda"]];
END;
Prog: PROC RETURNS [e: Exp] = BEGIN     --(note 4.7)
e ← Exp0[ ];
IF Rope.Equal[cToken, "#"] THEN RETURN;
UNTIL Rope.Equal[cToken, "#"] DO Next[ ] ENDLOOP;
NoteError["Input Error: Whole Expression not consumed"];
END;
Exp0: PROC RETURNS [Exp] = BEGIN
IF Rope.Equal[cToken, "let"] THEN {
Next[ ];
{v: Variable = Id[ ];
IF NOT Rope.Equal[cToken, "="] THEN NoteError["Input Error: No ="];
Next[ ];
{val: Exp = Exp1[ ];
IF NOT Rope.Equal[cToken, "in"] THEN NoteError["Input Error: No in"];
Next[ ];
RETURN[
NEW[ApplicationR ← [NEW[LambdaR ← [v, Exp0[ ]]], val]]] } } };
RETURN[Exp1[ ]];
END;
Exp1: PROC RETURNS [Exp] = BEGIN
IF Rope.Equal[cToken, "lambda"] THEN
{Next[ ];
{i: Variable = Id[ ];
IF NOT Rope.Equal[cToken, "."] THEN NoteError["Input Error: No ."];
Next[ ];
RETURN[NEW[LambdaR ← [i, Exp1[ ]]]] } };
RETURN[Exp2[ ]];
END;
Exp2: PROC RETURNS [e: Exp] = BEGIN
e ← Exp3[ ];
WHILE Rope.Equal[cToken, "("] OR IsId[cToken] DO
e ← NEW[ApplicationR ← [e, Exp3[ ]]];   --[4.0]
ENDLOOP;
END;
Exp3: PROC RETURNS [e: Exp] = BEGIN
IF Rope.Equal[cToken, "("] THEN {
Next[ ]; e ← Exp0[ ];
IF NOT Rope.Equal[cToken, ")"] THEN NoteError["Input Error: No )"];
Next[ ]}
ELSE e ← Id[ ];
END;
-- The FUN interpreter
Eval: PROC[x: Exp, env: Environment] RETURNS [Exp]= BEGIN   --(note 4.8)
DO
WITH x SELECT FROM
v: Variable => {t: Environment ← env;
UNTIL t=NIL OR Rope.Equal[v, t.first.var] DO t ← t.rest ENDLOOP;
RETURN[IF t=NIL THEN x ELSE t.first.val]};
p: Primitive => RETURN[x];
l: Lambda => RETURN[NEW[ClosureR ← [l, env]]];
a: Application =>
{rator: Exp = Eval[a.rator, env];
rand: Exp = Eval[a.rand, env];
WITH rator SELECT FROM
f: Closure => {
l: Lambda = NARROW[f.exp
! SafeStorage.NarrowRefFault =>
NoteError["Evaluation Error: Illegal application"] ];  --[4.1]
x ← l.body; env ← CONS[[l.bv, rand], f.env] };
prim: Primitive => RETURN[prim.p[prim.state, rand]];
ENDCASE => NoteError["Evaluation Error: Illegal application"]}; --[4.2]
f: Closure => RETURN[x];
ENDCASE
ENDLOOP;
END;
Plus: PROC[d, first: Exp] RETURNS [Exp] =     --(note 4.9)
{RETURN[NEW[PrimitiveR ← [Plus1, first]]]};
Plus1: PROC[first, second: Exp] RETURNS[v: Variable] = BEGIN
ENABLE IO.Error => NoteError["Evaluation Error: Not a number"]; --[4.3]
a: INT = IO.GetInt[IO.RIS[NARROW[first, ROPE]]];    --(note 4.10)
b: INT = IO.GetInt[IO.RIS[NARROW[second, ROPE]]];
RETURN[IO.PutFR[, IO.int[a+b]]];
END;
EvalLoop: PROC = BEGIN
DO
ENABLE {
FUNError => LOOP;    --(note 4%11)
IO.Error => EXIT};    --(note 4%12)
result: Exp ← NIL;
Next[ ]; 
result ← Eval[Prog[ ], LIST[["PLUS", NEW[PrimitiveR ← [Plus, NIL]]]]]; --(note 4.12)
dout.PutF["\nResult is %g\n\n",IO.refAny[result]]; --(note 4.11)
ENDLOOP
END;
[din, dout] ← ViewerIO.CreateViewerStreams["Fun"];
TRUSTED {Process.Detach[FORK EvalLoop[ ]]};
END.
CHANGE LOG
Changed by Bob Hagmann on May 8, 1984 11:14:27 am PDT
Cedar 5 conversion from < Cedar 3.5.2 (?):
IO.BreakAction, SafeStorage.NewZone eliminated
IO.CreateViewerStreams -> ViewerIO.CreateViewerStreams
IO.Handle -> IO.STREAM
Rope.Digit, Rope.Letter -> Ascii
converted IO.BreakProc from Cedar 3.5.2 convertions to Cedar 5