refactoring in preparation of force evaluatior

interpreter/code.c

@@ -14,7 +14,9 @@ struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target)
 			switch(expr->local_type)
 			{
 				case LIT_INT:
-					return updateI(target, ((LitEntry*) expr)->_int);	
+					return updateI(target, ((LitEntry*) expr)->_int);
+				case LIT_BOOL:
+					return updateB(target, ((LitEntry*) expr)->_bool);						
 				default:
 					printf("Exec: Unhandled LIT type");
 					exit(-1);
@@ -24,7 +26,7 @@ struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target)
 			switch(expr->local_type)
 			{
 				case VAR_FN:		
-					return updateF(target, ((VarEntry*) expr)->f, 0);
+					return updateF(target, get_slice(((VarEntry*) expr)->f, 0));
 					
 				case VAR_ARG:
 				{
@@ -50,7 +52,7 @@ struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target)
 			switch(var->base.local_type)
 			{
 				case VAR_FN:		
-					thunk = updateF(target, var->f, expr->nr_args);
+					thunk = updateF(target, get_slice(var->f, expr->nr_args));
 					for(int i=0; i<thunk->desc->arity; i++)
 					{
 						thunk->_args[i] = exec(((AppEntry*)expr)->args[i], frame_ptr, NULL);
@@ -61,8 +63,9 @@ struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target)
 					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);
+					thunk = updateF(target, 
+						get_slice(basethunk->desc->type == FT_SLICE ?
+							((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args));
 
 					for(int i=0; i<basethunk->desc->arity; i++)
 					{
@@ -82,8 +85,8 @@ struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target)
 		case CT_SELECT:
 		{
 			Thunk* pattern = exec(((SelectEntry*)expr)->expr, frame_ptr, NULL);
-			eval(pattern);
-						
+			pattern = eval(pattern);
+								
 			for(int i=0; i<expr->nr_cases; i++)
 			{
 				SelectCaseEntry* caseEntry = &((SelectEntry*)expr)->cases[i];
@@ -110,12 +113,16 @@ struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target)
 			}
 			
 			printf("Exec: no select cases matches");
+			print(pattern, false);
 			exit(-1);			
 		}
 		case CT_IF:
 		{
+			//Thunk* tmp = (Thunk*) malloc(sizeof(Thunk) + 8);
+			//tmp->desc = (Desc*) find_desc("add");
+			
 			Thunk* cond = exec(((IfEntry*)expr)->cond, frame_ptr, NULL);
-			eval(cond);
+			cond = eval(cond);
 			
 			if(readB(cond))
 			{

interpreter/desc.c

@@ -33,6 +33,11 @@ Desc* find_desc(char* fn)
 	return kh_get_val(khStrPtr, funHash, fn);
 }
 
+Desc* get_slice(Desc* f, int nrargs)
+{
+	return &(((SliceEntry*) f)[-(f->arity - nrargs)].base);
+}
+
 FunEntry* alloc_prim(char* name)
 {
 	int len = strlen(name);

interpreter/desc.h

@@ -82,6 +82,8 @@ void init_desc();
 void add_desc(char* fn, Desc* desc);
 Desc* find_desc(char* fn);
 
+Desc* get_slice(Desc* f, int nrargs);
+
 extern struct FunEntry* __INT__;
 extern struct FunEntry* __BOOL__;
 extern struct FunEntry* __CHAR__;

interpreter/main.c

@@ -56,8 +56,11 @@ 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 ";
+	// fib
 	
-	char* funstream = "43 F13 example.Start0 0 AF11 example.fib1 LI3 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 = "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
 	
 	int nrfuns = parse(&funstream, strlen(funstream));		
 	printf("Number of functions parsed: %d\n", nrfuns);	
@@ -65,6 +68,7 @@ int main()
 	// TODO: put it into a special "expression" space, instead of "code"
 
 	char *exprstream = "VF13 example.Start";
+	//char *exprstream = "VF11 Braun.Start";
 	
 	Code* expr = parseTerm(&exprstream);	
 	

interpreter/prim.c

@@ -11,8 +11,8 @@ void __add(Thunk* target)
 	Thunk* arg1 = stack[stack_top - 2];
 	Thunk* arg2 = stack[stack_top - 1];
 	
-	eval(arg1);
-	eval(arg2);
+	arg1 = eval(arg1);
+	arg2 = eval(arg2);
 	
 	updateI(target, readI(arg1) + readI(arg2));
 }
@@ -22,8 +22,8 @@ void __sub(Thunk* target)
 	Thunk* arg1 = stack[stack_top - 2];
 	Thunk* arg2 = stack[stack_top - 1];
 	
-	eval(arg1);
-	eval(arg2);
+	arg1 = eval(arg1);
+	arg2 = eval(arg2);
 	
 	updateI(target, readI(arg1) - readI(arg2));
 }
@@ -33,8 +33,8 @@ void __gt(Thunk* target)
 	Thunk* arg1 = stack[stack_top - 2];
 	Thunk* arg2 = stack[stack_top - 1];
 	
-	eval(arg1);
-	eval(arg2);
+	arg1 = eval(arg1);
+	arg2 = eval(arg2);
 	
 	updateB(target, readI(arg1) > readI(arg2));
 }
@@ -44,12 +44,43 @@ void __lt(Thunk* target)
 	Thunk* arg1 = stack[stack_top - 2];
 	Thunk* arg2 = stack[stack_top - 1];
 	
-	eval(arg1);
-	eval(arg2);
+	arg1 = eval(arg1);
+	arg2 = eval(arg2);
 	
 	updateB(target, readI(arg1) < readI(arg2));
 }
 
+void __eqI(Thunk* target)
+{
+	Thunk* arg1 = stack[stack_top - 2];
+	Thunk* arg2 = stack[stack_top - 1];
+	
+	arg1 = eval(arg1);
+	arg2 = eval(arg2);
+	
+	updateB(target, readI(arg1) == readI(arg2));
+}
+
+void __eqB(Thunk* target)
+{
+	Thunk* arg1 = stack[stack_top - 2];
+	Thunk* arg2 = stack[stack_top - 1];
+	
+	arg1 = eval(arg1);
+	arg2 = eval(arg2);
+	
+	updateB(target, readB(arg1) == readB(arg2));
+}
+
+void __not(Thunk* target)
+{
+	Thunk* arg1 = stack[stack_top - 1];
+	
+	arg1 = eval(arg1);
+	
+	updateB(target, !readB(arg1));
+}
+
 PrimEntry* add_prim(int arity, int strictness, char* name, void (*exec)(Thunk*))
 {
 	int nameLength = strlen(name);
@@ -79,4 +110,7 @@ void init_prim()
 	add_prim(2, 3, "sub", &__sub);
 	add_prim(2, 3, "gt", &__gt);
 	add_prim(2, 3, "lt", &__lt);
+	add_prim(2, 3, "eqI", &__eqI);
+	add_prim(2, 3, "eqB", &__eqB);
+	add_prim(1, 1, "not", &__not);
 }

interpreter/thunk.c

@@ -22,6 +22,7 @@ int printDesc(Desc* f)
 			printf("%s", ((PrimEntry*) f)->name);
 			return f->arity;			
 		case FT_FUN:
+		case FT_BOXED_LIT:
 			printf("%s", ((FunEntry*) f)->name);
 			return f->arity;
 		case FT_ADT:
@@ -31,7 +32,7 @@ int printDesc(Desc* f)
 			printf("%s", ((RecordEntry*) f)->name);
 			return f->arity;
 		default:
-			printf("printDesc: unhandled DESC\n");
+			printf("printDesc: unhandled DESC %d\n", f->type);
 			exit(-1);		
 	}	
 }	 
@@ -79,12 +80,7 @@ struct Thunk* updateI(Thunk* target, int i)
 }
 
 int readI(Thunk* thunk)
-{
-	while(thunk->desc == NULL)
-	{
-		thunk =  thunk->_forward_ptr;
-	}	
-	
+{	
 	if(thunk->desc != (Desc*) __INT__)
 	{
 		printf("readI: not an integer\n");
@@ -107,11 +103,6 @@ struct Thunk* updateB(Thunk* target, int b)
 
 int readB(Thunk* thunk)
 {
-	while(thunk->desc == NULL)
-	{
-		thunk =  thunk->_forward_ptr;
-	}	
-	
 	if(thunk->desc != (Desc*) __BOOL__)
 	{
 		printf("readB: not a boolean\n");
@@ -121,10 +112,10 @@ int readB(Thunk* thunk)
 	return thunk->_bool;
 }
 
-struct Thunk* updateF(Thunk* target, Desc* f, int nrargs)
+struct Thunk* updateF(Thunk* target, Desc* f)
 {
 	Thunk* thunk = target;
-	int newsize = max(sizeof(Thunk), sizeof(Desc*) + sizeof(Thunk*) * nrargs);
+	int newsize = max(sizeof(Thunk), sizeof(Desc*) + sizeof(Thunk*) * f->arity);
 	
 	if(thunk == NULL)
 	{
@@ -140,11 +131,11 @@ struct Thunk* updateF(Thunk* target, Desc* f, int nrargs)
 		}
 	}
 	
-	thunk->desc = &(((SliceEntry*) f)[-(f->arity - nrargs)].base);
+	thunk->desc = f;
 	return thunk;
 }
 
-void eval(Thunk* thunk)
+struct Thunk* eval(Thunk* thunk)
 {
 	while(true){
 				
@@ -153,8 +144,8 @@ void eval(Thunk* thunk)
 			thunk =  thunk->_forward_ptr;
 		}
 		
-		print(thunk, false);
-		printf("\n");		
+		//print(thunk, false);
+		//printf("\n");		
 		
 		switch(thunk->desc->type)
 		{
@@ -162,7 +153,7 @@ void eval(Thunk* thunk)
 			case FT_SLICE:
 			case FT_ADT:
 			case FT_RECORD:
-				return;
+				return thunk;
 			case FT_FUN:	
 				int old_top;
 				old_top = stack_top;

interpreter/thunk.h

@@ -28,9 +28,9 @@ int readI(Thunk* thunk);
 struct Thunk* updateB(Thunk* target, int b);
 int readB(Thunk* thunk);
 
-struct Thunk* updateF(Thunk* target, Desc* f, int nrargs);
+struct Thunk* updateF(Thunk* target, Desc* f);
 
-void eval(Thunk* thunk);
+struct Thunk* eval(Thunk* thunk);
 
 // Thunk is supposed to be in HNF
 void print(Thunk* thunk, bool force);