code.c

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

#include "debug.h"
#include "code.h"
#include "desc.h"
#include "thunk.h"
#include "mem.h"
    
void exec(Code* expr, int frame_ptr, int root_frame_ptr, Thunk* target, bool force)
{
    assert(expr != NULL);

    while(1)
    {
        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;
        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)));
                return;
            }else{
                push_a(updateF(target, get_slice(((VarEntry*) expr)->f, 0)));
                return;
            }
            break;
        case CT_APP:
        {
            // TODO: check over application
            // TODO: enforce strictness in ADT/Record

            VarEntry* var = &((AppEntry*) expr)->var;
            Thunk* thunk;

            if (var->base.local_type == VAR_LOCAL) 
            {
                Thunk* basethunk = eval(local(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);

                assert(thunk->desc->arity == 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++) {
                    exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a, NULL, false);
                    thunk->_args[basethunk->desc->arity + i] = pop_a();
                }

                stack_top_a = root_frame_ptr;
                push_a(thunk);
                return;
            }
            else
            {
                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, stack_top_a, &args[i], true);
                    }

                    thunk = ((PrimEntry*) slice)->exec(target);
                    
                    stack_top_a = root_frame_ptr;
                    push_a(thunk);
                    return;
                }
                else if (force && slice->type == FT_FUN) {

                    int new_frame_ptr = stack_top_a;

                    for (int i = 0; i < expr->nr_args; i++) {
                        exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a, NULL, is_strict_fun_arg((FunEntry*) slice, i));
                    }

                    expr = ((FunEntry*) slice)->body;
                    frame_ptr = new_frame_ptr;
                    continue;
                }
                else {
                    thunk = updateF(target, slice);

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

                    for (int i = 0; i < expr->nr_args; i++) {
                        exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a, NULL, false);
                        thunk->_args[i] = pop_a();
                    }
                    
                    stack_top_a = root_frame_ptr;
                    push_a(thunk);
                    return;                    
                }
            }
            break;
        }
        case CT_SELECT:
        {
            exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a, NULL, true);
            Thunk* pattern = eval(pop_a());

            bool handled = false;
            
            for (int i = 0; i < expr->nr_cases; i++) {
                SelectCaseEntry* caseEntry = &((SelectEntry*) expr)->cases[i];

                if (caseEntry->type == 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++) {
                        push_a(pattern->_args[i]);
                    }
                    
                    handled = true;
                    expr = caseEntry->body;
                    break;                    
                }
                else if (caseEntry->type == SC_LIT) {
                    printf("Exec: Unhandled entry type in CT_SELECT (SC_LIT)");
                    exit(-1);
                }
                
                // must be SC_DEFAULT now
                handled = true;
                expr = caseEntry->body;
                break;
            }

            if(handled) continue;
            
            printf("Exec: no select cases matches");
            print(pattern, false);
            exit(-1);
        }
        case CT_IF:
        {        
            Thunk tmp;
            tmp.desc = (Desc*) __BOOL__;

            exec(((IfEntry*) expr)->cond, frame_ptr, stack_top_a, &tmp, true);
            Thunk* cond = eval(pop_a());

            if (readB(cond)) {
                expr = ((IfEntry*) expr)->texpr;
                continue;                
            }
            else {
                expr = ((IfEntry*) expr)->fexpr;
                continue;     
            }
        }
        default:
            printf("Exec: Unhandled CODE type");
            exit(-1);
        }
    
    }
}