+ parsial application

+ ADT + Record
+ parameter passing

interpreter/code.c

@@ -2,13 +2,15 @@
 #include <stdlib.h>
 
 #include "code.h"
+#include "desc.h"
 #include "thunk.h"
+#include "mem.h"
 
-struct Thunk* exec(Code* expr)
+struct Thunk* exec(Code* expr, int frame_ptr)
 {   
 	switch(expr->type)
 	{
-		case CT_LIT:
+		case CT_LIT:		
 			switch(expr->local_type)
 			{
 				case LIT_INT:
@@ -24,13 +26,29 @@ struct Thunk* exec(Code* expr)
 			{
 				case VAR_FN:
 					return createF(((VarEntry*) expr)->f, 0);
-					break;
+				case VAR_ARG:				
+					return stack[frame_ptr - ((VarEntry*) expr)->index];
+				default:
+					printf("Exec: Unhandled VAR type");
+					exit(-1);				
+			}
+			break;
+		case CT_APP:		
+			VarEntry* var = ((AppEntry*)expr)->var;
+			switch(var->base.local_type)
+			{
+				case VAR_FN:
+					Thunk* thunk;
+					thunk = createF(var->f, ((AppEntry*)expr)->base.arity);
+					for(int i=0; i<thunk->desc->arity; i++)
+					{
+						// TODO: enforce strictness
+						thunk->_args[i] = exec(((AppEntry*)expr)->args[i], frame_ptr);
+					}
+					return thunk;
 				default:
 					printf("Exec: Unhandled VAR type");
 					exit(-1);				
 			}
-		default:
-			printf("Exec: Unhandled CODE type");
-			exit(-1);		
 	}
 }

interpreter/code.h

@@ -12,7 +12,7 @@ struct Code
 {
 	unsigned int type  		: 3;
 	unsigned int local_type : 3;
-	unsigned int arity 		: 4;
+	unsigned int arity		: 4;	// used in AppEntry
 };
 
 #define LIT_INT   			1
@@ -61,6 +61,6 @@ struct AppEntry
 	struct Code* args[];
 };
 
-struct Thunk* exec(Code* expr);
+struct Thunk* exec(Code* expr, int frame_ptr);
 
 #endif // __CODE_H
\ No newline at end of file

interpreter/compile.bat

-g++ -Wno-write-strings -Wno-pointer-arith main.c desc.c mem.c parse.c prim.c code.c thunk.c -o main
+g++ -Wno-write-strings main.c desc.c mem.c parse.c prim.c code.c thunk.c -o main

interpreter/desc.c

@@ -37,20 +37,20 @@ FunEntry* alloc_prim(char* name)
 {
 	int len = strlen(name);
 	FunEntry* entry = (FunEntry*) alloc_desc(sizeof(FunEntry) + len + 1);
-	entry->base.type = FT_FUN;
+	entry->base.type = FT_BOXED_LIT;
 	entry->base.arity = 0;
 	memcpy(entry->name, name, len + 1);	
 	return entry;
 }
 
-void gen_slices(void* dest, void* forward_ptr, int arity)
+void gen_slices(SliceEntry* dest, Desc* forward_ptr, int arity)
 {
 	for(int i=0; i<arity; i++)
 	{
-		SliceEntry* slice = (SliceEntry*) dest + sizeof(SliceEntry) * i;
+		SliceEntry* slice = dest + i;
 		slice->base.type = FT_SLICE;
 		slice->base.arity = i;
-		slice->forward_ptr = (Desc*) forward_ptr;
+		slice->forward_ptr = forward_ptr;
 	}
 }
 

interpreter/desc.h

@@ -4,6 +4,7 @@
 #include "thunk.h"
 #include "code.h"
 
+#define FT_BOXED_LIT		0
 #define FT_RECORD 			1
 #define FT_ADT 				2
 #define FT_CAF 				3
@@ -38,6 +39,7 @@ struct SliceEntry
 	struct Desc base;
 	Desc* forward_ptr; // FunEntry or ADTEntry
 };
+
 struct ADTEntry
 {
 	struct Desc base;
@@ -73,7 +75,7 @@ struct PrimEntry
 	char name[];
 };
 
-void gen_slices(void* dest, void* forward_ptr, int arity);
+void gen_slices(SliceEntry* dest, Desc* forward_ptr, int arity);
 
 void init_desc();
 

interpreter/main.c

@@ -2,11 +2,11 @@
 #include <stdio.h>
 #include <string.h>
 
-#include "mem.h"
 #include "desc.h"
 #include "prim.h"
 #include "parse.h"
 #include "code.h"
+#include "mem.h"
 
 int main()
 {   
@@ -15,10 +15,35 @@ int main()
 	init_prim();
 	
 	//char* funstream = "40 R10 example._R2 1 9 example.a9 example.b37 F12 example.g_482 3 AF3 add2 VA0 VA1 39 C9 example.fAF12 example.g_482 LI1 LI2 55 F13 example.Start0 0 AF10 example._R2 LI1 VF9 example.f29 F4 main0 0 VF13 example.Start";
-	char* funstream = "25 F13 example.Start0 0 LI1 29 F4 main0 0 VF13 example.Start";
-		
-	int nrfuns = parse(&funstream, strlen(funstream));
-		
+	
+	// OK char* funstream = "25 F13 example.Start0 0 LI1 29 F4 main0 0 VF13 example.Start";
+	// 1
+	// OK char* funstream = "20 F9 example.c1 1 VA0 40 F13 example.Start0 0 AF9 example.c1 LI1 29 F4 main0 0 VF13 example.Start";
+	// 1
+	// OK char* funstream = "20 F9 example.c2 1 VA0 44 F13 example.Start0 0 AF9 example.c2 LI2 LI1 29 F4 main0 0 VF13 example.Start";
+	// 1	
+	// OK char* funstream = "20 F9 example.c2 2 VA1 44 F13 example.Start0 0 AF9 example.c2 LI2 LI1 29 F4 main0 0 VF13 example.Start";
+	// 2
+	// OK char* funstream = "20 F9 example.c2 2 VA1 40 F13 example.Start0 0 AF9 example.c1 LI2 29 F4 main0 0 VF13 example.Start";
+	// example.c 2
+	// OK char* funstream = "20 F9 example.c3 7 VA1 40 F13 example.Start0 0 AF9 example.c1 LI1 29 F4 main0 0 VF13 example.Start";
+	// example.c 1	
+	// OK char* funstream = "20 F9 example.c3 7 VA1 40 F13 example.Start0 0 AF9 example.c1 LI1 29 F4 main0 0 VF13 example.Start";
+	// example.c 1
+	// OK char* funstream = "20 F9 example.c3 7 VA1 44 F13 example.Start0 0 AF9 example.c2 LI1 LI2 29 F4 main0 0 VF13 example.Start";
+	// example.c 1 2
+	// OK char* funstream = "20 F9 example.c3 7 VA1 49 F13 example.Start0 0 AF9 example.c3 LI1 LI33 LI2 29 F4 main0 0 VF13 example.Start";
+	// 33
+	// OK char* funstream = "33 A2 9 example.A2 2 9 example.B0 0 34 F13 example.Start0 0 VF9 example.B29 F4 main0 0 VF13 example.Start";
+	// example.B
+	// char* funstream = "33 A2 9 example.A2 2 9 example.B0 0 40 F13 example.Start0 0 AF9 example.A1 LI5 29 F4 main0 0 VF13 example.Start";
+	// example.A 5
+	// OK char* funstream = "33 A2 9 example.A2 2 9 example.B0 0 44 F13 example.Start0 0 AF9 example.A2 LI5 LI6 29 F4 main0 0 VF13 example.Start";
+	// example.A 5 6
+	// char* funstream = "40 R10 example._R2 1 9 example.a9 example.b46 F13 example.Start0 0 AF10 example._R2 LI6 LI7 29 F4 main0 0 VF13 example.Start";
+	// example._R 6 7
+	
+	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"
@@ -26,9 +51,9 @@ int main()
 	char *exprstream = "VF13 example.Start";
 	
 	Code* expr = parseTerm(&exprstream);	
-	Thunk* res = exec(expr);
-	
-	print(res);
+	Thunk* res = exec(expr, stack_top);
+		
+	print(eval(res));
 	
 //   add_fun("jimbo", (Desc*) "artist");
 //   char *tval = (char*) find_fun("jimbo");

interpreter/mem.c

@@ -6,11 +6,16 @@ int desc_alloc;
 int code_alloc;
 int heap_alloc;
 
+int stack_top;
+Thunk* stack[STACK_SIZE];
+
 void init_mem()
 {
 	desc_alloc = 0;
 	code_alloc = 0;
-	heap_alloc = 1;
+	heap_alloc = 0;
+	
+	stack_top = 0;
 }
 
 void* alloc_desc(int size)

interpreter/mem.h

 #ifndef __MEM_H
 #define __MEM_H
 
+#include "thunk.h"
+
+#define STACK_SIZE	1024
+
+extern int stack_top;
+extern Thunk* stack[STACK_SIZE];
+
+#define get(i) stack[stack_top-1-(i)]
+#define pops() stack[--stack_top]
+#define pushs(r) stack[stack_top++]=(r)
+#define pop(i) stack_top -= i
+
 void init_mem();
 
 // TODO: inline

interpreter/parse.c

@@ -78,9 +78,9 @@ int parseDef1(char** ptr)
 			if(!parseInt(ptr, &arity)) return 0;
 		
 			// before the FunEntry there are "arity" number of SliceEntries
-			void* entry_base = alloc_desc(sizeof(SliceEntry) * arity + sizeof(FunEntry) + nameLength + 1);
+			SliceEntry* entry_base = (SliceEntry*) alloc_desc(sizeof(SliceEntry) * arity + sizeof(FunEntry) + nameLength + 1);
 		
-			FunEntry* entry = (FunEntry*) (entry_base + sizeof(SliceEntry) * arity);
+			FunEntry* entry = (FunEntry*) (entry_base + arity);
 			entry->base.type = FT_FUN;
 			entry->base.arity = arity;			
 			
@@ -95,7 +95,7 @@ int parseDef1(char** ptr)
 			entry->parseCont = *ptr; 
 
 			// generate slices. avoid function call if arity is zero
-			if(arity>0) gen_slices(entry_base, entry, arity);
+			if(arity>0) gen_slices(entry_base, (Desc*) entry, arity);
 			
 			add_desc(entry->name, (Desc*) entry);
 			break;
@@ -146,9 +146,9 @@ int parseDef1(char** ptr)
 				if(!parseInt(ptr, &arity)) return 0;
 			
 				// before the FunEntry there are "arity" number of SliceEntries
-				void* entry_base = alloc_desc(sizeof(SliceEntry) * arity + sizeof(ADTEntry) + nameLength + 1);
+				SliceEntry* entry_base = (SliceEntry*) alloc_desc(sizeof(SliceEntry) * arity + sizeof(ADTEntry) + nameLength + 1);
 			
-				ADTEntry* entry = (ADTEntry*) (entry_base + sizeof(SliceEntry) * arity);
+				ADTEntry* entry = (ADTEntry*) (entry_base + arity);
 				entry->base.type = FT_ADT;
 				entry->base.arity = arity;			
 				
@@ -160,7 +160,7 @@ int parseDef1(char** ptr)
 				if(!parseInt(ptr, &entry->strictness)) return 0;
 				
 				// generate slices. avoid function call if arity is zero
-				if(arity>0) gen_slices(entry_base, entry, arity);
+				if(arity>0) gen_slices(entry_base, (Desc*) entry, arity);
 				
 				add_desc(entry->name, (Desc*) entry);
 			}			
@@ -324,6 +324,7 @@ AppEntry* parseApp(char **ptr)
 	
 	struct AppEntry* entry = (AppEntry*) alloc_code(sizeof(AppEntry) + sizeof(void*) * nrArgs);
 	entry->base.type = CT_APP;	
+	entry->base.arity = nrArgs;
 	entry->var = var;
 	
 	for(int i = 0; i < nrArgs; i++)

interpreter/prim.c

@@ -15,9 +15,9 @@ PrimEntry* add_prim(int arity, int strictness, char* name, void (*exec)())
 	int nameLength = strlen(name);
 	
 	// before the PrimEntry there are "arity" number of SliceEntries
-	void* entry_base = alloc_desc(sizeof(SliceEntry) * arity + sizeof(PrimEntry) + nameLength + 1);
+	SliceEntry* entry_base = (SliceEntry*) alloc_desc(sizeof(SliceEntry) * arity + sizeof(PrimEntry) + nameLength + 1);
 		
-	PrimEntry* entry = (PrimEntry*) (entry_base + sizeof(SliceEntry) * arity);
+	PrimEntry* entry = (PrimEntry*) (entry_base + arity);
 	entry->base.type = FT_PRIM;
 	entry->base.arity = arity;
 	entry->strictness = strictness;
@@ -28,7 +28,7 @@ PrimEntry* add_prim(int arity, int strictness, char* name, void (*exec)())
 	entry->name[nameLength] = '\0';
 	
 	// generate slices. avoid function call if arity is zero
-	if(arity>0) gen_slices(entry_base, entry, arity);
+	if(arity>0) gen_slices(entry_base, (Desc*) entry, arity);
 	
 	add_desc(entry->name, (Desc*) entry);
 }

interpreter/thunk.c

@@ -3,6 +3,7 @@
 
 #include "thunk.h"
 #include "desc.h"
+#include "code.h"
 #include "mem.h"
 
 struct Thunk* createI(int i)
@@ -16,27 +17,56 @@ struct Thunk* createI(int i)
 struct Thunk* createF(Desc* f, int nrargs)
 {
 	// Even if no arguments, still allocate enough space for a forward pointer 
-	Thunk* thunk = (Thunk*) alloc_heap(sizeof(Thunk) + sizeof(Thunk*) * (nrargs > 0 ? nrargs - 1 : 0));
-	
-	Desc* slice = f;
-	if(f->arity > 0)
-	{
-		slice = &(((SliceEntry*) f)[-f->arity].base);
-	}
-	
-	thunk->desc = slice;
+	Thunk* thunk = (Thunk*) alloc_heap(sizeof(Thunk) + sizeof(Thunk*) * (nrargs > 0 ? nrargs - 1 : 0));	
+	thunk->desc = &(((SliceEntry*) f)[-(f->arity - nrargs)].base);
 	return thunk;
 }
 
+Thunk* eval(Thunk* thunk)
+{
+	while(true){
+		switch(thunk->desc->type)
+		{
+			case FT_BOXED_LIT:
+			case FT_SLICE:
+			case FT_ADT:
+			case FT_RECORD:
+				return thunk;
+			case FT_FUN:			
+				int old_top;
+				old_top = stack_top;
+			
+				for(int i=0; i<thunk->desc->arity; i++)
+				{
+					pushs(thunk->_args[i]);
+				}
+				thunk = exec(((FunEntry*) thunk->desc)->body, stack_top - 1);
+
+				stack_top = old_top;
+				break;
+			default:
+				printf("eval: unhandled DESC\n");
+				exit(-1);					
+		}		
+	}
+}
+
 int printDesc(Desc* f)
 {
 	switch(f->type)
 	{
 		case FT_SLICE:
-			return printDesc(((SliceEntry*) f)->forward_ptr);
+			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);		
@@ -45,18 +75,26 @@ int printDesc(Desc* f)
 
 void print(Thunk* thunk)
 {
-	if((FunEntry*) thunk->desc == __INT__)
+	if(thunk->desc->type == FT_BOXED_LIT)
 	{
-		printf("%d", thunk->_int);
+		if((FunEntry*) thunk->desc == __INT__)
+		{
+			printf("%d", thunk->_int);
+		}
+		else
+		{
+			printf("printDesc: unhandled BOXED LIT\n");
+			exit(-1);						
+		}		
 	}
 	else
 	{
 		int arity = printDesc(thunk->desc);
 
-		if(arity > 0)
+		for(int i = 0; i < arity; i++)
 		{
-			printf("print: unhandled arity\n");
-			exit(-1);					
+			printf(" ");
+			print(thunk->_args[i]);
 		}
 	}
 }

interpreter/thunk.h

@@ -4,7 +4,7 @@
 #include "desc.h"
 #include "code.h"
 
-struct Thunk
+typedef struct Thunk
 {
 	struct Desc* desc;
 	union
@@ -15,12 +15,15 @@ struct Thunk
 		int _bool;
 		struct CleanString* _string_ptr;
 		//struct CleanString _string;
+		Thunk* _args[];
 	};
-};
+} Thunk;
 
 struct Thunk* createI(int i);
 struct Thunk* createF(Desc* f, int nrargs);
 
+Thunk* eval(Thunk* thunk);
+
 void print(Thunk* thunk);
 
 #endif // __THUNK_H
\ No newline at end of file

precompiler/precompiler.icl

@@ -20,14 +20,14 @@ 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
+addVars vars idx [v:vs] = addVars (put (unpackVar v) (Arg 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 0 params}
+	# ctx = {ctx & vars = addVars 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