Commit eab928c6 authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

+ pattern matching

+ local vars
current running maximum:

:: _predefined._List = _predefined._Cons a1 a2 | _predefined._Nil

example.map f_0 !_x_1 = select _x_1 (_predefined._Nil -> _predefined._Nil) (_predefined._Cons a_1_0 as_1_1 -> _predefined._Cons (f_0 a_1_0) (example.map f_0 as_1_1))
example.inc !a_0 = add a_0 1
example.Start = example.map example.inc (_predefined._Cons 1 (_predefined._Cons 2 (_predefined._Cons 3 _predefined._Nil)))
parent 936d585f
......@@ -25,11 +25,33 @@ struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target)
{
case VAR_FN:
return updateF(target, ((VarEntry*) expr)->f, 0);
case VAR_ARG:
return stack[frame_ptr - ((VarEntry*) expr)->index];
default:
printf("Exec: Unhandled VAR type");
exit(-1);
case VAR_ARG:
{
Thunk* var = stack[frame_ptr - ((VarEntry*) expr)->index];
if(target != NULL)
{
target->desc = NULL;
target->_forward_ptr = var;
return target;
}
return var;
}
case VAR_LOCAL:
{
Thunk* var = stack[frame_ptr + ((VarEntry*) expr)->index + 1];
if(target != NULL)
{
target->desc = NULL;
target->_forward_ptr = var;
return target;
}
return var;
}
}
break;
case CT_APP:
......@@ -37,7 +59,8 @@ struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target)
// TODO: check over application
// TODO: enforce strictness in ADT/Record
VarEntry* var = ((AppEntry*)expr)->var;
VarEntry* var;
var = ((AppEntry*)expr)->var;
Thunk* thunk;
switch(var->base.local_type)
......@@ -51,7 +74,8 @@ struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target)
return thunk;
case VAR_ARG:
Thunk* basethunk;
basethunk = eval(stack[frame_ptr - var->index]);
basethunk = stack[frame_ptr - var->index];
eval(basethunk);
thunk = updateF(target, basethunk->desc->type == FT_SLICE ?
((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
......@@ -70,6 +94,43 @@ struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target)
printf("Exec: Unhandled VAR type in CT_APP");
exit(-1);
}
break;
case CT_SELECT:
{
Thunk* pattern = exec(((SelectEntry*)expr)->expr, frame_ptr, NULL);
eval(pattern);
for(int i=0; i<expr->nr_cases; i++)
{
SelectCaseEntry* caseEntry = &((SelectEntry*)expr)->cases[i];
switch(caseEntry->type)
{
case 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++)
{
pushs(pattern->_args[i]);
}
// Fall through on purpose
case SC_DEFAULT:
return exec(caseEntry->body, frame_ptr, target);
default:
printf("Exec: Unhandled entry type in CT_SELECT");
exit(-1);
}
}
printf("Exec: no select cases matches");
exit(-1);
}
default:
printf("Exec: Unhandled CODE type");
exit(-1);
}
}
\ No newline at end of file
......@@ -7,12 +7,14 @@
#define CT_LIT 1
#define CT_VAR 2
#define CT_APP 3
#define CT_SELECT 4
struct Code
{
unsigned int type : 3;
unsigned int local_type : 3;
unsigned int nr_args : 4; // used in AppEntry
unsigned int nr_args : 5; // used in AppEntry
unsigned int nr_cases : 5; // used in SelectEntry
};
#define LIT_INT 1
......@@ -61,6 +63,28 @@ struct AppEntry
struct Code* args[];
};
#define SC_CONS 1
#define SC_LIT 2
#define SC_DEFAULT 3
struct SelectCaseEntry
{
int type;
struct Code* body;
union
{
struct ADTEntry* cons;
struct LitEntry* lit;
};
};
struct SelectEntry
{
struct Code base;
struct Code* expr;
struct SelectCaseEntry cases[];
};
struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target);
#endif // __CODE_H
\ No newline at end of file
......@@ -44,8 +44,17 @@ int main()
// 9
// char* funstream = "26 F9 example.g2 2 AA1 1 VA0 20 F9 example.f2 2 VA1 59 F13 example.Start0 0 AF9 example.g2 AF9 example.f1 LI8 LI9 29 F4 main0 0 VF13 example.Start";
// 8
char* funstream = "26 F9 example.g2 2 AA1 1 VA0 37 F12 example.f_502 3 AF3 add2 VA1 VA0 63 F13 example.Start0 0 AF9 example.g2 AF12 example.f_501 LI8 LI9 29 F4 main0 0 VF13 example.Start";
//char* funstream = "26 F9 example.g2 2 AA1 1 VA0 37 F12 example.f_502 3 AF3 add2 VA1 VA0 63 F13 example.Start0 0 AF9 example.g2 AF12 example.f_501 LI8 LI9 29 F4 main0 0 VF13 example.Start";
// 17
//char* funstream = "33 A2 9 example.A2 0 9 example.B0 0 49 F13 example.Start0 0 AF9 example.f1 VF9 example.B57 F9 example.f1 1 SVA0 2 C9 example.BLI11 C9 example.ALI22 ";
// 11
// char* funstream = "33 A2 9 example.A2 0 9 example.B0 0 61 F13 example.Start0 0 AF9 example.f1 AF9 example.A2 LI33 LI44 57 F9 example.f1 1 SVA0 2 C9 example.BLI11 C9 example.ALI22 ";
// 22
// char* funstream = "33 A2 9 example.A2 0 9 example.B0 0 61 F13 example.Start0 0 AF9 example.f1 AF9 example.A2 LI33 LI44 56 F9 example.f1 1 SVA0 2 C9 example.BLI11 C9 example.AVL0 ";
// 33
// char* funstream = "33 A2 9 example.A2 0 9 example.B0 0 61 F13 example.Start0 0 AF9 example.f1 AF9 example.A2 LI33 LI44 56 F9 example.f1 1 SVA0 2 C9 example.BLI11 C9 example.AVL1 ";
// 44
char* funstream = "160 F13 example.Start0 0 AF11 example.map2 VF11 example.incAF17 _predefined._Cons2 LI1 AF17 _predefined._Cons2 LI2 AF17 _predefined._Cons2 LI3 VF16 _predefined._Nil36 F11 example.inc1 1 AF3 add2 VA0 LI1 148 F11 example.map2 1 SVA0 2 C16 _predefined._NilVF16 _predefined._NilC17 _predefined._ConsAF17 _predefined._Cons2 AA1 1 VL0 AF11 example.map2 VA1 VL1 50 A2 17 _predefined._Cons2 0 16 _predefined._Nil0 0 ";
int nrfuns = parse(&funstream, strlen(funstream));
printf("Number of functions parsed: %d\n", nrfuns);
......@@ -55,9 +64,10 @@ int main()
char *exprstream = "VF13 example.Start";
Code* expr = parseTerm(&exprstream);
Thunk* res = exec(expr, stack_top, NULL);
print(eval(res));
eval(res);
print(res, true);
print_stat();
}
......@@ -48,6 +48,26 @@ void copyStringAndForward(char* dest, char** source, int length)
*source += length;
}
Desc* parseFunName(char** ptr)
{
// This is used to temporarily copy (converts clean string to C style) the function name for lookup
char name[MAX_IDENTIFIER_LENGTH];
int nameLength;
if(!parseInt(ptr, &nameLength)) return 0;
copyStringAndForward(name, ptr, nameLength);
Desc* f = (Desc*) find_desc(name);
if(f == 0)
{
printf("%s not found\n", name);
return 0;
}
return f;
}
int parseDef1(char** ptr)
{
int defSize;
......@@ -291,21 +311,7 @@ VarEntry* parseVar(char **ptr)
case 'F': // Function
{
entry->base.local_type = VAR_FN;
char name[MAX_IDENTIFIER_LENGTH];
int nameLength;
if(!parseInt(ptr, &nameLength)) return 0;
copyStringAndForward(name, ptr, nameLength);
entry->f = (Desc*) find_desc(name); // can fail
if(entry->f == 0)
{
printf("%s not found\n", name);
return 0;
}
entry->f = parseFunName(ptr); // can fail
break;
}
}
......@@ -336,6 +342,45 @@ AppEntry* parseApp(char **ptr)
return entry;
}
SelectEntry* parseSelect(char **ptr)
{
Code* expr = (Code*) 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
}
entry->cases[i].body = (Code*) parseTerm(ptr);
}
return entry;
}
Code* parseTerm(char **ptr)
{
// 1. Type char
......@@ -349,6 +394,11 @@ Code* parseTerm(char **ptr)
return (Code*) parseVar(ptr);
case 'A': // Application
return (Code*) parseApp(ptr);
case 'S': // Select
return (Code*) parseSelect(ptr);
default:
printf("parseTerm: unhandled term type\n");
exit(-1);
}
}
......@@ -358,9 +408,6 @@ int parseDef2(char** ptr)
if(!parseInt(ptr, &defSize)) return -1;
char* nextDef = *ptr + defSize;
// This is used to temporarily copy (converts clean string to C style) the function name for lookup
char name[MAX_IDENTIFIER_LENGTH];
// 2. Type char
char type = *(*ptr)++;
......@@ -369,11 +416,7 @@ int parseDef2(char** ptr)
{
case 'F': // Normal function
{
int nameLength;
if(!parseInt(ptr, &nameLength)) return 0;
copyStringAndForward(name, ptr, nameLength);
FunEntry* entry = (FunEntry*) find_desc(name); // should not fail, just added to the map in the 1. phase
FunEntry* entry = (FunEntry*) parseFunName(ptr); // should not fail, just added to the map in the 1. phase
// read continuation
*ptr = entry->parseCont;
......@@ -386,11 +429,7 @@ int parseDef2(char** ptr)
case 'C': // CAF
{
int nameLength;
if(!parseInt(ptr, &nameLength)) return 0;
copyStringAndForward(name, ptr, nameLength);
CAFEntry* entry = (CAFEntry*) find_desc(name); // should not fail, just added to the map in the 1. phase
CAFEntry* entry = (CAFEntry*) parseFunName(ptr); // should not fail, just added to the map in the 1. phase
// read continuation
*ptr = entry->parseCont;
......
......@@ -8,7 +8,13 @@
void __add(Thunk* target)
{
updateI(target, readI(eval(stack[stack_top - 2])) + readI(eval(stack[stack_top - 1])));
Thunk* arg1 = stack[stack_top - 2];
Thunk* arg2 = stack[stack_top - 1];
eval(arg1);
eval(arg2);
updateI(target, readI(arg1) + readI(arg2));
}
PrimEntry* add_prim(int arity, int strictness, char* name, void (*exec)(Thunk*))
......
......@@ -73,22 +73,25 @@ struct Thunk* updateF(Thunk* target, Desc* f, int nrargs)
return thunk;
}
Thunk* eval(Thunk* thunk)
void eval(Thunk* thunk)
{
while(true){
while(thunk->desc == NULL)
{
thunk = thunk->_forward_ptr;
}
//print(thunk, false);
//printf("\n");
switch(thunk->desc->type)
{
case FT_BOXED_LIT:
case FT_SLICE:
case FT_ADT:
case FT_RECORD:
return thunk;
return;
case FT_FUN:
int old_top;
old_top = stack_top;
......@@ -143,13 +146,15 @@ int printDesc(Desc* f)
}
}
void print(Thunk* thunk)
void print(Thunk* thunk, bool force)
{
while(thunk->desc == NULL)
{
thunk = thunk->_forward_ptr;
}
printf("[");
if(thunk->desc->type == FT_BOXED_LIT)
{
if((FunEntry*) thunk->desc == __INT__)
......@@ -163,13 +168,16 @@ void print(Thunk* thunk)
}
}
else
{
{
int arity = printDesc(thunk->desc);
for(int i = 0; i < arity; i++)
{
printf(" ");
print(thunk->_args[i]);
}
if(force) eval(thunk->_args[i]);
print(thunk->_args[i], true);
}
}
printf("]");
}
......@@ -25,8 +25,9 @@ int readI(Thunk* thunk);
struct Thunk* updateF(Thunk* target, Desc* f, int nrargs);
Thunk* eval(Thunk* thunk);
void eval(Thunk* thunk);
void print(Thunk* thunk);
// Thunk is supposed to be in HNF
void print(Thunk* thunk, bool force);
#endif // __THUNK_H
\ No newline at end of file
......@@ -19,15 +19,18 @@ import Text.Unicode.Encodings.JS
newContext = {vars = newMap, localcount = 0}
addVars vars idx [] = vars
addVars vars idx [v:vs] = addVars (put (unpackVar v) (Arg idx) vars) (idx - 1) vs
registerParams vars idx [] = vars
registerParams vars idx [v:vs] = registerParams (put (unpackVar v) (Arg idx) vars) (idx - 1) vs
registerLocals vars idx [] = vars
registerLocals vars idx [v:vs] = registerLocals (put (unpackVar v) (Local idx) vars) (idx + 1) vs
calcStrictness [] = 0
calcStrictness [StrictVar _ _:vs] = (1 << (length vs)) + calcStrictness vs
calcStrictness [NormalVar _ _:vs] = calcStrictness vs
sFunc ctx (FTFunc name body params) a
# ctx = {ctx & vars = addVars ctx.vars (length params - 1) params}
# ctx = {ctx & vars = registerParams ctx.vars (length params - 1) params}
= a <++ "F" <++ sText (unpackVar name) <++ sNum (length params) <++ sNum (calcStrictness params) <++ sTerm ctx body
sFunc ctx (FTCAF name body) a
......@@ -53,6 +56,15 @@ sText text a = a <++ sNum (textSize text) <++ text
sTerm ctx (SLit lit) a = a <++ "L" <++ lit
sTerm ctx (SVar var) a = a <++ "V" <++ sVar ctx var
sTerm ctx (SApplication var terms) a = a <++ "A" <++ sVar ctx var <++ sList (sTerm ctx) terms
sTerm ctx (SSelect expr cs) a = a <++ "S" <++ sTerm ctx expr <++ sList (sSelectCase ctx) cs
sSelectCase ctx (PCons varName params, expr) a
# ctx = {ctx & vars = registerLocals ctx.vars ctx.localcount params, localcount = ctx.localcount + length params}
= a <++ "C" <++ sText varName <++ sTerm ctx expr
sSelectCase ctx (PLit lit, expr) a
= a <++ "L" <++ lit <++ sTerm ctx expr
sSelectCase ctx (PDefault, expr) a
= a <++ "D" <++ sTerm ctx expr
sVar ctx var a
= case get varName ctx.vars of
......
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