-- FUN.mesa,
-- Last edited by Mitchell on December 16, 1982 2:50 pm
-- Last edited by Jim Morris, May 12, 1982 10:28 am
ROPE: TYPE = Rope.ROPE;
z: ZONE = SafeStorage.NewZone[ ]; --(note 4.1)
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.Handle;
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)
Next:
PROC = {
cToken ← IF din.EndOf[ ] THEN "#" ELSE din.GetToken[StTokenProc]};
StTokenProc: IO.BreakProc =
BEGIN --
(note 4.5)
OPEN IO; --(note 4.6)
RETURN[
IF Rope.Letter[c] OR Rope.Digit[c] THEN KeepGoing
ELSE IF c=
SP
OR c=
CR
OR c=
TAB
THEN StopAndTossChar ELSE StopAndIncludeChar];
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[Rope.Digit[x.Fetch[0]] OR Rope.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[
z.NEW[ApplicationR ← [z.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[z.NEW[LambdaR ← [i, Exp1[ ]]]] } };
RETURN[Exp2[ ]];
END;
Exp2:
PROC
RETURNS [e: Exp] =
BEGIN
e ← Exp3[ ];
WHILE Rope.Equal[cToken, "("]
OR IsId[cToken]
DO
e ← z.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[z.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[z.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", z.NEW[PrimitiveR ← [Plus, NIL]]]]]; --(note 4.12)
dout.PutF["\nResult is %g\n\n",IO.refAny[result]]; --(note 4.11)
ENDLOOP
END;
[din, dout] ← IO.CreateViewerStreams["Fun"];
TRUSTED {Process.Detach[FORK EvalLoop[ ]]};
END.