Baranov Ilya HW4

src/Expr.lama

@@ -3,6 +3,23 @@
 import List;
 import State;
 
+public fun binopOp (str, x, y) {
+  case str of
+      "+"  -> x + y
+    | "-"  -> x - y
+    | "*" -> x * y
+    | "/" -> x / y
+    | "%" -> x % y
+    | "==" -> x == y
+    | "!=" -> x != y
+    | "<" -> x  < y
+    | "<=" -> x <= y
+    | ">" -> x > y
+    | ">=" -> x >= y
+    | "&&" -> x && y
+    | "!!" -> x !! y
+  esac
+}
 
 -- The evaluator itself: takes a state and an expression,
 -- returns integer value
@@ -14,5 +31,9 @@ import State;
 --        Binop (string, expr, expr)
 
 public fun evalExpr (st, expr) {
-  failure ("evalExpr not implemented\n")
+  case expr of 
+      Var (x)              -> st (x)
+    | Const (x)            -> x
+    | Binop (op,  s1, s2)  -> binopOp (op, evalExpr (st, s1), evalExpr (st, s2))
+  esac
 }

src/Parser.lama

@@ -13,12 +13,35 @@ fun inbr (l, p, r) {
 }
 
 -- Primary expression
-local primary = memo $ eta (decimal @ fun (x) {Const (stringInt (x))} |
-                            lident  @ fun (x) {Var (x)} |
-                            inbr (s ("("), exp, s (")"))),
-      exp = memo $ eta (failure ("expression parsing not implemented\n"));
+local primary = memo $ eta syntax (x=decimal {Const (stringInt (x))} |
+                                   x=lident  {Var (x)}               |
+                                   inbr[s("("), exp, s(")")]),
+      binop = fun (l, op, r) {Binop(op, l, r)},
+      ops = {[Left, [s("!!"), binop] : {}],
+             [Left, [s("&&"), binop]: {}],
+             [Nona, [s("<") | s(">") | s(">=") | s("<=") | s("==") | s("!="), binop] : {}],
+             [Left, [s("+") | s("-"), binop] : {}],
+             [Left, [s("*") | s("/") | s("%"), binop] : {}]},
+      exp = memo $ eta expr(ops, primary);
+local stmt = memo $ eta syntax (
+       kWrite x = inbr[s("("), exp, s(")")] {Write(x)} |
+       kRead x = inbr[s("("), lident, s(")")] {Read(x)} |
+       x = lident s[":="] y = exp {Assn(x, y)} |
+       x = stmt s[";"] y = stmt end {Seq(x, y)} |
+       kSkip {Skip}|
+       kWhile e=exp kDo s=simpleStmt kOd {While (e, s)}|
+       kRepeat s=simpleStmt kUntil e=exp {Repeat (s, e)}|
+       kFor s1=simpleStmt s[","] e=exp s[","] s2=simpleStmt body=inbr[kDo, simpleStmt, kOd] {Seq(s1, While (e, Seq(body, s2)))}|
+       kIf e=exp kThen s1=simpleStmt s2=parserIf {If (e, s1, s2)}
+);
 
-local stmt = memo $ eta (failure ("statement parsing not implemented\n"));
+local parserIf = memo $ eta syntax (
+      -kFi           {Skip} |
+      -kElse simpleStmt -kFi      |
+       kElif cond=exp kThen s1=simpleStmt s2=parserIf {If (cond, s1, s2)}
+);
+local simpleStmt = memo $ eta syntax (stmt |
+       s1=stmt s[";"] s2=simpleStmt {Seq (s1, s2)});
 
 
 -- Public top-level parser

src/SM.lama

@@ -27,7 +27,17 @@ public fun showSM (prg) {
 -- Stack machine interpreter. Takes an SM-configuration and a program,
 -- returns a final configuration
 fun eval (c, insns) {
-  failure ("SM eval not implemented\n")
+  case c of
+    [s, st, w@[i, o]] -> case insns of
+        {} -> c
+      | BINOP (b) : p -> case s of x : y : ss -> eval ([binopOp (b, y, x) : ss, st, w], p) esac
+      | CONST (n) : p -> eval ([n : s, st, w], p)
+      | READ      : p -> case i of x : it -> eval ([x : s, st, [it, o]], p) esac
+      | WRITE     : p -> case s of x : ss -> eval ([ss, st, [i, x : o]], p) esac
+      | LD    (x) : p -> eval ([st (x) : s, st, w], p)
+      | ST    (x) : p -> case s of y : ss -> eval ([s, (st <- [x, y]), w], p) esac
+    esac
+  esac
 }
 
 -- Runs a stack machine for a given input and a given program, returns an output
@@ -39,12 +49,21 @@ public fun evalSM (input, insns) {
 -- Takes an expression, returns a list (of, possibly, lists)
 -- of stack machine instructions
 fun compileExpr (expr) {
-  failure ("compileExpr not implemented\n")
+  case expr of 
+    Var   (x)         -> singleton (LD (x))
+  | Const (n)         -> singleton (CONST (n))
+  | Binop (b, e1, e2) -> compileExpr (e1) +++ compileExpr (e2) +++ singleton (BINOP (b))
+  esac
 }
 
 -- Compiles a statement into a stack machine code.
 -- Takes a statement, returns a list of stack machine
 -- instructions.
 public fun compileSM (stmt) {
-  failure ("compileSM not implemented\n")
+  case stmt of
+    Assn (x, expr) -> compileExpr (expr) +++ singleton (ST (x))
+  | Read (x)       -> {READ, ST (x)}
+  | Write (expr)   -> compileExpr (expr) +++ singleton (WRITE)
+  | Seq (s1, s2)   -> compileSM (s1) +++ compileSM (s2)
+  esac
 }

src/Stmt.lama

@@ -20,7 +20,19 @@ import World;
 --        Repeat (stmt, expr)
 
 fun eval (c, stmt) {
-  failure ("Stmt eval not implemented\n")
+  case c of [st, [i, o]] ->
+    case stmt of
+        Skip         -> c
+      | Read (x)     -> case i of z : it -> [st <- [x, z], [it, o]] esac
+      | Write (expr) -> [st, [i, evalExpr (st, expr)  : o]]
+      | Assn (x, e)  -> [(st <- [x, evalExpr (st, e)]), [i, o]]
+      | Seq (s1, s2) -> eval (eval (c, s1), s2)
+      | If (expr, s1, s2) -> if (evalExpr(c[0], expr)) then eval (c, s1) else eval (c, s2) fi
+      | Repeat (s, expr) -> local c1 = eval (c, s);
+                                 if (evalExpr(c1[0], expr)) then eval (c1, Skip) else eval (c1, Repeat( s, expr)) fi
+      | While (expr, s) -> if (evalExpr(c[0], expr)) then eval (c, Seq(s, stmt)) else eval (c, Skip) fi
+      esac
+    esac 
 }
 
 -- Evaluates a program with a given input and returns an output

src/X86.lama

@@ -131,7 +131,7 @@ fun makeEnv (stack, stackSlots, globals) {
   }
 
   -- Pops two items from the symbolic stack; returns a triple:
-  -- popped items and an undated environment
+  -- popped items and an updated environment
   fun pop2 () {
     case stack of
       x : y : stack -> [x, y, makeEnv (stack, stackSlots, globals)]
@@ -289,7 +289,34 @@ fun compile (env, code) {
             case env.pop of
               [s, env] -> [env, code <+ Push (s) <+ Call ("Lwrite") <+ Pop (eax)]
             esac
-        | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string)
+        | CONST (n) ->
+            case env.allocate of
+              [s, env] -> [env, code <+ Mov (L (n), s)]
+            esac
+        | ST (x) -> 
+            case env.addGlobal (x).pop of
+              [s, env] -> [env, code <+> move (s, env.loc (x))]
+            esac   
+        | LD (x) ->
+            case env.allocate of
+              [s, env] -> [env, code <+> move (env.loc (x), s)]
+            esac
+        | BINOP (op) ->
+            case env.pop2 of
+              [x, y, env] -> 
+              case env.allocate of
+                [s, env] -> case op of
+            "+" -> [env, code <+ Mov (y, eax) <+ Binop("+", x, eax) <+ Mov (eax, s)]
+          | "-" -> [env, code <+ Mov (y, eax) <+ Binop("-", x, eax) <+ Mov (eax, s)]
+          | "*" -> [env, code <+ Mov (y, eax) <+ Binop("*", x, eax) <+ Mov (eax, s)]
+          | "&&" -> [env, code <+  Mov (y, edx) <+ Binop ("*", x, edx) <+ Binop ("cmp", L (0), edx) <+ Mov (L (0), eax) <+ Set ("ne", "%al") <+ Mov (eax, s)]
+          | "!!" -> [env, code <+  Mov (y, edx) <+ Binop ("!!", x, edx) <+ Binop ("cmp", L (0), edx) <+ Mov (L(0), eax) <+ Set ("ne", "%al") <+ Mov (eax, s)]
+          | "/" -> [env, code <+ Mov (y, eax) <+ Cltd  <+ IDiv (x)  <+ Mov (eax, s)]
+          | "%" -> [env, code <+ Mov (y, eax) <+ Cltd <+ IDiv (x) <+ Mov (edx, s)]
+          | _ -> [env, code <+ Mov (x, eax) <+ Binop ("cmp", eax, y)<+ Mov(L(0), eax)  <+ Set (suffix (op), "%al") <+ Mov (eax, s)]
+          esac
+              esac
+           esac
         esac
       }, [env, emptyBuffer ()], code)
   }
@@ -319,7 +346,7 @@ public fun compileX86 (args, code) {
                         code <+>
                         epilogue ()
                       )
-                   ).stringcat);
+                    ).stringcat);
 
        system ({"gcc -g -m32 -o ", args.getBaseName, " ", runtime, " ", asmFile}.stringcat)
   esac