code.c 21.7 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
        if(dst != NULL){ \
19
        dst->desc = (Desc*) __FORWARD_PTR__; \
20
21
        dst->_forward_ptr = thunk; \
        }
22

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

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

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

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

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

50
51
    return thunk;                        
}
52

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

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

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

71
72
73
74
75
76
    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] 
77
                = ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
78
    }
79
80
81
82
83
84
85
86
87

    return thunk;    
}

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

88
struct Thunk* create_thunk_var_unboxed(Code* expr, int frame_ptr)
89
90
91
{
    Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);

92
93
94
95
    // TODO: check if its on heap
    Thunk* target = (Thunk*) alloc_heap(sizeof (Thunk));
    memcpy(target, arg, sizeof(Thunk));
    return target;
96
97
98
99
100
101
102
}

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

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

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

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

            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;                        
        }
171
172
173
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
        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
213
            placeholder();                       
214
215
216
217
218
219
220
221
222
            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
223
            placeholder();                     
224
225
226
227
228
229
230
231
232
233
            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
234
            placeholder();                        
235
236
237
238
239
240
241
242
243
244
245
            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
246
            placeholder();                       
247
248
249
250
251
252
253
            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;                                    
        }        
254
        case CT_APP_PRIM2:
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
255
256
        {           
            placeholder();                       
257
            exec(((AppEntry*) expr)->args[0], frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
258
            placeholder();                        
259
            exec(((AppEntry*) expr)->args[1], frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
260
            
261
            ((PrimEntry*) ((AppEntry*) expr)->f)->exec(root_frame_ptr);
262

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

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

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
302
303
304
305
306
307
308
            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
309
310
311
            Thunk* thunk = get_dst(root_frame_ptr);
            int newsize = slice->thunk_size;
            
312
            if (thunk != NULL && thunk->desc->thunk_size < newsize) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
313
314
315
                Thunk* target = thunk;
                thunk = (Thunk*) alloc_heap(newsize);
                target->desc = (Desc*) __FORWARD_PTR__;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
316
317
                target->_forward_ptr = thunk;
                set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
318
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
319

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

            destroy_stack_frame(root_frame_ptr);
            destroy_stack_frame_b(root_frame_ptr_b);
            return;                                
        }
333
        case CT_APP_DYN:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
334
        {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
335
336
337
338
339
            push_a(local(frame_ptr, ((AppEntry*)expr)->var.index));

            Thunk** bt = &peek_a();
            (*bt)->desc->eval();
            
340
            Desc* slice =
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
341
342
                    get_slice((*bt)->desc->type == FT_SLICE ?
                              ((SliceEntry*) (*bt)->desc)->forward_ptr : (*bt)->desc, (*bt)->desc->arity + expr->nr_args);
343
344

            switch(slice->type) {
345
346
            case FT_PRIM1:
            case FT_PRIM2:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
347
            {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
348
349
350
351
                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();
                    
352
                }
353

354
                for (int i = 0; i < expr->nr_args; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
355
                    placeholder();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
356
                    exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
357
358
359
                } 

                ((PrimEntry*) slice)->exec(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
360
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
361
                destroy_stack_frame_b(root_frame_ptr_b);                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
362
363
                return;                    
            }
364
365
366
367
368
            case FT_FUN:
            {
                int new_frame_ptr = stack_top_a;                    
                int argmask = 1;

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
369
370
371
372
373
374
375
                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;
376
377
378
379
380
                }

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

382
383
384
385
386
387
388
389
                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
390
391
392
                Thunk* thunk = get_dst(root_frame_ptr);
                int newsize = slice->thunk_size;

393
                if (thunk != NULL && thunk->desc->thunk_size < newsize) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
394
395
396
                    Thunk* target = thunk;
                    thunk = (Thunk*) alloc_heap(newsize);
                    target->desc = (Desc*) __FORWARD_PTR__;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
397
398
                    target->_forward_ptr = thunk;
                    set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
399
                }
400

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
401
402
                thunk->desc = slice;
                
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
403
                assert(thunk->desc->arity == (*bt)->desc->arity + expr->nr_args);            
404

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
405
                memcpy(&thunk->_args, &(*bt)->_args, sizeof(Thunk*) * (*bt)->desc->arity);
406
407

                for (int i = 0; i < expr->nr_args; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
408
                    thunk->_args[(*bt)->desc->arity + i] 
409
                            = ((AppEntry*) expr)->args[i]->create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
410
411
412
                }

                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
413
                destroy_stack_frame_b(root_frame_ptr_b);
414
                return;                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
415
            }
416
417
418
419
420
421
422
423
            case FT_BOXED_LIT:
                abort("Literal unexpected here");                
            case FT_CAF:
            case FT_CAF_REDUCED:
                not_implemented("CAF");
            }
        }
        case CT_VAR_STRICT:
424
        case CT_VAR_UNBOXED:            
425
        {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
426
            Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);
427
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
428
            assert(is_hnf(arg));
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
429

430
            if(get_dst(root_frame_ptr) != NULL && arg->desc->unboxable)
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
431
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
432
                memcpy(get_dst(root_frame_ptr), arg, sizeof(Thunk));
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
433
434
435
436
            }
            else
            {
                forward_thunk(arg, root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
437
                set_return(root_frame_ptr, arg);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
438
439
            }
            
440
            destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
441
            destroy_stack_frame_b(root_frame_ptr_b);            
442
443
444
445
446
            return;                    
        }
        case CT_VAR:
        {
            Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
447

448
449
450
            follow_thunk(thunk);
            forward_thunk(thunk, root_frame_ptr);            
            set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
451

452
453
454
            switch(thunk->desc->type) {
            case FT_FUN:
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
455
456
                // Destroy stack frame before eval, it is not needed any more
                // Greatly reduces stack usage
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
457
458
                destroy_stack_frame(root_frame_ptr);
                destroy_stack_frame_b(root_frame_ptr_b);  
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
459
                                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
460
461
462
463
                frame_ptr = stack_top_a;
                // Here frame_ptr == root_frame_ptr

                int argmask = 1;
464

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
465
                for (int i = 0; i < thunk->desc->arity; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
466
467
468
469
470
471
472
                    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;
473
                }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
474
475
476

                expr = ((FunEntry*) thunk->desc)->body;
                continue;
477
            }
478
479
            case FT_PRIM1:
            case FT_PRIM2:
480
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
481
482

                for (int i = 0; i < thunk->desc->arity; i++) {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
483
484
485
                    push_a(thunk->_args[i]);
                    thunk->_args[i]->desc->eval();
                    thunk = stack_a[root_frame_ptr-1];
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
486
487
488
                }

                ((PrimEntry*) thunk->desc)->exec(root_frame_ptr);
489
490
                
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
491
                destroy_stack_frame_b(root_frame_ptr_b);                
492
493
494
495
496
497
498
499
500
501
                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
502
                destroy_stack_frame_b(root_frame_ptr_b);
503
504
                return;
            }            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
505
506
507
        }
        case CT_THUNK:
        {
508
509
            Thunk* thunk = &((ThunkEntry*) expr)->thunk;            
            forward_thunk(thunk, root_frame_ptr);            
510
            set_return(root_frame_ptr, thunk);
511
            destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
512
            destroy_stack_frame_b(root_frame_ptr_b);
513
            return;               
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
514
        }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
515
516
        case CT_SELECT_LIT:
        {
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
517
            placeholder();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
518
            exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
519
            Thunk* lit = pop_a();
520
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
521
522
523
524
            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
525

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

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
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 
618
619
        }
        
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
620
        argmask <<= 1;
621
622
    }

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
623
624
    exec(((FunEntry*) thunk->desc)->body, frame_ptr, frame_ptr);
}
625

Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
626
627
628
629
630
631
632
633
634
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 
635
    }
Laszlo Domoszlai's avatar
GC    
Laszlo Domoszlai committed
636
637
638
639
640
641
642
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

    ((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
675
    }
676
}