+ store literals internally as thunk and just memcpy it when requested

+ execute a single VAR_FN when forced
+ refactor basic struct Desc definition to avoid cyclic includes

interpreter/code.c

@@ -4,10 +4,9 @@
 
 #include "debug.h"
 #include "code.h"
-#include "desc.h"
-#include "thunk.h"
 #include "mem.h"
-    
+#include "desc.h"
+
 void exec(Code* expr, int frame_ptr, int root_frame_ptr, Thunk* target, bool force)
 {
     assert(expr != NULL);
@@ -17,30 +16,29 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr, Thunk* target, bool for
         switch (expr->type) {
         case CT_LIT:
             stack_top_a = root_frame_ptr; 
-            
-            switch (expr->local_type) {
-            case LIT_INT:
-                push_a(updateI(target, ((LitEntry*) expr)->_int));
-                return;
-            case LIT_BOOL:
-                push_a(updateB(target, ((LitEntry*) expr)->_bool));
-                return;
-            default:
-                printf("Exec: Unhandled LIT type");
-                exit(-1);
-            }
-            break;
+            push_a(updateT(target, &((LitEntry*) expr)->thunk));
+            return;
         case CT_VAR:
             stack_top_a = root_frame_ptr;     
             
             if (expr->local_type == VAR_LOCAL) {
-                push_a(forward_to(target, local(frame_ptr, ((VarEntry*) expr)->index)));
+                Thunk* thunk = forward_to(target, local(frame_ptr, ((VarEntry*) expr)->index));
+                if(force) push_a(eval(thunk)); else push_a(thunk);
                 return;
             }else{
-                push_a(updateF(target, get_slice(((VarEntry*) expr)->f, 0)));
-                return;
+                Desc* slice = get_slice(((VarEntry*) expr)->f, 0);
+                
+                if(force &&  slice->type == FT_FUN)
+                {
+                    expr = ((FunEntry*)slice)->body;
+                    continue;
+                }
+                else
+                {
+                    push_a(updateF(target, get_slice(((VarEntry*) expr)->f, 0)));
+                    return;
+                }
             }
-            break;
         case CT_APP:
         {
             // TODO: check over application

interpreter/code.h

 #ifndef __CODE_H
 #define __CODE_H
 
-#include "desc.h"
 #include "thunk.h"
 
 #define CT_LIT	 			1
@@ -23,21 +22,9 @@ struct Code {
 #define LIT_BOOL			4
 #define LIT_STRING			5
 
-struct CleanString {
-    int length;
-    char chars[];
-};
-
 struct LitEntry {
     struct Code base;
-
-    union {
-        int _int;
-        double _real;
-        char _char;
-        int _bool;
-        struct CleanString _string;
-    };
+    struct Thunk thunk;
 };
 
 #define VAR_LOCAL		0 

interpreter/desc.c

@@ -61,6 +61,30 @@ void gen_slices(SliceEntry* dest, Desc* forward_ptr, int arity) {
     }
 }
 
+int printDesc(Desc* f) {
+    switch (f->type) {
+        case FT_SLICE:
+            printDesc(((SliceEntry*) f)->forward_ptr);
+            return f->arity;
+        case FT_PRIM:
+            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:
+            printf("%s", ((ADTEntry*) f)->name);
+            return f->arity;
+        case FT_RECORD:
+            printf("%s", ((RecordEntry*) f)->name);
+            return f->arity;
+        default:
+            printf("printDesc: unhandled DESC %d\n", f->type);
+            exit(-1);
+    }
+}
+
 void init_desc() {
     __INT__ = alloc_prim("INT");
     __BOOL__ = alloc_prim("BOOL");

interpreter/desc.h

 #ifndef __DESC_H
 #define __DESC_H
 
+#include "desc_base.h"
 #include "thunk.h"
 #include "code.h"
 
-#define FT_BOXED_LIT		0
-#define FT_RECORD 			1
-#define FT_ADT 				2
-#define FT_CAF 				3
-#define FT_CAF_REDUCED 		4
-#define FT_FUN				5
-#define FT_SLICE			6
-#define FT_PRIM				7
-
 // LIMITATION: maximum 32 arguments
 
-struct Desc {
-    unsigned int type : 3;
-    unsigned int arity : 8;
-};
-
 struct FunEntry {
     struct Desc base;
     int strictness;
@@ -50,7 +37,7 @@ struct CAFEntry {
     union {
         char* parseCont;
         Code* body;
-        Thunk* value;
+        struct Thunk* value;
     };
     char name[];
 };
@@ -80,6 +67,8 @@ Desc* get_slice(Desc* f, int nrargs);
 
 bool is_strict_fun_arg(FunEntry* f, int nr_arg);
 
+int printDesc(Desc* f);
+
 extern struct FunEntry* __INT__;
 extern struct FunEntry* __BOOL__;
 extern struct FunEntry* __CHAR__;

interpreter/desc_base.h

+#ifndef __DESC_BASE_H
+#define __DESC_BASE_H
+
+#define FT_BOXED_LIT		0
+#define FT_RECORD 			1
+#define FT_ADT 				2
+#define FT_CAF 				3
+#define FT_CAF_REDUCED 		4
+#define FT_FUN				5
+#define FT_SLICE			6
+#define FT_PRIM				7
+
+struct Desc {
+    unsigned int type : 3;
+    unsigned int arity : 8;
+};
+
+#endif // __DESC_H
\ No newline at end of file

interpreter/mem.c

 #include <stdlib.h>
 #include <stdio.h>
-#include <assert.h>
 
+#include "debug.h"
 #include "mem.h"
 
 int desc_alloc;

interpreter/parse.c

@@ -5,9 +5,9 @@
 
 #include "parse.h"
 #include "mem.h"
-
-#include "desc.h"
 #include "code.h"
+#include "desc.h"
+
 
 int parseInt(char** ptr, int* result) {
     char *end;
@@ -224,26 +224,29 @@ LitEntry* parseLit(char **ptr) {
 
     struct LitEntry* entry = (LitEntry*) alloc_code(sizeof (LitEntry) + strlen + 1);
     entry->base.type = CT_LIT;
-
+    
     switch (type) {
         case 'I': // Int
         {
             entry->base.local_type = LIT_INT;
-            if (!parseInt(ptr, &entry->_int)) return 0;
+            entry->thunk.desc = (Desc*) __INT__;
+            if (!parseInt(ptr, &entry->thunk._int)) return 0;
             break;
         }
 
         case 'C': // Char
         {
             entry->base.local_type = LIT_CHAR;
-            entry->_char = *(*ptr)++;
+            entry->thunk.desc = (Desc*) __CHAR__;
+            entry->thunk._char = *(*ptr)++;
             break;
         }
 
         case 'R': // Real
         {
             entry->base.local_type = LIT_REAL;
-            if (!parseReal(ptr, &entry->_real)) return 0;
+            entry->thunk.desc = (Desc*) __REAL__;
+            if (!parseReal(ptr, &entry->thunk._real)) return 0;
             break;
         }
 
@@ -251,15 +254,15 @@ LitEntry* parseLit(char **ptr) {
         case '1':
         {
             entry->base.local_type = LIT_BOOL;
-            entry->_bool = type == '1';
+            entry->thunk.desc = (Desc*) __BOOL__;
+            entry->thunk._bool = type == '1';
             break;
         }
 
         case 'S': // String
         {
-            entry->base.local_type = LIT_STRING;
-            entry->_string.length = strlen;
-            copyStringAndForward(entry->_string.chars, ptr, strlen);
+            // TODO
+            return 0;
         }
     }
 

interpreter/prim.c

-
 #include <string.h>
 
 #include "prim.h"
@@ -9,52 +8,25 @@
 #define arg(idx) stack_a[stack_top_a - idx]
 
 struct Thunk* __add(Thunk* target) {
-    Thunk* arg1 = arg(2);
-    Thunk* arg2 = arg(1);
-
-    arg1 = eval(arg1);
-    arg2 = eval(arg2);
-
-    return updateI(target, readI(arg1) + readI(arg2));
+    return updateI(target, readI(arg(2)) + readI(arg(1)));
 }
 
 struct Thunk* __sub(Thunk* target) {
-    Thunk* arg1 = arg(2);
-    Thunk* arg2 = arg(1);
-
-    arg1 = eval(arg1);
-    arg2 = eval(arg2);
-
-    return updateI(target, readI(arg1) - readI(arg2));
+    return updateI(target, readI(arg(2)) - readI(arg(1)));
 }
 
 struct Thunk* __gt(Thunk* target) {
-    Thunk* arg1 = arg(2);
-    Thunk* arg2 = arg(1);
-
-    arg1 = eval(arg1);
-    arg2 = eval(arg2);
-
-    return updateB(target, readI(arg1) > readI(arg2));
+    return updateB(target, readI(arg(2)) > readI(arg(1)));
 }
 
 struct Thunk* __lt(Thunk* target) {
-    Thunk* arg1 = arg(2);
-    Thunk* arg2 = arg(1);
-
-    arg1 = eval(arg1);
-    arg2 = eval(arg2);
-
-    return updateB(target, readI(arg1) < readI(arg2));
+    return updateB(target, readI(arg(2)) < readI(arg(1)));
 }
 
 struct Thunk* __eqI(Thunk* target) {
     Thunk* arg1 = arg(2);
     Thunk* arg2 = arg(1);
 
-    arg1 = eval(arg1);
-    arg2 = eval(arg2);
-
     return updateB(target, readI(arg1) == readI(arg2));
 }
 
@@ -62,17 +34,12 @@ struct Thunk* __eqB(Thunk* target) {
     Thunk* arg1 = arg(2);
     Thunk* arg2 = arg(1);
 
-    arg1 = eval(arg1);
-    arg2 = eval(arg2);
-
     return updateB(target, readB(arg1) == readB(arg2));
 }
 
 struct Thunk* __not(Thunk* target) {
     Thunk* arg1 = arg(1);
 
-    arg1 = eval(arg1);
-
     return updateB(target, !readB(arg1));
 }
 

interpreter/thunk.c

 #include <stdio.h>
 #include <stdlib.h>
 #include <stdbool.h>
+#include <string.h>
 
 #include "debug.h"
 #include "thunk.h"
-#include "desc.h"
-#include "code.h"
 #include "mem.h"
+#include "desc.h"
 
 #define max(a,b) \
    ({ __typeof__ (a) _a = (a); \
        __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_PRIM:
-            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:
-            printf("%s", ((ADTEntry*) f)->name);
-            return f->arity;
-        case FT_RECORD:
-            printf("%s", ((RecordEntry*) f)->name);
-            return f->arity;
-        default:
-            printf("printDesc: unhandled DESC %d\n", f->type);
-            exit(-1);
-    }
-}
-
 Thunk* forward_to(Thunk* target, Thunk* thunk) {
     assert(thunk != NULL); 
     
@@ -75,13 +51,15 @@ struct Thunk* updateI(Thunk* target, int i) {
 
 int readI(Thunk* thunk) {
     assert(thunk != NULL);
-    
+
+#ifdef DEBUG    
     if (thunk->desc != (Desc*) __INT__) {
         printf("readI: not an integer\n");
         printDesc(thunk->desc);
         exit(-1);
     }
-
+#endif
+    
     return thunk->_int;
 }
 
@@ -97,14 +75,23 @@ struct Thunk* updateB(Thunk* target, int b) {
 int readB(Thunk* thunk) {
     assert(thunk != NULL);
     
+#ifdef DEBUG    
     if (thunk->desc != (Desc*) __BOOL__) {
         printf("readB: not a boolean\n");
         exit(-1);
     }
-
+#endif
+    
     return thunk->_bool;
 }
 
+struct Thunk* updateT(Thunk* target, Thunk* source) {
+    if (target == NULL) target = (Thunk*) alloc_heap(sizeof (Thunk));
+    
+    memcpy(target, source, sizeof(Thunk));
+    return target;
+}
+    
 struct Thunk* updateF(Thunk* target, Desc* f) {
     assert(f != NULL);
     
@@ -130,48 +117,33 @@ struct Thunk* updateF(Thunk* target, Desc* f) {
 struct Thunk* eval(Thunk* thunk) {
     assert(thunk != NULL);    
     
-    while (true) {
+    while (thunk->desc == NULL) {
+        thunk = thunk->_forward_ptr;
+    }
+
+    if (thunk->desc->type == FT_FUN) {
+        int frame_ptr = stack_top_a;
 
-        while (thunk->desc == NULL) {
-            thunk = thunk->_forward_ptr;
+        for (int i = 0; i < thunk->desc->arity; i++) {
+            // TODO: handle strictness
+            push_a(thunk->_args[i]);
         }
+        exec(((FunEntry*) thunk->desc)->body, frame_ptr, frame_ptr, thunk, true);
+        thunk = pop_a();
+    }
+    else if(thunk->desc->type == FT_PRIM) {
+        int frame_ptr = stack_top_a;
 
-        //print(thunk, false);
-        //printf("\n");		
-
-        switch (thunk->desc->type) {
-            case FT_BOXED_LIT:
-            case FT_SLICE:
-            case FT_ADT:
-            case FT_RECORD:
-                return thunk;
-            case FT_FUN:
-                int frame_ptr;
-                frame_ptr = stack_top_a;
-
-                for (int i = 0; i < thunk->desc->arity; i++) {
-                    // TODO: handle strictness
-                    push_a(thunk->_args[i]);
-                }
-                exec(((FunEntry*) thunk->desc)->body, frame_ptr, frame_ptr, thunk, true);
-                thunk = pop_a();
-                break;
-            case FT_PRIM:
-                frame_ptr = stack_top_a;
-
-                for (int i = 0; i < thunk->desc->arity; i++) {
-                    push_a(thunk->_args[i]);
-                }
-
-                ((PrimEntry*) thunk->desc)->exec(thunk);
-
-                stack_top_a = frame_ptr;
-                break;
-            default:
-                printf("eval: unhandled DESC\n");
-                exit(-1);
+        for (int i = 0; i < thunk->desc->arity; i++) {
+            push_a(thunk->_args[i]);
         }
+
+        ((PrimEntry*) thunk->desc)->exec(thunk);
+
+        stack_top_a = frame_ptr;        
     }
+ 
+    return thunk;
 }
 
 void print(Thunk* thunk, bool force) {

interpreter/thunk.h

 #ifndef __THUNK_H
 #define __THUNK_H
 
-#include "desc.h"
-#include "code.h"
+#include "desc_base.h"
 
 #pragma pack(push, 1)
 
+typedef struct __attribute__((packed)) CleanString {
+    int length;
+    char chars[];
+} CleanString;
+
 typedef struct __attribute__((packed)) Thunk {
     struct Desc* desc; // NULL, if it is a forward pointer
 
@@ -16,7 +20,7 @@ typedef struct __attribute__((packed)) Thunk {
         char _char;
         int _bool;
         struct CleanString* _string_ptr;
-        //struct CleanString _string;
+        struct CleanString _string;
         Thunk* _args[];
     };
 } Thunk;
@@ -31,11 +35,12 @@ int readI(Thunk* thunk);
 struct Thunk* updateB(Thunk* target, int b);
 int readB(Thunk* thunk);
 
+struct Thunk* updateT(Thunk* target, Thunk* source);
+
 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);