[SPBGU] A02 Mishchenko Stanislav

src/Expr.lama

@@ -13,6 +13,28 @@ import State;
 --        Const (int)                |
 --        Binop (string, expr, expr)
 
+public fun applyBinop(op, x, y) {
+  case op 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
+}
+
 public fun evalExpr (st, expr) {
-  failure ("evalExpr not implemented\n")
+  case expr of
+      Var (x) -> st(x)
+    | Const (i) -> i
+    | Binop (op, e1, e2) -> applyBinop (op, evalExpr (st, e1), evalExpr (st, e2))
+  esac
 }

src/SM.lama

@@ -1,4 +1,5 @@
 -- Stack machine.
+-- SM CONFIG: [STACK, [STATE, WORLD]]
 
 import List;
 import World;
@@ -24,10 +25,39 @@ public fun showSM (prg) {
   map (fun (i) {showSMInsn (i) ++ "\n"}, prg).stringcat
 }
 
+fun stack(x) { x[0] }
+
+fun state(x) { x[1] }
+
+fun world(x) { x[2] }
+
+fun evalRead (c) {
+  var newWorld;
+  newWorld := readWorld(c.world);
+  [newWorld.fst : c.stack, c.state, newWorld.snd]
+}
+
+fun evalIns (c, i) {
+  case i of 
+    READ      -> evalRead (c)
+  | WRITE     -> [c.stack.tl, c.state, writeWorld (c.stack.hd, c.world)]
+  | BINOP (s) -> 
+    case c.stack of
+      x : y : tl -> [applyBinop (s, y, x) : tl, c.state, c.world]
+    esac
+  | LD    (x) -> [state(c) (x) : c.stack, c.state, c.world]
+  | ST    (x) -> [c.stack.tl, (c.state <- [x, c.stack.hd]), c.world]
+  | CONST (n) -> [n : c.stack, c.state, c.world]
+  esac
+}
+
 -- 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 insns of
+    i : insns_tail -> eval(evalIns(c, i), insns_tail)
+    | {} -> c
+  esac
 }
 
 -- Runs a stack machine for a given input and a given program, returns an output
@@ -38,12 +68,22 @@ 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 (i) -> { CONST (i) }
+    | Binop (op, e1, e2) -> compileExpr(e1) +++ compileExpr (e2) +++ { BINOP (op) }
+  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, e) -> compileExpr (e) +++ { ST (x) }
+    | Seq (s1, s2) -> compileSM (s1) +++ compileSM (s2)
+    | Skip -> {}
+    | Read (x) ->  READ : { ST (x) }
+    | Write (e) -> compileExpr (e) +++ { WRITE }
+  esac
 }

src/Stmt.lama

@@ -16,8 +16,20 @@ import World;
 --        Read   (string)           |
 --        Write  (expr)             |
 
+fun evalRead (c, x) {
+  var newWorld;
+  newWorld := readWorld(c.snd);
+  [(c.fst <- [x, newWorld.fst]), newWorld.snd]
+}
+
 fun eval (c, stmt) {
-  failure ("Stmt eval not implemented\n")
+  case stmt of
+      Assn (x, e) -> [c.fst <- [x, evalExpr (c.fst, e)], c.snd]
+    | Seq (s1, s2) -> eval (eval (c, s1), s2)
+    | Skip -> c
+    | Read (x) -> evalRead(c, x)
+    | Write (e) -> [c.fst, writeWorld (evalExpr (c.fst, e), c.snd)]
+  esac
 }
 
 -- Evaluates a program with a given input and returns an output

src/X86_64.lama

@@ -285,6 +285,25 @@ fun suffix (op) {
   esac
 }
 
+fun asmOp (op) {
+  var cmp_op = "cmp";
+  case op of
+    "+" -> "+"
+  | "-" -> "-"
+  | "*" -> "*"
+  | "/" -> "/"
+  | "%" -> "%"
+  | "<" -> cmp_op
+  | ">" -> cmp_op
+  | "<=" -> cmp_op
+  | ">=" -> cmp_op
+  | "==" -> cmp_op
+  | "!=" -> cmp_op
+  | "&&" -> "&&"
+  | "!!" -> "!!"
+  esac
+}
+
 -- Compiles stack machine code into a list of x86 instructions. Takes an environment
 -- and stack machine code, returns an updated environment and x86 code.
 fun compile (env, code) {
@@ -300,6 +319,55 @@ fun compile (env, code) {
           case env.pop of
             [s, env] -> [env, code <+ Mov (s, rdi) <+ Call ("Lwrite")]
           esac
+      | BINOP (op) ->
+          case asmOp (op) of
+            "/" -> case env.pop2 of
+                     [x, y, env] -> [env.push (y), code <+ Mov (y, rax) <+ Cltd <+ IDiv (x) <+ Mov (rax, y)]
+                   esac
+          | "%" -> case env.pop2 of
+                     [x, y, env] -> [env.push (y), code <+ Mov (y, rax) <+ Cltd <+ IDiv (x) <+ Mov (rdx, y)]
+                   esac
+          | "cmp" -> case env.pop2 of
+                       [x, y, env] -> [env.push (y), code <+ Binop("^", rax, rax)
+                                                          <+ Binop ("cmp", x, y) <+ Set (suffix (op), "%al")
+                                                          <+ Mov (rax, y)]
+                     esac
+          | "!!" -> case env.pop2 of
+                        [x, y, env] -> [env.push (y), code -- <+ Mov (L(0), rax)
+                                                           <+ Binop("^", rax, rax)
+                                                           <+ Binop("^", rdx, rdx)
+                                                           <+ Binop ("cmp", x, rax) <+ Set (suffix ("!="), "%dl")
+                                                           <+ Binop ("cmp", y, rax) <+ Set (suffix ("!="), "%al")
+                                                           <+ Binop ("!!", rdx, rax)
+                                                           <+ Mov (rax, y)]
+                    esac
+          | "&&" -> case env.pop2 of
+                        [x, y, env] -> [env.push (y), code -- <+ Mov (L(0), rax)
+                                                           <+ Binop("^", rax, rax)
+                                                           <+ Binop("^", rdx, rdx)
+                                                           <+ Binop ("cmp", x, rax) <+ Set (suffix ("!="), "%dl")
+                                                           <+ Binop ("cmp", y, rax) <+ Set (suffix ("!="), "%al")
+                                                           <+ Binop ("&&", rax, rdx)
+                                                           <+ Mov (rax, y)]
+                    esac
+          | asm_op -> case env.pop2 of
+                        [x, y, env] -> [env.push (y), code <+ Binop (asm_op, x, y)]
+                    esac
+          esac
+      | CONST (n) ->
+          case env.allocate of
+            [s, env] -> [env, code <+ Mov (L (n), s)]
+          esac
+      | LD (x) ->
+          case env.allocate of
+            [s, env] -> [env, code <+ Mov (env.loc (x), s)]
+          esac
+      | ST (x) ->
+          case env.addGlobal (x) of
+            env -> case env.pop of
+                     [s, env] -> [env, code <+ Mov (s, env.loc (x))]
+                   esac
+          esac
       | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string)
       esac
     }, [env, emptyBuffer ()], code)
@@ -322,4 +390,4 @@ public fun compileX86 (code) {
               )
            ).stringcat
   esac
-}
+}