diff --git a/src/Expr.lama b/src/Expr.lama index b758035636..9ab7f0bd7f 100644 --- a/src/Expr.lama +++ b/src/Expr.lama @@ -13,6 +13,28 @@ import State; -- Const (int) | -- Binop (string, expr, expr) +public fun applyBinop(op, x, y) { + case op of + "+" -> (x + y) + | "-" -> (x - y) + | "*" -> (x * y) + | "/" -> (x / y) + | "%" -> (x % y) + | "<" -> (x < y) + | ">" -> (x > y) + | "<=" -> (x <= y) + | ">=" -> (x >= y) + | "==" -> (x == y) + | "!=" -> (x != y) + | "&&" -> (x && y) + | "!!" -> (x !! y) + esac +} + public fun evalExpr (st, expr) { - failure ("evalExpr not implemented\n") + case expr of + Var (x) -> st(x) + | Const (i) -> i + | Binop (op, e1, e2) -> applyBinop (op, evalExpr (st, e1), evalExpr (st, e2)) + esac } diff --git a/src/SM.lama b/src/SM.lama index 5e9e82bd9e..1012437378 100644 --- a/src/SM.lama +++ b/src/SM.lama @@ -1,4 +1,5 @@ -- Stack machine. +-- SM CONFIG: [STACK, [STATE, WORLD]] import List; import World; @@ -11,7 +12,7 @@ import Fun; -- string representation. public fun showSMInsn (i) { case i of - READ -> sprintf ("READ") + READ (x) -> sprintf ("READ %s", x) | WRITE -> sprintf ("WRITE") | BINOP (s) -> sprintf ("BINOP %s", s) | LD (x) -> sprintf ("LD %s", x) @@ -24,10 +25,39 @@ public fun showSM (prg) { map (fun (i) {showSMInsn (i) ++ "\n"}, prg).stringcat } +fun stack(x) { x[0] } + +fun state(x) { x[1] } + +fun world(x) { x[2] } + +fun evalRead (c) { + var newWorld; + newWorld := readWorld(c.world); + [newWorld.fst : c.stack, c.state, newWorld.snd] +} + +fun evalIns (c, i) { + case i of + READ -> evalRead (c) + | WRITE -> [c.stack.tl, c.state, writeWorld (c.stack.hd, c.world)] + | BINOP (s) -> + case c.stack of + x : y : tl -> [applyBinop (s, y, x) : tl, c.state, c.world] + esac + | LD (x) -> [state(c) (x) : c.stack, c.state, c.world] + | ST (x) -> [c.stack.tl, (c.state <- [x, c.stack.hd]), c.world] + | CONST (n) -> [n : c.stack, c.state, c.world] + esac +} + -- Stack machine interpreter. Takes an SM-configuration and a program, -- returns a final configuration fun eval (c, insns) { - failure ("SM eval not implemented\n") + case insns of + i : insns_tail -> eval(evalIns(c, i), insns_tail) + | {} -> c + esac } -- Runs a stack machine for a given input and a given program, returns an output @@ -38,12 +68,22 @@ public fun evalSM (input, insns) { -- 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) -> { LD (x) } + | Const (i) -> { CONST (i) } + | Binop (op, e1, e2) -> compileExpr(e1) +++ compileExpr (e2) +++ { 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 + Assn (x, e) -> compileExpr (e) +++ { ST (x) } + | Seq (s1, s2) -> compileSM (s1) +++ compileSM (s2) + | Skip -> {} + | Read (x) -> READ : { ST (x) } + | Write (e) -> compileExpr (e) +++ { WRITE } + esac } diff --git a/src/Stmt.lama b/src/Stmt.lama index 67ec6db9e6..dd0accd80a 100644 --- a/src/Stmt.lama +++ b/src/Stmt.lama @@ -16,8 +16,20 @@ import World; -- Read (string) | -- Write (expr) | +fun evalRead (c, x) { + var newWorld; + newWorld := readWorld(c.snd); + [(c.fst <- [x, newWorld.fst]), newWorld.snd] +} + fun eval (c, stmt) { - failure ("Stmt eval not implemented\n") + case stmt of + Assn (x, e) -> [c.fst <- [x, evalExpr (c.fst, e)], c.snd] + | Seq (s1, s2) -> eval (eval (c, s1), s2) + | Skip -> c + | Read (x) -> evalRead(c, x) + | Write (e) -> [c.fst, writeWorld (evalExpr (c.fst, e), c.snd)] + esac } -- Evaluates a program with a given input and returns an output