code.c 12.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
33
34
35
36
37
38
39
40
41
42
43
44
45
// 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;

#define arg_from_code(desc, arg) \
        if(((FunEntry*) (desc))->strictness & argmask) \
        { \
            push_a(NULL); \
            exec(arg, frame_ptr, stack_top_a); \
        } \
        else \
        { \
            push_a(create_thunk(arg, frame_ptr)); \
        } \
        argmask <<= 1;


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

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

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

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

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

75
        Thunk* thunk = createF(slice);
76

77
        assert(thunk->desc->arity == basethunk->desc->arity + expr->nr_args);            
78

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

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

        return thunk;
    }
90
    case CT_VAR:
91
    case CT_VAR_STRICT: 
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
92
93
        return local(frame_ptr, ((VarEntry*) expr)->index);
    case CT_THUNK:
94
95
96
97
98
        return &((ThunkEntry*) expr)->thunk;
    case CT_SELECT:
    case CT_IF:
        // Only here to avoid intervalum check at switch 
        abort("Unexpected code type");
99
100
    }
}
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
101

102
103
void exec(Code* expr, int frame_ptr, int root_frame_ptr)
{
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
104
105
    while(1)
    {
106
        assert(expr != NULL);
107
        assert(stack_top_a < STACK_SIZE_A);
108
109
110

        // TODO: check over application
        // TODO: enforce strictness in ADT/Record
111
        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
112
113
        switch (expr->type) {
        case CT_APP:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
114
        {
115
            Desc* slice = ((AppEntry*) expr)->f;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
116

117
118
            switch (slice->type) {
            case FT_PRIM:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
119
            {
120
121
122
123
124
                Thunk args[expr->nr_args];

                for (int i = 0; i < expr->nr_args; i++) {
                    push_a(&args[i]);                        
                    exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
125
                }
126
127
128
129
130
131
132
133
134
135
136
137

                ((PrimEntry*) slice)->exec(root_frame_ptr);
                destroy_stack_frame(root_frame_ptr);
                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
138
                }
139
140
141
142

                expr = ((FunEntry*) slice)->body;
                frame_ptr = new_frame_ptr;
                continue;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
143
            }
144
145
146
            case FT_SLICE:
            case FT_ADT:
            case FT_RECORD:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
147
            {
148
                Thunk* thunk = updateF(get_dst(root_frame_ptr), slice);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
149

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

152
153
154
                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
155
                }
156
157
158
159

                set_return(root_frame_ptr, thunk);
                destroy_stack_frame(root_frame_ptr);
                return;                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
160
            }
161
162
163
164
165
166
167
168
            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
169
        {
170
171
            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
172

173
174
175
176
177
178
            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
179
            {
180
181
182
                for (int i = 0; i < basethunk->desc->arity; i++) {
                    push_a(eval(basethunk->_args[i]));
                }
183

184
185
186
187
188
189
                for (int i = 0; i < expr->nr_args; i++) {
                    push_a(NULL);
                    exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
                } 

                ((PrimEntry*) slice)->exec(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
190
191
192
                destroy_stack_frame(root_frame_ptr);
                return;                    
            }
193
194
195
196
197
198
199
200
201
202
203
204
            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]);    
                } 
205

206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
                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);
                return;                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
230
            }
231
232
233
234
235
236
237
238
239
240
241
242
            case FT_BOXED_LIT:
                abort("Literal unexpected here");                
            case FT_CAF:
            case FT_CAF_REDUCED:
                not_implemented("CAF");
            }
        }
        case CT_VAR_STRICT:
        {
            Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
            
            assert(is_hnf(thunk));
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
243

244
            forward_thunk(thunk, root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
245
            set_return(root_frame_ptr, thunk);
246
247
248
249
250
251
            destroy_stack_frame(root_frame_ptr);
            return;                    
        }
        case CT_VAR:
        {
            Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
252

253
254
255
            follow_thunk(thunk);
            forward_thunk(thunk, root_frame_ptr);            
            set_return(root_frame_ptr, thunk);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
256

257
258
259
            switch(thunk->desc->type) {
            case FT_FUN:
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
260
261
262
263
264
265
266
                // Destroy stack frame before eval, it is not needed any more
                // Greatly reduces stack usage
                destroy_stack_frame(root_frame_ptr);                    
                frame_ptr = stack_top_a;
                // Here frame_ptr == root_frame_ptr

                int argmask = 1;
267

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
268
                for (int i = 0; i < thunk->desc->arity; i++) {
269
                    arg_from_thunk(thunk->desc, thunk->_args[i]);
270
                }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
271
272
273

                expr = ((FunEntry*) thunk->desc)->body;
                continue;
274
            }
275
276
            case FT_PRIM:
            {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
277
278
279
280
281
282

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

                ((PrimEntry*) thunk->desc)->exec(root_frame_ptr);
283
284
285
286
287
288
289
290
291
292
293
294
295
296
                
                destroy_stack_frame(root_frame_ptr);
                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);
                return;
            }            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
297
298
299
        }
        case CT_THUNK:
        {
300
301
            Thunk* thunk = &((ThunkEntry*) expr)->thunk;            
            forward_thunk(thunk, root_frame_ptr);            
302
            set_return(root_frame_ptr, thunk);
303
304
            destroy_stack_frame(root_frame_ptr);
            return;               
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
305
        }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
306
307
        case CT_SELECT:
        {
308
            push_a(NULL);
309
            exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a);
310
            Thunk* pattern = pop_a();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
311

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
312
313
314
            assert(is_hnf(pattern));
            assert(pattern->desc->type == FT_ADT);            
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
315
316
317
318
            bool handled = false;
            
            for (int i = 0; i < expr->nr_cases; i++) {
                SelectCaseEntry* caseEntry = &((SelectEntry*) expr)->cases[i];
319
                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
320
321
322
323
324
325
326
                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]);
327
                    }                  
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
328
329
330
331
332
333
334
335
336
337
                }
                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
338
339
            }

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
340
341
342
343
344
345
346
347
348
349
            if(handled) continue;
            
            printf("Exec: no select cases matches");
            print(pattern, false);
            exit(-1);
        }
        case CT_IF:
        {        
            Thunk tmp;
            tmp.desc = (Desc*) __BOOL__;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
350

351
            push_a(&tmp);
352
            exec(((IfEntry*) expr)->cond, frame_ptr, stack_top_a);
353
            Thunk* cond = pop_a();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
354
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
355
356
357
358
359
360
361
362
            if (readB(cond)) {
                expr = ((IfEntry*) expr)->texpr;
                continue;                
            }
            else {
                expr = ((IfEntry*) expr)->fexpr;
                continue;     
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
363
        }
364
365
366
367
368
369
        }
    }
}

struct Thunk* eval(Thunk* thunk) {
    assert(thunk != NULL);    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
370
    
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
    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]);
        }
        
        exec(((FunEntry*) thunk->desc)->body, frame_ptr, frame_ptr);
        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
411
    }
412
}