Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
72 changes: 63 additions & 9 deletions src/Expr.lama
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@ public fun evalOp (op, l, r) {
-- Helper function: checks that given name designates a regular variable in
-- a given state
fun lookupVal (state, name) {
case state.lookup (name) of
case lookup (state, name) of
x@Val (_) -> x
| _ -> error (sprintf ("the name ""%s"" does not designate a variable", name), getLoc (name))
esac
Expand All @@ -70,22 +70,22 @@ fun lookupVal (state, name) {
-- Helper function: checks that given name designates a function in
-- a given state
fun lookupFun (state, name) {
case state.lookup (name) of
case lookup (state, name) of
x@Fun (_, _) -> x
| _ -> 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, Val (0))}, state, names)
foldl (fun (s, name) {addName (s, name, Val (0))}, state, names)
}

-- Helper function: adds a function in current scope
fun addFunction (state, name, args, body) {
state.addName (name, Fun (args, body))
addName (state, name, Fun (args, body))
}

-- Evaluates a list of expressions, properly threading a configurations.
-- Returns the final configuration and the list of values
fun evalList (c, exprs) {
Expand All @@ -100,15 +100,69 @@ fun evalList (c, exprs) {
esac
}

(* Assignment *)
fun scopeHelper(s, expr) {
case expr of
Var (x) -> addNames(s, x)
| Fun (name, args, body) -> addFunction(s, name, args, body)
esac
}

fun callHelper(s, [name, value]) { addName(s, name, Val (value)) }

fun eval (c@[s, w], expr) {
failure ("evalExpr not implemented\n")
case expr of
Const (n) -> [c, n]
| Var (x) -> let Val (v) = lookupVal(s, x) in [c, v]
| Ref (x) -> [c, Ref (x)]
| Binop (op, e1, e2) -> let [c, {l, r}] = evalList(c, {e1, e2}) in [c, (evalOp(op, l, r))]
| Skip -> [c, Void]
| Assn(e1, e2) -> case evalList(c, {e1, e2}) of
[[s, w], { Ref (x), v }] -> [[s <- [x, Val (v)], w], v]
| [[s, w], { ElemRef (Sexp (_, arr), i), v }] -> arr[i] := v; [[s, w], v]
| [[s, w], { ElemRef (arr, i), v }] -> arr[i] := v; [[s, w], v]
esac
| Seq (e1, e2) -> let [c1, _] = eval(c, e1) in eval(c1, e2)
| If (e, s1, s2) -> let [c1, n] = eval(c, e) in if (n != 0) then eval(c1, s1) else eval(c1, s2) fi
| While (e, s) -> let [c1, n] = eval(c, e) in if (n == 0) then [c1, Void] else
let [c2, _] = eval(c1, s) in eval(c2, While (e, s))
fi
| DoWhile (s, e) -> evalList(c, {s, While (e, s)})
| Ignore (e) -> let [c, _] = eval(c, e) in [c, Void]
| Scope (ds, ss) -> let s = enterScope(s) in
let s = (foldl(scopeHelper, s, ds)) in
let [[s, w], v] = eval ([s, w], ss) in
[[leaveScope(s), w], v]
| Call (name, args) -> let Fun (argsNames, body) = lookupFun(s, name) in
let [[s, w], vs] = evalList(c, args) in
let s_inner = enterFunction(s) in
let s_inner = foldl(callHelper, s_inner, zip(argsNames, vs)) in
let [[s_inner, w], v] = eval([s_inner, w], body) in
[[leaveFunction(s, getGlobal(s_inner)), w], v]
| Builtin (x, args) -> let [[s, w], vs] = evalList (c, args) in
let [v, w] = evalBuiltin (x, vs, w) in
[[s, w], v]
| String (s) -> [c, s]
| Array (items) -> let [c, items] = evalList(c, items) in [c, listArray(items)]
| Elem (arr, i) -> let [c, arr] = eval(c, arr) in
let [c, i] = eval(c, i) in
case arr of
Sexp (_, arr) -> [c, arr[i]]
| arr -> [c, arr[i]]
esac
| ElemRef (arr, i) -> let [c, arr] = eval(c, arr) in
let [c, i] = eval(c, i) in
case arr of
Sexp (_, arr) -> [c, ElemRef (arr, i)]
| arr -> [c, ElemRef (arr, i)]
esac
| Sexp (tag, arr) -> let [c, arr] = evalList(c, arr) in [c, Sexp (tag, listArray(arr))]
esac
}

-- Evaluates a program with a given input and returns an output
public fun evalExpr (input, expr) {
case eval ([emptyState ().enterScope.addName ("read", Fun ({}, External))
.addName ("write", Fun ({"a"}, External))
.addName ("length", Fun ({"a"}, External)), createWorld (input)], expr) of
case eval ([emptyState ().enterScope, createWorld (input)], expr) of
[c, _] -> c.snd.getOutput
esac
}
75 changes: 58 additions & 17 deletions src/Parser.lama
Original file line number Diff line number Diff line change
Expand Up @@ -71,7 +71,7 @@ fun list (item) {
-- initializers into assignments
fun expandScope (defs, expr) {
fun expandDefs (defs, expr) {
foldr (fun ([defs, expr], def) {
foldr (fun ([defs, expr], def) {
case def of
[ident, None] -> [ident : defs, expr]
| [ident, Some (value)] -> [ident : defs, Seq (Ignore (Assn (Ref (ident), value)), expr)]
Expand All @@ -81,7 +81,7 @@ fun expandScope (defs, expr) {
defs)
}

case
case
foldr (fun ([defs, expr], def) {
case def of
f@Fun (_, _, _) -> [f : defs, expr]
Expand All @@ -94,7 +94,7 @@ fun expandScope (defs, expr) {
[{}, expr],
defs) of
[defs, expr] -> Scope (defs, expr)
esac
esac
}

-- Helper AST function: distributes a scope through an expression
Expand Down Expand Up @@ -124,17 +124,58 @@ var primary = memo $ eta syntax (
loc=pos x=decimal {fun (a) {assertValue (a, Const (stringInt (x)), loc)}} |

-- identifier
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), loc)
esac
}} |
$(failure ("the rest of primary parsing in not implemented\n"))),
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, case x of
"read" -> Builtin (x, args)
| "write" -> Builtin (x, args)
| "length" -> Builtin (x, args)
| "stringval" -> Builtin (x, args)
| _ -> Call (x, args)
esac, loc)
esac
}} |
(* Assignment *)
-- brackets
inbr[s("("), scopeExpr, s(")")] |
-- skip
loc=pos kSkip {fun(a) { assertVoid(a, Skip, loc) }} |
-- if elif else fi
loc=pos kIf e=scopeExpr kThen s1=scopeExpr elf=(-kElif scopeExpr -kThen scopeExpr)* s2=(-kElse scopeExpr)? kFi {
fun helper (final, elf, type) {
case elf of
{} -> final
| [e, s]:elf -> If (e(Val), s(type), helper(final, elf, type))
esac
}
fun (a) {
distributeScope(e(Val), fun (expr) { If(expr, s1(a), helper (
case s2 of
None -> assertVoid(a, Skip, loc)
| Some (s) -> s(a)
esac,
elf, a)) })
}
} |
-- while do od
loc=pos kWhile e=scopeExpr kDo s=scopeExpr kOd {fun(a) { assertVoid(a, While(e(Val), s(Void)), loc) }} |
-- do while od
loc=pos kDo s=scopeExpr kWhile e=scopeExpr kOd {fun(a) {
distributeScope(s(Void), fun (expr) { assertVoid(a, DoWhile(expr, e(Val)), loc) })
}} |
-- for do od
kFor s1=scopeExpr s[","] cond=scopeExpr s[","] s2=scopeExpr kDo s=scopeExpr kOd { fun (a) {
assertVoid (a, distributeScope (s1 (Void), fun (i) {
Seq (i, While (cond (Val), Seq ( s (Void), s2 (Void))))
}), loc)
}
}),
(* End *)
basic = memo $ eta (expr ({[Right, {[s (":="),
fun (l, loc, r) {
fun (a) {assertValue (a, Assn (l (Ref), r (Val)), loc)}
Expand Down Expand Up @@ -163,9 +204,9 @@ var primary = memo $ eta syntax (
scopeExpr = memo $ eta syntax (ds=definition* e=exp? {fun (a) {fun (e) {
case ds of
{} -> e
| _ -> expandScope (ds, e)
| _ -> expandScope (ds, e)
esac
} (case e of
} (case e of
Some (e) -> e (a)
| _ -> Skip
esac)
Expand All @@ -176,7 +217,7 @@ var primary = memo $ eta syntax (
body=inbr[s("{"), scopeExpr, s("}")] {
Fun (name, args, body (Weak))
}
),
),
exp = memo $ eta syntax (basic | s1=basic s[";"] s2=exp {fun (a) {Seq (s1 (Void), s2 (a))}});

-- Public top-level parser
Expand Down
Loading