[HSE] A03 Ekaterina Nikolaeva

src/Expr.lama

@@ -13,6 +13,29 @@ import State;
 --        Const (int)                |
 --        Binop (string, expr, expr)
 
+public fun evalOp (op, l, r) {
+  case op of
+    "+" -> l + r
+  | "-" -> l - r
+  | "*" -> l * r
+  | "/" -> l / r
+  | "%" -> l % r
+  | "<" -> l < r
+  | "<=" -> l <= r
+  | ">" -> l > r
+  | ">=" -> l >= r
+  | "==" -> l == r
+  | "!=" -> l != r
+  | "&&" -> l && r
+  | "!!" -> l !! r
+  esac
+
+}
+
 public fun evalExpr (st, expr) {
-  failure ("evalExpr not implemented\n")
+  case expr of
+    Var (x) -> st (x)
+  | Const (n) -> n
+  | Binop (op, l, r) -> evalOp (op, evalExpr(st, l), evalExpr(st, r))
+  esac
 }

src/Parser.lama

@@ -15,9 +15,46 @@ fun inbr (l, p, r) {
 var 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"));
+      exp = memo $ eta expr ({
+        [Right, {
+          [s(":="), fun(l, op, r) {Assn(l, r)}]
+        }],
+        [Left, {
+          [s("!!"), fun(l, op, r) {Binop(op, l, r)}]
+        }],
+        [Left, {
+          [s("&&"), fun(l, op, r) {Binop(op, l, r)}]
+        }],
+        [Nona, {
+          [s("=="), fun(l, op, r) {Binop(op, l, r)}],
+          [s("!="), fun(l, op, r) {Binop(op, l, r)}],
+          [s("<="), fun(l, op, r) {Binop(op, l, r)}],
+          [s("<"), fun(l, op, r) {Binop(op, l, r)}],
+          [s(">"), fun(l, op, r) {Binop(op, l, r)}],
+          [s(">="), fun(l, op, r) {Binop(op, l, r)}]
+        }],
+        [Left, {
+          [s("+"), fun(l, op, r) {Binop(op, l, r)}],
+          [s("-"), fun(l, op, r) {Binop(op, l, r)}]
+        }],
+        [Left, {
+          [s("*"), fun(l, op, r) {Binop(op, l, r)}],
+          [s("/"), fun(l, op, r) {Binop(op, l, r)}],
+          [s("%"), fun(l, op, r) {Binop(op, l, r)}]
+        }]
+    }, primary);
 
-var stmt = memo $ eta (failure ("statement parsing not implemented\n"));
+var line = memo $ eta syntax (
+  kRead name=inbr[s("("), lident, s(")")] {Read(name)} |
+  kWrite e=inbr[s("("), exp, s(")")] {Write(e)} |
+  kSkip {Skip} |
+  name=lident s[":="] e=exp {Assn(name, e)}
+);
+
+var stmt = memo $ eta syntax (
+  line |
+  head=line s[";"] tail=stmt {Seq(head, tail)}
+);
 
 
 -- Public top-level parser

src/SM.lama

@@ -26,8 +26,25 @@ public fun showSM (prg) {
 
 -- Stack machine interpreter. Takes an SM-configuration and a program,
 -- returns a final configuration
+
+fun evalInsn ([stack, states, world], insn) {
+  case insn of
+    CONST (n) -> [n:stack, states, world]
+  | ST (x) -> [snd (stack), states <- [x, fst (stack)], world]
+  | READ -> [fst (readWorld(world)):stack, states, snd (readWorld(world))]
+  | LD (x) -> [states(x):stack, states, world]
+  | WRITE -> [snd (stack), states, writeWorld (fst (stack), world)]
+  | BINOP (op) -> case stack of
+                    r:l:tail -> [evalOp(op, l, r):tail, states, world]
+                  esac
+  esac
+}
+
 fun eval (c, insns) {
-  failure ("SM eval not implemented\n")
+  case insns of
+    {} -> c
+  | head:tail -> eval(evalInsn(c, head), tail)
+  esac
 }
 
 -- Runs a stack machine for a given input and a given program, returns an output
@@ -39,12 +56,22 @@ public fun evalSM (input, insns) {
 -- 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 (n) -> {CONST (n)}
+  | Binop (op, l, r) -> compileExpr(l) +++ compileExpr(r) +++ {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
+    Read (x) -> {READ, ST (x)}
+  | Write (expr) -> compileExpr(expr) +++ {WRITE}
+  | Seq (l, r) -> compileSM(l) +++ compileSM(r)
+  | Assn (x, e) -> compileExpr(e) +++ {ST (x)}
+  | Skip -> {}
+  esac
 }

src/Stmt.lama

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

src/X86_64.lama

@@ -286,6 +286,30 @@ fun suffix (op) {
   esac
 }
 
+fun compileBinop (code, op, l, r, s) {
+  fun castToBool(st, reg, subreg) {
+    singletonBuffer (Binop("^", reg, reg)) <+ Binop("cmp", st, reg) <+ Set ("ne", subreg)
+  }
+
+  fun cmpBinop(suf) {
+    singletonBuffer(Binop("^", rax, rax)) <+ Binop("cmp", l, r) <+ Set (suf, "%al") <+ Mov (rax, s)
+  }
+
+  case op of
+    "/" -> code <+> move(r, rax) <+ Cltd <+ IDiv(l) <+ Mov (rax, s)
+  | "%" -> code <+> move(r, rax) <+ Cltd <+ IDiv(l) <+ Mov (rdx, s)
+  | "<" -> code <+> cmpBinop("l")
+  | ">" -> code <+> cmpBinop("g")
+  | ">=" -> code <+> cmpBinop("ge")
+  | "<=" -> code <+> cmpBinop("le")
+  | "==" -> code <+> cmpBinop("e")
+  | "!=" -> code <+> cmpBinop("ne")
+  | "&&" -> code <+> castToBool(l, rax, "%al") <+> castToBool(r, rdx, "%dl") <+ Binop("&&", rax, rdx) <+ Mov (rdx, s)
+  | "!!" -> code <+> castToBool(l, rax, "%al") <+> castToBool(r, rdx, "%dl") <+ Binop("!!", rax, rdx) <+ Mov (rdx, s)
+  | _ -> code <+ Binop(op, l, r) <+ Mov (r, s)
+  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) {
@@ -301,6 +325,24 @@ fun compile (env, code) {
           case env.pop of
             [s, env] -> [env, code <+ Mov (s, rdi) <+ Call ("Lwrite")]
           esac
+            | LD (x) ->
+          case env.addGlobal (x).allocate of
+            [s, env] -> [env, code <+> move (env.loc (x), s)]
+          esac
+      | ST (x) ->
+          case env.addGlobal (x).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
+      | BINOP (op) ->
+          case env.pop2 of
+	          [l, r, env] -> case env.allocate of
+              [s, env] -> [env, compileBinop(code, op, l, r, s)]
+            esac
+          esac
       | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string)
         esac
     }, [env, emptyBuffer ()], code)