[ITMO] T06 Svetlana Antoshkina

src/Expr.lama

@@ -94,11 +94,63 @@ fun evalList (c, exprs) {
   esac
 }
 
-(* Assignment *)
-fun eval (c@[s, w], expr) {
-  failure ("evalExpr not implemented\n")
+fun evalDecls(c, exprs) {
+  fun evalDecl(c@[s, w], e) {
+    case e of
+        Var(x) -> let s = s.addNames(x) in [s, w]
+      | Fun(name, args, body) -> let s = s.addFunction(name, args, body) in [s, w]
+    esac
+  }
+
+  foldl(evalDecl, c, exprs)
+}
+
+fun evalArgs(s, args) {
+  fun evalArg(s, [name, Val (value)]) {
+    s.addName(name, value) 
+  }
+
+  foldl(evalArg, s, args)
 }
-(* End *)
+
+(* Assignment *)
+fun eval (c@[st, w], expr) {
+  case expr of
+    Assn (expr1, expr2) -> let [c@[st, w], {Ref (x), Val (v)}] = evalList(c, {expr1, expr2}) in [[st <- [x, v], w], Val (v)]
+    | Seq (expr1, expr2) -> let [c1, v] = eval(c, expr1) in eval(c1, expr2)
+    | Skip -> [c, Void]
+    | Read (x) -> let [r, w] = readWorld(w) in [[st <- [x, r], w], Void]
+    | Write (e) -> let [c@[st1, w1], Val (v)] = eval(c, e) in [[st1, writeWorld(v, w1)], v]
+    | If (cond, expr1, expr2) -> let [c, Val (v)] = eval(c, cond) in if v then eval(c, expr1) else eval(c, expr2) fi
+    | While (cond, body) -> 
+      let [c1, Val (n)] = eval(c, cond) in 
+      if n != 0
+      then
+        let [c2, _] = eval(c1, body) in
+        eval(c2, While(cond, body))
+      else
+        [c1, 0]
+      fi
+    | DoWhile (cond, body) -> evalList(c, {body, While (cond, body)})
+    | Var (x) -> [c, Val (st.lookup(x))]
+    | Ref (x) -> [c, Ref (x)]
+    | Const (n) -> [c, Val (n)]
+    | Binop (op, expr1, expr2) -> let [c, {Val (l), Val (r)}] = evalList(c, {expr1, expr2}) in [c, Val (evalOp(op, l, r))]
+    | Ignore (expr1) -> let [c, v] = eval(c, expr1) in [c, Void]
+    | Scope (decl, stmt) -> 
+      let st = st.enterScope in
+      let c@[st, w] = evalDecls([st, w], decl) in
+      let [[st, w], x] = eval(c, stmt) in
+      [[st.leaveScope, w], x]
+    | Call (name, args) -> 
+      let Fun (argNames, body) = st.lookup(name) in
+      let [c@[st, w], vs] = c.evalList(args) in
+      let stIn = st.enterFunction in
+      let stIn = evalArgs(stIn, zip(argNames, vs)) in
+      let [[stIn, w], v] = eval([stIn, w], body) in
+      [[st.leaveFunction(stIn.getGlobal), w], v]
+  esac
+}(* End *)
 
 -- Evaluates a program with a given input and returns an output
 public fun evalExpr (input, expr) {

src/Parser.lama

@@ -57,6 +57,12 @@ fun binop (op) {
   ]
 }
 
+--var elseStmt = memo $ eta syntax (
+--  kElif e=exp kThen s1=exp s2=elseStmt {fun (a) {If(e(Val), s1(a), s2(a))}} |
+--  kElse s2=exp kFi {fun (a) {s2(a)}} |
+--  kFi {fun (a) {assertVoid(a, Skip, loc)}}
+--);
+
 -- Helper parser: parses a (possible empty) list of items separated by ","
 fun list0 (item) {
   list0By (item, s(","))
@@ -106,35 +112,53 @@ fun distributeScope (expr, exprConstructor) {
 }
 
 var primary    = memo $ eta syntax (
-                                      -- decimal constant
-                                      loc=pos x=decimal                                 {fun (a) {assertValue (a, Const (stringInt (x)), loc)}}     |
-
-                                      -- identifier
-                                      loc=pos x=lident args=inbr[s("("), list0(syntax(e=exp {e(Val)})), s(")")]? {fun (a) {
-                                                                                                                    case args of
-                                                                                                                      None -> case a of
-                                                                                                                                Ref  -> Ref (x)
-                                                                                                                              | Void -> Ignore (Var (x))
-                                                                                                                              | _    -> Var (x)
-                                                                                                                              esac
-                                                                                                                    | Some (args) -> assertValue (a, Call (x, args), loc)
-                                                                                                                   esac
-                                                                                                                }} |
-(* Assignment *)
-                                      $(failure ("the rest of primary parsing in not implemented\n"))),
-(* End *)
-      basic      = memo $ eta (expr ({[Right, {[s (":="),
-                                                fun (l, loc, r) {
-                                                  fun (a) {assertValue (a, Assn (l (Ref), r (Val)), loc)}
-                                                }]}],
-                                      [Left , map (binop, {"!!"})],
-                                      [Left , map (binop, {"&&"})],
-                                      [Nona , map (binop, {"==", "!=", "<", ">", "<=", ">="})],
-                                      [Left , map (binop, {"+", "-"})],
-                                      [Left , map (binop, {"*", "/", "%"})]
-                                     },
-                                     primary)),
-      scopeExpr  = memo $ eta syntax (ds=definition* e=exp? {fun (a) {fun (e) {
+      -- decimal constant
+      loc=pos x=decimal {fun (a) {assertValue (a, Const (stringInt (x)), loc)}} |
+
+      -- identifier
+      loc=pos x=lident args=inbr[s("("), list0(syntax(e=exp {e(Val)})), s(")")]? {
+        fun (a) {
+          case args of
+            None -> case a of
+                      Ref  -> Ref (x)
+                    | Void -> Ignore (Var (x))
+                    | _    -> Var (x)
+                    esac
+          | Some (args) -> assertValue (a, Call (x, args), loc)
+          esac
+        }
+      } |
+      inbr[s("("), scopeExpr, s(")")] |
+      kSkip {fun (a) {assertVoid(a, Skip, loc)}} |
+      kRead x=inbr[s("("), lident, s(")")] {fun (a) {assertVoid(a, Read (x), loc)}} |
+      kWrite x=inbr[s("("), scopeExpr, s(")")] {fun (a) {assertVoid(a, Write (x(Val)), loc)}} |
+      loc=pos kIf e=scopeExpr kThen s1=scopeExpr s2=elseStmt {fun (a) {If(e(Val), s1(a), s2(a))}} |
+      loc=pos kThen {fun (a) {assertVoid(a, Skip, loc)}} |
+      loc=pos kWhile e=scopeExpr kDo s=scopeExpr kOd {fun (a) {assertVoid(a, While (e(Val), s(Void)), loc)}} |
+      loc=pos kDo s=scopeExpr kWhile e=scopeExpr kOd {fun (a) {
+        distributeScope(s(Void), fun(s) {assertVoid(a, DoWhile(e(Val), s), loc)})
+      }} |
+      loc=pos kFor s1=scopeExpr s[","] e=scopeExpr s[","] s2=scopeExpr kDo s=scopeExpr kOd {fun (a) {
+        distributeScope(s1(Void), fun (s1) {assertVoid(a, Seq(s1, While (e(Val), Seq(s(Void), s2(Void)))), loc)})
+      }}
+    ),
+    elseStmt = memo $ eta syntax (
+      kElif e=scopeExpr kThen s1=scopeExpr s2=elseStmt {fun (a) {If(e(Val), s1(a), s2(a))}} |
+      kElse s2=scopeExpr kFi {fun (a) {s2(a)}} |
+      kFi {fun (a) {assertVoid(a, Skip, loc)}}
+    ),
+    basic    = memo $ eta (expr ({[Right, {[s (":="),
+                                            fun (l, loc, r) {
+                                              fun (a) {assertValue (a, Assn (l (Ref), r (Val)), loc)}
+                                            }]}],
+                                  [Left , map (binop, {"!!"})],
+                                  [Left , map (binop, {"&&"})],
+                                  [Nona , map (binop, {"==", "!=", "<", ">", "<=", ">="})],
+                                  [Left , map (binop, {"+", "-"})],
+                                  [Left , map (binop, {"*", "/", "%"})]
+                                 },
+                                 primary)),
+    scopeExpr  = memo $ eta syntax (ds=definition* e=exp? {fun (a) {fun (e) {
                                                                         case ds of
                                                                           {} -> e
                                                                         | _  -> expandScope (ds, e) 
@@ -144,14 +168,14 @@ var primary    = memo $ eta syntax (
                                                                          | _        -> Skip
                                                                          esac)
                                                                       }}),
-      definition = memo $ eta syntax (kVar ds=list[syntax (lident (s["="] e=basic {e (Val)})?)] s[";"] {Var (ds)} |
-                                      kFun name=lident
-                                           args=inbr[s("("), list0 (lident), s(")")]
-                                           body=inbr[s("{"), scopeExpr, s("}")] {
-                                           Fun (name, args, body (Weak))
-                                      }
-                                     ),                                    
-      exp        = memo $ eta syntax (basic | s1=basic s[";"] s2=exp {fun (a) {Seq (s1 (Void), s2 (a))}});
+    definition = memo $ eta syntax (kVar ds=list[syntax (lident (s["="] e=basic {e (Val)})?)] s[";"] {Var (ds)} |
+                                    kFun name=lident
+                                          args=inbr[s("("), list0 (lident), s(")")]
+                                          body=inbr[s("{"), scopeExpr, s("}")] {
+                                          Fun (name, args, body (Weak))
+                                    }
+                                    ),   
+    exp      = memo $ eta syntax (basic | s1=basic s[";"] s2=exp {fun (a) {Seq (s1 (Void), s2 (a))}});
 
 -- Public top-level parser
 public parse = syntax (s=scopeExpr {s (Void)});

src/SM.lama

@@ -124,6 +124,31 @@ fun eval (env, w, insns) {
   (* End *)
 
   eval ([{}, {}, makeState (0, 0), w], insns) [3].getOutput
+-- Stack machine interpreter. Takes an environment, an SM-configuration and a program,
+-- returns a final configuration
+--fun eval (env, c@[stack, st, w], insns) {
+--  case insns of
+--    i:rest -> case i of
+--        READ      -> let [n, w1] = readWorld(w) in eval(env, [n:stack, st, w1], rest)
+--      | WRITE     -> let v:stack1 = stack in eval(env, [stack1, st, writeWorld(v, w)], rest)
+--      | BINOP(op) -> let v2:v1:stack1 = stack in eval(env, [evalOp(op, v1, v2):stack1, st, w], rest)
+--      | LD(x)     -> eval(env, [st(x):stack, st, w], rest)
+--      | LDA(x)    -> eval(env, [Ref(x):stack, st, w], rest)
+--      | ST(x)     -> let v:stack1 = stack in eval(env, [v:stack1, st <- [x, v], w], rest)
+--      | STI       -> let v:Ref(ref):stack1 = stack in eval(env, [v:stack1, st <-[ref, v], w], rest)
+--      | CONST(n)  -> eval(env, [n:stack, st, w], rest)
+--      | LABEL (s) -> eval(env, c, rest)
+--      | JMP (l)   -> eval(env, c, fromLabel(env, l))
+--      | CJMP (c, l) -> 
+--        let v:stack1 = stack in
+--        case c of
+--          "z"  -> if v == 0 then eval(env, [stack1, st, w], fromLabel(env, l)) else eval(env, [stack1, st, w], rest) fi
+--        | "nz" -> if v != 0 then eval(env, [stack1, st, w], fromLabel(env, l)) else eval(env, [stack1, st, w], rest) fi
+--        esac
+--      | DROP      -> let _:stack1 = stack in eval(env, [stack1, st, w], rest)
+--      esac
+--  | {} -> c
+--  esac
 }
 
 -- Runs a stack machine for a given input and a given program, returns an output
@@ -349,6 +374,17 @@ fun addVars (env, names) {
 --    (use env.addArg).
 
 -- Compiles an expression into a stack machine code.
+-- Takes an expression, returns a list of stack machine instructions
+fun compileExpr (expr) {
+   case expr of
+     Var(x) -> singletonBuffer(LD(x))
+   | Const(n) -> singletonBuffer (CONST(n))
+   | Binop(op, e1, e2) -> compileExpr(e1) <+> compileExpr(e2) <+> singletonBuffer(BINOP(op))
+   esac
+}
+
+-- Compiles a statement into a stack machine code.
+-- Takes a statement, returns a list of stack machine
 -- Takes an expression, returns a list of stack machine
 -- instructions.
 public fun compileSM (stmt) {
@@ -361,10 +397,58 @@ public fun compileSM (stmt) {
 
   fun compile (lab, env, stmt) {
     case stmt of
-      Skip              -> [false, env, emptyBuffer ()]
-    | Var    (x)        -> [false, env, singletonBuffer (LD (x))]
-    | Ref    (x)        -> [false, env, singletonBuffer (LDA (x))]
-    | Const  (n)        -> [false, env, singletonBuffer (CONST (n))]
+      Skip           -> [false, env, emptyBuffer ()]
+    | Var   (x)      -> [false, env, singletonBuffer (LD (x))]
+    | Ref   (x)      -> [false, env, singletonBuffer (LDA (x))]
+    | Const (n)      -> [false, env, singletonBuffer (CONST (n))]
+    | Read  (x)      -> [false, env, singletonBuffer (READ) <+ ST (x) <+ DROP]
+    | Write (e)      -> --[false, env, compileExpr (e) <+ WRITE]
+        let [wLab, env] = env.genLabel in
+        let [wLabUsed, env, code] = compile (wLab, env, e) in
+        [false, env, code <+> label (wLab, wLabUsed) <+ WRITE]
+    | Assn  (x, e)   -> --[false, env, compileExpr (e) <+ ST (x)]
+        let [xLab, eLab, env] = env.genLabels(2) in
+        let [xLabUsed, env, xCode] = compile(xLab, env, x) in
+        let [eLabUsed, env, eCode] = compile(eLab, env, e) in
+        [false, env, xCode <+> label(xLab, xLabUsed) <+> eCode <+> label(eLab, eLabUsed) <+ STI]
+    | Seq   (s1, s2) -> 
+        let [s2Lab, env] = env.genLabel in
+        let [s2LabUsed, env, s1Code] = compile (s2Lab, env, s1) in
+        let [labUsed, env, s2Code] = compile (lab, env, s2) in 
+        [labUsed, env, s1Code <+> label (s2Lab, s2LabUsed) <+> s2Code]
+    | If(expr, s1, s2) -> 
+        let [elseLab, env] = env.genLabel in
+        let [_, env, thenBody] = compile (lab, env, s1) in
+        let [_, env, elseBody] = compile (lab, env, s2) in
+          [true, env, 
+            compileExpr(expr) 
+            <+ CJMP ("z", elseLab) 
+            <+> thenBody 
+            <+ JMP (lab) 
+            <+ LABEL (elseLab) 
+            <+> elseBody
+          ]
+    | While(expr, s)  -> 
+        let [condLab, bodyLab, env] = env.genLabels (2) in
+        let [_, env, cond] = compile (condLab, env, s) in
+          [false, env, 
+            singletonBuffer (JMP (condLab))
+            <+ LABEL (bodyLab) 
+            <+> cond
+            <+ LABEL (condLab)  
+            <+> compileExpr (expr)
+            <+ CJMP ("nz", bodyLab)
+          ]
+    | DoWhile(expr, s) -> 
+        compile(lab, env, Seq(s, While(expr, s)))
+    | Binop (op, l, r) -> 
+        let [lLab, rLab, env] = env.genLabels(2) in
+        let [lLabUsed, env, lCode] = compile(lLab, env, l) in
+        let [rLabUsed, env, rCode] = compile(rLab, env, r) in
+        [false, env, lCode <+> label(lLab, lLabUsed) <+> rCode <+> label(rLab, rLabUsed) <+ BINOP(op)]
+    | Ignore(expr)     -> 
+        let [labUsed, env, code] = compile(lab, env, expr) in 
+        [false, env, code <+> label(lab, labUsed) <+ DROP]
     | _                 ->  failure ("compileSM not implemented\n")
     esac
   }

src/Stmt.lama

@@ -19,10 +19,20 @@ import World;
 --        While  (expr, stmt)       |
 --        Repeat (stmt, expr)
 
-fun eval (c, stmt) {
-  failure ("Stmt eval not implemented\n")
+fun eval (c@[st, w], stmt) {
+   case stmt of
+     Assn(x, e) -> [st <- [x, evalExpr(st, e)], w]
+   | Seq(stmt1, stmt2) -> eval(eval(c, stmt1), stmt2)
+   | Skip -> c
+   | Read(x) -> let [res, w1] = readWorld(w) in [st <- [x, res], w1]
+   | Write(e) -> [st, writeWorld(evalExpr(st, e), w)]
+   | If(e, s1, s2) -> if evalExpr(st, e) != 0 then eval(c, s1) else eval(c, s2) fi
+   | While(e, s) -> if evalExpr(st, e) != 0 then eval(eval(c, s), stmt) else c fi
+   | DoWhile(e, s) -> eval(eval(c, s), While(e, s))
+   esac
 }
 
+
 -- Evaluates a program with a given input and returns an output
 public fun evalStmt (input, stmt) {
   eval ([emptyState, createWorld (input)], stmt).snd.getOutput