-- FUN.mesa, -- Last edited by Mitchell on December 16, 1982 2:50 pm -- Last edited by Jim Morris, May 12, 1982 10:28 am DIRECTORY IO USING [BreakAction, BreakProc, CR, CreateViewerStreams, EndOf, Error, GetInt, GetToken, Handle, int, PutF, PutFR, refAny, rope, RIS, SP, TAB], Process USING [Detach], Rope USING [Digit, Equal, Fetch, Letter, ROPE], SafeStorage USING [NarrowRefFault, NewZone]; FUN: CEDAR PROGRAM IMPORTS IO, Process, Rope, SafeStorage = BEGIN 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. Κc– "Cedar" style˜Idefault– "Cedar" stylešΟc ˜ Kš7˜7K– "Cedar" styleš3˜3 modheaderšΟk ˜ Kšžœžœ‰˜‘Icodešœžœ ˜Kšœžœžœ˜/Kšœ žœ˜,—šœž ˜Kšžœžœ˜(—Lšž˜Jšžœžœžœ˜Jšœžœ!Οa ˜2unitš œžœžœžœ ΠckœŸ ˜JIprocšœ žœžœ˜šœ žœžœ˜%Kšœžœžœ˜.—šœžœžœ ˜Kšœ žœžœ˜0—šœ žœžœ ˜Kšœ žœžœ˜4—šœ žœ˜!Jš œ žœžœžœ žœ˜H—Oš œ žœžœžœžœ˜<—Nšœ žœ˜Nšœ ž œžœŸ ˜'NšΟn œžœžœž˜#šœ6˜6Mšœ&˜&Mšžœ ˜Jšž˜—Nš1˜1Ošœžœ Ÿ ˜š‘œžœ˜Jšœ žœžœžœ˜B—š‘ œžœŸ ˜0JšžœžœŸ ˜&šžœ˜Kšžœžœžœ ˜1š žœžœžœžœžœž˜Kšžœžœ˜.——Jšž˜—š‘œžœžœž˜&Jšžœžœ˜*Jšžœ˜$Jšžœ˜—š ‘œžœžœžœžœž˜-Kšžœžœžœžœžœžœžœžœ˜“Jšž˜—š ‘œžœžœ žœŸ ˜4Kšœ ˜ Kšžœžœžœ˜'Kšžœžœ žœ˜1Kšœ8˜8Kšžœ˜—š‘œžœžœ ž˜ šžœžœ˜#šœ˜Kšœ˜Kšžœžœžœ ˜Cšœ˜Kšœ˜Kšžœžœžœ!˜EKšœ˜šžœ˜Kšœžœžœ'˜B————Kšžœ ˜Kšžœ˜—š‘œžœžœ ž˜ šžœž˜$šœ ˜ Kšœ˜Kšžœžœžœžœ˜CKšœ˜Kšžœžœ˜*——Kšžœ ˜Kšžœ˜—š‘œžœžœ ž˜#Kšœ ˜ šžœžœž˜0Kšœžœ(Ÿ˜6Kšžœ˜—Kšžœ˜—š‘œžœžœ ž˜#šžœžœ˜!Kšœ˜Kšžœžœžœ ˜CKšœ˜—Kšžœ˜Kšžœ˜—Nš˜š ‘œžœžœžœŸ ˜Hšž˜šžœžœž˜šœ%˜%Kš žœžœžœžœ žœ˜@Kš žœžœžœžœžœ˜*—Kšœž œ˜Kšœ žœžœžœ˜0šœ˜Kšœ!˜!Kšœ˜šžœžœž˜šœ˜šœ žœ˜KšœYŸ˜^—Kšœžœ˜.—Kšœžœ˜4Kšžœ;Ÿ˜G——Kšœžœ˜Kšž˜—Kšžœ˜—Kšžœ˜—š‘œžœžœŸ ˜;Kšœžœžœ ˜-—š‘œžœžœž˜=Kšž œ9Ÿ˜GKš œžœžœžœžœžœŸ ˜KKš œžœžœžœžœ žœ˜1Kšžœžœ žœ ˜ Kšž˜—š‘œžœž˜šž˜šžœ˜Kšœ žœŸ ˜"Kšœ žœŸ ˜#—Kšœžœ˜Kšœ ˜ Kšœžœ žœžœ Ÿ ˜WMšœžœŸ ˜@Kšž˜—Kšžœ˜—Nšœžœ!˜1Kšž œžœ˜+Kšžœ˜J˜—…—΄