save progress. BROKEN!

interpreter/Makefile

+TARGET = main
+LIBS =
+CC = g++
+CFLAGS = -g -Wno-write-strings
+
+.PHONY: default all clean
+
+default: $(TARGET)
+all: default
+
+OBJECTS = $(patsubst %.c, %.o, $(wildcard *.c))
+HEADERS = $(wildcard *.h)
+
+%.o: %.c $(HEADERS)
+	$(CC) $(CFLAGS) -c $< -o $@
+
+.PRECIOUS: $(TARGET) $(OBJECTS)
+
+$(TARGET): $(OBJECTS)
+	$(CC) $(OBJECTS) -g -Wall $(LIBS) -o $@
+
+clean:
+	-rm -f *.o
+	-rm -f $(TARGET)
\ No newline at end of file

interpreter/code.c

 #include <stdio.h>
 #include <stdlib.h>
+#include <stdbool.h>
 
 #include "code.h"
 #include "desc.h"
 #include "thunk.h"
 #include "mem.h"
 
-struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target)
-{   
-	switch(expr->type)
-	{
-		case CT_LIT:		
-			switch(expr->local_type)
-			{
-				case LIT_INT:
-					return updateI(target, ((LitEntry*) expr)->_int);
-				case LIT_BOOL:
-					return updateB(target, ((LitEntry*) expr)->_bool);						
-				default:
-					printf("Exec: Unhandled LIT type");
-					exit(-1);
-			}
-			break;
-		case CT_VAR:
-			switch(expr->local_type)
-			{
-				case VAR_FN:		
-					return updateF(target, get_slice(((VarEntry*) expr)->f, 0));
-					
-				case VAR_ARG:
-				{
-					Thunk* var = stack[frame_ptr - ((VarEntry*) expr)->index];
-					return forward_to(target, var);
-				}
-				case VAR_LOCAL:
-				{
-					Thunk* var = stack[frame_ptr + ((VarEntry*) expr)->index + 1];
-					return forward_to(target, var);
-				}
-			}
-			break;
-		case CT_APP:		
-		
-			// TODO: check over application
-			// TODO: enforce strictness in ADT/Record
-		
-			VarEntry* var;
-			var = ((AppEntry*)expr)->var;
-			Thunk* thunk;
-			
-			switch(var->base.local_type)
-			{
-				case VAR_FN:		
-					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);
-					}
-					return thunk;
-				case VAR_ARG:
-					Thunk* basethunk;
-					basethunk = stack[frame_ptr - var->index];
-					eval(basethunk);
-					
-					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++)
-					{
-						thunk->_args[i] = basethunk->_args[i];
-					}
-					
-					for(int i=0; i<expr->nr_args; i++)
-					{
-						thunk->_args[basethunk->desc->arity + i] = exec(((AppEntry*)expr)->args[i], frame_ptr, NULL);
-					}
-					return thunk;					
-				default:
-					printf("Exec: Unhandled VAR type in CT_APP");
-					exit(-1);				
-			}
-			break;
-		case CT_SELECT:
-		{
-			Thunk* pattern = exec(((SelectEntry*)expr)->expr, frame_ptr, NULL);
-			pattern = 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");
-			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);
-			cond = 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);				
-	}
+struct Thunk*
+exec(Code* expr, int frame_ptr, Thunk* target, bool force)
+{
+    switch (expr->type) {
+    case CT_LIT:
+        switch (expr->local_type) {
+        case LIT_INT:
+            return updateI(target, ((LitEntry*) expr)->_int);
+        case LIT_BOOL:
+            return updateB(target, ((LitEntry*) expr)->_bool);
+        default:
+            printf("Exec: Unhandled LIT type");
+            exit(-1);
+        }
+        break;
+    case CT_VAR:
+        switch (expr->local_type) {
+        case VAR_FN:
+            return updateF(target, get_slice(((VarEntry*) expr)->f, 0));
+
+        case VAR_ARG:
+        {
+            Thunk* var = stack[frame_ptr - ((VarEntry*) expr)->index];
+            return forward_to(target, var);
+        }
+        case VAR_LOCAL:
+        {
+            Thunk* var = stack[frame_ptr + ((VarEntry*) expr)->index + 1];
+            return forward_to(target, var);
+        }
+        }
+        break;
+    case CT_APP:
+
+        // TODO: check over application
+        // TODO: enforce strictness in ADT/Record
+
+        VarEntry* var;
+        var = ((AppEntry*) expr)->var;
+        Thunk* thunk;
+
+        switch (var->base.local_type) {
+        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++) {
+                    exec(((AppEntry*) expr)->args[i], frame_ptr, &args[i], true);
+                }
+
+                int old_top = stack_top;
+
+                for (int i = 0; i < expr->nr_args; i++) {
+                    pushs(&args[i]);
+                }
+
+                thunk = ((PrimEntry*) slice)->exec(target);
+
+                stack_top = old_top;
+            }
+            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);
+                }
+
+                int old_top = stack_top;
+
+                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);
+
+                stack_top = old_top;
+            }
+            else {
+                thunk = updateF(target, slice);
+                for (int i = 0; i < expr->nr_args; i++) {
+                    thunk->_args[i] = exec(((AppEntry*) expr)->args[i], frame_ptr, NULL, false);
+                }
+            }
+            return thunk;
+        }
+        case VAR_ARG:
+        {
+            Thunk* basethunk = eval(stack[frame_ptr - var->index]);
+
+            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);
+
+            for (int i = 0; i < basethunk->desc->arity; i++) {
+                thunk->_args[i] = basethunk->_args[i];
+            }
+
+            for (int i = 0; i < expr->nr_args; i++) {
+                thunk->_args[basethunk->desc->arity + i] = exec(((AppEntry*) expr)->args[i], frame_ptr, NULL, false);
+            }
+
+            return thunk;
+        }
+        default:
+            printf("Exec: Unhandled VAR type in CT_APP");
+            exit(-1);
+        }
+        break;
+    case CT_SELECT:
+    {
+        Thunk* pattern = exec(((SelectEntry*) expr)->expr, frame_ptr, NULL, true);
+        pattern = 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, false);
+            default:
+                printf("Exec: Unhandled entry type in CT_SELECT");
+                exit(-1);
+            }
+        }
+
+        printf("Exec: no select cases matches");
+        print(pattern, false);
+        exit(-1);
+    }
+    case CT_IF:
+    {
+        Thunk* tmp = (Thunk*) malloc(sizeof (Thunk));
+        tmp->desc = (Desc*) __BOOL__;
+
+        Thunk* cond = exec(((IfEntry*) expr)->cond, frame_ptr, NULL, true);
+        cond = eval(cond);
+
+        if (readB(cond)) {
+            return exec(((IfEntry*) expr)->texpr, frame_ptr, target, force);
+        }
+        else {
+            return exec(((IfEntry*) expr)->fexpr, frame_ptr, target, force);
+        }
+    }
+    default:
+        printf("Exec: Unhandled CODE type");
+        exit(-1);
+    }
 }
-	
\ No newline at end of file

interpreter/code.h

@@ -10,12 +10,11 @@
 #define CT_SELECT			4
 #define CT_IF				5
 
-struct Code
-{
-	unsigned int type  		: 3;
-	unsigned int local_type : 3;
-	unsigned int nr_args	: 5;	// used in AppEntry
-	unsigned int nr_cases	: 5;	// used in SelectEntry
+struct Code {
+    unsigned int type : 3;
+    unsigned int local_type : 3;
+    unsigned int nr_args : 5; // used in AppEntry
+    unsigned int nr_cases : 5; // used in SelectEntry
 };
 
 #define LIT_INT   			1
@@ -24,76 +23,69 @@ struct Code
 #define LIT_BOOL			4
 #define LIT_STRING			5
 
-struct CleanString
-{
-	int length;
-	char chars[];
+struct CleanString {
+    int length;
+    char chars[];
 };
 
-struct LitEntry
-{
-	struct Code base;
-	union 
-	{
-		int _int;
-		double _real;
-		char _char;
-		int _bool;
-		struct CleanString _string;
-	};
+struct LitEntry {
+    struct Code base;
+
+    union {
+        int _int;
+        double _real;
+        char _char;
+        int _bool;
+        struct CleanString _string;
+    };
 };
 
 #define VAR_ARG			1
 #define VAR_LOCAL		2
 #define VAR_FN			3
 
-struct VarEntry
-{
-	struct Code base;
-	union
-	{
-		int index; // index on the stack
-		struct Desc* f;
-	};
+struct VarEntry {
+    struct Code base;
+
+    union {
+        int index; // index on the stack
+        struct Desc* f;
+    };
 };
 
-struct AppEntry
-{
-	struct Code base;
-	struct VarEntry* var;  // TODO: remove * here (embed VarEntry to save a space of one pointer)
-	struct Code* args[];
+struct AppEntry {
+    struct Code base;
+    struct VarEntry* var; // TODO: remove * here (embed VarEntry to save a space of one pointer)
+    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 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 SelectEntry {
+    struct Code base;
+    struct Code* expr;
+    struct SelectCaseEntry cases[];
 };
 
-struct IfEntry
-{
-	struct Code base;
-	struct Code* cond;
-	struct Code* texpr;
-	struct Code* fexpr;
+struct IfEntry {
+    struct Code base;
+    struct Code* cond;
+    struct Code* texpr;
+    struct Code* fexpr;
 };
 
-struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target);
+struct Thunk* exec(Code* expr, int frame_ptr, Thunk* target, bool force);
 
 #endif // __CODE_H
\ No newline at end of file

interpreter/desc.c

@@ -19,54 +19,47 @@ const int khStrPtr = 33;
 KHASH_MAP_INIT_STR(khStrPtr, Desc*) // setup khash to handle string key with an arbitrary pointer payload
 
 // create a hashtable
-khash_t(khStrPtr) *funHash = kh_init(khStrPtr); 
+khash_t(khStrPtr) * funHash = kh_init(khStrPtr);
 
-void add_desc(char* fn, Desc* desc)
-{
-	khiter_t k; // used by the macros   
-	kh_set(khStrPtr, funHash, fn, desc);
+void add_desc(char* fn, Desc* desc) {
+    khiter_t k; // used by the macros   
+    kh_set(khStrPtr, funHash, fn, desc);
 }
 
-Desc* find_desc(char* fn)
-{
-	khiter_t k; // used by the macros   
-	return kh_get_val(khStrPtr, funHash, fn);
+Desc* find_desc(char* fn) {
+    khiter_t k; // used by the macros   
+    return kh_get_val(khStrPtr, funHash, fn);
 }
 
-Desc* get_slice(Desc* f, int nrargs)
-{
-	return &(((SliceEntry*) f)[-(f->arity - nrargs)].base);
+Desc* get_slice(Desc* f, int nrargs) {
+    return &(((SliceEntry*) f)[-(f->arity - nrargs)].base);
 }
 
-FunEntry* alloc_prim(char* name)
-{
-	int len = strlen(name);
-	FunEntry* entry = (FunEntry*) alloc_desc(sizeof(FunEntry) + len + 1);
-	entry->base.type = FT_BOXED_LIT;
-	entry->base.arity = 0;
-	memcpy(entry->name, name, len + 1);	
-	return entry;
+FunEntry* alloc_prim(char* name) {
+    int len = strlen(name);
+    FunEntry* entry = (FunEntry*) alloc_desc(sizeof (FunEntry) + len + 1);
+    entry->base.type = FT_BOXED_LIT;
+    entry->base.arity = 0;
+    memcpy(entry->name, name, len + 1);
+    return entry;
 }
 
-void gen_slices(SliceEntry* dest, Desc* forward_ptr, int arity)
-{
-	for(int i=0; i<arity; i++)
-	{
-		SliceEntry* slice = dest + i;
-		slice->base.type = FT_SLICE;
-		slice->base.arity = i;
-		slice->forward_ptr = forward_ptr;
-	}
+void gen_slices(SliceEntry* dest, Desc* forward_ptr, int arity) {
+    for (int i = 0; i < arity; i++) {
+        SliceEntry* slice = dest + i;
+        slice->base.type = FT_SLICE;
+        slice->base.arity = i;
+        slice->forward_ptr = forward_ptr;
+    }
 }
 
-void init_desc()
-{
-	__INT__ = alloc_prim("INT");
-	__BOOL__ = alloc_prim("BOOL");
-	__CHAR__ = alloc_prim("CHAR");
-	__REAL__ = alloc_prim("REAL");
-	__STRING__ = alloc_prim("STRING");	
-	__ARRAY__ = alloc_prim("ARRAY");	
+void init_desc() {
+    __INT__ = alloc_prim("INT");
+    __BOOL__ = alloc_prim("BOOL");
+    __CHAR__ = alloc_prim("CHAR");
+    __REAL__ = alloc_prim("REAL");
+    __STRING__ = alloc_prim("STRING");
+    __ARRAY__ = alloc_prim("ARRAY");
 }
 
 struct FunEntry* __INT__;

interpreter/desc.h

@@ -15,64 +15,58 @@
 
 // LIMITATION: maximum 32 arguments
 
-struct Desc
-{
-	unsigned int type  : 3;
-	unsigned int arity : 8;
+struct Desc {
+    unsigned int type : 3;
+    unsigned int arity : 8;
 };
 
-struct FunEntry
-{
-	struct Desc base;
-	int strictness;
-	union
-	{
-		char* parseCont;						
-		struct Code* body;
-	};
-	char name[];
+struct FunEntry {
+    struct Desc base;
+    int strictness;
+
+    union {
+        char* parseCont;
+        struct Code* body;
+    };
+    char name[];
 };
 
 // an array of these is just before an ADTEntry/FunEntry (as many as arity)
-struct SliceEntry
-{
-	struct Desc base;
-	Desc* forward_ptr; // FunEntry or ADTEntry
+
+struct SliceEntry {
+    struct Desc base;
+    Desc* forward_ptr; // FunEntry or ADTEntry
 };
 
-struct ADTEntry
-{
-	struct Desc base;
-	int strictness;
-	char name[];
+struct ADTEntry {
+    struct Desc base;
+    int strictness;
+    char name[];
 };
 
-struct CAFEntry
-{
-	struct Desc base;
-	union
-	{
-		char* parseCont;				
-		Code* body;	
-		Thunk* value;
-	};