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

first stub on strictness

parent 6ca85fbb
Hide whitespace changes
Inline Side-by-side
interpreter/code.c
View file @ 56188eaa
#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <assert.h>
#include "code.h"
#include "desc.h"
#include "thunk.h"
#include "mem.h"
struct Thunk*
exec(Code* expr, int frame_ptr, Thunk* target, bool force)
{
assert(expr != NULL);
switch (expr->type) {
case CT_LIT:
switch (expr->local_type) {
......@@ -40,7 +43,7 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
}
break;
case CT_APP:
// TODO: check over application
// TODO: enforce strictness in ADT/Record
......@@ -52,7 +55,7 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
case VAR_FN:
{
Desc* slice = get_slice(var->f, expr->nr_args);
if (force && slice->type == FT_PRIM) {
Thunk args[expr->nr_args];
for (int i = 0; i < expr->nr_args; i++) {
......@@ -72,24 +75,24 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
else if (force && slice->type == FT_FUN) {
Thunk * args[expr->nr_args];
for (int i = 0; i < expr->nr_args; i++) {
args[i] = exec(((AppEntry*) expr)->args[i], frame_ptr, NULL, false);
args[i] = exec(((AppEntry*) expr)->args[i], frame_ptr, NULL, is_strict_fun_arg((FunEntry*) slice, i));
}
int old_top = stack_top;
for (int i = 0; i < expr->nr_args; i++) {
for (int i = 0; i < expr->nr_args; i++) {
pushs(args[i]);
}
printf("name: %s\n", ((FunEntry*) slice)->name);
printf("target: %d\n", target);
thunk = exec(((FunEntry*) slice)->body, stack_top, target, false);
thunk = exec(((FunEntry*) slice)->body, stack_top - 1, target, true);
stack_top = old_top;
}
else {
thunk = updateF(target, slice);
assert(thunk->desc->arity == expr->nr_args);
for (int i = 0; i < expr->nr_args; i++) {
thunk->_args[i] = exec(((AppEntry*) expr)->args[i], frame_ptr, NULL, false);
}
......@@ -103,9 +106,11 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
Desc* slice =
get_slice(basethunk->desc->type == FT_SLICE ?
((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
thunk = updateF(target, slice);
assert(thunk->desc->arity == basethunk->desc->arity + expr->nr_args);
for (int i = 0; i < basethunk->desc->arity; i++) {
thunk->_args[i] = basethunk->_args[i];
}
......@@ -124,6 +129,7 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
case CT_SELECT:
{
Thunk* pattern = exec(((SelectEntry*) expr)->expr, frame_ptr, NULL, true);
Thunk* p = pattern;
pattern = eval(pattern);
for (int i = 0; i < expr->nr_cases; i++) {
......@@ -141,7 +147,7 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
// Fall through on purpose
case SC_DEFAULT:
return exec(caseEntry->body, frame_ptr, target, false);
return exec(caseEntry->body, frame_ptr, target, force);
default:
printf("Exec: Unhandled entry type in CT_SELECT");
exit(-1);
......@@ -153,11 +159,11 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
exit(-1);
}
case CT_IF:
{
Thunk* tmp = (Thunk*) malloc(sizeof (Thunk));
tmp->desc = (Desc*) __BOOL__;
{
Thunk tmp;
tmp.desc = (Desc*) __BOOL__;
Thunk* cond = exec(((IfEntry*) expr)->cond, frame_ptr, NULL, true);
Thunk* cond = exec(((IfEntry*) expr)->cond, frame_ptr, &tmp, true);
cond = eval(cond);
if (readB(cond)) {
......
interpreter/desc.c
View file @ 56188eaa
#include "desc.h"
#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <assert.h>
#include "desc.h"
#include "khash.h"
#include "mem.h"
......@@ -32,9 +34,15 @@ Desc* find_desc(char* fn) {
}
Desc* get_slice(Desc* f, int nrargs) {
assert(nrargs<=f->arity);
return &(((SliceEntry*) f)[-(f->arity - nrargs)].base);
}
bool is_strict_fun_arg(FunEntry* f, int nr_arg)
{
return (f->strictness & 1 << (f->base.arity - nr_arg - 1)) > 0;
}
FunEntry* alloc_prim(char* name) {
int len = strlen(name);
FunEntry* entry = (FunEntry*) alloc_desc(sizeof (FunEntry) + len + 1);
......
interpreter/desc.h
View file @ 56188eaa
......@@ -78,6 +78,8 @@ Desc* find_desc(char* fn);
Desc* get_slice(Desc* f, int nrargs);
bool is_strict_fun_arg(FunEntry* f, int nr_arg);
extern struct FunEntry* __INT__;
extern struct FunEntry* __BOOL__;
extern struct FunEntry* __CHAR__;
......
interpreter/main.c
View file @ 56188eaa
#include <stdio.h>
#include <stdbool.h>
#include <string.h>
#include "desc.h"
......@@ -55,22 +55,25 @@ int main() {
// 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 ";
// [_predefined._Cons [2] [_predefined._Cons [3] [_predefined._Cons [4] [_predefined._Nil]]]]
char* funstream = "43 F13 example.Start0 0 AF11 example.fib1 LI5 119 F11 example.fib1 1 IAF2 lt2 VA0 LI2 LI1 AF3 add2 AF11 example.fib1 AF3 sub2 VA0 LI1 AF11 example.fib1 AF3 sub2 VA0 LI2 ";
// char* funstream = "44 F13 example.Start0 0 AF11 example.fib1 LI36 119 F11 example.fib1 1 IAF2 lt2 VA0 LI2 LI1 AF3 add2 AF11 example.fib1 AF3 sub2 VA0 LI1 AF11 example.fib1 AF3 sub2 VA0 LI2 ";
// fib
// char* funstream = "29 F9 Braun.int1 1 IVA0 LI1 LI0 27 F9 Braun.and2 2 IVA1 VA0 L099 F9 Braun.all2 1 SVA0 2 C9 Flite.NilL1C10 Flite.ConsAF9 Braun.and2 AA1 1 VL0 AF9 Braun.all2 VA1 VL1 98 F16 Braun._c;39;3_203 4 IAF3 eqB2 VA2 L0L0IAF3 eqB2 VA2 L1AF14 Braun.equal_182 VA1 VA0 VF7 nomatch175 F14 Braun.equal_182 3 SVA1 2 C9 Flite.NilSVA0 2 C9 Flite.NilL1C10 Flite.ConsL0C10 Flite.ConsSVA0 2 C9 Flite.NilL0C10 Flite.ConsAF16 Braun._c;39;3_203 AF3 eqI2 VL0 VL2 VL1 VL3 176 F9 Braun.ilv2 3 SVA1 2 C9 Flite.NilVA0 C10 Flite.ConsSVA0 2 C9 Flite.NilAF10 Flite.Cons2 VL0 VL1 C10 Flite.ConsAF10 Flite.Cons2 VL0 AF10 Flite.Cons2 VL2 AF9 Braun.ilv2 VL1 VL3 153 F12 Braun.toList1 1 SVA0 2 C11 Braun.EmptyVF9 Flite.NilC12 Braun.BranchAF10 Flite.Cons2 VL0 AF9 Braun.ilv2 AF12 Braun.toList1 VL1 AF12 Braun.toList1 VL2 40 A2 11 Braun.Empty0 0 12 Braun.Branch3 0 167 F12 Braun.insert2 1 SVA0 2 C11 Braun.EmptyAF12 Braun.Branch3 VA1 VF11 Braun.EmptyVF11 Braun.EmptyC12 Braun.BranchAF12 Braun.Branch3 VA1 AF12 Braun.insert2 VL0 VL2 VL1 119 F14 Braun.fromList1 1 SVA0 2 C9 Flite.NilVF11 Braun.EmptyC10 Flite.ConsAF12 Braun.insert2 VL0 AF14 Braun.fromList1 VL1 90 F13 Braun.prop_171 1 AF14 Braun.equal_182 VA0 AF12 Braun.toList1 AF14 Braun.fromList1 VA0 118 F15 Braun.replicate2 2 IAF3 eqI2 VA1 LI0 VF9 Flite.NilAF10 Flite.Cons2 VA0 AF15 Braun.replicate2 AF3 sub2 VA1 LI1 VA0 44 F11 Braun.<=_162 3 AF3 not1 AF2 lt2 VA0 VA1 35 A2 9 Flite.Nil0 0 10 Flite.Cons2 0 121 F12 Braun.fromTo2 3 IAF11 Braun.<=_162 VA1 VA0 AF10 Flite.Cons2 VA1 AF12 Braun.fromTo2 AF3 add2 VA1 LI1 VA0 VF9 Flite.Nil125 F11 Braun.Start0 0 AF9 Braun.int1 AF9 Braun.all2 VF13 Braun.prop_17AF15 Braun.replicate2 LI6000 AF12 Braun.fromTo2 LI0 LI255 27 F4 main0 0 VF11 Braun.Start";
char* funstream = "29 F9 Braun.int1 1 IVA0 LI1 LI0 27 F9 Braun.and2 2 IVA1 VA0 L099 F9 Braun.all2 1 SVA0 2 C9 Flite.NilL1C10 Flite.ConsAF9 Braun.and2 AA1 1 VL0 AF9 Braun.all2 VA1 VL1 98 F16 Braun._c;39;3_203 4 IAF3 eqB2 VA2 L0L0IAF3 eqB2 VA2 L1AF14 Braun.equal_182 VA1 VA0 VF7 nomatch175 F14 Braun.equal_182 3 SVA1 2 C9 Flite.NilSVA0 2 C9 Flite.NilL1C10 Flite.ConsL0C10 Flite.ConsSVA0 2 C9 Flite.NilL0C10 Flite.ConsAF16 Braun._c;39;3_203 AF3 eqI2 VL0 VL2 VL1 VL3 176 F9 Braun.ilv2 3 SVA1 2 C9 Flite.NilVA0 C10 Flite.ConsSVA0 2 C9 Flite.NilAF10 Flite.Cons2 VL0 VL1 C10 Flite.ConsAF10 Flite.Cons2 VL0 AF10 Flite.Cons2 VL2 AF9 Braun.ilv2 VL1 VL3 153 F12 Braun.toList1 1 SVA0 2 C11 Braun.EmptyVF9 Flite.NilC12 Braun.BranchAF10 Flite.Cons2 VL0 AF9 Braun.ilv2 AF12 Braun.toList1 VL1 AF12 Braun.toList1 VL2 40 A2 11 Braun.Empty0 0 12 Braun.Branch3 0 167 F12 Braun.insert2 1 SVA0 2 C11 Braun.EmptyAF12 Braun.Branch3 VA1 VF11 Braun.EmptyVF11 Braun.EmptyC12 Braun.BranchAF12 Braun.Branch3 VA1 AF12 Braun.insert2 VL0 VL2 VL1 119 F14 Braun.fromList1 1 SVA0 2 C9 Flite.NilVF11 Braun.EmptyC10 Flite.ConsAF12 Braun.insert2 VL0 AF14 Braun.fromList1 VL1 90 F13 Braun.prop_171 1 AF14 Braun.equal_182 VA0 AF12 Braun.toList1 AF14 Braun.fromList1 VA0 118 F15 Braun.replicate2 2 IAF3 eqI2 VA1 LI0 VF9 Flite.NilAF10 Flite.Cons2 VA0 AF15 Braun.replicate2 AF3 sub2 VA1 LI1 VA0 44 F11 Braun.<=_162 3 AF3 not1 AF2 lt2 VA0 VA1 35 A2 9 Flite.Nil0 0 10 Flite.Cons2 0 121 F12 Braun.fromTo2 3 IAF11 Braun.<=_162 VA1 VA0 AF10 Flite.Cons2 VA1 AF12 Braun.fromTo2 AF3 add2 VA1 LI1 VA0 VF9 Flite.Nil125 F11 Braun.Start0 0 AF9 Braun.int1 AF9 Braun.all2 VF13 Braun.prop_17AF15 Braun.replicate2 LI6000 AF12 Braun.fromTo2 LI0 LI255 27 F4 main0 0 VF11 Braun.Start";
//braun
printf("sizeof(int): %d, sizeof(long): %d, sizeof(void*): %d, sizeof(Thunk): %d\n\n",
sizeof(int), sizeof(long), sizeof(void*), sizeof(Thunk));
int nrfuns = parse(&funstream, strlen(funstream));
printf("Number of functions parsed: %d\n", nrfuns);
// TODO: put it into a special "expression" space, instead of "code"
char *exprstream = "VF13 example.Start";
//char *exprstream = "VF11 Braun.Start";
//char *exprstream = "VF13 example.Start";
char *exprstream = "VF11 Braun.Start";
Code* expr = parseTerm(&exprstream);
Thunk* res = exec(expr, stack_top, NULL, true);
eval(res);
print(res, true);
......
interpreter/mem.c
View file @ 56188eaa
#include <stdlib.h>
#include <stdio.h>
#include <assert.h>
#include "mem.h"
int desc_alloc;
int code_alloc;
int heap_alloc;
int nr_heap_alloc;
int stack_top;
Thunk* stack[STACK_SIZE];
#define heap_size 1024*1024*1024
char* heap_start;
void print_stat() {
printf("\n\nallocation:\n");
printf("desc: %d\n", desc_alloc);
printf("code: %d\n", code_alloc);
printf("heap: %d\n", heap_alloc);
printf("heap: %d (%d thunks)\n", heap_alloc, nr_heap_alloc);
}
void init_mem() {
desc_alloc = 0;
code_alloc = 0;
heap_alloc = 0;
nr_heap_alloc = 0;
stack_top = 0;
heap_start = (char*) malloc(heap_size);
assert(heap_start != NULL);
}
void* alloc_desc(int size) {
......@@ -36,6 +45,13 @@ void* alloc_code(int size) {
}
void* alloc_heap(int size) {
char* curr = heap_start + heap_alloc;
heap_alloc += size;
return malloc(size);
nr_heap_alloc++;
assert(heap_alloc < heap_size);
return curr;
}
\ No newline at end of file
interpreter/mem.h
View file @ 56188eaa
......@@ -3,7 +3,7 @@
#include "thunk.h"
#define STACK_SIZE 1024
#define STACK_SIZE 10240
extern int stack_top;
extern Thunk* stack[STACK_SIZE];
......
interpreter/prim.c
View file @ 56188eaa
......@@ -74,7 +74,7 @@ struct Thunk* __not(Thunk* target) {
return updateB(target, !readB(arg1));
}
PrimEntry* add_prim(int arity, int strictness, char* name, Thunk* (*exec)(Thunk*)) {
void add_prim(int arity, int strictness, char* name, Thunk* (*exec)(Thunk*)) {
int nameLength = strlen(name);
// before the PrimEntry there are "arity" number of SliceEntries
......
interpreter/thunk.c
View file @ 56188eaa
#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <assert.h>
#include "thunk.h"
#include "desc.h"
......@@ -37,6 +38,8 @@ int printDesc(Desc* f) {
}
Thunk* forward_to(Thunk* target, Thunk* thunk) {
assert(thunk != NULL);
if (target != NULL) {
target->desc = NULL;
target->_forward_ptr = thunk;
......@@ -47,9 +50,11 @@ Thunk* forward_to(Thunk* target, Thunk* thunk) {
}
int thunk_size(Thunk* thunk) {
assert(thunk != NULL);
if (thunk->desc == NULL || thunk->desc->type == FT_BOXED_LIT) {
if (thunk->desc == (Desc*) __STRING__ || thunk->desc == (Desc*) __ARRAY__) {
printf("tunk_size: unhandled literal type\n");
printf("thunk_size: unhandled literal type\n");
exit(-1);
}
......@@ -69,6 +74,8 @@ struct Thunk* updateI(Thunk* target, int i) {
}
int readI(Thunk* thunk) {
assert(thunk != NULL);
if (thunk->desc != (Desc*) __INT__) {
printf("readI: not an integer\n");
printDesc(thunk->desc);
......@@ -88,6 +95,8 @@ struct Thunk* updateB(Thunk* target, int b) {
}
int readB(Thunk* thunk) {
assert(thunk != NULL);
if (thunk->desc != (Desc*) __BOOL__) {
printf("readB: not a boolean\n");
exit(-1);
......@@ -97,6 +106,8 @@ int readB(Thunk* thunk) {
}
struct Thunk* updateF(Thunk* target, Desc* f) {
assert(f != NULL);
Thunk* thunk = target;
int newsize = max(sizeof (Thunk), sizeof (Desc*) + sizeof (Thunk*) * f->arity);
......@@ -110,11 +121,15 @@ struct Thunk* updateF(Thunk* target, Desc* f) {
}
}
assert(thunk != NULL);
thunk->desc = f;
return thunk;
}
struct Thunk* eval(Thunk* thunk) {
assert(thunk != NULL);
while (true) {
while (thunk->desc == NULL) {
......@@ -178,6 +193,7 @@ void print(Thunk* thunk, bool force) {
}
} else {
printf("print: unhandled BOXED LIT\n");
printDesc(thunk->desc);
exit(-1);
}
} else {
......
interpreter/thunk.h
View file @ 56188eaa
......@@ -4,7 +4,9 @@
#include "desc.h"
#include "code.h"
typedef struct Thunk {
#pragma pack(push, 1)
typedef struct __attribute__((packed)) Thunk {
struct Desc* desc; // NULL, if it is a forward pointer
union {
......@@ -31,6 +33,7 @@ struct Thunk* updateF(Thunk* target, Desc* f);
struct Thunk* eval(Thunk* thunk);
int printDesc(Desc* f);
// Thunk is supposed to be in HNF
void print(Thunk* thunk, bool force);
......
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