Belyakov Artem HW3

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

@@ -15,9 +15,21 @@ fun inbr (l, p, r) {
 local primary = memo $ eta syntax (x=decimal {Const (stringInt (x))} |
                                    x=lident  {Var (x)}               |
                                    inbr[s("("), exp, s(")")]),
-      exp = memo $ eta (failure ("expression parsing not implemented\n"));
+      binOps = fun(l, op, r) {Binop(op, l, r)},
+      ops = {
+		[Left, [s ("!!"), binOps] : {}],
+		[Left, [s ("&&"), binOps] : {}],
+		[Nona, [s ("<") | s (">") | s ("<=") | s (">=") | s ("==") | s ("!="), binOps] : {}],
+		[Left, [s ("+") | s ("-"), binOps] : {}],
+		[Left, [s ("*") | s ("/") | s ("%"), binOps] : {}]},
+      exp = memo $ eta expr (ops, primary) ;
 
-local stmt = memo $ eta (failure ("statement parsing not implemented\n"));
+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)}   |
+  	st1=stmt s[";"] st2=stmt end          {Seq (st1, st2)}
+);
 
 
 -- 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

@@ -17,7 +17,15 @@ import World;
 --        Write  (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)
+      esac
+    esac 
 }
 
 -- Evaluates a program with a given input and returns an output

src/X86.lama

@@ -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)
   }