1scheme COMPILER = 2class 3 type 4 Prog == mk_Prog(stmt : Stmt), 5 6 Stmt == 7 mk_Asgn(ide : Identifier, expr : Expr) | 8 mk_If(cond : Expr, s1 : Stmt, s2 : Stmt) | 9 mk_Seq(head : Stmt, last : Stmt), 10 11 Expr == 12 mk_Const(const : Int) | 13 mk_Plus(fst : Expr, snd : Expr) | 14 mk_Id(ide : Identifier), 15 Identifier = Text 16 17type /* storage for program variables */ 18 `Sigma = Identifier -m-> Int 19 20value 21 m : Prog -> `Sigma -> `Sigma 22 m(p)(`sigma) is m(stmt(p))(`sigma), 23 24 m : Stmt -> `Sigma -> `Sigma 25 m(s)(`sigma) is 26 case s of 27 mk_Asgn(i, e) -> `sigma !! [i +> m(e)(`sigma)], 28 mk_Seq(s1, s2) -> m(s2)(m(s1)(`sigma)), 29 mk_If(c, s1, s2) -> 30 if m(c)(`sigma) ~= 0 then m(s1)(`sigma) else m(s2)(`sigma) end 31 end, 32 33 m : Expr -> `Sigma -> Int 34 m(e)(`sigma) is 35 case e of 36 mk_Const(n) -> n, 37 mk_Plus(e1, e2) -> m(e1)(`sigma) + m(e2)(`sigma), 38 mk_Id(id) -> if id isin dom `sigma then `sigma(id) else 0 end 39 end 40 41type 42 MProg = Inst-list, 43 Inst == 44 mk_Push(ide1 : Identifier) | 45 mk_Pop(Unit) | 46 mk_Add(Unit) | 47 mk_Cnst(val : Int) | 48 mk_Store(ide2 : Identifier) | 49 mk_Jumpfalse(off1 : Int) | 50 mk_Jump(off2 : Int) 51 52 53/* An interpreter for SMALL instructions */ 54 55type Stack = Int-list 56value 57 I : MProg >< Int >< Stack -> (`Sigma ->`Sigma) 58 I(mp, pc, s)(`sigma) is 59 if pc <= 0 \/ pc > len mp then `sigma else 60 case mp(pc) of 61 mk_Push(x) -> if x isin dom `sigma 62 then I(mp, pc + 1, <.`sigma(x).> ^ s)(`sigma) 63 else I(mp, pc + 1, <.0.> ^ s)(`sigma) end, 64 mk_Pop(()) -> if len s = 0 then `sigma 65 else I(mp, pc + 1, tl s)(`sigma) end, 66 mk_Cnst(n) -> I(mp, pc + 1, <.n.> ^ s)(`sigma), 67 mk_Add(()) -> if len s < 2 then `sigma 68 else I(mp, pc + 1,<.s(1) + s(2).> ^ tl tl s)(`sigma) end, 69 mk_Store(x) -> if len s = 0 then `sigma 70 else I(mp, pc + 1, s)(`sigma !! [x +> s(1)]) end, 71 mk_Jumpfalse(n) -> if len s = 0 then `sigma 72 elsif hd s ~= 0 then I(mp, pc + 1, s)(`sigma) 73 else I(mp, pc + n, s)(`sigma) end, 74 mk_Jump(n) -> I(mp, pc + n, s)(`sigma) 75 end 76 end 77 78value 79 comp_Prog : Prog -> MProg 80 comp_Prog(p) is comp_Stmt(stmt(p)), 81 82 comp_Stmt : Stmt -> MProg 83 comp_Stmt(s) is 84 case s of 85 mk_Asgn(id, e) -> comp_Expr(e) ^ <. mk_Store(id), mk_Pop() .>, 86 mk_Seq(s1, s2) -> comp_Stmt(s1) ^ comp_Stmt(s2), 87 mk_If(e, s1, s2) -> 88 let 89 ce = comp_Expr(e), 90 cs1 = comp_Stmt(s1), cs2 = comp_Stmt(s2) 91 in 92 ce ^ 93 <. mk_Jumpfalse(len cs1 + 3) .> ^ 94 <. mk_Pop() .> ^ 95 cs1 ^ 96 <. mk_Jump(len cs2 + 2) .> ^ 97 <. mk_Pop() .> ^ 98 cs2 99 end 100 end, 101 102 comp_Expr : Expr -> MProg 103 comp_Expr(e) is 104 case e of 105 mk_Const(n) -> <. mk_Cnst(n) .>, 106 mk_Plus(e1, e2) -> 107 comp_Expr(e1) ^ comp_Expr(e2) ^ <. mk_Add() .>, 108 mk_Id(id) -> <. mk_Push(id) .> 109 end 110 111end 112