code.c

/*
 * Some properties: 
 * - get_dst(root_frame_ptr) can be NULL, but never a FORWARD_PTR (at least I hope so)
 *   
 *
 */

#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <strings.h>

#include "debug.h"
#include "code.h"
#include "mem.h"
#include "desc.h"
#include "gc.h"

// For compressing the source code a bit

#define instackb(addr) ((char*)addr >= (char*) &stack_b[0] && (char*)addr < (char*) &stack_b[STACK_SIZE_B])

#define follow_thunk(thunk) while (thunk->desc == (Desc*) __FORWARD_PTR__) thunk = thunk->_forward_ptr;

#define forward_thunk(thunk, frame_ptr) \
        Thunk* dst = get_dst(frame_ptr); \
        if(dst != NULL){ \
            dst->desc = (Desc*) __FORWARD_PTR__; \
            dst->_forward_ptr = thunk; \
        }

#define placeholder() \
        push_a(alloc_b());

#define arg_from_code(descarg, arg) \
        if(((FunEntry*) (descarg))->boxing & argmask) \
        { \
            placeholder(); \
            exec(arg, frame_ptr, stack_top_a); \
        } \
        else if(((FunEntry*) (descarg))->strictness & argmask) \
        { \
            push_a(NULL); \
            exec(arg, frame_ptr, stack_top_a); \
        } \
        else \
        { \
            arg->create_thunk(arg, &stack_a[stack_top_a++], frame_ptr); \
        } \
        argmask <<= 1;

void create_thunk_app_static(Code* expr, Thunk** target, int frame_ptr)
{
    Thunk* thunk = (Thunk*) alloc_heap(((AppEntry*) expr)->f->thunk_size);
    *target = thunk;
    thunk->desc = ((AppEntry*) expr)->f;

    assert(thunk->desc->arity == expr->nr_args);

    for (int i = 0; i < expr->nr_args; i++) {
         ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], &thunk->_args[i], frame_ptr);
    }                     
}

void create_thunk_app_dyn(Code* expr, Thunk** target, int frame_ptr)
{
    push_a(local(frame_ptr, ((AppEntry*)expr)->var.index));

    int tmp = gc_enabled;
    gc_enabled = 0;
    peek_a()->desc->eval();
    gc_enabled = tmp;
    
    Thunk* basethunk = pop_a();
    
    Desc* slice =
            get_slice(basethunk->desc->type == FT_SLICE ?
                      ((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);

    Thunk* thunk = (Thunk*) alloc_heap(slice->thunk_size);
    thunk->desc = slice;
    *target = thunk;
    
    assert(thunk->desc->arity == basethunk->desc->arity + expr->nr_args);            

    memcpy(&thunk->_args, &basethunk->_args, sizeof(Thunk*) * basethunk->desc->arity);

    for (int i = 0; i < expr->nr_args; i++) {
        ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], &thunk->_args[basethunk->desc->arity + i], frame_ptr);
    } 
}

void create_thunk_var(Code* expr, Thunk** target, int frame_ptr)
{
    *target = local(frame_ptr, ((VarEntry*) expr)->index);    
    assert(!instackb(*target));
}

void create_thunk_var_unboxed(Code* expr, Thunk** target, int frame_ptr)
{
    Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);

    if(instackb(arg))
    {
        // The likely case
        Thunk* newthunk = (Thunk*) alloc_heap(sizeof (Thunk));
        memcpy(newthunk, arg, sizeof(Thunk));
        *target = newthunk;        
    }
    else
    {
        *target = arg;
    }
    
    assert(!instackb(*target));
}

void create_thunk_thunk(Code* expr, Thunk** target, int frame_ptr)
{
    *target = &((ThunkEntry*) expr)->thunk;
    assert(!instackb(*target));
}

void set_create_thunk_fun(Code* code)
{
    switch(code->type)
    {
        case CT_APP_PRIM_FAST:
        case CT_APP_PRIM:            
        case CT_APP_FUN:
        case CT_APP_FUN_TR:
        case CT_APP_FUN1:
        case CT_APP_FUN2:
        case CT_APP_THUNK:
            code->create_thunk = create_thunk_app_static;
            break;
        case CT_APP_DYN:
            code->create_thunk = create_thunk_app_dyn;
            break;
        case CT_VAR:
        case CT_VAR_STRICT:            
            code->create_thunk = create_thunk_var;
            break;
        case CT_VAR_UNBOXED:
            code->create_thunk = create_thunk_var_unboxed;
            break;
        case CT_THUNK:
            code->create_thunk = create_thunk_thunk;
            break;
        case CT_SELECT_ADT:
        case CT_SELECT_LIT:    
        case CT_SELECT_STR:
        case CT_SELECT_REC:
        case CT_IF:
        case CT_LET:
            code->create_thunk = NULL;
            break;            
    }
}

// eval: frame_ptr, frame_ptr
// start: stack_top_a, stack_top_a
// otherwise: frame_ptr, stack_top_a

// frame_ptr: first arguments
// root_frame_ptr: place of the result

void exec(Code* expr, int frame_ptr, int root_frame_ptr)
{
    if(heap_curr > gc_trigger) gc();
    
    int root_frame_ptr_b = stack_top_b;    
    
    while(1)
    {  
        assert(expr != NULL);
        assert(stack_top_a < STACK_SIZE_A);
        assert(stack_top_b < STACK_SIZE_B);

        // TODO: check over application
        // TODO: enforce strictness in ADT/Record
        
        switch (expr->type) {
        case CT_APP_PRIM_FAST:
        {                         
            // careful, "exec" may trigger garbage collection
            // read local variables only after the last exec            
            switch(expr->arg_pattern)
            {
            case 0:
                placeholder();                       
                exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
                placeholder();                        
                exec(((AppEntry*) expr)->args[1], frame_ptr, stack_top_a);
                break;
            case 1:
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[0])->index));  
                push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[1])->thunk);
                break;
            case 2:
                push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[0])->thunk);            
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[1])->index));                        
                break;
            case 3:
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[0])->index));
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[1])->index));
                break;                    
            case 4:
                push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[0])->thunk);            
                placeholder();                       
                exec(((AppEntry*) expr)->args[1], frame_ptr, stack_top_a);                    
                break;                    
            case 5:
                placeholder();                     
                exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
                push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[1])->thunk);                                
                break;                    
            case 6:
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[0])->index));
                placeholder();                       
                exec(((AppEntry*) expr)->args[1], frame_ptr, stack_top_a);
                break;                    
            case 7:
                placeholder();                        
                exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[1])->index));
                break;                    
            case 8:
                push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[0])->index));  
                break;
            case 9:
                push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[0])->thunk);            
                break;
            default: // 10
                placeholder();                        
                exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
                break;
            }
            
            if(get_dst(root_frame_ptr) == NULL && (((AppEntry*) expr)->f)->unboxable_return)
            {
                Thunk* tmp = (Thunk*) alloc_heap(sizeof(Thunk));
                set_return(root_frame_ptr, tmp);
            }

            ((PrimEntry*) ((AppEntry*) expr)->f)->exec(root_frame_ptr);

            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;            
        }
        case CT_APP_PRIM:
        {           
            PrimEntry* desc = (PrimEntry*) ((AppEntry*) expr)->f;
            int argmask = 1;            

            for (int i = 0; i < desc->base.arity; i++) {

                if(desc->boxingMap & argmask)
                {
                    placeholder();
                }
                else
                {
                    push_a(NULL);
                }
                
                exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
                argmask <<= 1;            
            }

            if(get_dst(root_frame_ptr) == NULL && (((AppEntry*) expr)->f)->unboxable_return)
            {
                Thunk* tmp = (Thunk*) alloc_heap(sizeof(Thunk));
                set_return(root_frame_ptr, tmp);
            }

            desc->exec(root_frame_ptr);
            
            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;            
        }        
        case CT_APP_FUN1:
        {
            Desc* slice = ((AppEntry*) expr)->f;

            int argmask = 1;            
            arg_from_code(slice, ((AppEntry*) expr)->args[0]);
              
#ifdef DEBUG_EXEC            
            printf("FUN1: <");
            printDesc(slice);
            printf(">\n");
#endif            
            
            expr = ((FunEntry*) slice)->body;
            frame_ptr = stack_top_a - 1;
            continue;                        
        }        
        case CT_APP_FUN2:
        {
            Desc* slice = ((AppEntry*) expr)->f;

            int argmask = 1;
            
            arg_from_code(slice, ((AppEntry*) expr)->args[0]);
            arg_from_code(slice, ((AppEntry*) expr)->args[1]);

#ifdef DEBUG_EXEC
            printf("FUN2: <");
            printDesc(slice);
            printf(">\n");
#endif
            
            expr = ((FunEntry*) slice)->body;
            frame_ptr = stack_top_a - 2;
            continue;                        
        }
        case CT_APP_FUN:
        {            
            Desc* slice = ((AppEntry*) expr)->f;

            int new_frame_ptr = stack_top_a;
            int argmask = 1;
            
            for (int i = 0; i < expr->nr_args; i++) {
                arg_from_code(slice, ((AppEntry*) expr)->args[i]);
            }

#ifdef DEBUG_EXEC
            printf("FUN: <");
            printDesc(slice);
            printf(">\n");
#endif
            
            expr = ((FunEntry*) slice)->body;

            frame_ptr = new_frame_ptr;
            continue;            
        }
        case CT_APP_FUN_TR:
        {            
            Desc* slice = ((AppEntry*) expr)->f;

            // TODO: B stack?
            int new_frame_ptr = stack_top_a;
            int argmask = 1;
                        
            for (int i = 0; i < expr->nr_args; i++) {
                arg_from_code(slice, ((AppEntry*) expr)->args[i]);
            }

            memcpy(&stack_a[frame_ptr], &stack_a[new_frame_ptr], sizeof(void*) * expr->nr_args);
            stack_top_a = frame_ptr + expr->nr_args;
 
#ifdef DEBUG_EXEC
            printf("FUN TR: <");
            printDesc(slice);
            printf(">\n");
#endif
            
            expr = ((FunEntry*) slice)->body;
            continue;            
        }
        case CT_APP_THUNK:
        {
            Desc* slice = ((AppEntry*) expr)->f;
            Thunk* thunk = get_dst(root_frame_ptr);

#ifdef DEBUG_EXEC
            printf("APP THUNK: <");
            printDesc(slice);
            printf(">\n");
#endif
            
            // no need to check for array length, thunks in HNF are never overwritten
            int newsize = slice->thunk_size;
            
            if (thunk == NULL)
            {
                thunk = (Thunk*) alloc_heap(newsize);
            }
            else if (thunk->desc->thunk_size < newsize) 
            {
                Thunk* target = thunk;
                thunk = (Thunk*) alloc_heap(newsize);
                target->desc = (Desc*) __FORWARD_PTR__;
                target->_forward_ptr = thunk;
            }

            set_return(root_frame_ptr, thunk);
            thunk->desc = slice;
            
            assert(thunk->desc->arity == expr->nr_args);
            
            for (int i = 0; i < expr->nr_args; i++) {  
                ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], &thunk->_args[i], frame_ptr);
            }

            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;                                
        }
        case CT_APP_DYN:
        {
            push_a(local(frame_ptr, ((AppEntry*)expr)->var.index));

            Thunk** bt = &peek_a();
            (*bt)->desc->eval(); // eval follows FORWARD_PTRs
            
            // The original fun arity if it is a slice
            Desc* baseDesc = (*bt)->desc->type == FT_SLICE ?
                              ((SliceEntry*) (*bt)->desc)->forward_ptr : (*bt)->desc;
            
            int totalArity = (*bt)->desc->arity + expr->nr_args;            
            int usedNrArgs = 0;
            
            Desc* slice;
            
            while(totalArity > baseDesc->arity)
            {
                // must be an FT_FUN
                                
                Desc* d = (*bt)->desc;
                
                int remainingNrArgs = totalArity - baseDesc->arity;        
                slice = get_slice(baseDesc, baseDesc->arity);
              
                int new_frame_ptr = stack_top_a;
                                                
                int argmask = 1;
                
                for (int i = 0; i < (*bt)->desc->arity; i++) {
                    push_a((*bt)->_args[i]);
                    if(((FunEntry*) (slice))->strictness & argmask) 
                    { 
                        (*bt)->_args[i]->desc->eval(); 
                    } 
                    argmask <<= 1;
                }

                for (int i = usedNrArgs; i < expr->nr_args - remainingNrArgs; i++) {
                    arg_from_code(slice, ((AppEntry*) expr)->args[i]);
                    usedNrArgs++;
                } 

                // VERY important, otherwise we overwrite the original thunk with something else
                set_return(new_frame_ptr, NULL);
                exec(((FunEntry*) slice)->body, new_frame_ptr, new_frame_ptr);
                                
                totalArity = (*bt)->desc->arity + expr->nr_args - usedNrArgs;
                
                baseDesc = (*bt)->desc->type == FT_SLICE ?
                              ((SliceEntry*) (*bt)->desc)->forward_ptr : (*bt)->desc;                
            }
            
            slice = get_slice(baseDesc, totalArity);
            
            switch(slice->type) {
            case FT_PRIM:
            {
                for (int i = 0; i < (*bt)->desc->arity; i++) {
                    push_a((*bt)->_args[i]);
                    (*bt)->_args[i]->desc->eval();
                }

                int argmask = 1 << (*bt)->desc->arity;  

                for (int i = usedNrArgs; i < expr->nr_args; i++) {
                    
                    if(((PrimEntry*) slice)->boxingMap & argmask)
                    {
                        placeholder();
                    }
                    else
                    {
                        push_a(NULL);
                    }

                    exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
                    argmask <<= 1;            
                }

                if(get_dst(root_frame_ptr) == NULL && slice->unboxable_return)
                {
                    Thunk* tmp = (Thunk*) alloc_heap(sizeof(Thunk));
                    set_return(root_frame_ptr, tmp);
                }
                                
                ((PrimEntry*) slice)->exec(root_frame_ptr);
                destroy_stack_frame(root_frame_ptr);
                destroy_stack_frame_b(root_frame_ptr_b);                
                return;                    
            }
            case FT_FUN:
            {
                int new_frame_ptr = stack_top_a;                    
                int argmask = 1;

                for (int i = 0; i < (*bt)->desc->arity; i++) {                    
                    push_a((*bt)->_args[i]);
                    if(((FunEntry*) (slice))->strictness & argmask) 
                    { 
                        (*bt)->_args[i]->desc->eval(); 
                    } 
                    argmask <<= 1;
                }
                
                for (int i = usedNrArgs; i < expr->nr_args; i++) {
                    arg_from_code(slice, ((AppEntry*) expr)->args[i]);    
                } 

                expr = ((FunEntry*) slice)->body;
                frame_ptr = new_frame_ptr;
                continue;                    
            }
            case FT_SLICE:
            case FT_ADT:
            case FT_RECORD:
            {
                Thunk* thunk = get_dst(root_frame_ptr);
                // no need to check for array length, thunks in HNF are never overwritten
                int newsize = slice->thunk_size;

                if (thunk == NULL)
                {
                    thunk = (Thunk*) alloc_heap(newsize);
                }
                else if (thunk->desc->thunk_size < newsize) 
                {
                    Thunk* target = thunk;
                    thunk = (Thunk*) alloc_heap(newsize);
                    target->desc = (Desc*) __FORWARD_PTR__;
                    target->_forward_ptr = thunk;
                }
                
                set_return(root_frame_ptr, thunk);
                thunk->desc = slice;
                
                assert(thunk->desc->arity == (*bt)->desc->arity + expr->nr_args);            

                memcpy(&thunk->_args, &(*bt)->_args, sizeof(Thunk*) * (*bt)->desc->arity);

                for (int i = usedNrArgs; i < expr->nr_args; i++) {
                    ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], &thunk->_args[(*bt)->desc->arity + i], frame_ptr);
                }

                destroy_stack_frame(root_frame_ptr);
                destroy_stack_frame_b(root_frame_ptr_b);
                return;                    
            }
            case FT_BOXED_LIT:
                abort("Literal unexpected here");                
            case FT_CAF:
            case FT_CAF_REDUCED:
                not_implemented("CAF");
            }
        }
        case CT_VAR_UNBOXED:       
        {
            Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);
            follow_thunk(arg);
                        
            assert(is_hnf(arg));

#ifdef DEBUG_EXEC
            printf("VAR@: %d\n", ((VarEntry*) expr)->index);
#endif
            
            // no need to check for array length, thunks in HNF are never overwritten
            if(get_dst(root_frame_ptr) != NULL)
            {
                memcpy(get_dst(root_frame_ptr), arg, sizeof(Thunk));
            }
            else
            {
                if(instackb(arg))
                {
                    Thunk* newthunk = (Thunk*) alloc_heap(sizeof (Thunk));
                    memcpy(newthunk, arg, sizeof(Thunk));
                    set_return(root_frame_ptr, newthunk);
                }
                else
                {
                    set_return(root_frame_ptr, arg);
                }
            }
            
            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);            
            return;                                
        }
        case CT_VAR_STRICT:     
        {
            Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);
            follow_thunk(arg);
                        
            assert(is_hnf(arg));

#ifdef DEBUG_EXEC
            printf("VAR!: %d\n", ((VarEntry*) expr)->index);
#endif
            
            // no need to check for array length, thunks in HNF are never overwritten
            // arrays always referenced
            if(get_dst(root_frame_ptr) != NULL && arg->desc->thunk_size <= sizeof(Thunk) && arg->desc != (Desc*) __ARRAY__)
            {
                memcpy(get_dst(root_frame_ptr), arg, sizeof(Thunk));
            }
            else
            {
                forward_thunk(arg, root_frame_ptr);
                set_return(root_frame_ptr, arg);
            }
            
            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);            
            return;                    
        }
        case CT_VAR:
        {
            Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);

#ifdef DEBUG_EXEC
            printf("VAR: %d\n", ((VarEntry*) expr)->index);
#endif
            
            assert(!instackb(thunk));
            
            follow_thunk(thunk);
            forward_thunk(thunk, root_frame_ptr);            
            set_return(root_frame_ptr, thunk);

            switch(thunk->desc->type) {
            case FT_FUN:
            {
                // Destroy stack frame before eval, it is not needed any more
                // Greatly reduces stack usage
                destroy_stack_frame(root_frame_ptr);
                destroy_stack_frame_b(root_frame_ptr_b);  
                                
                frame_ptr = stack_top_a;
                // Here frame_ptr == root_frame_ptr

                int argmask = 1;

                for (int i = 0; i < thunk->desc->arity; i++) {
                    push_a(thunk->_args[i]);
                    if(((FunEntry*) (thunk->desc))->strictness & argmask) 
                    { 
                        thunk->_args[i]->desc->eval(); 
                        thunk = stack_a[root_frame_ptr-1];
                    }
                    argmask <<= 1;
                }

                expr = ((FunEntry*) thunk->desc)->body;
                continue;
            }
            case FT_PRIM:
            {
                for (int i = 0; i < thunk->desc->arity; i++) {
                    push_a(thunk->_args[i]);
                    thunk->_args[i]->desc->eval();
                    thunk = stack_a[root_frame_ptr-1];
                }

                // get_dst(root_frame_ptr) cannot be NULL, no need to check
                
                ((PrimEntry*) thunk->desc)->exec(root_frame_ptr);
                
                destroy_stack_frame(root_frame_ptr);
                destroy_stack_frame_b(root_frame_ptr_b);                
                return;
            }
            case FT_CAF:
            case FT_CAF_REDUCED:
                not_implemented("CAF");            
            case FT_SLICE:
            case FT_ADT:
            case FT_RECORD:
            case FT_BOXED_LIT:
                destroy_stack_frame(root_frame_ptr);
                destroy_stack_frame_b(root_frame_ptr_b);
                return;
            }            
        }
        case CT_THUNK:
        {
            Thunk* thunk = &((ThunkEntry*) expr)->thunk;            
            Thunk* dst = get_dst(root_frame_ptr);

            if(dst != NULL)
            {
                memcpy(dst, thunk, sizeof(Thunk));
                
                if(!instackb(dst))
                {
                    set_return(root_frame_ptr, thunk);
                }                
            }
            else
            {
                set_return(root_frame_ptr, thunk);
            }

            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;               
        }
        case CT_SELECT_LIT:
        {
            placeholder();
            exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a);
            Thunk* lit = pop_a();
            
            bool handled = false;
            
            for (int i = 0; i < expr->nr_cases; i++) {
                SelectLitCaseEntry* caseEntry = &((SelectEntry*) expr)->cases[i];

                // NULL means "default", we accept it anyway
                if(caseEntry->lit != NULL)
                {
                    assert(caseEntry->lit->thunk.desc == (Desc*) __INT__ ||
                           caseEntry->lit->thunk.desc == (Desc*) __BOOL__ || 
                           caseEntry->lit->thunk.desc == (Desc*) __CHAR__ ||
                           caseEntry->lit->thunk.desc == (Desc*) __REAL__);

                    if(caseEntry->lit->thunk.desc == (Desc*) __REAL__)
                    {
                        if(caseEntry->lit->thunk._real != lit->_real) continue;
                    }
                    else
                    {
                        if(caseEntry->lit->thunk._int != lit->_int) continue;
                    }
                }
                
                // must be SC_DEFAULT now
                handled = true;
                expr = caseEntry->body;
                break;
            }
            
            if(handled) continue;
            
            if(((SelectEntry*) expr)->fallback != NULL)
            {
                stack_top_a -= ((SelectEntry*) expr)->fallback_nrargs;
                expr = ((SelectEntry*) expr)->fallback;
                
                continue;
            }
            
            abort("no match");
        }
        case CT_SELECT_STR:
        {                        
            SelectEntry* select = (SelectEntry*) expr;
            
            push_a(NULL);
            exec(select->expr, frame_ptr, stack_top_a);
            Thunk* str = pop_a();
            
            int length;
            char* chars;

            if(str->desc == (Desc*) __STRING_PTR__)
            {
                chars = str->_string_ptr->chars;
                length = str->_string_ptr->length;
            }
            else
            {
                chars = str->_array._chars;
                length = str->_array.length;
            }
            
            bool handled = false;
            
            for (int i = 0; i < expr->nr_cases; i++) {
                SelectLitCaseEntry* caseEntry = &((SelectEntry*) expr)->cases[i];

                // NULL means "default", we accept it anyway
                if(caseEntry->lit != NULL)
                {
                    assert(caseEntry->lit->thunk.desc == (Desc*) __STRING_PTR__); 

                    int eq = length == caseEntry->lit->thunk._string_ptr->length;
                    int i = 0;
                    while(i<length && eq)
                    {
                        eq = chars[i] == caseEntry->lit->thunk._string_ptr->chars[i];
                        i++;
                    }
                    
                    if(!eq) continue;
                }
                
                // must be SC_DEFAULT now
                handled = true;
                expr = caseEntry->body;
                break;
            }
            
            if(handled) continue;
            
            if(((SelectEntry*) expr)->fallback != NULL)
            {
                stack_top_a -= ((SelectEntry*) expr)->fallback_nrargs;
                expr = ((SelectEntry*) expr)->fallback;
                
                continue;
            }
            
            abort("no match");
        }
        case CT_SELECT_ADT:
        {                        
            SelectEntry* select = (SelectEntry*) expr;
            
            push_a(NULL);
            exec(select->expr, frame_ptr, stack_top_a);
            Thunk* cons = pop_a();            
                                    
            expr = select->bodies[((ADTEntry*)cons->desc)->idx];
            
            if(expr != NULL)
            {
                // Skip the arguments in the case of a default 
                if(!(select->default_map & 1<<((ADTEntry*)cons->desc)->idx))
                {
                    for (int i = 0; i < cons->desc->arity; i++) {
                        push_a(cons->_args[i]);
                    }                                      
                }
                
                continue;
            }
            
            if(select->fallback != NULL)
            {
                stack_top_a -= select->fallback_nrargs;
                expr = select->fallback;
                
                continue;
            }
            
            abort("no match");
        }
        case CT_SELECT_REC:
        {                        
            SelectEntry* select = (SelectEntry*) expr;
            
            push_a(NULL);
            exec(select->expr, frame_ptr, stack_top_a);
            Thunk* cons = pop_a();            
            
            expr = select->bodies[0];
            
            if(expr != NULL)
            {
                for (int i = 0; i < cons->desc->arity; i++) {
                    push_a(cons->_args[i]);
                }                  
                
                continue;
            }
            
            // This cannot happen in record field selection            
            abort("no match");
        }
        case CT_IF:
        {        
            placeholder();
            exec(((IfEntry*) expr)->cond, frame_ptr, stack_top_a);
            Thunk* cond = pop_a();
            
            // safe to do it before read as nothing can overwrite it in between
            stack_top_b--;
            
            if (readB(cond)) {
                expr = ((IfEntry*) expr)->texpr;
                continue;                
            }
            else {
                expr = ((IfEntry*) expr)->fexpr;
                continue;     
            }
        }
        case CT_LET:
        {
            for(int i=0; i<expr->nr_bindings; i++)
            {
                LetBindingEntry* binding = ((LetEntry*) expr)->bindings[i];
                
                // Normal
                if(binding->type == 0)
                {
                    binding->body->create_thunk(binding->body, &stack_a[stack_top_a++], frame_ptr);
                }
                else // strict (including unboxed))
                {
                    push_a(NULL);
                    exec(binding->body, frame_ptr, stack_top_a);
                }
            }
            
            expr = ((LetEntry*) expr)->body;
            continue;
        }
        }
    }
}

void eval_hnf()
{
    return;
}

void eval_fun()
{
    Thunk* thunk = peek_a();    
    int frame_ptr = stack_top_a;
    int argmask = 1;
    
    for (int i = 0; i < thunk->desc->arity; i++) {
        push_a(thunk->_args[i]);

        if(((FunEntry*) (thunk->desc))->strictness & argmask)
        {
            thunk->_args[i]->desc->eval();
            thunk = stack_a[frame_ptr-1]; // refresh thunk ptr after eval 
        }
        
        argmask <<= 1;
    }

    exec(((FunEntry*) thunk->desc)->body, frame_ptr, frame_ptr);
}

void eval_prim()
{
    Thunk* thunk = peek_a();
    int frame_ptr = stack_top_a;

    for (int i = 0; i < thunk->desc->arity; i++) {
        push_a(thunk->_args[i]);        
        thunk->_args[i]->desc->eval();
        thunk = stack_a[frame_ptr-1]; // refresh thunk ptr after eval 
    }

    ((PrimEntry*) thunk->desc)->exec(frame_ptr);        

    stack_top_a = frame_ptr;        
}

void eval_fwd_ptr()
{
    Thunk* thunk = pop_a();
    follow_thunk(thunk);
    push_a(thunk);
    thunk->desc->eval();
}   
   
void set_eval_fun(Desc* desc)
{
    if(desc == (Desc*) __FORWARD_PTR__)
    {
        desc->eval = eval_fwd_ptr;
        return;
    }
    
    switch(desc->type)
    {
        case FT_BOXED_LIT:
        case FT_RECORD:
        case FT_ADT:
        case FT_CAF:
        case FT_CAF_REDUCED:
        case FT_SLICE:
            desc->eval = eval_hnf;
            break;
        case FT_FUN:
            desc->eval = eval_fun;
            break;
        case FT_PRIM:
            desc->eval = eval_prim;
            break;
    }
}