code.c 21.9 KB
Newer Older
1
2
#include <stdio.h>
#include <stdlib.h>
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
3
#include <stdbool.h>
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
4
#include <strings.h>
5

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
6
#include "debug.h"
7
#include "code.h"
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
8
#include "mem.h"
9
#include "desc.h"
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
10
#include "gc.h"
11

12
13
14
15
16
17
// For compressing the source code a bit

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

#define forward_thunk(thunk, frame_ptr) \
        Thunk* dst = get_dst(frame_ptr); \
18
19
        dst->desc = (Desc*) __FORWARD_PTR__; \
        dst->_forward_ptr = thunk; 
20

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
21
22
23
#define placeholder() \
        push_a(alloc_b()); \
        peek_a()->desc = (Desc*) __STACK_PLACEHOLDER__; \
24

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
25
26
#define arg_from_code(descarg, arg) \
        if(((FunEntry*) (descarg))->strictness & argmask) \
27
        { \
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
28
            placeholder(); \
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
29
            exec(arg, frame_ptr, stack_top_a); \
30
31
32
        } \
        else \
        { \
33
            push_a(arg->create_thunk(arg, frame_ptr)); \
34
35
36
        } \
        argmask <<= 1;

37
struct Thunk* create_thunk_app_static(Code* expr, int frame_ptr)
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
38
{
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
39
40
    Thunk* thunk = (Thunk*) alloc_heap(((AppEntry*) expr)->f->thunk_size);
    thunk->desc = ((AppEntry*) expr)->f;
41

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

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

48
49
    return thunk;                        
}
50

51
52
struct Thunk* create_thunk_app_dyn(Code* expr, int frame_ptr)
{
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
53
    push_a(local(frame_ptr, ((AppEntry*)expr)->var.index));
54

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
55
56
57
58
59
60
61
    int tmp = gc_enabled;
    gc_enabled = 0;
    peek_a()->desc->eval();
    gc_enabled = tmp;
    
    Thunk* basethunk = pop_a();
    
62
63
64
    Desc* slice =
            get_slice(basethunk->desc->type == FT_SLICE ?
                      ((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
65

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
66
67
    Thunk* thunk = (Thunk*) alloc_heap(slice->thunk_size);
    thunk->desc = slice;
68

69
70
71
72
73
74
    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++) {
        thunk->_args[basethunk->desc->arity + i] 
75
                = ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
76
    }
77
78
79
80
81
82
83
84
85
86
87
88
89

    return thunk;    
}

struct Thunk* create_thunk_var(Code* expr, int frame_ptr)
{
    return local(frame_ptr, ((VarEntry*) expr)->index);    
}

struct Thunk* create_thunk_var_strict(Code* expr, int frame_ptr)
{
    Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
90
    if(arg->desc->unboxable) // unboxable means it is on the B stack
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
91
    {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
92
93
94
        Thunk* target = (Thunk*) alloc_heap(sizeof (Thunk));
        memcpy(target, arg, sizeof(Thunk));
        return target;
95
96
97
98
    }
    else
    {
        return arg;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
99
    }
100
101
102
103
104
105
106
}

struct Thunk* create_thunk_thunk(Code* expr, int frame_ptr)
{
    return &((ThunkEntry*) expr)->thunk;
}

107
void set_create_thunk_fun(Code* code)
108
{
109
110
111
    switch(code->type)
    {
        case CT_APP_PRIM1:
112
        case CT_APP_PRIM_S:
113
        case CT_APP_PRIM2:
114
115
116
117
118
119
120
        case CT_APP_PRIM_ST:
        case CT_APP_PRIM_TS:
        case CT_APP_PRIM_SS:
        case CT_APP_PRIM_AT:
        case CT_APP_PRIM_TA:
        case CT_APP_PRIM_AS:
        case CT_APP_PRIM_SA:
121
        case CT_APP_FUN:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
122
123
        case CT_APP_FUN1:
        case CT_APP_FUN2:
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
        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:
            code->create_thunk = create_thunk_var;
            break;
        case CT_VAR_STRICT:
            code->create_thunk = create_thunk_var_strict;
            break;
        case CT_THUNK:
            code->create_thunk = create_thunk_thunk;
            break;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
139
140
        case CT_SELECT_ADT:
        case CT_SELECT_LIT:    
141
        case CT_IF:
142
143
144
            code->create_thunk = NULL;
            break;            
    }
145
146
}

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
147
void exec(Code* expr, int frame_ptr, int root_frame_ptr)
148
{
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
149
150
    if(heap_curr > gc_trigger) gc();
    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
151
152
    int root_frame_ptr_b = stack_top_b;    
    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
153
    while(1)
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
154
    {        
155
        assert(expr != NULL);
156
        assert(stack_top_a < STACK_SIZE_A);
157
        assert(stack_top_b < STACK_SIZE_B);
158
159
160

        // TODO: check over application
        // TODO: enforce strictness in ADT/Record
161
        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
162
        switch (expr->type) {
163
164
        case CT_APP_PRIM1:
        {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
165
            placeholder();                        
166
            exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
167
            
168
169
170
171
172
173
            ((PrimEntry*) ((AppEntry*) expr)->f)->exec(root_frame_ptr);

            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;                        
        }
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
        case CT_APP_PRIM_S:
        {
            push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[0])->index));                        
            ((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_ST:
        {            
            push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[0])->index));                        
            push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[1])->thunk);                        
            ((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_TS:
        {            
            push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[0])->thunk);            
            push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[1])->index));                        
            ((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_SS:
        {            
            push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[0])->index));
            push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[1])->index));
            ((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_TA:
        {            
            push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[0])->thunk);            
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
216
            placeholder();                       
217
218
219
220
221
222
223
224
225
            exec(((AppEntry*) expr)->args[1], frame_ptr, stack_top_a);
            ((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_AT:
        {            
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
226
            placeholder();                     
227
228
229
230
231
232
233
234
235
236
            exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
            push_a(&((ThunkEntry*) ((AppEntry*) expr)->args[1])->thunk);            
            ((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_AS:
        {            
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
237
            placeholder();                        
238
239
240
241
242
243
244
245
246
247
248
            exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
            push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[1])->index));
            ((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_SA:
        {            
            push_a(local(frame_ptr, ((VarEntry*) ((AppEntry*) expr)->args[0])->index));
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
249
            placeholder();                       
250
251
252
253
254
255
256
            exec(((AppEntry*) expr)->args[1], frame_ptr, stack_top_a);
            ((PrimEntry*) ((AppEntry*) expr)->f)->exec(root_frame_ptr);

            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;                                    
        }        
257
        case CT_APP_PRIM2:
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
258
259
        {           
            placeholder();                       
260
            exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
261
            placeholder();                        
262
            exec(((AppEntry*) expr)->args[1], frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
263
            
264
            ((PrimEntry*) ((AppEntry*) expr)->f)->exec(root_frame_ptr);
265

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
266
267
268
269
            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;            
        }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
        case CT_APP_FUN1:
        {
            Desc* slice = ((AppEntry*) expr)->f;

            int argmask = 1;            
            arg_from_code(slice, ((AppEntry*) expr)->args[0]);
              
            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]);
              
            expr = ((FunEntry*) slice)->body;
            frame_ptr = stack_top_a - 2;
            continue;                        
        }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
294
        case CT_APP_FUN:
295
        {            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
296
            Desc* slice = ((AppEntry*) expr)->f;
297

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
298
299
            int new_frame_ptr = stack_top_a;
            int argmask = 1;
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
300
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
301
302
            for (int i = 0; i < expr->nr_args; i++) {
                arg_from_code(slice, ((AppEntry*) expr)->args[i]);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
303
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
304

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
305
306
307
308
309
310
311
            expr = ((FunEntry*) slice)->body;
            frame_ptr = new_frame_ptr;
            continue;            
        }
        case CT_APP_THUNK:
        {
            Desc* slice = ((AppEntry*) expr)->f;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
312
313
314
315
316
317
318
            Thunk* thunk = get_dst(root_frame_ptr);
            int newsize = slice->thunk_size;
            
            if (thunk->desc->thunk_size < newsize) {
                Thunk* target = thunk;
                thunk = (Thunk*) alloc_heap(newsize);
                target->desc = (Desc*) __FORWARD_PTR__;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
319
320
                target->_forward_ptr = thunk;
                set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
321
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
322

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
323
324
            thunk->desc = slice;
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
325
            assert(thunk->desc->arity == expr->nr_args);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
326
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
327
328
            for (int i = 0; i < expr->nr_args; i++) {
                thunk->_args[i]  
329
                        = ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
330
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
331
332
333
334
335

            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;                                
        }
336
        case CT_APP_DYN:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
337
        {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
338
339
340
341
342
343
344
345
346
            push_a(local(frame_ptr, ((AppEntry*)expr)->var.index));
            //if(!basethunk->desc->hnf) basethunk = basethunk->desc->eval();
            //peek_a()->desc->eval();
            //Thunk* basethunk = peek_a();
            //basethunk->desc->eval();

            Thunk** bt = &peek_a();
            (*bt)->desc->eval();
            
347
            Desc* slice =
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
348
349
                    get_slice((*bt)->desc->type == FT_SLICE ?
                              ((SliceEntry*) (*bt)->desc)->forward_ptr : (*bt)->desc, (*bt)->desc->arity + expr->nr_args);
350
351

            switch(slice->type) {
352
353
            case FT_PRIM1:
            case FT_PRIM2:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
354
            {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
355
356
357
358
                for (int i = 0; i < (*bt)->desc->arity; i++) {
                    push_a((*bt)->_args[i]);
                    /*if(!basethunk->_args[i]->desc->hnf)*/ (*bt)->_args[i]->desc->eval();
                    
359
                }
360

361
                for (int i = 0; i < expr->nr_args; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
362
                    placeholder();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
363
                    exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
364
365
366
                } 

                ((PrimEntry*) slice)->exec(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
367
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
368
                destroy_stack_frame_b(root_frame_ptr_b);                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
369
370
                return;                    
            }
371
372
373
374
375
            case FT_FUN:
            {
                int new_frame_ptr = stack_top_a;                    
                int argmask = 1;

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
376
377
378
379
380
381
382
                for (int i = 0; i < (*bt)->desc->arity; i++) {                    
                    push_a((*bt)->_args[i]);
                    if(((FunEntry*) (slice))->strictness & argmask /*&& !arg->desc->hnf*/) 
                    { 
                        (*bt)->_args[i]->desc->eval(); 
                    } 
                    argmask <<= 1;
383
384
385
386
387
                }

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

389
390
391
392
393
394
395
396
                expr = ((FunEntry*) slice)->body;
                frame_ptr = new_frame_ptr;
                continue;                    
            }
            case FT_SLICE:
            case FT_ADT:
            case FT_RECORD:
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
397
398
399
400
401
402
403
                Thunk* thunk = get_dst(root_frame_ptr);
                int newsize = slice->thunk_size;

                if (thunk->desc->thunk_size < newsize) {
                    Thunk* target = thunk;
                    thunk = (Thunk*) alloc_heap(newsize);
                    target->desc = (Desc*) __FORWARD_PTR__;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
404
405
                    target->_forward_ptr = thunk;
                    set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
406
                }
407

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
408
409
                thunk->desc = slice;
                
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
410
                assert(thunk->desc->arity == (*bt)->desc->arity + expr->nr_args);            
411

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
412
                memcpy(&thunk->_args, &(*bt)->_args, sizeof(Thunk*) * (*bt)->desc->arity);
413
414

                for (int i = 0; i < expr->nr_args; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
415
                    thunk->_args[(*bt)->desc->arity + i] 
416
                            = ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
417
418
419
                }

                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
420
                destroy_stack_frame_b(root_frame_ptr_b);
421
                return;                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
422
            }
423
424
425
426
427
428
429
430
431
            case FT_BOXED_LIT:
                abort("Literal unexpected here");                
            case FT_CAF:
            case FT_CAF_REDUCED:
                not_implemented("CAF");
            }
        }
        case CT_VAR_STRICT:
        {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
432
            Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);
433
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
434
            assert(is_hnf(arg));
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
435

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
436
            // TODO: check how often happens
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
437
438
            if(arg->desc->unboxable)
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
439
                memcpy(get_dst(root_frame_ptr), arg, sizeof(Thunk));
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
440
441
442
443
            }
            else
            {
                forward_thunk(arg, root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
444
                set_return(root_frame_ptr, arg);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
445
446
            }
            
447
            destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
448
            destroy_stack_frame_b(root_frame_ptr_b);            
449
450
451
452
453
            return;                    
        }
        case CT_VAR:
        {
            Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
454

455
456
457
            follow_thunk(thunk);
            forward_thunk(thunk, root_frame_ptr);            
            set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
458

459
460
461
            switch(thunk->desc->type) {
            case FT_FUN:
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
462
463
                // Destroy stack frame before eval, it is not needed any more
                // Greatly reduces stack usage
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
464
465
                destroy_stack_frame(root_frame_ptr);
                destroy_stack_frame_b(root_frame_ptr_b);  
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
466
                                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
467
468
469
470
                frame_ptr = stack_top_a;
                // Here frame_ptr == root_frame_ptr

                int argmask = 1;
471

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
472
                for (int i = 0; i < thunk->desc->arity; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
473
474
475
476
477
478
479
                    push_a(thunk->_args[i]);
                    if(((FunEntry*) (thunk->desc))->strictness & argmask /*&& !arg->desc->hnf*/) 
                    { 
                        thunk->_args[i]->desc->eval(); 
                        thunk = stack_a[root_frame_ptr-1];
                    }
                    argmask <<= 1;
480
                }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
481
482
483

                expr = ((FunEntry*) thunk->desc)->body;
                continue;
484
            }
485
486
            case FT_PRIM1:
            case FT_PRIM2:
487
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
488
489

                for (int i = 0; i < thunk->desc->arity; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
490
491
492
                    push_a(thunk->_args[i]);
                    thunk->_args[i]->desc->eval();
                    thunk = stack_a[root_frame_ptr-1];
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
493
494
495
                }

                ((PrimEntry*) thunk->desc)->exec(root_frame_ptr);
496
497
                
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
498
                destroy_stack_frame_b(root_frame_ptr_b);                
499
500
501
502
503
504
505
506
507
508
                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);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
509
                destroy_stack_frame_b(root_frame_ptr_b);
510
511
                return;
            }            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
512
513
514
        }
        case CT_THUNK:
        {
515
516
            Thunk* thunk = &((ThunkEntry*) expr)->thunk;            
            forward_thunk(thunk, root_frame_ptr);            
517
            set_return(root_frame_ptr, thunk);
518
            destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
519
            destroy_stack_frame_b(root_frame_ptr_b);
520
            return;               
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
521
        }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
522
523
        case CT_SELECT_LIT:
        {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
524
            placeholder();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
525
            exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
526
            Thunk* lit = pop_a();
527
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
528
529
530
531
            bool handled = false;
            
            for (int i = 0; i < expr->nr_cases; i++) {
                SelectLitCaseEntry* caseEntry = &((SelectEntry*) expr)->cases[i];
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
532

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
533
534
                // NULL means "default", we accept it anyway
                if(caseEntry->lit != NULL)
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
535
                {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
536
537
538
                    assert(caseEntry->lit->thunk.desc != (Desc*) __INT__);
 
                    if(caseEntry->lit->thunk._int != lit->_int) continue;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
539
                }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
540
541
542
543
544
545
546
547
548
                
                // must be SC_DEFAULT now
                handled = true;
                expr = caseEntry->body;
                break;
            }
            
            if(handled) continue;
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
549
550
551
552
553
554
555
556
557
            if(((SelectEntry*) expr)->fallback != NULL)
            {
                stack_top_a -= ((SelectEntry*) expr)->fallback_nrargs;
                expr = ((SelectEntry*) expr)->fallback;
                
                continue;
            }
            
            abort("no match");
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
558
559
560
        }
        case CT_SELECT_ADT:
        {                        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
561
562
            SelectEntry* select = (SelectEntry*) expr;
            
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
563
            placeholder();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
564
            exec(select->expr, frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
565
            Thunk* cons = pop_a();            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
566
567
            
            expr = select->bodies[((ADTEntry*)cons->desc)->idx];
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
568
569
570
571
572
573
574
575
576
            
            if(expr != NULL)
            {
                for (int i = 0; i < cons->desc->arity; i++) {
                    push_a(cons->_args[i]);
                }                  
                
                continue;
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
577
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
578
579
580
581
582
583
584
585
586
            if(select->fallback != NULL)
            {
                stack_top_a -= select->fallback_nrargs;
                expr = select->fallback;
                
                continue;
            }
            
            abort("no match");
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
587
588
589
        }
        case CT_IF:
        {        
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
590
            placeholder();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
591
            exec(((IfEntry*) expr)->cond, frame_ptr, stack_top_a);
592
            Thunk* cond = pop_a();
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
593
               
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
594
595
596
597
598
599
600
601
            if (readB(cond)) {
                expr = ((IfEntry*) expr)->texpr;
                continue;                
            }
            else {
                expr = ((IfEntry*) expr)->fexpr;
                continue;     
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
602
        }
603
604
605
606
        }
    }
}

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
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 
625
626
        }
        
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
627
        argmask <<= 1;
628
629
    }

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
630
631
    exec(((FunEntry*) thunk->desc)->body, frame_ptr, frame_ptr);
}
632

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
633
634
635
636
637
638
639
640
641
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 
642
    }
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681

    ((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_PRIM1:
        case FT_PRIM2:
            desc->eval = eval_prim;
            break;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
682
    }
683
}