A02 Domoratsky Eridan

.gitignore

@@ -3,6 +3,7 @@
 !*.*
 *.aux
 *.log
+*.run
 !/regression/orig/*.log
 *.out
 *.o
@@ -11,4 +12,4 @@
 *.i
 *.s
 !Makefile
-~/runrime/gc_runtime.s
+~/runrime/gc_runtime.s

src/Expr.lama

@@ -14,5 +14,27 @@ 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, lhs, rhs) ->
+    var lv = evalExpr (st, lhs);
+    var rv = evalExpr (st, rhs);
+
+    case op of
+      "+" -> lv + rv
+    | "-" -> lv - rv
+    | "*" -> lv * rv
+    | "/" -> lv / rv
+    | "%" -> lv % rv
+    | "==" -> lv == rv
+    | "!=" -> lv != rv
+    | "<" -> lv < rv
+    | "<=" -> lv <= rv
+    | ">" -> lv > rv
+    | ">=" -> lv >= rv
+    | "!!" -> lv !! rv
+    | "&&" -> lv && rv
+    esac
+  esac
 }

src/SM.lama

@@ -26,8 +26,36 @@ 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")
+fun eval ([stack, st, w], insns) {
+  case insns of
+    {} -> [stack, st, w]
+  | ins:insns -> case ins of
+      READ       -> case readWorld (w) of [x, w] -> eval ([x:stack, st, w], insns) esac
+    | WRITE      -> case stack of v:stack -> eval ([stack, st, writeWorld (v, w)], insns) esac
+    | BINOP (op) -> case stack of b:a:stack ->
+        var res = case op of
+          "+" -> a + b
+        | "-" -> a - b
+        | "*" -> a * b
+        | "/" -> a / b
+        | "%" -> a % b
+        | "==" -> a == b
+        | "!=" -> a != b
+        | "<" -> a < b
+        | "<=" -> a <= b
+        | ">" -> a > b
+        | ">=" -> a >= b
+        | "!!" -> a !! b
+        | "&&" -> a && b
+        esac;
+
+        eval ([res:stack, st, w], insns)
+      esac
+    | LD    (x)  -> eval ([st (x):stack, st, w], insns)
+    | ST    (x)  -> case stack of v:stack -> eval ([stack, st <- [x, v], w], insns) esac
+    | CONST (v)  -> eval ([v:stack, st, w], insns)
+    esac
+  esac
 }
 
 -- Runs a stack machine for a given input and a given program, returns an output
@@ -38,12 +66,26 @@ public fun evalSM (input, insns) {
 -- Compiles an expression into a stack machine code.
 -- Takes an expression, returns a list of stack machine instructions
 fun compileExpr (expr) {
-  failure ("compileExpr not implemented\n")
+  case expr of
+    Var   (x)   -> { LD (x) }
+  | Const (x)   -> { CONST (x) }
+  | Binop (op, lhs, rhs) -> BINOP (op):compileExpr (rhs) +++ compileExpr (lhs)
+  esac
+}
+
+public fun compileStmt (stmt) {
+  case stmt of
+    Assn  (x, v) -> ST (x):compileExpr (v)
+  | Seq   (a, b) -> compileStmt (b) +++ compileStmt (a)
+  | Skip         -> {}
+  | Read  (x)    -> { ST (x), READ }
+  | Write (x)    -> WRITE:compileExpr (x)
+  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")
+  reverse (compileStmt (stmt))
 }

src/Stmt.lama

@@ -16,8 +16,14 @@ import World;
 --        Read   (string)           |
 --        Write  (expr)             |
 
-fun eval (c, stmt) {
-  failure ("Stmt eval not implemented\n")
+fun eval ([st, w], stmt) {
+  case stmt of
+    Assn  (x, v) -> [st <- [x, evalExpr (st, v)], w]
+  | Seq   (a, b) -> eval (eval ([st, w], a), b)
+  | Skip         -> [st, w]
+  | Read  (x)    -> case readWorld (w) of [v, w] -> [st <- [x, v], w] esac
+  | Write (x)    -> [st, writeWorld (evalExpr (st, x), w)]
+  esac
 }
 
 -- Evaluates a program with a given input and returns an output

src/X86.lama

@@ -287,7 +287,73 @@ 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)
+      | BINOP (op) -> case env.pop2 of [s, z, env] ->
+          case env.allocate of [r, env] ->
+            var newCode = case op of
+              "+" -> code <+ Binop ("+", s, z) <+> move (z, r)
+            | "-" -> code <+ Binop ("-", s, z) <+> move (z, r)
+            | "*" -> code <+ Binop ("*", s, z) <+> move (z, r)
+            | "/" -> code <+ Mov (z, eax) <+ Cltd <+ IDiv (s) <+ Mov (eax, r)
+            | "%" -> code <+ Mov (z, eax) <+ Cltd <+ IDiv (s) <+ Mov (edx, r)
+            | "==" -> code
+              <+ Binop ("^", eax, eax)
+              <+ Binop ("cmp", s, z)
+              <+ Set ("e", "%al")
+              <+ Mov (eax, r)
+            | "!=" -> code
+              <+ Binop ("^", eax, eax)
+              <+ Binop ("cmp", s, z)
+              <+ Set ("ne", "%al")
+              <+ Mov (eax, r)
+            | "<" -> code
+              <+ Binop ("^", eax, eax)
+              <+ Binop ("cmp", s, z)
+              <+ Set ("l", "%al")
+              <+ Mov (eax, r)
+            | "<=" -> code
+              <+ Binop ("^", eax, eax)
+              <+ Binop ("cmp", s, z)
+              <+ Set ("le", "%al")
+              <+ Mov (eax, r)
+            | ">" -> code
+              <+ Binop ("^", eax, eax)
+              <+ Binop ("cmp", s, z)
+              <+ Set ("g", "%al")
+              <+ Mov (eax, r)
+            | ">=" -> code
+              <+ Binop ("^", eax, eax)
+              <+ Binop ("cmp", s, z)
+              <+ Set ("ge", "%al")
+              <+ Mov (eax, r)
+            | "!!" -> code
+              <+ Binop ("!!", s, z)
+              <+ Mov (z, edx)
+              <+ Binop ("^", eax, eax)
+              <+ Meta ("\ttest\t%edx,\t%edx\n")
+              <+ Set ("z", "%al")
+              <+ Mov (eax, r)
+            | "&&" -> code
+              <+ Binop ("&&", s, z)
+              <+ Mov (z, edx)
+              <+ Binop ("^", eax, eax)
+              <+ Meta ("\ttest\t%edx,\t%edx\n")
+              <+ Set ("z", "%al")
+              <+ Mov (eax, r)
+            esac;
+
+            [env, newCode]
+          esac
+        esac
+      | LD    (x) -> case env.allocate of [s, env] ->
+          env := env.addGlobal (x);
+          [env, code <+> move (env.loc (x), s)]
+        esac
+      | ST    (x) -> case env.pop of
+          [s, env] -> [env, code <+> move (s, env.loc (x))]
+        esac
+      | CONST (n) -> case env.allocate of
+          [s, env] -> [env, code <+ Mov (L (n), s)]
+        esac
       esac
     }, [env, emptyBuffer ()], code)
 }