[ITMO] T07 Kudryavtsev Alexander

src/Driver.lama

@@ -19,11 +19,13 @@ import Manifest;
 fun parseArgs (args) {
   var mode   = ref (Comp),
       infile = ref ({}),
-      smDump = ref (false);
+      smDump = ref (false),
+      astDump = ref(false);
 
   fun setDump (m) {
     case m of
       SM -> smDump ::= true
+    | AST -> astDump ::= true
     esac
   }
 
@@ -50,6 +52,7 @@ fun parseArgs (args) {
                  "-i"  -> setMode (Int)
                | "-s"  -> setMode (SM)
                | "-ds" -> setDump (SM)
+               | "-dt" -> setDump (AST)
                | fn    -> setInFile (fn)
                esac;
                rec (t)
@@ -59,7 +62,8 @@ fun parseArgs (args) {
 
   [fun () {deref (mode)},
    fun () {case deref(infile) of #val -> failure ("input file name not set\n") | fn -> fn esac},
-   fun () {deref (smDump)}
+   fun () {deref (smDump)},
+   fun () {deref(astDump)}
   ]        
 }
 
@@ -69,14 +73,19 @@ fun peepSM (args, smCode) {
   smCode
 }
 
+fun peepAST (args, astCode) {
+  dumpAST (args, lazy (astCode.string));
+  astCode
+}
+
 var args = parseArgs (arrayList (sysargs).tl);
 
 -- The main part: parses input file, invokes interpreter/stack machine interpreter/x86
 -- code generator
 case parseString (parse |> bypass (end), fread (args.getInFile)) of
   Succ (program) ->
     case args.getMode of
-      Comp -> compileX86 (args, peepSM (args, compileSM (program)))
+      Comp -> compileX86 (args, peepSM (args, compileSM (peepAST(args, program))))
     | mode ->
        var input =
           reverse (fix (fun (f) {
@@ -89,8 +98,8 @@ case parseString (parse |> bypass (end), fread (args.getInFile)) of
 
        iter (fun (x) {printf ("%d\n", x)},
              case mode of
-               Int -> evalExpr (input, program)
-             | SM  -> evalSM   (input, peepSM (args, compileSM (program)))
+               Int -> evalExpr (input, peepAST(args, program))
+             | SM  -> evalSM   (input, peepSM (args, compileSM (peepAST(args, program))))
              esac) 
     esac
 | x@Fail (err, line, col) ->   

src/Expr.lama

@@ -59,29 +59,15 @@ public fun evalOp (op, l, r) {
 -- def = Var (string list)                |
 --       Fun (string, string list, expr)
 
--- Helper function: checks that given name designates a regular variable in
--- a given state
-fun checkVar (state, name) {
-  case state.lookup (name) of
-    Var (_) -> skip
-  | _       -> error (sprintf ("the name ""%s"" does not designate a variable", name), getLoc (name))
-  esac
-}
-
--- Helper function: checks that given name designates a function in
--- a given state
-fun checkFun (state, name) {
-  case state.lookup (name) of
-    Fun (_, _) -> skip
-  | _          -> error (sprintf ("the name ""%s"" does not designate a function", name), getLoc (name))
-  esac
-}
-
 -- Helper function: adds a bunch of regular variables current scope
 fun addNames (state, names) {
   foldl (fun (s, name) {s.addName (name, Var (0))}, state, names)
 }
 
+fun addNamesValues (state, names, values) {
+  foldl (fun (s, [name, value]) { s.addName(name, value) }, state, zip(names, values))
+}
+
 -- Helper function: adds a function in current scope
 fun addFunction (state, name, args, body) {
   state.addName (name, Fun (args, body))
@@ -101,11 +87,118 @@ fun evalList (c, exprs) {
   esac
 }
 
-(* Assignment *)
+fun evalRef(c, expr) {
+  let [c, out] = eval(c, expr) in
+  case out of
+    Ref(x) -> [c, x]
+  | _ -> failure("Expected ref, got %s", out.string)
+  esac
+}
+
+fun evalVal(c, expr) {
+  let [c, out] = eval(c, expr) in
+  case out of
+    Val(x) -> [c, x]
+  | _ -> failure("Expected val, got %s", out.string)
+  esac
+}
+
+fun evalFun(c, expr) {
+  let [c, out] = eval(c, expr) in
+  case out of
+    Fun(u, f) -> [c, [u, f]]
+  | _ -> failure("Expected fun, got %s", out.string)
+  esac
+}
+
+fun evalObject(c, expr) {
+  let [c, out] = eval(c, expr) in
+  case out of
+    Val(x) -> [c, out]
+  | Fun(f) -> [c, out]
+  | _ -> failure("Expected obj, got %s", out.string)
+  esac
+}
+
+fun evalVoid(c, expr) {
+  let [c, out] = eval(c, expr) in
+  case out of
+    None -> [c, out]
+  | _ -> failure("Expected void, got %s", out.string)
+  esac
+}
+
 fun eval (c@[s, w], expr) {
-  failure ("evalExpr not implemented\n")
+  case expr of
+      Assn(to, from) ->
+        let [c, ref] = evalRef(c, to) in
+        let [[s, w], output] = evalObject(c, from) in
+        [[s <- [ref, output], w], output]
+    | Seq(fst, snd) ->
+        let [c, out] = evalVoid(c, fst) in eval(c, snd)
+    | Skip -> [c, None]
+    | Read(name) ->
+        let [out, w] = readWorld(w) in [[s <- [name, Val(out)], w], None]
+    | Write(expr) ->
+        let [[s, w], out] = evalVal(c, expr) in [[s, writeWorld(out, w)], None]
+    | If(cond, tru, fls) ->
+        let [c, check] = evalVal(c, cond) in
+        if check then eval(c, tru) else eval(c, fls) fi
+    | While(cond, code) -> (
+        var continue, temp;
+        temp := evalVal(c, cond); c := temp[0]; continue := temp[1];
+        while continue do
+          temp := evalVoid(c, code); c := temp[0];
+          temp := evalVal(c, cond); c := temp[0]; continue := temp[1]
+        od;
+        [c, None]
+      )
+    | DoWhile(cond, code) -> (
+        var continue = true, temp;
+        while continue do
+          temp := evalVoid(c, code); c := temp[0];
+          temp := evalVal(c, cond); c := temp[0]; continue := temp[1]
+        od;
+        [c, None]
+      )
+    | Var(name) -> [c, s.lookup(name)]
+    | Ref(name) -> [c, Ref(name)]
+    | Const(x) -> [c, Val(x)]
+    | Binop(op, left, right) ->
+      let [c, leftV] = evalVal(c, left) in
+      let [c, rightV] = evalVal(c, right) in
+      [c, Val(evalOp(op, leftV, rightV))]
+    | Ignore(expr) -> let [c, dropped] = eval(c, expr) in [c, None]
+    | Scope(decls, stmt) ->
+      let s = s.enterScope in
+      let c = evalDecls([s, w], decls) in
+      let [[s, w], x] = eval(c, stmt) in
+      let s = s.leaveScope in
+      [[s, w], x]
+    | Call(nm, args) ->
+      let [c, [argdefs, code]] = evalFun(c, Var(nm)) in
+      let [[s, w], xs] = c.evalList(args) in
+      let s1 = s in
+      let s = s.enterFunction in
+      let s = s.addNamesValues(argdefs, xs) in
+      let [[s, w], rv] = eval([s, w], code) in
+      let s = s1.leaveFunction(s.getGlobal) in
+      [[s, w], rv]
+    | _ -> failure("Unknown instruction: %s", expr.string)
+  esac
+}
+
+fun evalDecls(c, exprs) {
+  fun oneDecl(c@[s, w], expr) {
+    case expr of
+        Var(xs) -> let s = s.addNames(xs) in [s, w]
+      | Fun(nm, args, code) -> let s = s.addFunction(nm, args, code) in [s, w]
+      | _ -> failure("Unknown declaration: %s", expr.string)
+    esac
+  }
+
+  foldl(oneDecl, c, exprs)
 }
-(* End *)
 
 -- Evaluates a program with a given input and returns an output
 public fun evalExpr (input, expr) {

src/Parser.lama

@@ -57,6 +57,20 @@ fun binop (op) {
   ]
 }
 
+fun mkElifs(kind, elseBr, elifs) {
+   case elifs of
+     [] -> elseBr
+   | {} -> elseBr
+   | x:xs -> If(x[0](Val), x[1](kind), mkElifs(kind, elseBr, xs))
+   esac
+}
+fun getOrSkip(x, kind, loc) {
+   case x of
+     None -> assertVoid(kind, Skip, loc)
+   | Some(x) -> x(kind)
+   esac
+}
+
 -- Helper parser: parses a (possible empty) list of items separated by ","
 fun list0 (item) {
   list0By (item, s(","))
@@ -107,21 +121,37 @@ fun distributeScope (expr, exprConstructor) {
 
 var primary    = memo $ eta syntax (
                                       -- decimal constant
-                                      loc=pos x=decimal                                 {fun (a) {assertValue (a, Const (stringInt (x)), loc)}}     |
+                                      loc=pos x=decimal
+                                    {fun (a) { assertValue (a, Const (stringInt (x)), loc) }} |
 
                                       -- identifier
-                                      x=lident args=inbr[s("("), list0(syntax(e=exp {e(Val)})), s(")")]? {fun (a) {
+                                    loc=pos x=lident args=inbr[s("("), list0(syntax(e=exp {e(Val)})), s(")")]? {fun (a) {
                                                                                                             case args of
                                                                                                               None -> case a of
                                                                                                                         Ref  -> Ref (x)
                                                                                                                       | Void -> Ignore (Var (x))
                                                                                                                       | _    -> Var (x)
                                                                                                                       esac
-                                                                                                            | Some (args) -> assertValue (a, Call (x, args))
+                                                                                                            | Some (args) -> assertValue (a, Call (x, args), loc)
                                                                                                             esac
                                                                                                          }} |
 (* Assignment *)
-                                      $(failure ("the rest of primary parsing in not implemented\n"))),
+
+                                  loc=pos kRead e=inbr[s("("), lident, s(")")]
+                                    {fun(a) { assertVoid(a, Read(e), loc) }} |
+                                  loc=pos kWrite e=inbr[s("("), scopeExpr, s(")")]
+                                    {fun(a) { assertVoid(a, Write(e(Val)), loc)}} |
+                                  loc=pos kIf e=scopeExpr kThen tru=scopeExpr elifs=(-kElif scopeExpr -kThen scopeExpr)* fls=(-kElse scopeExpr)? kFi
+                                    {fun(a) { distributeScope(e(Val), fun(x) { If(x, tru(a), mkElifs(a, getOrSkip(fls, a, loc), elifs))}) }} |
+                                  loc=pos kWhile e=scopeExpr kDo c=scopeExpr kOd
+                                    {fun(a) { assertVoid(a, While(e(Val), c(Void)), loc) }} |
+                                  loc=pos kDo c=scopeExpr kWhile e=scopeExpr kOd
+                                    {fun(a) { distributeScope(c(Void), fun(x) { assertVoid(a, DoWhile(e(Val), x), loc) }) }} |
+                                  loc=pos kSkip {fun(a) { assertVoid(a, Skip, loc) }} |
+                                  kFor ini=scopeExpr s[","] cond=scopeExpr s[","] act=scopeExpr kDo c=scopeExpr kOd
+                                    {fun(a) { distributeScope(ini(Void), fun(x) { Seq(x, While(cond(Val), Seq(c(Void), act(Void)))) }) } } |
+                                  e=inbr[s("("), scopeExpr, s(")")]
+                                  ),
 (* End *)
       basic      = memo $ eta (expr ({[Right, {[s (":="),
                                                 fun (l, loc, r) {