A06 Цехановская Руслана

src/Expr.lama

@@ -64,7 +64,45 @@ fun evalList (c, exprs) {
 }
 
 fun eval (c@[s, w], expr) {
-  failure ("evalExpr not implemented\n")
+  case expr of
+    Var (str) -> [c, s (str)]
+  | Const (val) -> [c, val]
+  | Binop (str, e1, e2) -> 
+      case evalList (c, {e1, e2}) of
+        [c_, {l, r}] -> [c_, evalOp (str, l, r)]
+      esac
+  | Assn (e1, e2) -> 
+      case evalList (c, {e1, e2}) of
+        [[s_, w_], {Ref (x), v}] -> [[s_ <- [x, v], w_], v]
+      esac
+  | Seq (e1, e2) -> eval (eval (c, e1).fst, e2)
+  | Skip -> [c, Void]
+  | Read (str) -> 
+      case readWorld (w) of
+        [v, w_] -> [[s <- [str, v], w_], Void]
+      esac
+  | Write (e) -> 
+      case eval (c, e) of
+        [[s_, w_], v] -> [[s_, writeWorld (v, w_)], Void]
+      esac
+  | If (cond, e1, e2) -> 
+      case eval (c, cond) of
+        [c_, 0] -> eval (c_, e2)
+      | [c_, _] -> eval (c_, e1)
+      esac
+  | While (cond, e) ->
+      case eval (c, cond) of
+        [c_, 0] -> [c_, Void]
+      | [c_, _] -> eval (eval (c_, e).fst, While (cond, e))
+      esac
+  | Repeat (e, cond) -> 
+      case eval (eval (c, e).fst, cond) of
+        [c_, 0] -> eval (c_, Repeat (e, cond))
+      | [c_, _] -> [c_, Void]
+      esac
+  | Ref (str) -> [c, Ref (str)]
+  | Ignore (e) -> [eval (c, e).fst, Void]
+  esac
 }
 
 

src/Parser.lama

@@ -64,7 +64,15 @@ local primary  = memo $ eta syntax (
                                                                                          | _    -> Var (x)
                                                                                          esac
                                                                                       }} |
-                                    $(failure ("the rest of primary parsing in not implemented\n"))),
+                                    inbr [s ("("), exp, s (")")] |
+                                    loc=pos kSkip {fun (a) {assertVoid (a, Skip, loc)}} |
+                                    loc=pos kRead str=inbr[s ("("), lident, s (")")] {fun (a) {assertVoid (a, Read (str), loc)}} |
+                                    loc=pos kWrite e=inbr[s ("("), exp, s (")")] {fun (a) {assertVoid (a, Write (e (Val)), loc)}} |
+                                    kIf e=exp kThen s=exp ep=elsePart kFi {fun (a) {If (e (Val), s (a), ep (a))}} |
+                                    loc=pos kWhile e=exp kDo s=exp kOd {fun (a) {assertVoid (a, While (e (Val), s (Void)), loc)}} |
+                                    loc=pos kRepeat s=exp kUntil e=basic {fun (a) {assertVoid (a, Repeat (s (Void), e (Val)), loc)}} |
+                                    loc=pos kFor s1=exp s[","] e=exp s[","] s2=exp kDo s3=exp kOd {fun (a) {assertVoid (a, Seq (s1 (Void), While (e (Val), Seq (s3 (Void), s2 (Void)))), loc)}}),
+      elsePart = memo $ eta syntax (s[""] {fun (a) {assertVoid (a, Skip, loc)}} | kElse s=exp {fun (a) {s (a)}} | kElif e=exp kThen s=exp ep=elsePart {fun (a) {If (e (Val), s (a), ep (a))}}),
       basic    = memo $ eta (expr ({[Right, singleton ([s (":="),
                                                         fun (l, loc, r) {
                                                           fun (a) {assertValue (a, Assn (l (Ref), r (Val)), loc)}

src/SM.lama

@@ -60,7 +60,39 @@ 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")
+  local stack = c[0], s = c[1], w = c[2];
+  if insns.size == 0 
+  then return c
+  fi;
+  case insns.hd of
+    READ -> 
+      local v_w = readWorld (w);
+      eval (env, [v_w[0]:stack, s, v_w[1]], insns.tl)
+  | WRITE -> 
+      local v = stack.hd, tale = stack.tl;
+      return eval (env, [tale, s, writeWorld (v, w)], insns.tl)
+  | BINOP (str) -> 
+      local y = stack.hd, x = stack.tl.hd, tale = stack.tl.tl;
+      eval (env, [evalOp (str, x, y):tale, s, w], insns.tl)
+  | LD (x) -> eval (env, [s (x):stack, s, w], insns.tl)
+  | LDA (x) -> eval (env, [Ref (x):stack, s, w], insns.tl)
+  | ST (x) -> eval (env, [stack.tl, s <- [x, stack.hd], w], insns.tl)
+  | STI -> 
+      case stack of
+        v:(Ref (x)):tale -> eval (env, [v:tale, s <- [x, v], w], insns.tl)
+      esac
+  | CONST (n) -> eval (env, [n:stack, s, w], insns.tl)
+  | LABEL (s) -> eval (env, c, insns.tl)
+  | JMP (l) -> eval (env, c, fromLabel (env, l))
+  | CJMP (v, l) -> 
+    case [v, stack.hd] of
+      ["z", 0] -> eval (env, [stack.tl, s, w], fromLabel (env, l))
+    | ["z", _] -> eval (env, [stack.tl, s, w], insns.tl)
+    | ["nz", 0] -> eval (env, [stack.tl, s, w], insns.tl)
+    | ["nz", _] -> eval (env, [stack.tl, s, w], fromLabel (env, l)) 
+    esac
+  | DROP -> eval (env, [stack.tl, s, w], insns.tl)
+  esac
 }
 
 -- Runs a stack machine for a given input and a given program, returns an output
@@ -98,9 +130,36 @@ fun genLabels (env, n) {
   listArray (inner (env, n))
 }
 
--- Compiles an expression into a stack machine code.
--- Takes an expression, returns a list of stack machine
+local cnt = 0;
+
+-- 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
+    Var (str) -> singleton (LD (str))
+  | Const (val) -> singleton (CONST (val))
+  | Binop (str, expr1, expr2) -> compileSM (expr1) +++ compileSM (expr2) +++ singleton (BINOP (str))
+  | Assn (e1, e2) -> compileSM (e1) +++ compileSM (e2) +++ singleton (STI)
+  | Read (str) -> singleton (READ) +++ singleton (ST (str))
+  | Write (expr) -> compileSM (expr) +++ singleton (WRITE)
+  | Seq (stmt1, stmt2) -> compileSM (stmt1) +++ compileSM (stmt2)
+  | If (expr, stmt1, stmt2) -> 
+      local l1 = sprintf ("l%d", cnt), l2 = sprintf ("l%d", cnt + 1);
+      cnt := cnt + 2;
+      compileSM (expr) +++ singleton (CJMP ("nz", l1)) +++ compileSM (stmt2) +++ 
+      singleton (JMP (l2)) +++ singleton (LABEL (l1)) +++ compileSM (stmt1) +++ singleton (LABEL (l2))
+  | While (expr, stmt) -> 
+      local l1 = sprintf ("l%d", cnt), l2 = sprintf ("l%d", cnt + 1);
+      cnt := cnt + 2;
+      singleton (JMP (l2)) +++ singleton (LABEL (l1)) +++ compileSM (stmt) +++ 
+      singleton (LABEL (l2)) +++ compileSM (expr) +++ singleton (CJMP ("nz", l1))
+  | Repeat (stmt, expr) -> 
+      local l = sprintf ("l%d", cnt);
+      cnt := cnt + 1;
+      singleton (LABEL (l)) +++ compileSM (stmt) +++ compileSM (expr) +++ singleton (CJMP ("z", l))
+  | Skip -> {}
+  | Ref (str) -> singleton (LDA (str))
+  | Ignore (expr) -> compileSM (expr) +++ singleton (DROP)
+  esac
 }

src/X86.lama

@@ -363,7 +363,53 @@ 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 (str) -> 
+          case env.pop2 of
+            [y, x, env] -> 
+              case env.allocate of
+                [s, env] ->
+                  case str of 
+                    "/" -> [env, code <+ Mov (x, eax) <+ Cltd <+ IDiv (y) <+ Mov (eax, s)]
+                  | "%" -> [env, code <+ Mov (x, eax) <+ Cltd <+ IDiv (y) <+ Mov (edx, s)]
+                  | "+" -> [env, code <+ Mov (y, edx) <+ Mov (x, eax) <+ Binop (str, edx, eax) <+ Mov (eax, s)]
+                  | "-" -> [env, code <+ Mov (y, edx) <+ Mov (x, eax) <+ Binop (str, edx, eax) <+ Mov (eax, s)]
+                  | "*" -> [env, code <+ Mov (y, edx) <+ Mov (x, eax) <+ Binop (str, edx, eax) <+ Mov (eax, s)]
+                  | "&&" -> [env, code <+ Mov (y, edx) <+ Mov (x, eax) <+ Binop ("*", edx, eax) <+ Binop ("cmp", L (0), eax) <+ Mov (L (0), eax) <+ Set ("ne", "%al") <+ Mov (eax, s)]  
+                  | "!!" -> [env, code <+ Mov (y, edx) <+ Mov (x, eax) <+ Binop ("+", edx, eax) <+ Binop ("cmp", L (0), eax) <+ Mov (L (0), eax) <+ Set ("ne", "%al") <+ Mov (eax, s)]  
+                  | _ -> [env, code <+ Mov (y, edx) <+ Mov (x, eax) <+ Binop ("cmp", edx, eax) <+ Mov (L (0), eax) <+ Set (suffix (str), "%al") <+ Mov (eax, s)]      
+                  esac
+              esac
+          esac
+        | LD (x) -> 
+            case env.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
+        | LABEL (s) -> [if env.isBarrier then env.retrieveStack (s) else env fi, code <+ Label (s)]
+        | JMP (l) -> [env.setStack (l).setBarrier, code <+ Jmp (l)]
+        | CJMP (v, l) -> 
+            case env.pop of
+              [s, env] -> [env.setStack (l), code <+ Binop ("!!", L (0), s) <+ CJmp (v, l)]
+            esac
+        | LDA (x) ->
+            case env.addGlobal (x).allocate of
+              [s, env] -> [env, code <+ Lea (env.loc (x), s)]
+            esac
+        | STI ->
+            case env.pop of 
+              [v, env] ->
+                case env.peek of
+                  x -> [env, code <+> move (v, I (0, x)) <+ Mov (v, x)]
+                esac
+            esac
+        | DROP -> [env.pop.snd, code]
         esac
       }, [env, emptyBuffer ()], code)
   }
@@ -397,4 +443,4 @@ public fun compileX86 (args, code) {
 
        system ({"gcc -g -m32 -o ", args.getBaseName, " ", runtime, " ", asmFile}.stringcat)
   esac
-}
+}