Commit 7b630f28 authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

record field selection

parent ff729da7
......@@ -140,6 +140,7 @@ void set_create_thunk_fun(Code* code)
case CT_SELECT_ADT:
case CT_SELECT_LIT:
case CT_SELECT_STR:
case CT_SELECT_REC:
case CT_IF:
case CT_LET:
code->create_thunk = NULL;
......@@ -702,6 +703,28 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
abort("no match");
}
case CT_SELECT_REC:
{
SelectEntry* select = (SelectEntry*) expr;
push_a(NULL);
exec(select->expr, frame_ptr, stack_top_a);
Thunk* cons = pop_a();
expr = select->bodies[0];
if(expr != NULL)
{
for (int i = 0; i < cons->desc->arity; i++) {
push_a(cons->_args[i]);
}
continue;
}
// This cannot happen in record field selection
abort("no match");
}
case CT_IF:
{
placeholder();
......
......@@ -19,6 +19,7 @@ enum CodeType {
CT_SELECT_ADT,
CT_SELECT_LIT,
CT_SELECT_STR,
CT_SELECT_REC, // Record field selection
CT_IF,
CT_LET,
CT_THUNK // constant, always fits the B stack
......
......@@ -541,30 +541,48 @@ SelectEntry* parseSelect(char **ptr, Code* fallback, int fallback_nrargs) {
if(isADT)
{
(*ptr)++;
int nrConses = 1;
ADTEntry* firstCase = (ADTEntry*) parseFunName(ptr);
Code* firstBody = (Code*) parseSelectBody(ptr, child_fallback,
child_fallback_base_nrargs + firstCase->base.arity);
Desc* firstCase = (Desc*) parseFunName(ptr);
entry = (SelectEntry*) alloc_code(sizeof (SelectEntry) + sizeof (Code*) * firstCase->nrConses);
entry->base.type = CT_SELECT_ADT;
entry->base.nr_cases = firstCase->nrConses;
// set the default case for all the entries
for (int i = 0; i < firstCase->nrConses; i++) {
entry->bodies[i] = defaultBody;
if(firstCase->type == FT_ADT)
{
nrConses = ((ADTEntry*) firstCase)->nrConses;
}
if(isDefault) nrCases--;
Code* firstBody = (Code*) parseSelectBody(ptr, child_fallback,
child_fallback_base_nrargs + firstCase->arity);
nrCases--; // firstCase
entry->bodies[firstCase->idx] = firstBody;
entry = (SelectEntry*) alloc_code(sizeof (SelectEntry) + sizeof (Code*) * nrConses);
for (int i = 0; i < nrCases; i++) {
(*ptr)++; // skip type
ADTEntry* nextCase = (ADTEntry*) parseFunName(ptr);
entry->bodies[nextCase->idx] = (Code*) parseSelectBody(ptr, child_fallback,
child_fallback_base_nrargs + nextCase->base.arity);
if(firstCase->type == FT_ADT)
{
entry->base.type = CT_SELECT_ADT;
entry->base.nr_cases = nrConses;
// set the default case for all the entries
for (int i = 0; i < nrConses; i++) {
entry->bodies[i] = defaultBody;
}
if(isDefault) nrCases--;
nrCases--; // firstCase
entry->bodies[((ADTEntry*)firstCase)->idx] = firstBody;
for (int i = 0; i < nrCases; i++) {
(*ptr)++; // skip type
ADTEntry* nextCase = (ADTEntry*) parseFunName(ptr);
entry->bodies[nextCase->idx] = (Code*) parseSelectBody(ptr, child_fallback,
child_fallback_base_nrargs + nextCase->base.arity);
}
}
else
{
entry->base.type = CT_SELECT_REC;
entry->base.nr_cases = 1;
entry->bodies[0] = firstBody;
}
}
else
......
main = record.Start
record.Start = _Tuple2 (record.sel1 record.rec) (record.sel2 record.rec)
record.rec = record._R 9 "nine"
:: record._R = {record.f1::I, record.f2}
record.sel2 !_x_0 = select _x_0 (record._R f1_1_0 f2_1_1 -> f2_1_1)
record.sel1::I !_x_0 = select _x_0 (record._R f1_1_0 f2_1_1 -> f1_1_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