diff --git a/src/Expr.lama b/src/Expr.lama index b758035636..bbe76bf942 100644 --- a/src/Expr.lama +++ b/src/Expr.lama @@ -13,6 +13,28 @@ import State; -- Const (int) | -- Binop (string, expr, expr) +public fun evalBinop (left, right, bop) { + case bop of + "+" -> left + right + | "-" -> left - right + | "*" -> left * right + | "/" -> left / right + | "%" -> left % right + | "!!" -> left !! right + | "&&" -> left && right + | "==" -> left == right + | "!=" -> left != right + | "<=" -> left <= right + | "<" -> left < right + | ">=" -> left >= right + | ">" -> left > right + esac +} + public fun evalExpr (st, expr) { - failure ("evalExpr not implemented\n") + case expr of + Var (varName) -> st(varName) + | Const (n) -> n + | Binop (bop, left, right) -> evalBinop(evalExpr(st, left), evalExpr(st, right), bop) + esac } diff --git a/src/Parser.lama b/src/Parser.lama index 0de3dce168..dffc1a77d1 100644 --- a/src/Parser.lama +++ b/src/Parser.lama @@ -12,14 +12,46 @@ fun inbr (l, p, r) { syntax (-l p -r) } +fun parens(p) { + inbr (s ("("), p, s (")")) +} + +fun binop (l, bop, r) { + Binop (bop, l, r) +} + -- Primary expression -var primary = memo $ eta (decimal @ fun (x) {Const (stringInt (x))} | - lident @ fun (x) {Var (x)} | - inbr (s ("("), exp, s (")"))), - exp = memo $ eta (failure ("expression parsing not implemented\n")); +var primary = memo $ eta syntax (x=decimal {Const (stringInt (x))} | + x=lident {Var (x)} | + inbr[s("("), exp, s(")")]), + exp = memo $ eta expr ({ + [Left, {[s ("!!"), binop]}], + [Left, {[s ("&&"), binop]}], + [Nona, {[s ("<"), binop], [s ("<="), binop], [s (">"), binop], [s (">="), binop], [s ("=="), binop], [s ("!="), binop]}], + [Left, {[s ("+"), binop], [s ("-"), binop]}], + [Left, {[s ("*"), binop], [s ("/"), binop], [s ("%"), binop]}] + }, primary), + ifHead = memo $ eta syntax (kIf condition=exp kThen body=stmts tail=ifTail {If (condition, body, tail)}), + ifTail = memo $ eta syntax (kElif condition=exp kThen body=stmts tail=ifTail {If (condition, body, tail)} | + kElse body=stmts kFi {body} | + kFi {Skip}); + +var stmt = memo $ eta syntax ( + kRead x=parens[lident] {Read (x)} | + kWrite x=parens[exp] {Write (x)} | + kSkip {Skip} | + target=lident s[":="] value=exp {Assn (target, value)} | + ifStmt=ifHead {ifStmt} | + kWhile condition=exp kDo body=stmts kOd {While (condition, body)} | + kDo body=stmts kWhile condition=exp kOd {DoWhile(body, condition)} | + kFor iterator=stmts s[","] condition=exp s[","] step=stmts kDo body=stmts kOd {Seq (iterator, While(condition, Seq(body, step)))} +); -var stmt = memo $ eta (failure ("statement parsing not implemented\n")); +var stmts = memo $ eta syntax ( + stmt | + head=stmt s[";"] tail=stmts {Seq (head, tail)} +); -- Public top-level parser -public parse = stmt; +public parse = stmts; diff --git a/src/SM.lama b/src/SM.lama index 9c40800506..c96484ae53 100644 --- a/src/SM.lama +++ b/src/SM.lama @@ -8,6 +8,7 @@ import World; import State; import Expr; import Buffer; +import Parser; -- Stack code printer. Takes a list of SM instructions, return its -- string representation. @@ -52,10 +53,48 @@ fun fromLabel (env, lab) { env [0] (lab) } +fun compileCJmp(znz, lab, env, [(x:t), state, world]) { + case znz of + ("z") -> if x then [None, [t, state, world]] else [Some (env.fromLabel (lab)), [t, state, world]] fi + | ("nz") -> if x then [Some (env.fromLabel (lab)), [t, state, world]] else [None, [t, state, world]] fi + esac +} + +fun evalSingle (env, conf@[stack, state, world], instruction) { + case instruction of + READ -> + case readWorld(world) of + [value, newWorld] -> [None, [value:stack, state, newWorld]] + esac + | WRITE -> + [None, [tl(stack), state, writeWorld(hd(stack), world)]] + | BINOP (bop) -> + case stack of + snd:fst:tail -> [None, [evalBinop(fst, snd, bop):tail, state, world]] + esac + | LD (varName) -> + [None, [state(varName):stack, state, world]] + | ST (varName) -> + [None, [stack, state <- [varName, hd(stack)], world]] + | CONST (n) -> + [None, [n:stack, state, world]] + | LABEL (_) -> [None, conf] + | JMP (lab) -> [Some (env.fromLabel (lab)), conf] + | CJMP (znz, lab) -> compileCJmp (znz, lab, env, conf) + esac +} + -- 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") + case insns of + {} -> c + | ins:insns -> + case evalSingle(env, c, ins) of + [None, conf] -> eval(env, conf, insns) + | [Some (insns), conf] -> eval(env, conf, insns) + esac + esac } -- Runs a stack machine for a given input and a given program, returns an output @@ -96,7 +135,11 @@ fun genLabels (env, n) { -- 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 (varName) -> singletonBuffer (LD (varName)) + | Const (num) -> singletonBuffer (CONST (num)) + | Binop (bop, left, right) -> compileExpr(left) <+> compileExpr(right) <+ BINOP (bop) + esac } -- Compiles a statement into a stack machine code. @@ -137,7 +180,24 @@ public fun compileSM (stmt) { esac esac esac - | _ -> failure ("compileSM not implemented\n") + | If (condition, ifBranch, elseBranch) -> + case env.genLabel of + [elseBranchLab, env] -> + case compile (lab, env, ifBranch) of + [_, env, ifBranchCode] -> + case compile (lab, env, elseBranch) of + [_, env, elseBranchCode] -> [true, env, compileExpr (condition) <+ CJMP ("z", elseBranchLab) <+> ifBranchCode <+ JMP (lab) <+ LABEL (elseBranchLab) <+> elseBranchCode] + esac + esac + esac + | While (condition, body) -> + case env.genLabels (2) of + [conditionLab, bodyLab, env] -> + case compile (conditionLab, env, body) of + [_, env, bodyCode] -> [true, env, singletonBuffer (LABEL (conditionLab)) <+> compileExpr (condition) <+ CJMP ("z", lab) <+> bodyCode <+ JMP (conditionLab)] + esac + esac + | DoWhile (body, condition) -> compile (lab, env, Seq (body, While (condition, body))) esac } diff --git a/src/Stmt.lama b/src/Stmt.lama index 8b94e3bfc3..49d57fbff1 100644 --- a/src/Stmt.lama +++ b/src/Stmt.lama @@ -20,7 +20,30 @@ import World; -- DoWhile (stmt, expr) fun eval (c, stmt) { - failure ("Stmt eval not implemented\n") + var state = c.fst; + var world = c.snd; + + case stmt of + Assn (varName, expr) -> [state <- [varName, evalExpr(state, expr)], world] + | Seq (stmt1, stmt2) -> eval(eval(c, stmt1), stmt2) + | Skip -> c + | Read (varName) -> + case readWorld(world) of + [value, newWorld] -> [state <- [varName, value], newWorld] + esac + | Write (expr) -> [state, writeWorld(evalExpr(state, expr), world)] + | If (condition, body, elsePart) -> + case evalExpr(state, condition) of + 0 -> eval([state, world], elsePart) + | _ -> eval([state, world], body) + esac + | node@While (condition, body) -> + case evalExpr(state, condition) of + 0 -> [state, world] + | _ -> eval(eval([state, world], body), node) + esac + | DoWhile(body, condition) -> eval(eval(c, body), While(condition, body)) + esac } -- Evaluates a program with a given input and returns an output diff --git a/src/X86.lama b/src/X86.lama index 310790444d..8a08ed9747 100644 --- a/src/X86.lama +++ b/src/X86.lama @@ -299,6 +299,81 @@ fun suffix (op) { esac } +fun isComparison(bop) { + case bop of + "<=" -> true + | "<" -> true + | ">=" -> true + | ">" -> true + | "==" -> true + | "!=" -> true + | _ -> false + esac +} + +fun compileComparison(cmp, left, right, env, code) { + case env.allocate of + [s, newEnv] -> [newEnv, code <+> move (left, eax) <+ Mov (L(0), edx) <+ Binop ("cmp", right, eax) <+ Set (suffix (cmp), "%dl") <+> move (edx, s)] + esac +} + +fun isDivMod(bop) { + case bop of + "/" -> true + | "%" -> true + | _ -> false + esac +} + +fun compileDivMod(bop, left, right, env, code) { + var commonPart = code <+> move (left, eax) <+ Cltd <+ IDiv (right); + case env.allocate of + [s, newEnv] -> + case bop of + "/" -> [newEnv, commonPart <+> move (eax, s)] + | "%" -> [newEnv, commonPart <+> move (edx, s)] + esac + esac +} + +fun isLogical(bop) { + case bop of + "&&" -> true + | "!!" -> true + | _ -> false + esac +} + +fun compileLogical(bop, left, right, env, code) { + case env.allocate of + [s, newEnv] -> [newEnv, code <+ Mov (L(0), eax) <+ Binop ("cmp", eax, left) <+ Set (suffix ("!="), "%al") + <+ Mov (L(0), edx) <+ Binop ("cmp", edx, right) <+ Set (suffix ("!="), "%dl") <+ Binop (bop, edx, eax) <+> move (eax, s)] + esac +} + +fun compileSimpleBinaryOperation(bop, left, right, env, code) { + case env.allocate of + [s, newEnv] -> [newEnv, code <+> move (left, eax) <+ Binop (bop, right, eax) <+> move (eax, s)] + esac +} + +fun compileBinaryOperation(bop, env, code) { + fun compileImpl([right, left, newEnv]) { + if isComparison (bop) + then compileComparison (bop, left, right, newEnv, code) + elif isDivMod (bop) + then compileDivMod (bop, left, right, newEnv, code) + elif isLogical (bop) + then compileLogical (bop, left, right, newEnv, code) + else compileSimpleBinaryOperation (bop, left, right, newEnv, code) + fi + } + + case env.pop2 of + result -> compileImpl(result) + 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) { @@ -314,6 +389,25 @@ fun compile (env, code) { case env.pop of [s, env] -> [env, code <+> genCallF(env, "Lwrite", singletonBuffer(Push(s)), singletonBuffer(Pop (eax)))] esac + | LD (x) -> + case env.addGlobal (x).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 + | BINOP (bop) -> compileBinaryOperation(bop, env, code) + | CONST (n) -> + case env.allocate of + [s, env] -> [env, code <+> move (L (n), s)] + esac + | LABEL (lab) -> [env, code <+ Label (lab)] + | JMP (lab) -> [env, code <+ Jmp (lab)] + | CJMP (znz, lab) -> + case env.pop of + [s, env] -> [env, code <+ Binop ("cmp", L(0), s) <+ CJmp (znz, lab)] + esac | _ -> failure ("codegeneration for instruction %s is not yet implemented\n", i.string) esac }, [env, emptyBuffer ()], code)}