Commit 571f9aff authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

record update syntax basically works. needs more tests

parent 31dbc0df
......@@ -164,6 +164,8 @@ void set_create_thunk_fun(Code* code)
case CT_SELECT:
code->create_thunk = create_thunk_select;
break;
case CT_UPDATE:
// it is always lifted to a function when at lazy position
case CT_CASE_ADT:
case CT_CASE_LIT:
case CT_CASE_STR:
......@@ -813,6 +815,29 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
destroy_stack_frame_b(root_frame_ptr_b);
return;
}
case CT_UPDATE:
{
push_a(NULL);
exec(((UpdateEntry*) expr)->expr, frame_ptr, stack_top_a);
Thunk* rec = pop_a();
Thunk* newrec = (Thunk*) alloc_heap(rec->desc->thunk_size);
memcpy(newrec, rec, rec->desc->thunk_size);
for(int i=0; i<expr->nr_updates; i++)
{
// TODO: check strictness
Code* upd = ((UpdateEntry*) expr)->updates[i]->expr;
upd->create_thunk(upd, &newrec->_args[((UpdateEntry*) expr)->updates[i]->idx], frame_ptr);
}
forward_thunk(newrec, root_frame_ptr);
set_return(root_frame_ptr, newrec);
destroy_stack_frame(root_frame_ptr);
destroy_stack_frame_b(root_frame_ptr_b);
return;
}
case CT_CASE_STR:
{
push_a(NULL);
......
......@@ -15,7 +15,8 @@ enum CodeType {
CT_APP_FUN1,
CT_APP_FUN2,
CT_APP_FUN_TR, // tail recursive
CT_SELECT,
CT_SELECT, // record field select
CT_UPDATE, // record update
CT_CASE_ADT,
CT_CASE_LIT,
CT_CASE_STR,
......@@ -30,6 +31,7 @@ struct Code {
unsigned int nr_args : 5; // used in AppEntry
unsigned int nr_cases : 5; // used in SelectEntry
unsigned int nr_bindings : 8; // used in LetEntry
unsigned int nr_updates : 4; // used in UpdateEntry
unsigned int strict : 1; // used in VarEntry
unsigned int arg_pattern : 4;
void (*create_thunk)(Code*, struct Thunk**, int);
......@@ -60,6 +62,17 @@ struct SelectEntry {
Thunk idx;
};
struct UpdateEntry {
struct Code base;
struct Code* expr;
struct OneUpdateEntry* updates[];
};
struct OneUpdateEntry {
struct Code* expr;
int idx;
};
struct CaseLitCaseEntry {
struct Code* body;
struct ThunkEntry* lit; // NULL -> default
......
......@@ -668,6 +668,33 @@ SelectEntry* parseSelect(char **ptr) {
return entry;
}
UpdateEntry* parseUpdate(char **ptr) {
Code* recExpr = parseTerm(ptr);
int nrUpdates;
if (!parseInt(ptr, &nrUpdates)) return 0;
struct UpdateEntry* entry = (UpdateEntry*) alloc_code(sizeof (UpdateEntry) + sizeof (OneUpdateEntry*) * nrUpdates);
entry->expr = recExpr;
entry->base.type = CT_UPDATE;
entry->base.nr_updates = nrUpdates;
for(int i=0; i<nrUpdates; i++)
{
struct OneUpdateEntry* upd = (OneUpdateEntry*) alloc_code(sizeof (OneUpdateEntry));
if (!parseInt(ptr, &upd->idx)) return 0;
upd->expr = parseTerm(ptr);
entry->updates[i] = upd;
}
set_create_thunk_fun((Code*) entry);
return entry;
}
LetEntry* parseLet(char **ptr) {
Code* body = parseTerm(ptr);
......@@ -726,6 +753,8 @@ Code* parseTerm(char **ptr) {
return (Code*) parseApp(ptr, true, false);
case 'S': // Select
return (Code*) parseSelect(ptr);
case 'U': // Update
return (Code*) parseUpdate(ptr);
case 'C': // Case
return (Code*) parseCase(ptr, NULL, 0);
case 'I': // If
......
......@@ -93,11 +93,14 @@ sList0 f [] a = a
sNum num a = a <++ num <++ " "
sText text a = a <++ sNum (textSize text) <++ text
sOneUpdate ctx (idx, expr) a = a <++ sNum idx <++ sTerm ctx expr
sTerm ctx t a = sTermS ctx (simplify t) a
where
sTermS ctx (SLit lit) a = a <++ "L" <++ lit
sTermS ctx (SVar var) a = a <++ sVarApp ctx var
sTermS ctx (SSelect expr _ idx) a = a <++ "S" <++ sTerm {ctx & inspine = False} expr <++ sNum idx
sTermS ctx (SUpdate expr _ upds) a = a <++ "U" <++ sTerm {ctx & inspine = False} expr <++ sList (sOneUpdate ctx) upds
// The function part could by arbitrary SaplTerm in theory, but in practice at this point
// it can be only SVar
sTermS ctx (SApplication (SVar var) terms) a = a <++ appType ctx var <++ sNum (length terms) <++ sVar ctx var <++ sList0 (sTerm {ctx & inspine = False}) terms
......
main = record.Start
record.Start = update (record.r 1)::record._R [1:2,2:2]
:: record._R = {record.a::I, record.b::I, record.c::I}
record.r i_0::I = record._R (addI 1 i_0) (addI 2 i_0) (addI 3 i_0)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment