fib works (uses a hell lot of memory)

interpreter/code.c

@@ -29,28 +29,12 @@ struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target)
 				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;
+					return forward_to(target, 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;
+					return forward_to(target, var);
 				}
 			}
 			break;
@@ -128,6 +112,20 @@ struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target)
 			printf("Exec: no select cases matches");
 			exit(-1);			
 		}
+		case CT_IF:
+		{
+			Thunk* cond = exec(((IfEntry*)expr)->cond, frame_ptr, NULL);
+			eval(cond);
+			
+			if(readB(cond))
+			{
+				return exec(((IfEntry*)expr)->texpr, frame_ptr, target);
+			}
+			else
+			{
+				return exec(((IfEntry*)expr)->fexpr, frame_ptr, target);
+			}
+		}			
 		default:
 			printf("Exec: Unhandled CODE type");
 			exit(-1);				

interpreter/code.h

@@ -8,6 +8,7 @@
 #define CT_VAR 				2
 #define CT_APP 				3
 #define CT_SELECT			4
+#define CT_IF				5
 
 struct Code
 {
@@ -85,6 +86,14 @@ struct SelectEntry
 	struct SelectCaseEntry cases[];
 };
 
+struct IfEntry
+{
+	struct Code base;
+	struct Code* cond;
+	struct Code* texpr;
+	struct Code* fexpr;
+};
+
 struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target);
 
 #endif // __CODE_H
\ No newline at end of file

interpreter/main.c

@@ -54,7 +54,10 @@ int main()
 	// 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 ";
+	// 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 = "44 F13 example.Start0 0 AF11 example.fib1 LI35 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 ";
 	
 	int nrfuns = parse(&funstream, strlen(funstream));		
 	printf("Number of functions parsed: %d\n", nrfuns);	

interpreter/parse.c

@@ -344,7 +344,7 @@ AppEntry* parseApp(char **ptr)
 
 SelectEntry* parseSelect(char **ptr)
 {
-	Code* expr = (Code*) parseTerm(ptr);
+	Code* expr = parseTerm(ptr);
 	
 	int nrCases;
 	if(!parseInt(ptr, &nrCases)) return 0;
@@ -381,6 +381,17 @@ SelectEntry* parseSelect(char **ptr)
 	return entry;
 }
 
+IfEntry* parseIf(char **ptr)
+{
+	struct IfEntry* entry = (IfEntry*) alloc_code(sizeof(IfEntry));
+	entry->base.type = CT_IF;	
+	entry->cond = parseTerm(ptr);
+	entry->texpr = parseTerm(ptr);
+	entry->fexpr = parseTerm(ptr);
+	
+	return entry;
+}
+
 Code* parseTerm(char **ptr)
 {
 	// 1. Type char
@@ -395,7 +406,9 @@ Code* parseTerm(char **ptr)
 		case 'A': // Application
 			return (Code*) parseApp(ptr);
 		case 'S': // Select
-			return (Code*) parseSelect(ptr);			
+			return (Code*) parseSelect(ptr);
+		case 'I': // If
+			return (Code*) parseIf(ptr);
 		default:
 			printf("parseTerm: unhandled term type\n");
 			exit(-1);	

interpreter/prim.c

@@ -17,6 +17,39 @@ void __add(Thunk* target)
 	updateI(target, readI(arg1) + readI(arg2));
 }
 
+void __sub(Thunk* target)
+{
+	Thunk* arg1 = stack[stack_top - 2];
+	Thunk* arg2 = stack[stack_top - 1];
+	
+	eval(arg1);
+	eval(arg2);
+	
+	updateI(target, readI(arg1) - readI(arg2));
+}
+
+void __gt(Thunk* target)
+{
+	Thunk* arg1 = stack[stack_top - 2];
+	Thunk* arg2 = stack[stack_top - 1];
+	
+	eval(arg1);
+	eval(arg2);
+	
+	updateB(target, readI(arg1) > readI(arg2));
+}
+
+void __lt(Thunk* target)
+{
+	Thunk* arg1 = stack[stack_top - 2];
+	Thunk* arg2 = stack[stack_top - 1];
+	
+	eval(arg1);
+	eval(arg2);
+	
+	updateB(target, readI(arg1) < readI(arg2));
+}
+
 PrimEntry* add_prim(int arity, int strictness, char* name, void (*exec)(Thunk*))
 {
 	int nameLength = strlen(name);
@@ -43,4 +76,7 @@ PrimEntry* add_prim(int arity, int strictness, char* name, void (*exec)(Thunk*))
 void init_prim()
 {
 	add_prim(2, 3, "add", &__add);
+	add_prim(2, 3, "sub", &__sub);
+	add_prim(2, 3, "gt", &__gt);
+	add_prim(2, 3, "lt", &__lt);
 }

interpreter/thunk.c

@@ -11,6 +11,42 @@
        __typeof__ (b) _b = (b); \
      _a > _b ? _a : _b; })
 
+int printDesc(Desc* f)
+{
+	switch(f->type)
+	{
+		case FT_SLICE:
+			printDesc(((SliceEntry*) f)->forward_ptr);
+			return f->arity;
+		case FT_FUN:
+			printf("%s", ((FunEntry*) f)->name);
+			return f->arity;
+		case FT_ADT:
+			printf("%s", ((ADTEntry*) f)->name);
+			return f->arity;
+		case FT_RECORD:
+			printf("%s", ((RecordEntry*) f)->name);
+			return f->arity;
+		default:
+			printf("printDesc: unhandled DESC\n");
+			exit(-1);		
+	}	
+}	 
+	 
+Thunk* forward_to(Thunk* target, Thunk* thunk)
+{
+	if(target != NULL)
+	{
+		target->desc = NULL;
+		target->_forward_ptr = thunk;	
+		return target;		
+	}
+	else
+	{
+		return thunk;
+	}
+}	
+
 int thunk_size(Thunk* thunk)
 {
 	if(thunk->desc == NULL || thunk->desc->type == FT_BOXED_LIT)
@@ -41,15 +77,47 @@ 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");
+		printDesc(thunk->desc);
 		exit(-1);							
 	}
 	
 	return thunk->_int;
 }
 
+struct Thunk* updateB(Thunk* target, int b)
+{
+	if(target == NULL) target = (Thunk*) alloc_heap(sizeof(Thunk));
+	
+	// always can be overwritten with boxed integer
+	target->desc = (Desc*) __BOOL__;
+	target->_bool = b;
+	return target;
+}
+
+int readB(Thunk* thunk)
+{
+	while(thunk->desc == NULL)
+	{
+		thunk =  thunk->_forward_ptr;
+	}	
+	
+	if(thunk->desc != (Desc*) __BOOL__)
+	{
+		printf("readB: not a boolean\n");
+		exit(-1);							
+	}
+	
+	return thunk->_bool;
+}
+
 struct Thunk* updateF(Thunk* target, Desc* f, int nrargs)
 {
 	Thunk* thunk = target;
@@ -124,28 +192,6 @@ void eval(Thunk* thunk)
 	}
 }
 
-int printDesc(Desc* f)
-{
-	switch(f->type)
-	{
-		case FT_SLICE:
-			printDesc(((SliceEntry*) f)->forward_ptr);
-			return f->arity;
-		case FT_FUN:
-			printf("%s", ((FunEntry*) f)->name);
-			return f->arity;
-		case FT_ADT:
-			printf("%s", ((ADTEntry*) f)->name);
-			return f->arity;
-		case FT_RECORD:
-			printf("%s", ((RecordEntry*) f)->name);
-			return f->arity;
-		default:
-			printf("printDesc: unhandled DESC\n");
-			exit(-1);		
-	}	
-}
-
 void print(Thunk* thunk, bool force)
 {
 	while(thunk->desc == NULL)

interpreter/thunk.h

@@ -20,9 +20,14 @@ typedef struct Thunk
 	};
 } Thunk;
 
+Thunk* forward_to(Thunk* target, Thunk* thunk);
+
 struct Thunk* updateI(Thunk* target, int i);
 int readI(Thunk* thunk);
 
+struct Thunk* updateB(Thunk* target, int b);
+int readB(Thunk* thunk);
+
 struct Thunk* updateF(Thunk* target, Desc* f, int nrargs);
 
 void eval(Thunk* thunk);

precompiler/precompiler.icl

@@ -57,6 +57,7 @@ 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
+sTerm ctx (SIf cond texpr fexpr) a = a <++ "I" <++ sTerm ctx cond <++ sTerm ctx texpr <++ sTerm ctx fexpr
 
 sSelectCase ctx (PCons varName params, expr) a
 	# ctx = {ctx & vars = registerLocals ctx.vars ctx.localcount params, localcount = ctx.localcount + length params}