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

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
5
#include "debug.h"
6
#include "code.h"
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
7
#include "mem.h"
8
9
#include "desc.h"

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
// 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); \
        if(dst != NULL) \
        { \
            dst->desc = (Desc*) __FORWARD_PTR__; \
            dst->_forward_ptr = thunk; \
        }

#define arg_from_thunk(desc, arg) \
        if(((FunEntry*) (desc))->strictness & argmask) \
        { \
            push_a(eval(arg)); \
        } \
        else \
        { \
            push_a(arg); \
        } \
        argmask <<= 1;

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
33
34
#define arg_from_code(descarg, arg) \
        if(((FunEntry*) (descarg))->strictness & argmask) \
35
        { \
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
36
37
38
39
            Thunk* phl = alloc_b(); \
            phl->desc = (Desc*) __STACK_PLACEHOLDER__; \
            push_a(phl); \
            exec(arg, frame_ptr, stack_top_a, stack_top_b); \
40
41
42
43
44
45
46
47
        } \
        else \
        { \
            push_a(create_thunk(arg, frame_ptr)); \
        } \
        argmask <<= 1;


48
struct Thunk* create_thunk(Code* expr, int frame_ptr)
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
49
{
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
50
    assert(expr != NULL);
51
    
52
53
54
    // TODO: check over application
    // TODO: enforce strictness in ADT/Record
        
55
56
57
    switch (expr->type) {
    case CT_APP:
    {
58
        Thunk* thunk = createF(((AppEntry*) expr)->f);
59

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

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

66
67
68
69
70
71
        return thunk;                    
    }
    case CT_APP_DYN:
    {
        Thunk* basethunk = local(frame_ptr, ((AppEntry*)expr)->var.index);
        if(!((AppEntry*)expr)->var.base.strict) basethunk = eval(basethunk);
72

73
74
75
        Desc* slice =
                get_slice(basethunk->desc->type == FT_SLICE ?
                          ((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
76

77
        Thunk* thunk = createF(slice);
78

79
        assert(thunk->desc->arity == basethunk->desc->arity + expr->nr_args);            
80

81
82
83
        for (int i = 0; i < basethunk->desc->arity; i++) {
            thunk->_args[i] = basethunk->_args[i];
        }
84

85
86
87
        for (int i = 0; i < expr->nr_args; i++) {
            thunk->_args[basethunk->desc->arity + i] 
                    = create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
88
        }
89
90
91

        return thunk;
    }
92
    case CT_VAR:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
93
        return local(frame_ptr, ((VarEntry*) expr)->index);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
94
95
96
97
98
99
100
101
102
103
104
105
106
    case CT_VAR_STRICT: 
    {
        Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);
        
        if(arg->desc->unboxable)
        {
            return createT(arg);
        }
        else
        {
            return arg;
        }
    }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
107
    case CT_THUNK:
108
109
110
111
112
        return &((ThunkEntry*) expr)->thunk;
    case CT_SELECT:
    case CT_IF:
        // Only here to avoid intervalum check at switch 
        abort("Unexpected code type");
113
114
    }
}
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
115

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
116
void exec(Code* expr, int frame_ptr, int root_frame_ptr, int root_frame_ptr_b)
117
{
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
118
119
    while(1)
    {
120
        assert(expr != NULL);
121
        assert(stack_top_a < STACK_SIZE_A);
122
123
124

        // TODO: check over application
        // TODO: enforce strictness in ADT/Record
125
        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
126
127
        switch (expr->type) {
        case CT_APP:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
128
        {
129
            Desc* slice = ((AppEntry*) expr)->f;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
130

131
132
            switch (slice->type) {
            case FT_PRIM:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
133
            {
134
                for (int i = 0; i < expr->nr_args; i++) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
135
136
                    push_a(alloc_b());                        
                    exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a, stack_top_b);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
137
                }
138
139
140

                ((PrimEntry*) slice)->exec(root_frame_ptr);
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
141
                destroy_stack_frame_b(root_frame_ptr_b);
142
143
144
145
146
147
148
149
150
                return;
            }
            case FT_FUN:
            {
                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]);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
151
                }
152
153
154
155

                expr = ((FunEntry*) slice)->body;
                frame_ptr = new_frame_ptr;
                continue;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
156
            }
157
158
159
            case FT_SLICE:
            case FT_ADT:
            case FT_RECORD:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
160
            {
161
                Thunk* thunk = updateF(get_dst(root_frame_ptr), slice);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
162

163
                assert(thunk->desc->arity == expr->nr_args);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
164

165
166
167
                for (int i = 0; i < expr->nr_args; i++) {
                    thunk->_args[i] 
                            = create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
168
                }
169
170
171

                set_return(root_frame_ptr, thunk);
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
172
                destroy_stack_frame_b(root_frame_ptr_b);
173
                return;                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
174
            }
175
176
177
178
179
180
181
182
            case FT_BOXED_LIT:
                abort("Literal unexpected here");
            case FT_CAF:
            case FT_CAF_REDUCED:
                not_implemented("CAF");
            }
        }                        
        case CT_APP_DYN:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
183
        {
184
185
            Thunk* basethunk = local(frame_ptr, ((AppEntry*)expr)->var.index);
            if(!((AppEntry*)expr)->var.base.strict) basethunk = eval(basethunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
186

187
188
189
190
191
192
            Desc* slice =
                    get_slice(basethunk->desc->type == FT_SLICE ?
                              ((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);

            switch(slice->type) {
            case FT_PRIM:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
193
            {
194
195
196
                for (int i = 0; i < basethunk->desc->arity; i++) {
                    push_a(eval(basethunk->_args[i]));
                }
197

198
                for (int i = 0; i < expr->nr_args; i++) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
199
200
                    push_a(alloc_b());
                    exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a, stack_top_b);
201
202
203
                } 

                ((PrimEntry*) slice)->exec(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
204
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
205
                destroy_stack_frame_b(root_frame_ptr_b);                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
206
207
                return;                    
            }
208
209
210
211
212
213
214
215
216
217
218
219
            case FT_FUN:
            {
                int new_frame_ptr = stack_top_a;                    
                int argmask = 1;

                for (int i = 0; i < basethunk->desc->arity; i++) {
                    arg_from_thunk(slice, basethunk->_args[i])
                }

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

221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
                expr = ((FunEntry*) slice)->body;
                frame_ptr = new_frame_ptr;
                continue;                    
            }
            case FT_SLICE:
            case FT_ADT:
            case FT_RECORD:
            {
                Thunk* thunk = updateF(get_dst(root_frame_ptr), 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++) {
                    thunk->_args[basethunk->desc->arity + i] 
                            = create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
                }

                set_return(root_frame_ptr, thunk);
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
244
                destroy_stack_frame_b(root_frame_ptr_b);
245
                return;                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
246
            }
247
248
249
250
251
252
253
254
255
            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
256
            Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);
257
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
258
            assert(is_hnf(arg));
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
259

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
260
261
262
263
264
265
266
267
268
269
            if(arg->desc->unboxable)
            {
                arg = updateT(get_dst(root_frame_ptr), arg);
            }
            else
            {
                forward_thunk(arg, root_frame_ptr);
            }
            
            set_return(root_frame_ptr, arg);
270
            destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
271
            destroy_stack_frame_b(root_frame_ptr_b);            
272
273
274
275
276
            return;                    
        }
        case CT_VAR:
        {
            Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
277

278
279
280
            follow_thunk(thunk);
            forward_thunk(thunk, root_frame_ptr);            
            set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
281

282
283
284
            switch(thunk->desc->type) {
            case FT_FUN:
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
285
286
                // Destroy stack frame before eval, it is not needed any more
                // Greatly reduces stack usage
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
287
288
                destroy_stack_frame(root_frame_ptr);
                destroy_stack_frame_b(root_frame_ptr_b);  
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
289
290
291
292
                frame_ptr = stack_top_a;
                // Here frame_ptr == root_frame_ptr

                int argmask = 1;
293

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
294
                for (int i = 0; i < thunk->desc->arity; i++) {
295
                    arg_from_thunk(thunk->desc, thunk->_args[i]);
296
                }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
297
298
299

                expr = ((FunEntry*) thunk->desc)->body;
                continue;
300
            }
301
302
            case FT_PRIM:
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
303
304
305
306
307
308

                for (int i = 0; i < thunk->desc->arity; i++) {
                    push_a(eval(thunk->_args[i]));
                }

                ((PrimEntry*) thunk->desc)->exec(root_frame_ptr);
309
310
                
                destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
311
                destroy_stack_frame_b(root_frame_ptr_b);
312
313
314
315
316
317
318
319
320
321
                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
322
                destroy_stack_frame_b(root_frame_ptr_b);
323
324
                return;
            }            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
325
326
327
        }
        case CT_THUNK:
        {
328
329
            Thunk* thunk = &((ThunkEntry*) expr)->thunk;            
            forward_thunk(thunk, root_frame_ptr);            
330
            set_return(root_frame_ptr, thunk);
331
            destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
332
            destroy_stack_frame_b(root_frame_ptr_b);
333
            return;               
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
334
        }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
335
336
        case CT_SELECT:
        {
337
            push_a(NULL);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
338
            exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a, stack_top_b);
339
            Thunk* pattern = pop_a();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
340

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
341
342
            assert(is_hnf(pattern));
            assert(pattern->desc->type == FT_ADT);            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
343

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
344
345
346
347
            bool handled = false;
            
            for (int i = 0; i < expr->nr_cases; i++) {
                SelectCaseEntry* caseEntry = &((SelectEntry*) expr)->cases[i];
348
                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
349
350
351
352
353
354
355
                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]);
356
                    }                  
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
357
358
359
360
361
362
363
364
365
366
                }
                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;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
367
368
            }

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
369
370
371
372
373
374
375
376
            if(handled) continue;
            
            printf("Exec: no select cases matches");
            print(pattern, false);
            exit(-1);
        }
        case CT_IF:
        {        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
377
378
            push_a(alloc_b());
            exec(((IfEntry*) expr)->cond, frame_ptr, stack_top_a, stack_top_b);
379
            Thunk* cond = pop_a();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
380
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
381
382
383
384
385
386
387
388
            if (readB(cond)) {
                expr = ((IfEntry*) expr)->texpr;
                continue;                
            }
            else {
                expr = ((IfEntry*) expr)->fexpr;
                continue;     
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
389
        }
390
391
392
393
394
395
        }
    }
}

struct Thunk* eval(Thunk* thunk) {
    assert(thunk != NULL);    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
396
    
397
398
399
400
401
402
403
404
405
406
407
408
409
    follow_thunk(thunk);
    
    switch(thunk->desc->type) {
    case FT_FUN:
    {
        push_a(thunk);
        int frame_ptr = stack_top_a;
        int argmask = 1;
        
        for (int i = 0; i < thunk->desc->arity; i++) {
            arg_from_thunk(thunk->desc, thunk->_args[i]);
        }
        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
410
        exec(((FunEntry*) thunk->desc)->body, frame_ptr, frame_ptr, stack_top_b);
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
        thunk = pop_a();
        return thunk;
    }
    case FT_PRIM:
    {
        push_a(thunk);
        int frame_ptr = stack_top_a;

        for (int i = 0; i < thunk->desc->arity; i++) {
            push_a(eval(thunk->_args[i]));
        }

        ((PrimEntry*) thunk->desc)->exec(frame_ptr);        
        
        stack_top_a = frame_ptr;        
        thunk = pop_a();
        return thunk;
    }
    case FT_CAF:
    case FT_CAF_REDUCED:
        not_implemented("CAF");            
    case FT_SLICE:
    case FT_ADT:
    case FT_RECORD:
    case FT_BOXED_LIT:
        return thunk;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
437
    }
438
}