Skip to content
GitLab
Commit b5b61142 authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

better SELECT

parent d525bab2
Hide whitespace changes
Inline Side-by-side
interpreter/code.c
View file @ b5b61142
......@@ -138,7 +138,8 @@ void set_create_thunk_fun(Code* code)
case CT_THUNK:
code->create_thunk = create_thunk_thunk;
break;
case CT_SELECT:
case CT_SELECT_ADT:
case CT_SELECT_LIT:
case CT_IF:
code->create_thunk = NULL;
break;
......@@ -503,86 +504,56 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
destroy_stack_frame_b(root_frame_ptr_b);
return;
}
case CT_SELECT:
{
bool handled = false;
Thunk* pattern = alloc_b();
pattern->desc = (Desc*) __STACK_PLACEHOLDER__;
push_a(pattern);
case CT_SELECT_LIT:
{
Thunk* lit = alloc_b();
push_a(lit);
exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a);
pattern = pop_a();
lit = pop_a();
int i = 0;
do
{
assert(is_hnf(pattern));
for (;i < expr->nr_cases; i++) {
SelectCaseEntry* caseEntry = &((SelectEntry*) expr)->cases[i];
if (caseEntry->type == SC_CONS) {
// Pattern match
if ((Desc*) caseEntry->cons != pattern->desc) continue;
// Put the constructor arguments to the stack if matches
for (int i = 0; i < pattern->desc->arity; i++) {
push_a(pattern->_args[i]);
}
}
else if(caseEntry->type == SC_DEFAULT)
{
// accept it
}
else if (caseEntry->type == SC_LIT) {
assert(caseEntry->lit->thunk.desc != (Desc*) __INT__);
if(caseEntry->lit->thunk._int != pattern->_int) continue;
}
// must be SC_DEFAULT now
expr = caseEntry->body;
if(expr->type == CT_SELECT)
{
i=-1;
((SelectEntry*) expr)->saved_pattern = pattern;
pattern = alloc_b();
pattern->desc = (Desc*) __STACK_PLACEHOLDER__;
push_a(pattern);
exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a);
pattern = pop_a();
continue;
}
handled = true;
break;
}
bool handled = false;
for (int i = 0; i < expr->nr_cases; i++) {
SelectLitCaseEntry* caseEntry = &((SelectEntry*) expr)->cases[i];
if(!handled)
// NULL means "default", we accept it anyway
if(caseEntry->lit != NULL)
{
if(((SelectEntry*) expr)->fallback != NULL)
{
expr = (Code*) ((SelectEntry*) expr)->fallback;
i = ((SelectEntry*) expr)->fallbackidx;
pattern = ((SelectEntry*) expr)->saved_pattern;
}
else
{
printf("Exec: no select cases matches");
print(pattern, false);
exit(-1);
}
assert(caseEntry->lit->thunk.desc != (Desc*) __INT__);
if(caseEntry->lit->thunk._int != lit->_int) continue;
}
}
while(!handled);
// must be SC_DEFAULT now
handled = true;
expr = caseEntry->body;
break;
}
if(handled) continue;
not_implemented("fallback");
}
case CT_SELECT_ADT:
{
Thunk* cons = alloc_b();
cons->desc = (Desc*) __INT__;
push_a(cons);
exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a);
cons = pop_a();
expr = ((SelectEntry*) expr)->bodies[((ADTEntry*)cons->desc)->idx];
if(expr != NULL)
{
for (int i = 0; i < cons->desc->arity; i++) {
push_a(cons->_args[i]);
}
continue;
}
continue;
not_implemented("fallback");
}
case CT_IF:
{
......
interpreter/code.h
View file @ b5b61142
......@@ -9,7 +9,7 @@ enum CodeType {
CT_APP_PRIM2, CT_APP_PRIM_ST, CT_APP_PRIM_TS, CT_APP_PRIM_SS, CT_APP_PRIM_TA, CT_APP_PRIM_AT, CT_APP_PRIM_AS, CT_APP_PRIM_SA,
CT_APP_THUNK, CT_APP_DYN,
CT_APP_FUN, CT_APP_FUN1, CT_APP_FUN2,
CT_SELECT, CT_IF,
CT_SELECT_ADT, CT_SELECT_LIT, CT_IF,
CT_THUNK
};
......@@ -40,33 +40,20 @@ struct AppEntry {
struct Code* args[];
};
#define SC_CONS 1
#define SC_LIT 2
#define SC_DEFAULT 3
struct SelectCaseEntry {
int type;
struct Code* body;
Code* parent; // SelectEntry
union {
struct ADTEntry* cons;
struct ThunkEntry* lit;
};
struct SelectLitCaseEntry {
struct Code* body;
struct ThunkEntry* lit; // NULL -> default
};
struct SelectEntry {
struct Code base;
struct Code* expr;
SelectEntry* fallback;
int fallbackidx;
// save pattern temporarily before SelectEntry child is tried
Thunk* saved_pattern;
struct SelectCaseEntry cases[];
union
{
struct SelectLitCaseEntry cases[];
struct Code* bodies[];
};
};
struct IfEntry {
......
interpreter/desc.h
View file @ b5b61142
......@@ -26,6 +26,10 @@ struct SliceEntry {
struct ADTEntry {
struct Desc base;
int strictness;
unsigned int nrConses; // number of constructors in the type
unsigned int idx; // constructor index
char name[];
};
......
interpreter/main.c
View file @ b5b61142
......@@ -29,7 +29,7 @@ int main ( int argc, char *argv[] )
init_desc();
init_prim();
char* input = "..\\tests\\Eval.bsapl";
char* input = "..\\tests\\queens.bsapl";
if ( argc == 2 )
{
......@@ -77,7 +77,7 @@ int main ( int argc, char *argv[] )
// TODO: put it into a special "expression" space, instead of "code"
char *exprstream = "A0 F4 main";
Code* expr = parseTerm(&exprstream, NULL);
Code* expr = parseTerm(&exprstream);
#ifdef BENCHMARK
struct timeval t1, t2;
......
interpreter/parse.c
View file @ b5b61142
......@@ -165,6 +165,8 @@ int parseDef1(char** ptr) {
entry->base.thunk_size = thunk_size_f(arity);
entry->base.unboxable = false;
entry->base.hnf = true;
entry->idx = i;
entry->nrConses = conNum;
// now the name can be copied into the ADTEntry
memcpy(entry->name, namePtr, nameLength);
......@@ -302,7 +304,7 @@ VarEntry* parseVar(char **ptr, VarEntry* target) {
return entry;
}
Code* parseTerm(char **ptr, SelectCaseEntry* fallback);
Code* parseTerm(char **ptr);
/*
* It is very messy, because it handles 3 cases:
......@@ -344,7 +346,7 @@ Code* parseApp(char **ptr, bool dynamic) {
entry = (AppEntry*) alloc_code(sizeof (AppEntry) + sizeof (void*) * nrArgs);
for (int i = 0; i < nrArgs; i++) {
entry->args[i] = parseTerm(ptr, NULL);
entry->args[i] = parseTerm(ptr);
if (entry->args[i] == 0) return 0;
}
......@@ -434,51 +436,80 @@ Code* parseApp(char **ptr, bool dynamic) {
return (Code*) entry;
}
SelectEntry* parseSelect(char **ptr, SelectCaseEntry* fallback) {
Code* expr = parseTerm(ptr, NULL);
SelectEntry* parseSelect(char **ptr) {
Code* expr = parseTerm(ptr);
int nrCases;
if (!parseInt(ptr, &nrCases)) return 0;
struct SelectEntry* entry = (SelectEntry*) alloc_code(sizeof (SelectEntry) + sizeof (SelectCaseEntry) * nrCases);
entry->base.type = CT_SELECT;
entry->base.nr_cases = nrCases;
entry->expr = expr;
for (int i = 0; i < nrCases; i++) {
char type = *(*ptr)++;
switch (type) {
case 'C':
entry->cases[i].type = SC_CONS;
entry->cases[i].cons = (ADTEntry*) parseFunName(ptr);
break;
case 'L':
entry->cases[i].type = SC_LIT;
entry->cases[i].lit = parseLit(ptr);
break;
case 'D':
entry->cases[i].type = SC_DEFAULT;
break;
default:
return 0; // unknown case
}
struct SelectEntry* entry = NULL;
char type = **ptr;
entry->cases[i].parent = (Code*) entry;
entry->cases[i].body = (Code*) parseTerm(ptr, &entry->cases[i]);
bool isDefault = false;
Code* defaultBody = NULL;
// Default is always the first
if(type == 'D')
{
isDefault = true;
(*ptr)++;
defaultBody = (Code*) parseTerm(ptr);
type = **ptr;
}
if(fallback != NULL)
bool isADT = type == 'C';
if(isADT)
{
SelectEntry* parent = (SelectEntry*) fallback->parent;
entry->fallback = parent;
entry->fallbackidx = (fallback - parent->cases) + 1;
(*ptr)++;
ADTEntry* firstCase = (ADTEntry*) parseFunName(ptr);
Code* firstBody = (Code*) parseTerm(ptr);
entry = (SelectEntry*) alloc_code(sizeof (SelectEntry) + sizeof (Code*) * firstCase->nrConses);
entry->base.type = CT_SELECT_ADT;
entry->base.nr_cases = firstCase->nrConses;
entry->expr = expr;
// set the default case for all the entries
for (int i = 0; i < firstCase->nrConses; i++) {
entry->bodies[i] = defaultBody;
}
if(isDefault) nrCases--;
nrCases--; // firstCase
entry->bodies[firstCase->idx] = firstBody;
for (int i = 0; i < nrCases; i++) {
(*ptr)++; // skip type
ADTEntry* nextCase = (ADTEntry*) parseFunName(ptr);
entry->bodies[nextCase->idx] = (Code*) parseTerm(ptr);
}
}
else
{
entry->fallback = NULL;
entry = (SelectEntry*) alloc_code(sizeof (SelectEntry) + sizeof (SelectLitCaseEntry) * nrCases);
entry->base.type = CT_SELECT_LIT;
entry->base.nr_cases = nrCases;
entry->expr = expr;
if(isDefault)
{
nrCases--;
entry->cases[nrCases].body = defaultBody;
entry->cases[nrCases].lit = NULL;
}
for (int i = 0; i < nrCases; i++) {
(*ptr)++; // skip type
entry->cases[i].lit = parseLit(ptr);
entry->cases[i].body = (Code*) parseTerm(ptr);
}
}
set_create_thunk_fun((Code*) entry);
return entry;
}
......@@ -486,15 +517,15 @@ SelectEntry* parseSelect(char **ptr, SelectCaseEntry* fallback) {
IfEntry* parseIf(char **ptr) {
struct IfEntry* entry = (IfEntry*) alloc_code(sizeof (IfEntry));
entry->base.type = CT_IF;
entry->cond = parseTerm(ptr, NULL);
entry->texpr = parseTerm(ptr, NULL);
entry->fexpr = parseTerm(ptr, NULL);
entry->cond = parseTerm(ptr);
entry->texpr = parseTerm(ptr);
entry->fexpr = parseTerm(ptr);
set_create_thunk_fun((Code*) entry);
return entry;
}
Code* parseTerm(char **ptr, SelectCaseEntry* parent) {
Code* parseTerm(char **ptr) {
// 1. Type char
char type = *(*ptr)++;
......@@ -510,7 +541,7 @@ Code* parseTerm(char **ptr, SelectCaseEntry* parent) {
case 'D': // Dynamic application
return (Code*) parseApp(ptr, true);
case 'S': // Select
return (Code*) parseSelect(ptr, parent);
return (Code*) parseSelect(ptr);
case 'I': // If
return (Code*) parseIf(ptr);
default:
......@@ -537,7 +568,7 @@ int parseDef2(char** ptr) {
*ptr = entry->parseCont;
// parse body
entry->body = parseTerm(ptr, NULL);
entry->body = parseTerm(ptr);
break;
}
......@@ -550,7 +581,7 @@ int parseDef2(char** ptr) {
*ptr = entry->parseCont;
// parse body
entry->body = parseTerm(ptr, NULL);
entry->body = parseTerm(ptr);
break;
}
......
interpreter/parse.h
View file @ b5b61142
......@@ -7,6 +7,6 @@
int parse(char** ptr, int length);
Code* parseTerm(char **ptr, SelectCaseEntry* fallback);
Code* parseTerm(char **ptr);
#endif // __PARSE_H
\ No newline at end of file
tests/primes.bsapl 0 → 100644
View file @ b5b61142
112 F9 primes.el2 3 SVS0 2 DSVS1 1 C11 primes.ConsT2 A2 VS0 LI1 F3 subVL3 F9 primes.elLI0 SVS1 1 C11 primes.ConsVL2 161 F11 primes.filt2 2 SVS1 2 C12 primes.EmptyA0 F12 primes.EmptyC11 primes.ConsID1 VL2 L0 A2 VL2 A2 VL0 VL3 F11 primes.filtF11 primes.ConsT2 VL0 VL3 F11 primes.filt49 F10 primes.nmz2 3 A2 A2 VS1 VS0 F3 modLI0 F4 neqI116 F8 primes.s1 1 SVS0 1 C11 primes.ConsA2 VL1 A1 A2 A1 VL1 F10 primes.nmzVL2 F11 primes.filtF8 primes.sF11 primes.Cons40 A2 11 primes.Cons2 0 12 primes.Empty0 0 70 F9 primes.fr1 0 A2 VL0 A1 A2 VL0 LI1 F3 addF9 primes.frF11 primes.Cons49 F9 primes.pr0 0 A1 A1 LI2 F9 primes.frF8 primes.s57 F12 primes.Start0 0 A2 LI5000 A0 F9 primes.prF9 primes.el30 F4 main0 0 A0 F12 primes.Start
\ No newline at end of file
Supports Markdown
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