diff --git a/regression/test001.run b/regression/test001.run new file mode 100755 index 000000000..bc9ea7c8e Binary files /dev/null and b/regression/test001.run differ diff --git a/src/Expr.lama b/src/Expr.lama index b75803563..9ab7f0bd7 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 5e9e82bd9..9ae7982f1 100644 --- a/src/SM.lama +++ b/src/SM.lama @@ -1,4 +1,5 @@ -- Stack machine. +-- SM CONFIG: [STACK, [STATE, WORLD]] import List; import World; @@ -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 67ec6db9e..dd0accd80 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 diff --git a/src/X86_64.lama b/src/X86_64.lama index 9c03745cb..94ea800fa 100644 --- a/src/X86_64.lama +++ b/src/X86_64.lama @@ -285,6 +285,25 @@ fun suffix (op) { esac } +fun asmOp (op) { + var cmp_op = "cmp"; + case op of + "+" -> "+" + | "-" -> "-" + | "*" -> "*" + | "/" -> "/" + | "%" -> "%" + | "<" -> cmp_op + | ">" -> cmp_op + | "<=" -> cmp_op + | ">=" -> cmp_op + | "==" -> cmp_op + | "!=" -> cmp_op + | "&&" -> "&&" + | "!!" -> "!!" + 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) { @@ -300,6 +319,55 @@ fun compile (env, code) { case env.pop of [s, env] -> [env, code <+ Mov (s, rdi) <+ Call ("Lwrite")] esac + | BINOP (op) -> + case asmOp (op) of + "/" -> case env.pop2 of + [x, y, env] -> [env.push (y), code <+ Mov (y, rax) <+ Cltd <+ IDiv (x) <+ Mov (rax, y)] + esac + | "%" -> case env.pop2 of + [x, y, env] -> [env.push (y), code <+ Mov (y, rax) <+ Cltd <+ IDiv (x) <+ Mov (rdx, y)] + esac + | "cmp" -> case env.pop2 of + [x, y, env] -> [env.push (y), code <+ Binop("^", rax, rax) + <+ Binop ("cmp", x, y) <+ Set (suffix (op), "%al") + <+ Mov (rax, y)] + esac + | "!!" -> case env.pop2 of + [x, y, env] -> [env.push (y), code -- <+ Mov (L(0), rax) + <+ Binop("^", rax, rax) + <+ Binop("^", rdx, rdx) + <+ Binop ("cmp", x, rax) <+ Set (suffix ("!="), "%dl") + <+ Binop ("cmp", y, rax) <+ Set (suffix ("!="), "%al") + <+ Binop ("!!", rdx, rax) + <+ Mov (rax, y)] + esac + | "&&" -> case env.pop2 of + [x, y, env] -> [env.push (y), code -- <+ Mov (L(0), rax) + <+ Binop("^", rax, rax) + <+ Binop("^", rdx, rdx) + <+ Binop ("cmp", x, rax) <+ Set (suffix ("!="), "%dl") + <+ Binop ("cmp", y, rax) <+ Set (suffix ("!="), "%al") + <+ Binop ("&&", rax, rdx) + <+ Mov (rax, y)] + esac + | asm_op -> case env.pop2 of + [x, y, env] -> [env.push (y), code <+ Binop (asm_op, x, y)] + esac + esac + | CONST (n) -> + case env.allocate of + [s, env] -> [env, code <+ Mov (L (n), s)] + esac + | LD (x) -> + case env.allocate of + [s, env] -> [env, code <+ Mov (env.loc (x), s)] + esac + | ST (x) -> + case env.addGlobal (x) of + env -> case env.pop of + [s, env] -> [env, code <+ Mov (s, env.loc (x))] + esac + esac | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string) esac }, [env, emptyBuffer ()], code) @@ -322,4 +390,4 @@ public fun compileX86 (code) { ) ).stringcat esac -} \ No newline at end of file +}