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
55 changes: 54 additions & 1 deletion src/Expr.lama
Original file line number Diff line number Diff line change
Expand Up @@ -94,9 +94,62 @@ fun evalList (c, exprs) {
esac
}

fun addArgs (state, args, vals) {
foldl(fun (s, [arg, value]) {s.addName(arg, value)}, state, zip(args, vals))
}

fun scopeFoldl (state, decs) {
foldl(fun (s, dec) {
case dec of
Var(n) -> s.addNames(n)
| Fun(n, a, b) -> s.addFunction(n, a, b)
esac
}, state, decs)
}
(* Assignment *)
fun eval (c@[s, w], expr) {
failure ("evalExpr not implemented\n")
case expr of
Var(v) -> [c, s.lookup(v)]
| Ref(r) -> [c, r]
| Const(i) -> [c, i]
| Skip -> [c, None]
| Binop(op, expr1, expr2) -> let [c, {l, r}] = evalList(c, {expr1, expr2}) in [c, evalOp(op, l, r)]
| Assn(expr1, expr2) ->
case evalList(c, {expr1, expr2}) of
[c@[s, w], {left, right}] -> [[s <- [left, right], w], right]
esac
| Seq(expr1, expr2) -> let [c, v] = eval(c, expr1) in eval(c, expr2)
| Read(v) ->
case readWorld(w) of
[r, w] -> [[s <- [v, r], w], 0]
esac
| Write(exp) ->
case eval(c, exp) of
[c@[s, w], new] -> [[s, writeWorld(new, w)], 0]
esac
| If(state, try, fls) ->
case eval(c, state) of
[c, v] -> if v then eval(c, try) else eval(c, fls) fi
esac
| While(state, body) ->
case eval(c, state) of
[c, 0] -> [c, 0]
| [c, _] -> let [c, _] = eval(c, body) in eval(c, While(state, body))
esac
| DoWhile(state, body) -> eval(c, Seq(body, While(state, body)))
| Ignore(expr) -> [eval(c, expr)[0], None]
| Scope(d, expr) -> case eval([s.enterScope.scopeFoldl(d), w], expr) of
[[s, world], v] -> [[s.leaveScope, world], v]
esac
| Call(f, expr) -> case evalList(c, expr) of
[[s, world], vals]-> case s.lookup(f) of
Fun(args, body) -> case eval([s.enterFunction.addArgs(args, vals), world], body) of
[[ss, world], v] -> [[s.leaveFunction(ss.getGlobal), world], v]
esac
esac
esac
| _ -> [c, None]
esac
}
(* End *)

Expand Down
222 changes: 117 additions & 105 deletions src/Parser.lama
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
-- Parser

import Ostap;
import Lexer;
import List;
Expand All @@ -10,148 +9,161 @@ import Collection;

-- Signals an error; takes an error message and location info
public fun error (msg, loc) {
failure ("%s at %d:%d\n", msg, loc.fst, loc.snd)
failure("%s at %d:%d\n", msg, loc.fst, loc.snd)
}

-- An attribute-processing functions
-- Attributes are:
-- Val --- a plain value (aka "rvalue")
-- Ref --- a reference to a mutable cell (aka "lvalue")
-- Void --- no value (aka "void"/"unit")
-- Weak --- works like Val, but allows to provide a "default" value for void constructs

-- Checks if a plain value "val" can be used in the context described by
-- the attribute "atr".
fun assertValue (atr, v, loc) {
case atr of
Ref -> error ("reference expected", loc)
| Void -> Ignore (v)
| _ -> v
esac
case atr of
Ref -> error("reference expected", loc)
| Void -> Ignore(v)
| _ -> v
esac
}

-- Checks if a void epxression can be used in the context described by
-- the attribute "atr".
fun assertVoid (atr, v, loc) {
case atr of
Void -> v
| Val -> error ("value expected", loc)
| Weak -> Seq (v, Const (0))
| _ -> error ("reference expected", loc)
esac
case atr of
Void -> v
| Val -> error("value expected", loc)
| Weak -> Seq(v, Const(0))
| _ -> error("reference expected", loc)
esac
}

-- A parser of "something" in brackets; l, r are left and right
-- brackets as parsers, p --- a parser of "something"
fun inbr (l, p, r) {
syntax (-l p -r)
syntax (-l p -r)
}

-- A helper function to be used with super-combinator "expr"
fun binop (op) {
[syntax (pos -s[op]), fun (l, loc, r) {
fun (a) {
assertValue (a, Binop (op, l (Val), r (Val)), loc)
}
}
]
[syntax (pos -s[op]), fun (l, loc, r) {fun (a) {assertValue(a, Binop(op, l(Val), r(Val)), loc)}}]
}

-- Helper parser: parses a (possible empty) list of items separated by ","
fun list0 (item) {
list0By (item, s(","))
list0By(item, s(","))
}

-- Helper parser: parses a non-empty list of items separated by ","
fun list (item) {
listBy (item, s(","))
listBy(item, s(","))
}

-- Helper AST function: expands a "raw" scope expression, reifying
-- initializers into assignments
fun expandScope (defs, expr) {
fun expandDefs (defs, expr) {
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)]
esac
},
[{}, expr],
defs)
}

case
foldr (fun ([defs, expr], def) {
fun expandDefs (defs, expr) {
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)]
esac
}, [{}, expr], defs)
}

case foldr(fun ([defs, expr], def) {
case def of
f@Fun (_, _, _) -> [f : defs, expr]
| Var (ds) ->
case expandDefs (ds, expr) of
[ds, expr] -> [Var (ds) : defs, expr]
esac
f@Fun(_, _, _) -> [f : defs, expr]
| Var(ds) -> case expandDefs(ds, expr) of
[ds, expr] -> [Var(ds) : defs, expr]
esac
esac
},
[{}, expr],
defs) of
[defs, expr] -> Scope (defs, expr)
esac
}, [{}, expr], defs) of
[defs, expr] -> Scope(defs, expr)
esac
}

-- Helper AST function: distributes a scope through an expression
fun distributeScope (expr, exprConstructor) {
case expr of
Scope (defs, sexpr) -> Scope (defs, exprConstructor (sexpr))
| _ -> exprConstructor (expr)
esac
case expr of
Scope(defs, sexpr) -> Scope(defs, exprConstructor(sexpr))
| _ -> exprConstructor(expr)
esac
}

var primary = memo $ eta syntax (
-- decimal constant
loc=pos x=decimal {fun (a) {assertValue (a, Const (stringInt (x)), loc)}} |
-- decimal constant
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
}
} |

(* Assignment *)
inbr[s("("), scopeExpr, s(")")] |
kRead expres=inbr[s("("), lident, s(")")] {fun (a) {assertVoid(a, Read(expres), loc)}} |
kSkip {fun (a) {assertVoid(a, Skip, loc)}} |
kWrite expres=inbr[s("("), scopeExpr, s(")")] {fun (a) {assertVoid(a, Write(expres(Val)), loc)}} |
kIf expres=scopeExpr kThen s1=scopeExpr s2=ifRec {fun (a) {If(expres(Val), s1(a), s2(a))}} |
kThen {fun (a) {assertVoid(a, Skip, loc)}} |
kWhile expres=scopeExpr kDo s=scopeExpr kOd {fun (a) {assertVoid(a, While(expres(Val), s(Void)), loc)}} |
kDo s=scopeExpr kWhile e=scopeExpr kOd {
fun (a) {assertVoid(a, distributeScope(s(Void), fun (i) {DoWhile(e(Val), i)}), loc)}
} |
kDo s=scopeExpr kWhile expres=scopeExpr kOd {fun (a) {assertVoid(a, distributeScope(s(Void), fun (i) {DoWhile(expres(Val), i)}), loc)}} |

kFor i0=scopeExpr s[","] cond=scopeExpr s[","] step=scopeExpr kDo body=scopeExpr kOd {
fun (a) { assertVoid(a, distributeScope(i0(Void),
fun (init) {Seq(init, While(cond(Val), Seq(body(Void), step(Void))))}), loc)
}
}
),
(* End *)
basic = memo $ eta (
expr({[Right, {[s(":="), fun (l, loc, r) {fun (a) {assertValue(a, Assn(l(Ref), r(Val)), loc)}}]}],
[Left, map(binop, {"!!"})],
[Left, map(binop, {"&&"})],
[Nona, map(binop, {"==", "!=", "<", ">", "<=", ">="})],
[Left, map(binop, {"+", "-"})],
[Left, map(binop, {"*", "/", "%"})]}, primary)
),
scopeExpr = memo $ eta syntax (
ds=definition* e=exp? {
fun (a) {
fun (e) {
case ds of
{} -> e
| _ -> expandScope(ds, e)
esac
}(case e of
Some(e) -> e(a)
| _ -> Skip
esac)
}
}
),
definition = memo $ eta syntax (
kVar ds=list[syntax (lident (s["="] e=basic {e(Val)})?)] s[";"] {Var(ds)} |

kFun name=lident args=inbr[s("("),
list0(lident),
s(")")] 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))}}
),
ifRec = memo $ eta syntax (
kElif expres=exp kThen try=scopeExpr fls=ifRec {fun (a) {If(expres(Val), try(a), fls(a))}} |

-- 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
}} |
(* Assignment *)
$(failure ("the rest of primary parsing in not implemented\n"))),
(* End *)
basic = memo $ eta (expr ({[Right, {[s (":="),
fun (l, loc, r) {
fun (a) {assertValue (a, Assn (l (Ref), r (Val)), loc)}
}]}],
[Left , map (binop, {"!!"})],
[Left , map (binop, {"&&"})],
[Nona , map (binop, {"==", "!=", "<", ">", "<=", ">="})],
[Left , map (binop, {"+", "-"})],
[Left , map (binop, {"*", "/", "%"})]
},
primary)),
scopeExpr = memo $ eta syntax (ds=definition* e=exp? {fun (a) {fun (e) {
case ds of
{} -> e
| _ -> expandScope (ds, e)
esac
} (case e of
Some (e) -> e (a)
| _ -> Skip
esac)
}}),
definition = memo $ eta syntax (kVar ds=list[syntax (lident (s["="] e=basic {e (Val)})?)] s[";"] {Var (ds)} |
kFun name=lident
args=inbr[s("("), list0 (lident), s(")")]
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))}});
kElse s2=scopeExpr kFi {fun (a) {s2(a)}} |

kFi {fun (a) {assertVoid(a, Skip, loc)}}
);
-- Public top-level parser
public parse = syntax (s=scopeExpr {s (Void)});
public parse = syntax (s=scopeExpr {s(Void)});
Loading