[ITMO] T04 Svetlana Antoshkina

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(n) -> n
+   | Binop(op, e1, e2) -> evalBinop(op, evalExpr(st, e1), evalExpr(st, e2))
+   esac
+}
+
+public fun evalBinop(op, e1, e2) {
+   case op of
+     "+" -> e1 + e2
+   | "-" -> e1 - e2
+   | "*" -> e1 * e2
+   | "/" -> e1 / e2
+   | "%" -> e1 % e2
+   | "<" -> e1 < e2
+   | ">" -> e1 > e2
+   | "<=" -> e1 <= e2
+   | ">=" -> e1 >= e2
+   | "==" -> e1 == e2
+   | "!=" -> e1 != e2
+   | "&&" -> e1 && e2
+   | "!!" -> e1 !! e2
+   esac
 }

src/Parser.lama

@@ -13,13 +13,50 @@ fun inbr (l, p, r) {
 }
 
 -- Primary expression
-var 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"));
+var primary = memo $ eta syntax (x=decimal {Const (stringInt (x))} |
+                                 x=lident  {Var (x)}               |
+                                 inbr[s("("), exp, s(")")]),
+    exp = memo $ eta (expr(
+      {
+        [Left, {[s("!!"), fun (l, op, r) {Binop ("!!", l, r)}],
+                [s("&&"), fun (l, op, r) {Binop ("&&", l, r)}]}],
+        [Nona, {[s("=="), fun (l, op, r) {Binop ("==", l, r)}],
+                [s("!="), fun (l, op, r) {Binop ("!=", l, r)}],
+                [s("<="), fun (l, op, r) {Binop ("<=", l, r)}],
+                [s("<"),  fun (l, op, r) {Binop ("<",  l, r)}],
+                [s(">="), fun (l, op, r) {Binop (">=", l, r)}],
+                [s(">"),  fun (l, op, r) {Binop (">",  l, r)}]}],
+        [Left, {[s("+"),  fun (l, op, r) {Binop ("+",  l, r)}],
+                [s("-"),  fun (l, op, r) {Binop ("-",  l, r)}]}],
+        [Left, {[s("*"),  fun (l, op, r) {Binop ("*",  l, r)}],
+                [s("/"),  fun (l, op, r) {Binop ("/",  l, r)}],
+                [s("%"),  fun (l, op, r) {Binop ("%",  l, r)}]}]
+      },
+      primary
+    ));
 
-var stmt = memo $ eta (failure ("statement parsing not implemented\n"));
+var elseStmt = memo $ eta syntax (
+  kElif e=exp kThen s1=parse s2=elseStmt {If(e, s1, s2)} |
+  kElse s2=parse kFi {s2} |
+  kFi {Skip}
+);
+
+var stmt = memo $ eta syntax (
+  kSkip {Skip} |
+  kRead x=inbr[s("("), lident, s(")")] {Read (x)} |
+  kWrite x=inbr[s("("), exp, s(")")] {Write (x)} |
+  x=lident s[":="] e=exp {Assn (x, e)} |
+  kIf e=exp kThen s1=parse s2=elseStmt {If(e, s1, s2)} |
+  kThen {Skip} |
+  kWhile e=exp kDo s=parse kOd {While (e, s)} |
+  kDo s=parse kWhile e=exp kOd {DoWhile (e, s)} |
+  kFor s1=parse s[","] e=exp s[","] s2=parse kDo s=parse kOd {Seq(s1, While (e, Seq(s, s2)))}
+);
 
 
 -- Public top-level parser
-public parse = stmt;
+public parse = memo $ eta syntax (
+  stmt |
+  s1=stmt s[";"] s2=parse {Seq (s1, s2)}
+);
+

src/SM.lama

@@ -54,8 +54,26 @@ fun fromLabel (env, lab) {
 
 -- Stack machine interpreter. Takes an environment, an SM-configuration and a program,
 -- returns a final configuration
-fun eval (env, c, insns) {
-  failure ("SM eval not implemented\n")
+fun eval (env, c@[stack, st, w], insns) {
+  case insns of
+     i:rest -> case i of
+        READ      -> let [n, w1] = readWorld(w) in eval(env, [n:stack, st, w1], rest)
+      | WRITE     -> let v:stack1 = stack in eval(env, [stack1, st, writeWorld(v, w)], rest)
+      | BINOP(op) -> let v2:v1:stack1 = stack in eval(env, [evalBinop(op, v1, v2):stack1, st, w], rest)
+      | LD(x)     -> eval(env, [st(x):stack, st, w], rest)
+      | ST(x)     -> let v:stack1 = stack in eval(env, [stack1, st <- [x, v], w], rest)
+      | CONST(n)  -> eval(env, [n:stack, st, w], rest)
+      | LABEL (s) -> eval(env, c, rest)
+      | JMP (l)   -> eval(env, c, fromLabel(env, l))
+      | CJMP (c, l) -> 
+        let v:stack1 = stack in
+        case c of
+          "z"  -> if v == 0 then eval(env, [stack1, st, w], fromLabel(env, l)) else eval(env, [stack1, st, w], rest) fi
+        | "nz" -> if v != 0 then eval(env, [stack1, st, w], fromLabel(env, l)) else eval(env, [stack1, st, w], rest) fi
+        esac
+      esac
+   | {} -> c
+   esac
 }
 
 -- Runs a stack machine for a given input and a given program, returns an output
@@ -96,7 +114,11 @@ fun genLabels (env, n) {
 -- 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) -> singletonBuffer(LD(x))
+   | Const(n) -> singletonBuffer (CONST(n))
+   | Binop(op, e1, e2) -> compileExpr(e1) <+> compileExpr(e2) <+> singletonBuffer(BINOP(op))
+   esac
 }
 
 -- Compiles a statement into a stack machine code.
@@ -137,7 +159,31 @@ public fun compileSM (stmt) {
                   esac
              esac
         esac
-    | _              -> failure ("compileSM not implemented\n")
+    | If(expr, s1, s2) -> 
+        let [elseLab, env] = env.genLabel in
+        let [_, env, thenBody] = compile (lab, env, s1) in
+        let [_, env, elseBody] = compile (lab, env, s2) in
+          [true, env, 
+            compileExpr(expr) 
+            <+ CJMP ("z", elseLab) 
+            <+> thenBody 
+            <+ JMP (lab) 
+            <+ LABEL (elseLab) 
+            <+> elseBody
+          ]
+    | While(expr, s)  -> 
+        let [condLab, bodyLab, env] = env.genLabels (2) in
+        let [_, env, cond] = compile (condLab, env, s) in
+          [false, env, 
+            singletonBuffer (JMP (condLab))
+            <+ LABEL (bodyLab) 
+            <+> cond
+            <+ LABEL (condLab)  
+            <+> compileExpr (expr)
+            <+ CJMP ("nz", bodyLab)
+          ]
+    | DoWhile(expr, s) -> 
+        compile(lab, env, Seq(s, While(expr, s)))
     esac
   }  
 

src/Stmt.lama

@@ -10,19 +10,29 @@ import World;
 --
 -- A statement is represented by a data structure of the following shape:
 --
--- stmt = Assn    (string, expr)     |
---        Seq     (stmt, stmt)       |
---        Skip                       |
---        Read    (string)           |
---        Write   (expr)             |
+-- stmt = Assn   (string, expr)     |
+--        Seq    (stmt, stmt)       |
+--        Skip                      |
+--        Read   (string)           |
+--        Write  (expr)             |
 --        If      (expr, stmt, stmt) |
 --        While   (expr, stmt)       |
 --        DoWhile (stmt, expr)
 
-fun eval (c, stmt) {
-  failure ("Stmt eval not implemented\n")
+fun eval (c@[st, w], stmt) {
+   case stmt of
+     Assn(x, e) -> [st <- [x, evalExpr(st, e)], w]
+   | Seq(stmt1, stmt2) -> eval(eval(c, stmt1), stmt2)
+   | Skip -> c
+   | Read(x) -> let [res, w1] = readWorld(w) in [st <- [x, res], w1]
+   | Write(e) -> [st, writeWorld(evalExpr(st, e), w)]
+   | If(e, s1, s2) -> if evalExpr(st, e) != 0 then eval(c, s1) else eval(c, s2) fi
+   | While(e, s) -> if evalExpr(st, e) != 0 then eval(eval(c, s), stmt) else c fi
+   | DoWhile(e, s) -> eval(eval(c, s), While(e, s))
+   esac
 }
 
+
 -- Evaluates a program with a given input and returns an output
 public fun evalStmt (input, stmt) {
   eval ([emptyState, createWorld (input)], stmt).snd.getOutput

src/X86_64.lama

@@ -292,6 +292,37 @@ fun suffix (op) {
   esac
 }
 
+-- Helper function to compile binary operations
+fun compileBinop (op, env, code) {
+  case env.pop2 of 
+    [s1, s2, env] -> case env.allocate of 
+      [s, env] -> [env, 
+        case op of
+          "+" -> code <+ Mov (s2, rax) <+ Binop (op, s1, rax) <+ Mov (rax, s)
+        | "-" -> code <+ Mov (s2, rax) <+ Binop (op, s1, rax) <+ Mov (rax, s)
+        | "*" -> code <+ Mov (s2, rax) <+ Binop (op, s1, rax) <+ Mov (rax, s)
+        | "/" -> code <+ Mov (s2, rax) <+ Cltd <+ IDiv (s1) <+ Mov (rax, s)
+        | "%" -> code <+ Mov (s2, rax) <+ Cltd <+ IDiv (s1) <+ Mov (rdx, s)
+        | "<" -> code <+ Binop ("cmp", s1, s2) <+ Set (suffix(op), "%al") <+ Binop ("&&", L (1), rax) <+ Mov (rax, s)
+        | ">" -> code <+ Binop ("cmp", s1, s2) <+ Set (suffix(op), "%al") <+ Binop ("&&", L (1), rax) <+ Mov (rax, s)
+        | "<=" -> code <+ Binop ("cmp", s1, s2) <+ Set (suffix(op), "%al") <+ Binop ("&&", L (1), rax) <+ Mov (rax, s)
+        | ">=" -> code <+ Binop ("cmp", s1, s2) <+ Set (suffix(op), "%al") <+ Binop ("&&", L (1), rax) <+ Mov (rax, s)
+        | "==" -> code <+ Binop ("cmp", s1, s2) <+ Set (suffix(op), "%al") <+ Binop ("&&", L (1), rax) <+ Mov (rax, s)
+        | "!=" -> code <+ Binop ("cmp", s1, s2) <+ Set (suffix(op), "%al") <+ Binop ("&&", L (1), rax) <+ Mov (rax, s)
+        | "&&" -> code 
+            <+ Mov (L (0), rax) <+ Binop ("cmp", rax, s1) <+ Set ("ne", "%al") <+ Mov (rax, s1)
+            <+ Mov (L (0), rax) <+ Binop ("cmp", rax, s2) <+ Set ("ne", "%al") <+ Mov (rax, s2)
+            <+ Binop ("&&", s1, s2) <+ Mov (s2, s)
+        | "!!" -> code 
+            <+ Mov (L (0), rax) <+ Binop ("cmp", rax, s1) <+ Set ("ne", "%al") <+ Mov (rax, s1)
+            <+ Mov (L (0), rax) <+ Binop ("cmp", rax, s2) <+ Set ("ne", "%al") <+ Mov (rax, s2)
+            <+ Binop ("!!", s1, s2) <+ Mov (s2, s)
+        esac
+      ]
+    esac
+  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) {
@@ -307,6 +338,30 @@ fun compile (env, code) {
           case env.pop of
             [s, env] -> [env, code <+ Mov (s, rdi) <+ Call ("Lwrite")]
           esac
+      | CONST(n) ->
+          case env.allocate of
+            [s, env] -> [env, code <+ Mov (L(n), s)]
+          esac
+      | LD(x) ->
+          let env = env.addGlobal(x)
+          in case env.allocate of
+            [s, env] -> [env, code <+> move(env.loc(x), s)]
+          esac
+      | ST(x) ->
+          let env = env.addGlobal(x)
+          in case env.pop of
+            [s, env] -> [env, code <+> move(s, env.loc(x))]
+          esac
+      | BINOP(op) ->
+          compileBinop(op, env, code)
+      | LABEL(l) ->
+          [env, code <+ Label(l)]
+      | JMP(l) ->
+          [env, code <+ Jmp(l)]
+      | CJMP(c, l) ->
+          case env.pop of
+            [s, env] -> [env, code <+ Binop("cmp", L(0), s) <+ CJmp(c, l)]
+          esac
       | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string)
       esac
     }, [env, emptyBuffer ()], code)