Skip to content

Commit

Permalink
Done
Browse files Browse the repository at this point in the history
  • Loading branch information
@Stepavly
Stepavly committed Aug 12, 2024
1 parent 35fb506 commit 03df9b8
Show file tree
Hide file tree
Showing 4 changed files with 191 additions and 125 deletions.
99 changes: 72 additions & 27 deletions src/Expr.lama
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
import List;
import State;
import World;
-- import Utils;

-- As association map which maps "\otimes" into "\oplus"
var ops = {
Expand All @@ -23,9 +24,21 @@ var ops = {

-- The evaluator for infix operators: takes an operator as a string
-- and two operand values, and returns the result
public fun evalOp (op, l, r) {
case assoc (ops, op) of
Some (f) -> f (l, r)
public fun evalOp (bop, left, right) {
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
}

Expand All @@ -49,35 +62,67 @@ public fun evalOp (op, l, r) {
-- Binop (string, expr, expr) |
-- Ignore (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) {
case expr of
Var (varName) -> st(varName)
| Const (n) -> n
| Binop (bop, left, right) -> evalBinop(evalExpr(st, left), evalExpr(st, right), bop)
public fun eval (conf@[state, world], expr) {
case expr of
Skip -> [conf, Nothing]
| Var (varName) -> [conf, state (varName)]
| Const (n) -> [conf, n]
| Ref (r) -> [conf, VarRef (r)]
| Read (varExpr) ->
case eval (conf, varExpr) of
[[state, world], VarRef (varName)] ->
case readWorld(world) of
[value, newWorld] -> [[state <- [varName, value], newWorld], Nothing]
esac
esac
| Write (expr) ->
case eval (conf, expr) of
[[state, world], value] -> [[state, writeWorld (value, world)], Nothing]
esac
| Binop (bop, left, right) ->
case eval (conf, left) of
[conf, leftValue] ->
case eval (conf, right) of
[conf, rightValue] ->
[conf, evalOp (bop, leftValue, rightValue)]
esac
esac
| Ignore (expr) ->
case eval(conf, expr) of
[conf, _] -> [conf, Nothing]
esac
| Assn (targetNode, valueNode) ->
case eval (conf, targetNode) of
[conf, VarRef (varName)] ->
case eval (conf, valueNode) of
[[state, world], value] -> [[state <- [varName, value], world], value]
esac
esac
| Seq (head, tail) ->
case eval (conf, head) of
[conf, _] -> eval (conf, tail)
esac
| If (condition, ifBody, elseBody) ->
case eval (conf, condition) of
[conf, 0] -> eval (conf, elseBody)
| [conf, n] -> eval (conf, ifBody)
esac
| node@While (condition, body) ->
case eval (conf, condition) of
[conf, 0] -> [conf, Nothing]
| [conf, _] ->
case eval (conf, body) of
[conf, _] -> eval (conf, node)
esac
esac
| DoWhile (body, condition) -> eval (conf, Seq (body, While (condition, body)))
esac
}


-- Evaluates a program with a given input and returns an output
public fun evalExpr (input, expr) {
-- printf(showTree(expr));
-- printf("\n\n");
case eval ([emptyState, createWorld (input)], expr) of
[c, _] -> c.snd.getOutput
esac
Expand Down
60 changes: 13 additions & 47 deletions src/Parser.lama
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,6 @@ fun inbr (l, p, r) {
syntax (-l p -r)
}

<<<<<<< HEAD
fun binop (op) {
[syntax (pos -s[op]), fun (l, loc, r) {
fun (a) {
Expand All @@ -54,6 +53,7 @@ fun binop (op) {
}

var primary = memo $ eta syntax (
x=inbr[s("("), exp, s(")")] {eta x} |
-- decimal constant
loc=pos x=decimal {fun (a) {assertValue (a, Const (stringInt (x)), loc)}} |

Expand All @@ -65,7 +65,14 @@ var primary = memo $ eta syntax (
| _ -> Var (x)
esac
}} |
$(failure ("the rest of primary parsing in not implemented\n"))),
ifHead |
loc=pos kSkip {fun (a) {assertVoid (a, Skip, loc)}} |

kRead loc=pos x=inbr[s("("), exp, s(")")] {fun (a) {assertVoid (a, Read (x (Ref)), loc)}} |
kWrite loc=pos x=inbr[s("("), exp, s(")")] {fun (a) {assertVoid (a, Write (x (Val)), loc)}} |
kWhile loc=pos condition=exp kDo body=exp kOd {fun (a) {assertVoid (a, While (condition (Val), body (Void)), loc)}} |
kDo loc=pos body=exp kWhile condition=exp kOd {fun (a) {assertVoid (a, DoWhile (body (Void), condition (Val)), loc)}} |
kFor loc=pos iterator=exp s[","] condition=exp s[","] step=exp kDo body=exp kOd {fun (a) {assertVoid (a, Seq (iterator (Void), While(condition (Val), Seq(body (Void), step (Void)))), loc)}}),
basic = memo $ eta (expr ({[Right, {[s (":="),
fun (l, loc, r) {
fun (a) {assertValue (a, Assn (l (Ref), r (Val)), loc)}
Expand All @@ -77,52 +84,11 @@ var primary = memo $ eta syntax (
[Left , map (binop, {"*", "/", "%"})]
},
primary)),
ifHead = memo $ eta syntax (kIf condition=exp kThen body=exp tail=ifTail {fun (a) {If (condition (Val), body (a), tail (a))}}),
ifTail = memo $ eta syntax (kElif condition=exp kThen body=exp tail=ifTail {fun (a) {If (condition (Val), body (a), tail (a))}} |
kElse body=exp kFi {eta body} |
loc=pos kFi {fun (a) {assertVoid (a, Skip, loc)}}),
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=exp {s (Void)});
=======
fun parens(p) {
inbr (s ("("), p, s (")"))
}

fun binop (l, bop, r) {
Binop (bop, l, r)
}

-- Primary expression
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 stmts = memo $ eta syntax (
stmt |
head=stmt s[";"] tail=stmts {Seq (head, tail)}
);


-- Public top-level parser
public parse = stmts;
>>>>>>> 2ad0c4f (Implement control flow compiler)
91 changes: 75 additions & 16 deletions src/SM.lama
View file
Original file line number Diff line number Diff line change
Expand Up @@ -74,12 +74,22 @@ fun evalSingle (env, conf@[stack, state, world], instruction) {
[None, [tl(stack), state, writeWorld(hd(stack), world)]]
| BINOP (bop) ->
case stack of
snd:fst:tail -> [None, [evalBinop(fst, snd, bop):tail, state, world]]
snd:fst:tail -> [None, [evalOp(bop, fst, snd):tail, state, world]]
esac
| LD (varName) ->
[None, [state(varName):stack, state, world]]
| LDA (varName) ->
[None, [REF (varName):stack, state, world]]
| ST (varName) ->
[None, [stack, state <- [varName, hd(stack)], world]]
| STI ->
case stack of
(value:REF (varName):tail) -> [None, [value:tail, state <- [varName, value], world]]
esac
| DROP ->
case stack of
(_:tail) -> [None, [tail, state, world]]
esac
| CONST (n) ->
[None, [n:stack, state, world]]
| LABEL (_) -> [None, conf]
Expand Down Expand Up @@ -159,11 +169,53 @@ public fun compileSM (stmt) {

fun compile (lab, env, stmt) {
case stmt of
Skip -> [false, env, emptyBuffer ()]
| Read (x) -> [false, env, singletonBuffer (READ) <+ ST (x)]
| Write (e) -> [false, env, compileExpr (e) <+ WRITE]
| Assn (x, e) -> [false, env, compileExpr (e) <+ ST (x)]
| Seq (s1, s2) ->
Skip -> [false, env, emptyBuffer ()]
| Var (varName) -> [false, env, singletonBuffer (LD (varName))]
| Ref (varName) -> [false, env, singletonBuffer (LDA (varName))]
| Const (n) -> [false, env, singletonBuffer (CONST (n))]
| Read (x) ->
case env.genLabel of
[lab, env] ->
case compile (lab, env, x) of
[labUsed, env, code] -> [false, env, code <+> label (lab, labUsed) <+ READ <+ STI <+ DROP]
esac
esac
| Write (e) ->
case env.genLabel of
[lab, env] ->
case compile (lab, env, e) of
[labUsed, env, code] -> [false, env, code <+> label (lab, labUsed) <+ WRITE]
esac
esac
| Assn (x, e) ->
case env.genLabels (2) of
[xLab, eLab, env] ->
case compile (eLab, env, e) of
[eLabUsed, env, eCode] ->
case compile (xLab, env, x) of
[xLabUsed, env, xCode] -> [false, env, xCode <+> label (xLab, xLabUsed) <+> eCode <+> label (eLab, eLabUsed) <+ STI]
esac
esac
esac
| Ignore (e) ->
case env.genLabel of
[lab, env] ->
case compile (lab, env, e) of
[labUsed, env, code] -> [false, env, code <+> label(lab, labUsed) <+ DROP]
esac
esac
| Binop (bop, left, right) ->
case env.genLabels (2) of
[leftLab, rightLab, env] ->
case compile (leftLab, env, left) of
[leftLabUsed, env, leftCode] ->
case compile (rightLab, env, right) of
[rightLabUsed, env, rightCode] ->
[false, env, leftCode <+> label (leftLab, leftLabUsed) <+> rightCode <+> label (rightLab, rightLabUsed) <+ BINOP (bop)]
esac
esac
esac
| Seq (s1, s2) ->
case env.genLabel of
[s2Lab, env] ->
case compile (s2Lab, env, s1) of
Expand All @@ -174,20 +226,27 @@ public fun compileSM (stmt) {
esac
esac
| 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]
case env.genLabels (2) of
[conditionLab, elseBranchLab, env] ->
case compile (lab, env, condition) of
[conditionLabUsed, env, conditionCode] ->
case compile (lab, env, ifBranch) of
[_, env, ifBranchCode] ->
case compile (lab, env, elseBranch) of
[_, env, elseBranchCode] ->
[true, env, conditionCode <+> label (conditionLab, conditionLabUsed) <+ CJMP ("z", elseBranchLab) <+> ifBranchCode <+ JMP (lab) <+ LABEL (elseBranchLab) <+> elseBranchCode]
esac
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)]
case env.genLabels (3) of
[afterConditionLab, beforeConditionLab, bodyLab, env] ->
case compile (afterConditionLab, env, condition) of
[afterConditionLabUsed, env, conditionCode] ->
case compile (beforeConditionLab, env, body) of
[_, env, bodyCode] -> [true, env, singletonBuffer (LABEL (beforeConditionLab)) <+> compileExpr (condition) <+> label (afterConditionLab, afterConditionLabUsed) <+ CJMP ("z", lab) <+> bodyCode <+ JMP (beforeConditionLab)]
esac
esac
esac
| DoWhile (body, condition) -> compile (lab, env, Seq (body, While (condition, body)))
Expand Down
Loading

0 comments on commit 03df9b8

Please sign in to comment.