[ITMO] T06 Boyko Vladislav

src/Expr.lama

@@ -95,8 +95,46 @@ fun evalList (c, exprs) {
 }
 
 (* Assignment *)
+fun scopeHelper(s, expr) {
+    case expr of
+        Var (x) -> s.addNames(x)
+      | Fun (name, args, body) -> s.addFunction(name, args, body)
+    esac
+}
+
+fun callHelper(s, [name, Val (value)]) { s.addName(name, value) }
+
+-- Invariant: ALWAYS REAL VALUE IN STATE, YOU STUPID BASTARD
 fun eval (c@[s, w], expr) {
-  failure ("evalExpr not implemented\n")
+  case expr of 
+      Const (n) -> [c, Val (n)]
+    | Var (x) -> [c, Val (s.lookup(x))]
+    | Ref (x) -> [c, Ref (x)]
+    | Binop (op, e1, e2) -> let [c, {Val (l), Val (r)}] = evalList(c, {e1, e2}) in [c, Val (evalOp(op, l, r))]
+    | Skip -> [c, Void]
+    | Assn (e1, e2) -> let [[s, w], Ref (x)] = eval ([s, w], e1) in
+                       let [[s, w], Val (v)] = eval ([s, w], e2) in
+                       [[s <- [x, v], w], Val (v)]
+    | Read (x) -> let [z, w1] = readWorld(w) in [[s <- [x, z], w1], Void]
+    | Write (e) -> let [c@[s1, w1], Val (v)] = eval(c, e) in [[s1, writeWorld(v, w1)], Void]
+    | Seq (e1, e2) -> let [c1, _] = eval(c, e1) in eval(c1, e2)
+    | If (e, s1, s2) -> let [c1, Val (n)] = eval(c, e) in if (n != 0) then eval(c1, s1) else eval(c1, s2) fi
+    | While (e, s) -> let [c1, Val (n)] = eval(c, e) in if (n == 0) then [c1, Void] else 
+        let [c2, _] = eval(c1, s) in eval(c2, While (e, s)) 
+      fi
+    | DoWhile (s, e) -> evalList(c, {s, While (e, s)})
+    | Ignore (e) -> let [c, _] = eval(c, e) in [c, Void]
+    | Scope (ds, ss) -> let s = s.enterScope in 
+                        let s = (foldl(scopeHelper, s, ds)) in
+                        let [[s, w], v] = eval ([s, w], ss) in
+                        [[s.leaveScope, w], v]
+    | Call (name, args) -> let Fun (argsNames, body) = s.lookup(name) in
+                           let [c@[s, w], vs] = c.evalList(args) in
+                           let s_inner = s.enterFunction in
+                           let s_inner = foldl(callHelper, s_inner, zip(argsNames, vs)) in
+                           let [[s_inner, w], v] = eval([s_inner, w], body) in
+                           [[s.leaveFunction(s_inner.getGlobal), w], v]
+    esac
 }
 (* End *)
 

src/Parser.lama

@@ -121,7 +121,41 @@ var primary    = memo $ eta syntax (
                                                                                                                    esac
                                                                                                                 }} |
 (* Assignment *)
-                                      $(failure ("the rest of primary parsing in not implemented\n"))),
+                                  -- brackets
+                                  inbr[s("("), scopeExpr, s(")")] |
+                                  -- read
+                                  loc=pos kRead x=inbr[s("("), lident, s(")")] {fun(a) { assertVoid(a, Read(x), loc) }} |
+                                  -- write
+                                  loc=pos kWrite e=inbr[s("("), scopeExpr, s(")")] {fun(a) { assertVoid(a, Write(e(Val)), loc)}} |
+                                  -- skip
+                                  loc=pos kSkip {fun(a) { assertVoid(a, Skip, loc) }} |
+                                  -- if elif else fi
+                                  kIf e=scopeExpr kThen s1=scopeExpr elf=(-kElif scopeExpr -kThen scopeExpr)* s2=(-kElse scopeExpr)? kFi {
+                                    fun helper (final, elf, type) {
+                                      case elf of
+                                      {} -> final
+                                      | [e, s]:elf -> If (e(Val), s(type), helper(final, elf, type))
+                                      esac
+                                    }
+                                    fun(a) { 
+                                      distributeScope(e(Val), fun (expr) { If(expr, s1(a), helper (
+                                        case s2 of
+                                          None -> Skip
+                                          | Some (s) -> s(a)
+                                        esac, 
+                                        elf, a)) })
+                                      }
+                                    } |
+                                  -- while do od
+                                  loc=pos kWhile e=scopeExpr kDo s=scopeExpr kOd {fun(a) { assertVoid(a, While(e(Val), s(Void)), loc) }} |
+                                  -- do while od
+                                  loc=pos kDo s=scopeExpr kWhile e=scopeExpr kOd {fun(a) { 
+                                    distributeScope(s(Void), fun (expr) { assertVoid(a, DoWhile(expr, e(Val)), loc) }) 
+                                  }} |
+                                  -- for do od
+                                  kFor s1=scopeExpr s[","] cond=scopeExpr s[","] s2=scopeExpr kDo s=scopeExpr kOd {
+                                    fun(a) { distributeScope(s1(Void), fun (expr) { Seq(expr, While (cond(Val), Seq(s(Void), s2(Void)))) })}
+                                  }),
 (* End *)
       basic      = memo $ eta (expr ({[Right, {[s (":="),
                                                 fun (l, loc, r) {

src/SM.lama

@@ -72,58 +72,43 @@ fun fromLabel (env, lab) {
   env [0] (lab)
 }
 
--- Stack machine interpreter. Takes an environment, a world and a program,
--- returns a final output
-fun eval (env, w, insns) {
-  -- Global state maps names of global variables to values
-  var globalState = ref (fun (x) {error (sprintf ("name ""%s"" is undefined", x), getLoc (x))});
-
-  -- Make a fresh local state: a pair of arrays for arguments and local variables;
-  -- takes the numbers of arguments and local variables respectively
-  fun makeState (a, l) {
-    [initArray (a, fun (_) {0}), initArray (l, fun (_) {0})]
-  }
-
-  -- Lookups a location in local/global states
-  fun lookup ([args, locs], loc) {
-    case loc of
-      Arg (i) -> args[i]
-    | Loc (i) -> locs[i]
-    | Glb (x) -> deref (globalState) (x)
-    esac 
-  }
-
-  -- Assigns a value to a location
-  fun assign ([args, locs], loc, v) {
-    case loc of
-      Arg (i) -> args[i] := v
-    | Loc (i) -> locs[i] := v
-    | Glb (x) -> var g = deref (globalState);
-                 globalState ::= fun (y) {if compare (x, y) == 0 then v else g (y) fi}
-    esac
-  }
-
-  -- Takes n positions from the list, retursn a pair: the remaining list and the taken
-  -- sublist
-  fun take (list, n) {
-    fun inner (n, acc, list) {
-      if n == 0
-      then [list, acc]
-      else inner (n-1, list.hd : acc, list.tl)
-      fi
-    }
-
-    inner (n, {}, list)
-  }
-
-  -- Core interpreter: takes a configuration and a program, returns a configuration
-  (* Assignment *)
-  fun eval (c@[st, cst, s, w], insns) {
-    failure ("SM interpreter is not implemented\n")
-  }
-  (* 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, [s, st, w], insns) {
+   case insns of
+      {} -> [s, st, w]
+      |  i:insns -> case i of
+         BINOP(op) -> let y:x:s = s in case op of
+            "+" -> eval(env, [(x + y):s, st, w], insns)
+            | "-" -> eval(env, [(x - y):s, st, w], insns)
+            | "*" -> eval(env, [(x * y):s, st, w], insns)
+            | "/" -> eval(env, [(x / y):s, st, w], insns)
+            | "%" -> eval(env, [(x % y):s, st, w], insns)
+            | "<" -> eval(env, [(x < y):s, st, w], insns)
+            | ">" -> eval(env, [(x > y):s, st, w], insns)
+            | "<=" -> eval(env, [(x <= y):s, st, w], insns)
+            | ">=" -> eval(env, [(x >= y):s, st, w], insns)
+            | "==" -> eval(env, [(x == y):s, st, w], insns)
+            | "!=" -> eval(env, [(x != y):s, st, w], insns)
+            | "&&" -> eval(env, [(x && y):s, st, w], insns)
+            | "!!" -> eval(env, [(x !! y):s, st, w], insns)
+         esac
+         | CONST(n) -> eval(env, [n:s, st, w], insns)
+         | READ -> let [z, w] = readWorld(w) in eval(env, [z:s, st, w], insns)
+         | WRITE -> let z:s = s in eval(env, [s, st, writeWorld(z, w)], insns)
+         | LD(x) -> eval(env, [st(x):s, st, w], insns)
+         | ST(x) -> let z:s = s in eval(env, [z:s, st <- [x, z], w], insns)
+         | LABEL(lab) -> eval(env, [s, st, w], insns)
+         | JMP(lab) -> eval(env, [s, st, w], env.fromLabel(lab))
+         | CJMP(c, lab) -> let x:s = s in case c of
+                 "z" -> if x == 0 then eval(env, [s, st, w], env.fromLabel(lab)) else eval(env, [s, st, w], insns) fi
+              | "nz" -> if x != 0 then eval(env, [s, st, w], env.fromLabel(lab)) else eval(env, [s, st, w], insns) fi
+           esac
+         | LDA(x) -> eval(env, [Ref(x):s, st, w], insns)
+         | STI -> let v:Ref(x):s = s in eval(env, [v:s, st <- [x, v], w], insns)
+         | DROP -> let x:s = s in eval(env, [s, st, w], insns)
+      esac
+   esac
 }
 
 -- Runs a stack machine for a given input and a given program, returns an output
@@ -365,7 +350,109 @@ public fun compileSM (stmt) {
     | Var    (x)        -> [false, env, singletonBuffer (LD (x))]
     | Ref    (x)        -> [false, env, singletonBuffer (LDA (x))]
     | Const  (n)        -> [false, env, singletonBuffer (CONST (n))]
-    | _                 ->  failure ("compileSM not implemented\n")
+    | Ignore (e)        ->
+      let [eLab, env] = env.genLabel in
+      let [eLabUsed, env, eCode] = compile (eLab, env, e) in
+      [false, env, 
+
+      eCode <+> 
+      label (eLab, eLabUsed) <+ 
+      DROP]
+
+    | Binop (op, e1, e2)-> 
+      let [e1Lab, env] = env.genLabel in
+      let [e2Lab, env] = env.genLabel in
+      let [e1LabUsed, env, e1Code] = compile(e1Lab, env, e1) in
+      let [e2LabUsed, env, e2Code] = compile(e2Lab, env, e2) in
+      [false, env, 
+
+      e1Code <+> 
+      label(e1Lab, e1LabUsed) <+> 
+      e2Code <+> 
+      label(e2Lab, e2LabUsed) <+
+      BINOP(op)]
+
+    | Read  (x)      -> [false, env, singletonBuffer (READ) <+ ST (x) <+ DROP]
+    | Write (e)      -> 
+      let [eLab, env] = env.genLabel in
+      let [eLabUsed, env, eCode] = compile(eLab, env, e) in
+      [false, env, 
+
+      eCode <+> 
+      label(eLab, eLabUsed) <+ 
+      WRITE]
+
+    | Assn  (x, e)   -> 
+      let [xLab, env] = env.genLabel in
+      let [eLab, env] = env.genLabel 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) -> case env.genLabel of
+      [s2Lab, env] -> case compile (s2Lab, env, s1) of
+      [s2LabUsed, env, s1Code] -> case compile (lab, env, s2) of
+      [labUsed, env, s2Code] -> 
+      [labUsed, env,
+
+      s1Code <+> 
+      label (s2Lab, s2LabUsed) <+> 
+      s2Code]
+
+      esac esac esac
+    | If (e, s1, s2) -> 
+      let [eLab, env] = env.genLabel in
+      let [s2Lab, env] = env.genLabel in
+      let [eLabUsed, env, eCode] = compile (eLab, env, e) in
+      let [_, env, s1Code] = compile (lab, env, s1) in
+      let [_, env, s2Code] = compile (lab, env, s2) in
+      [true, env, 
+
+      eCode <+> 
+      label (eLab, eLabUsed) <+ 
+      CJMP ("z", s2Lab) <+> 
+      s1Code <+ 
+      JMP (lab) <+ 
+      LABEL (s2Lab) <+> 
+      s2Code]
+
+    | While (e, s) -> 
+      let [eLab, env] = env.genLabel in
+      let [codeLab, env] = env.genLabel in 
+      let [condLab, env] = env.genLabel in 
+      let [eLabUsed, env, eCode] = compile (eLab, env, e) in
+      let [_, env, code] = compile (condLab, env, s) in 
+      [false, env,  
+
+      singletonBuffer(JMP (condLab)) <+>
+      label (codeLab, true) <+>
+      code <+>
+      label (condLab, true) <+>
+      eCode <+>
+      label (eLab, eLabUsed) <+
+      CJMP("nz", codeLab)]
+
+    | DoWhile (s, e) -> 
+      let [eLab, env] = env.genLabel in
+      let [codeLab, env] = env.genLabel in 
+      let [condLab, env] = env.genLabel in 
+      let [eLabUsed, env, eCode] = compile (eLab, env, e) in
+      let [condLabUsed, env, code] = compile (condLab, env, s) in 
+      [false, env,  
+
+      label (codeLab, true) <+>
+      code <+>
+      label (condLab, condLabUsed) <+>
+      eCode <+>
+      label (eLab, eLabUsed) <+
+      CJMP("nz", codeLab)]
+
     esac
   }