hw10 Ilya Voronin

.gitignore

@@ -0,0 +1,3 @@
+*.i
+*.o
+*.s

.travis.yml

@@ -0,0 +1,8 @@
+language: c
+services:
+  - docker
+before_install:
+    - docker pull berezun/cw-2020
+    - docker run -d -it --name cw-2020 -v $(pwd):/usr/share/compiler-2020 berezun/cw-2020
+script:
+     docker exec -it cw-2020 sh test.sh

README.md

@@ -1,2 +1 @@
-# compiler-2020
-A supplementary repository for the course on compilers.
+# HW 6

regression/Embedding.meta

@@ -0,0 +1,82 @@
+-- A deep embedding of L0 into Lama
+import List;
+import Array;
+import Fun;
+import World;
+import Stmt;
+import State;
+import SM;
+import X86;
+
+-- Embeds expression operands: strings are 
+-- embedded into identifiers, integer constants --- into
+-- constants; non-operand expressions are left intact
+
+# define HASH #
+
+fun opnd (x) {
+  case x of
+    HASH string  -> Var   (x)
+  | HASH unboxed -> Const (x)
+  | _        -> x
+  esac
+}
+
+-- Redefinition of standard infix operators
+infix +  at +  (l, r) {Binop ("+",  opnd (l), opnd (r))}
+infix -  at -  (l, r) {Binop ("-",  opnd (l), opnd (r))}
+infix *  at *  (l, r) {Binop ("*",  opnd (l), opnd (r))}
+infix /  at /  (l, r) {Binop ("/",  opnd (l), opnd (r))}
+infix %  at %  (l, r) {Binop ("%",  opnd (l), opnd (r))}
+infix == at == (l, r) {Binop ("==", opnd (l), opnd (r))}
+infix != at != (l, r) {Binop ("!=", opnd (l), opnd (r))}
+infix <  at <  (l, r) {Binop ("<",  opnd (l), opnd (r))}
+infix <= at <= (l, r) {Binop ("<=", opnd (l), opnd (r))}
+infix >  at >  (l, r) {Binop (">",  opnd (l), opnd (r))}
+infix >= at >= (l, r) {Binop (">=", opnd (l), opnd (r))}
+infix && at && (l, r) {Binop ("&&", opnd (l), opnd (r))}
+infix !! at !! (l, r) {Binop ("!!", opnd (l), opnd (r))}
+
+-- Embeds "read" construct; x is expected to be a string (not a "Var")
+fun read (x) {
+  Read (x)
+}
+
+-- Embeds "write" construct; note, e is expression, thus it
+-- is embedded using "opnd"
+fun write (e) {
+  Write (opnd (e))
+}
+
+-- Embeds assignment operator; x is expected to be string, e is expression, this
+-- it is embeeded using "opnd"
+infix ::= before := (x, e) {
+  Assn (x, opnd (e))
+}
+
+-- Embeds sequential composition
+infixr >> before ::= (s1, s2) {
+  Seq (s1, s2)
+}
+
+-- Returns embedded program (thus, the file has to be recompiled as the
+-- program changes)
+fun program () {
+  PROGRAM_BODY
+}
+
+fun state (x) {
+  Read (x)
+}
+
+
+local input = reverse (fix (fun (f) {fun (acc) {case readLine () of #unboxed -> acc | arg -> f (stringInt (arg) : acc) esac}}) ({}));
+
+iter (fun (x) {printf ("%d\n", x)},
+      case sysargs[1] of
+--        "-i" -> evalStmt (input, program ())
+--      | "-s" -> evalSM (input, compileSM (program ()))
+	  "-i" -> evalExpr (input, program ())
+	| _ -> failure ("Invalid compiler flag\n")
+      esac
+     )

runtime/runtime.c

@@ -79,11 +79,11 @@ void* Bsta (int i0, void *v, void *x) {
   return v;
 }
 
-void Lwrite (int x) {
-  printf ("%d\n", UNBOX (x));
+void Bwrite (int x) {
+  printf ("%d\n", UNBOX(x));
 }
 
-int Lread () {
+int Bread () {
   int result;
 
   scanf  ("%d", &result);

src/Expr.lama

@@ -99,11 +99,107 @@ fun evalList (c, exprs) {
   esac
 }
 
-(* Assignment *)
-fun eval (c@[s, w], expr) {
-  failure ("evalExpr not implemented\n")
+fun dvar(v) {
+  case v of 
+      Var(x) -> x
+      | _ -> failure("not a var")
+  esac
+}
+
+fun eval (c@[state, world], expr) {
+    case expr of 
+      Read(x) -> case readWorld(world) of [val, nworld] ->
+          [[
+            state<-[x, Var(val)],
+            nworld
+          ],
+          Void
+          ]
+          esac
+      | Write(expr) ->
+          case eval(c, expr) of [[state, world], res] ->
+          [[
+            state, 
+            writeWorld(res, world)
+          ],
+          Void]
+          esac
+      | Assn(x, expr) -> case evalList(c, {x, expr}) of [[state, world], var:res:_] ->
+        [
+        [
+          case var of
+          Ref(x) -> state<-[x, Var(res)] |
+          ElemRef(arr, i) -> arr[i] := res; state
+          esac,
+          world
+        ],
+        res
+        ]
+        esac
+      | Seq(stmt1, stmt2) -> 
+        eval(
+          eval(c, stmt1).fst,
+          stmt2
+        )
+      | If(cond, stmt, estmt) -> case eval(c, cond) of 
+          [newConf, 0] -> case estmt of None -> [newConf, Void] | _ -> eval(newConf, estmt) esac |
+          [newConf, _] -> eval(newConf, stmt)
+        esac
+      | While(cond, stmt) -> case eval(c, cond) of 
+          [newConf, 0] -> [newConf, Void] |
+          [newConf, _] -> eval(eval(newConf, stmt).fst, While(cond, stmt))
+        esac
+      | Rep(stmt, cond) -> 
+          case eval(c, stmt).fst of newConf ->
+              case eval(newConf, cond) of 
+                  [newConf1, 0] -> eval(newConf1, Rep(stmt, cond)) |
+                  [newConf1, _] -> [newConf1, Void]
+              esac
+          esac
+      | Skip -> [c, Void]
+      | Const(n) -> [c, n]
+      | Var(x) -> [c, state.lookup(x).dvar]
+      | Binop(op, lefto, righto) -> case evalList(c, {lefto, righto}) of [c, a:b:_] ->
+                                    [c, evalOp(op, a, b)]
+                                    esac
+      | Ref(x) -> [c, Ref(x)]
+      | Ignore(expr) -> [eval(c, expr).fst, Void]
+      | Scope(defs, expr) -> case evalList([state.enterScope, world], defs) of [c, _] -> 
+            case eval(c, expr) of [[s, w], res] -> [[s.leaveScope, w], res] esac
+        esac
+      | Local(vars) -> [[state.addNames(vars), world], Void]
+      | Fun(name, args, body) -> [[state.addFunction(name, args, body), world], Void]
+      | Call(f, argExps) -> case c.evalList(argExps) of [[s, w], argVals] -> case state.lookup(f) of Fun(args, body) ->
+            case body of 
+            External -> case evalBuiltin(f, argVals, w) of [res, w] -> [[s, w], res] esac|
+            _ ->   local news = foldl(
+                          fun (olds, [arg, val]) {olds.addName(arg, Var(val))}, 
+                          s.enterFunction, 
+                          zip(args, argVals)
+                        );
+              case eval([news, w],
+                        body
+                      ) of [[sres, w], res] ->
+                  [[s.leaveFunction(sres.getGlobal), w], res]
+              esac
+            esac
+        esac esac
+      | ElemRef(arr, i) -> case evalList(c, {arr, i}) of 
+        [c, {arrRes, ires}] -> [c, ElemRef(arrRes, ires)]
+        esac
+      | Elem(arr, i) -> case evalList(c, {arr, i}) of 
+        [c, {arrRes, ires}] -> [c, arrRes[ires]]
+        esac
+      | String(s) -> [c, s]
+      | Array(exps) -> case evalList(c, exps) of [c, ress] -> [c, listArray(ress)] esac
+      | Builtin(name, args) -> case evalList(c, args) of [[s, w], argRes] ->
+          case evalBuiltin(name, argRes, w) of [res, w] ->
+            [[s, w], res]
+          esac
+        esac
+    esac
 }
-(* End *)
+
 
 -- Evaluates a program with a given input and returns an output
 public fun evalExpr (input, expr) {

src/Parser.lama

@@ -74,7 +74,7 @@ fun expandScope (defs, expr) {
     foldr (fun ([defs, expr], def) {     
              case def of
                 [ident, None]         -> [ident : defs, expr]
-             |  [ident, Some (value)] -> [ident : defs, Seq (Ignore (Assn (Ref (ident), value)), expr)]
+             |  [ident, Some (value)] -> [ident : defs, Seq (Ignore (Assn (Ref (ident), value(Val))), expr)]
              esac
            },
            [{}, expr],
@@ -129,8 +129,44 @@ local primary    = memo $ eta syntax (
                                                                                                             | Some (args) -> assertValue (a, Call (x, args))
                                                                                                             esac
                                                                                                          }} |
-(* Assignment *)
-                                      $(failure ("the rest of primary parsing in not implemented\n"))),
+                                      bexp=inbr[s("("), exp, s(")")] {fun(a) {bexp(a)} } |
+                                      loc=pos kSkip {fun(a) {assertVoid(a, Skip, loc)} } |
+
+                                      kIf c=exp kThen s=scopeExpr ot=elifStmt kFi {fun(a) {If(c(Val), s(a), ot(a))} } |
+                                      loc=pos kIf c=exp kThen s=scopeExpr kFi {fun(a) {assertVoid(a, If(c(Val), s(Void), None), loc)}} |
+                                      loc=pos kWhile c=exp kDo s=scopeExpr kOd {fun(a) { assertVoid(a, While(c(Val), s(Void)), loc)} }|
+                                      loc=pos kFor i=scopeExpr s[","] c=exp s[","] s=exp kDo ot=scopeExpr kOd 
+                                          { fun(a) {
+                                            distributeScope(i(Void), 
+                                              fun(e) { assertVoid(
+                                                                a, 
+                                                                Seq(e, While(c(Val), Seq(ot(Void), s(Void)))), 
+                                                                loc
+                                                                ) 
+                                                    } 
+                                            )
+                                          }} |
+                                      loc=pos kRepeat b=scopeExpr kUntil c=inbr[s("("), exp, s(")")] { 
+                                        fun(a) {
+                                          distributeScope(b(Void), fun(e) {assertVoid(a, Rep(e, c(Val)), loc) })
+                                          } 
+                                      }|
+                                      se=inbr[s("{"), scopeExpr, s("}")] {fun(a) {se(a)}}
+      ),
+      varDef = memo $ eta syntax (
+        x=lident v=(-s["="] basic)? {[x, v]}
+      ),
+      funDef = memo $ eta syntax (
+        kFun name=lident args=inbr[s("("), list0(lident), s(")")] body=inbr[s("{"), scopeExpr, s("}")] {Fun(name, args, body(Weak))}
+      ),
+      def = memo $ eta syntax (
+        kLocal l=list[varDef] s[";"] {Local(l)} |
+        funDef
+      ),
+      scopeExpr = memo $ eta syntax (
+        defs=def+ e=exp? {fun(a) {expandScope(defs, case e of None -> Skip | Some(ee) -> ee(a) esac)}} |
+        e=exp {fun (a) {e(a)}}
+      ),
 (* End *)
       basic      = memo $ eta (expr ({[Right, singleton ([s (":="),
                                                           fun (l, loc, r) {
@@ -142,7 +178,7 @@ local primary    = memo $ eta syntax (
                                       [Left , map (binop, {"+", "-"})],
                                       [Left , map (binop, {"*", "/", "%"})]
                                      },
-                                     postfix)(id)),
+                                     postfix)),
       postfix    = memo $ eta syntax (loc=pos e=primary ps=(i=inbr[s("["), exp, s("]")] {Index (i (Val))} |
                                                             -s["."] kLength {Length}
                                                            )* {fun (a) {foldl (fun (e, p) {                                                                            
@@ -158,25 +194,14 @@ local primary    = memo $ eta syntax (
                                                                                  esac                                                                            
                                                                                }, e, ps) (a)
                                                               }}
-                                     ),
-      scopeExpr  = memo $ eta syntax (ds=definition* e=exp? {fun (a) {fun (e) {
-                                                                        case ds of
-                                                                          {} -> e
-                                                                        | _  -> expandScope (ds, e) 
-                                                                        esac
-                                                                      } (case e of 
-                                                                           Some (e) -> e (a)
-                                                                         | _        -> Skip
-                                                                         esac)
-                                                                      }}),
-      definition = memo $ eta syntax (kLocal ds=list[syntax (lident (s["="] e=basic {e (Val)})?)] s[";"] {Local (ds)} |
-                                      kFun name=lident
-                                           args=inbr[s("("), list0 (lident), s(")")]
-                                           body=inbr[s("{"), scopeExpr, s("}")] {
-                                           Fun (name, args, body (Weak))
-                                      }
-                                     ),                                    
+                                     ),                                
       exp        = memo $ eta syntax (basic | s1=basic s[";"] s2=exp {fun (a) {Seq (s1 (Void), s2 (a))}});
 
 -- Public top-level parser
 public parse = syntax (s=scopeExpr {s (Void)});
+
+local elifStmt = syntax (
+  kElif e=exp kThen s=scopeExpr ot=elifStmt {fun(a) { If(e(Val), s(a), ot(a))} } |
+  loc=pos kElif e=exp kThen s=scopeExpr {fun(a) { assertVoid(a, If(e(Val), s(Void), e(Void)), loc) }} |
+  kElse s=scopeExpr { fun(a) {s(a)} }
+);