Skip to content

[ITMO] T09 Boyko Vladislav #1894

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
Leatherlord wants to merge 1 commit into
base: T09
Choose a base branch
from
Open

[ITMO] T09 Boyko Vladislav #1894

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
82 changes: 67 additions & 15 deletions src/Expr.lama
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,6 @@ import State;
import World;
import Lexer;
import Parser;
import Fun;
import Builtins;

-- As association map which maps "\otimes" into "\oplus"
Expand Down Expand Up @@ -40,8 +39,7 @@ public fun evalOp (op, l, r) {
--
-- A expression is represented by a data structure of the following shape:
--
-- expr = Assn (expr, expr) |
-- Set (string, expr) |
-- expr = Assn (string, expr) |
-- Seq (expr, expr) |
-- Skip |
-- if (expr, expr, expr) |
Expand All @@ -57,12 +55,13 @@ public fun evalOp (op, l, r) {
-- Array (expr list) |
-- Elem (expr, expr) |
-- ElemRef (expr, expr) |
-- Sexp (string, expr list) |
-- Builtin (string, expr list)

-- 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 @@ -71,28 +70,28 @@ 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) {
case foldl (fun ([c, vals], e) {
case eval (c, e) of
[c, v] -> [c, v : vals]
[c, vl] -> [c, vl : vals]
esac
},
[c, {}],
Expand All @@ -101,16 +100,69 @@ fun evalList (c, exprs) {
esac
}

fun eval (c@[s, w], expr) {
failure ("evalExpr not implemented\n")
(* 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) {
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
}
}
107 changes: 68 additions & 39 deletions src/Parser.lama
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -70,43 +70,31 @@ fun list (item) {
-- Helper AST function: expands a "raw" scope expression, reifying
-- initializers into assignments
fun expandScope (defs, expr) {
fun expandVarDefs (defs, expr) {
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 (Set (ident, value)), expr)]
| [ident, Some (value)] -> [ident : defs, Seq (Ignore (Assn (Ref (ident), value)), expr)]
esac
},
[{}, expr],
defs)
}

fun expandValDefs (defs, expr) {
foldr (fun ([defs, expr], [ident, value]) {
[ident : defs, Seq (Ignore (Set (ident, value)), expr)]
},
[{}, expr],
defs)
}

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

-- Helper AST function: distributes a scope through an expression
Expand All @@ -116,17 +104,22 @@ fun distributeScope (expr, exprConstructor) {
| _ -> exprConstructor (expr)
esac
}

var primary = memo $ eta syntax (
-- S-expression
loc=pos tag=uident
args=(args=inbr[s("("), list (syntax (e=exp {e (Val)})), s(")")]? {case args of
Some (args) -> args | None -> {} esac}) {fun (a) {assertValue (a, Sexp (tag, args), loc)}} |

-- array constant
loc=pos x=inbr[s("["), list0(syntax (e=exp {e(Val)})), s("]")] {fun (a) {assertValue (a, Array (x), loc)}} |

-- string constant
loc=pos x=strlit {fun (a) {assertValue (a, String (x), loc)}} |

-- character literal
loc=pos x=chrlit {fun (a) {assertValue (a, Const (x), loc)}} |

-- decimal constant
loc=pos x=decimal {fun (a) {assertValue (a, Const (stringInt (x)), loc)}} |

Expand All @@ -138,58 +131,94 @@ var primary = memo $ eta syntax (
| Void -> Ignore (Var (x))
| _ -> Var (x)
esac
| Some (args) -> assertValue (a, Call (x, args))
| 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
}} |

-- S-expression
loc=pos x=uident args=inbr[s("("), list0(syntax(e=exp {e(Val)})), s(")")]? {fun (a) {assertValue (a, Sexp (x, case args of
None -> {}
| Some (args) -> args
esac), loc)}} |
$(failure ("the rest of primary parsing in not implemented\n"))),
(* 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)}
}]}],
}]}],
[Left , map (binop, {"!!"})],
[Left , map (binop, {"&&"})],
[Nona , map (binop, {"==", "!=", "<", ">", "<=", ">="})],
[Left , map (binop, {"+", "-"})],
[Left , map (binop, {"*", "/", "%"})]
},
postfix)),
postfix = memo $ eta syntax (loc=pos e=primary ps=(i=inbr[s("["), exp, s("]")] {Index (i (Val))})* {fun (a) {foldl (fun (e, p) { case p of
postfix = memo $ eta syntax (loc=pos e=primary ps=(i=inbr[s("["), exp, s("]")] {Index (i (Val))})* {
fun (a) {foldl (fun (e, p) {
case p of
Index (i) ->
fun (a) {
case a of
Ref -> ElemRef (e (Val), i)
| _ -> assertValue (a, Elem (e (Val), i), loc)
esac
}
esac
esac
}, e, ps) (a)
}}
),
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)
}}),
definition = memo $ eta syntax (kVar ds=list[syntax (lident (s["="] e=basic {e (Val)})?)] s[";"] {Var (ds)} |
kVal ds=list[syntax (lident (s["="] e=basic {e (Val)}))] s[";"] {Val (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))}});

-- Public top-level parser
public parse = syntax (s=scopeExpr {s (Void)});
public parse = syntax (s=scopeExpr {s (Void)});
Loading