code.c 12.7 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
struct Thunk* create_thunk(Code* expr, int frame_ptr)
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
11
{
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
12
    assert(expr != NULL);
13
14
15
16
17
18
19
20
21
22
23
    
    switch (expr->type) {
    case CT_APP:
    {
        // TODO: check over application
        // TODO: enforce strictness in ADT/Record

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

        if (var->base.local_type == VAR_LOCAL) 
        {
24
25
26
            Thunk* basethunk = local(frame_ptr, var->index);
            if(!var->base.strict) basethunk = eval(basethunk);
            
27
28
29
30
            Desc* slice =
                    get_slice(basethunk->desc->type == FT_SLICE ?
                              ((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);

31
            Thunk* thunk = createF(slice);
32
33
34
35
36
37
38
39

            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++) {
40
                thunk->_args[basethunk->desc->arity + i] 
41
                        = create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
42
43
            }

44
            return thunk;
45
46
47
        }
        else
        {
48
            Thunk* thunk = createF(get_slice(var->f, expr->nr_args));
49
50
51
52

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

            for (int i = 0; i < expr->nr_args; i++) {
53
                thunk->_args[i] = create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
54
55
            }

56
            return thunk;                    
57
        }
58
59
60
    }        
    case CT_VAR:
        if (expr->local_type == VAR_LOCAL) {
61
            return local(frame_ptr, ((VarEntry*) expr)->index);
62
        }else{
63
            return createF(get_slice(((VarEntry*) expr)->f, 0));
64
65
        }
    case CT_LIT:
66
        return createT(&((LitEntry*) expr)->thunk);        
67
68
    }
}
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
69

70
71
void exec(Code* expr, int frame_ptr, int root_frame_ptr)
{
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
72
73
    while(1)
    {
74
        assert(expr != NULL);
75
76
        assert(stack_top_a < STACK_SIZE_A);
        
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
77
78
        switch (expr->type) {
        case CT_APP:
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
79
        {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
80
81
            // TODO: check over application
            // TODO: enforce strictness in ADT/Record
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
82

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
83
            VarEntry* var = &((AppEntry*) expr)->var;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
84

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
85
86
            if (var->base.local_type == VAR_LOCAL) 
            {
87
88
89
                Thunk* basethunk = local(frame_ptr, var->index);
                if(!var->base.strict) basethunk = eval(basethunk);
                
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
90
91
92
                Desc* slice =
                        get_slice(basethunk->desc->type == FT_SLICE ?
                                  ((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
93

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
94
95
96
                if(slice->type == FT_PRIM)
                {
                    for (int i = 0; i < basethunk->desc->arity; i++) {
97
                        push_a(eval(basethunk->_args[i]));
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
98
99
100
101
102
103
104
105
106
107
108
109
110
111
                    }
                    
                    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);
                    destroy_stack_frame(root_frame_ptr);
                    return;                    
                }
                else if(slice->type == FT_FUN)
                {
                    int new_frame_ptr = stack_top_a;                    
112
                    int argmask = 1;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
113
114
                    
                    for (int i = 0; i < basethunk->desc->arity; i++) {
115
                        
116
                        if(((FunEntry*) slice)->strictness & argmask)
117
118
119
120
121
122
123
                        {
                            push_a(eval(basethunk->_args[i]));
                        }
                        else
                        {
                            push_a(basethunk->_args[i]);
                        }
124
125
                        
                        argmask <<= 1;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
126
127
128
                    }
                    
                    for (int i = 0; i < expr->nr_args; i++) {
129
                        
130
                        if(((FunEntry*) slice)->strictness & argmask)
131
132
133
134
135
136
137
138
                        {
                            push_a(NULL);
                            exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
                        }
                        else
                        {
                            push_a(create_thunk(((AppEntry*) expr)->args[i], frame_ptr));
                        }
139
140
                        
                        argmask <<= 1;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
141
142
143
144
145
146
147
148
149
                    } 
                    
                    expr = ((FunEntry*) slice)->body;
                    frame_ptr = new_frame_ptr;
                    continue;                    
                }
                else
                {
                    Thunk* thunk = updateF(get_dst(root_frame_ptr), slice);
150

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

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
153
154
155
                    for (int i = 0; i < basethunk->desc->arity; i++) {
                        thunk->_args[i] = basethunk->_args[i];
                    }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
156

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
157
158
                    for (int i = 0; i < expr->nr_args; i++) {
                        thunk->_args[basethunk->desc->arity + i] 
159
                                = create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
160
161
162
163
164
                    }
                    
                    set_return(root_frame_ptr, thunk);
                    destroy_stack_frame(root_frame_ptr);
                    return;                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
165
166
                }
            }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
167
168
169
            else
            {
                Desc* slice = get_slice(var->f, expr->nr_args);
170
                
171
                if (slice->type == FT_PRIM) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
172
173
174
                    Thunk args[expr->nr_args];

                    for (int i = 0; i < expr->nr_args; i++) {
175
                        push_a(&args[i]);                        
176
                        exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
177
178
                    }

179
                    ((PrimEntry*) slice)->exec(root_frame_ptr);
180
                    destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
181
182
                    return;
                }
183
                else if (slice->type == FT_FUN) {
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
184

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
185
                    int new_frame_ptr = stack_top_a;
186
187
                    int argmask = 1;
                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
188
                    for (int i = 0; i < expr->nr_args; i++) {
189
                        
190
                        if(((FunEntry*) slice)->strictness & argmask)
191
                        {
192
                            push_a(NULL);
193
194
195
196
                            exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
                        }
                        else
                        {
197
                            push_a(create_thunk(((AppEntry*) expr)->args[i], frame_ptr));  
198
                        }
199
200
                        
                        argmask <<= 1;
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
201
                    }
202
                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
203
204
205
206
207
                    expr = ((FunEntry*) slice)->body;
                    frame_ptr = new_frame_ptr;
                    continue;
                }
                else {
208
                    Thunk* thunk = updateF(get_dst(root_frame_ptr), slice);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
209
210
211
212

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

                    for (int i = 0; i < expr->nr_args; i++) {
213
                        thunk->_args[i] 
214
                                = create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
215
216
                    }
                    
217
218
                    set_return(root_frame_ptr, thunk);
                    destroy_stack_frame(root_frame_ptr);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
219
                    return;                    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
220
                }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
221
222
            }
            break;
223
224
225
        }            
        case CT_VAR:
            if (expr->local_type == VAR_LOCAL) {
226
                Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
227
228
229
230
231
232
233
234
235
236
            
                if(((VarEntry*) expr)->base.strict)
                {
                    assert(is_hnf(thunk));
                    
                    set_return(root_frame_ptr, thunk);
                    destroy_stack_frame(root_frame_ptr);
                    return;                    
                }
                
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
                while (thunk->desc == (Desc*) __FORWARD_PTR__) {
                    thunk = thunk->_forward_ptr;
                }

                forward_to(get_dst(root_frame_ptr), thunk);
                set_return(root_frame_ptr, thunk);
                
                if (thunk->desc->type == FT_FUN) {
                    
                    // 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
                    
252
253
                    int argmask = 1;
                    
254
                    for (int i = 0; i < thunk->desc->arity; i++) {
255

256
                        if(((FunEntry*) thunk->desc)->strictness & argmask)
257
258
259
260
261
262
263
                        {
                            push_a(eval(thunk->_args[i]));
                        }
                        else
                        {
                            push_a(thunk->_args[i]);
                        }
264
265
                        
                        argmask <<= 1;
266
267
268
269
270
271
272
273
                    }
                    
                    expr = ((FunEntry*) thunk->desc)->body;
                    continue;
                }
                else if(thunk->desc->type == FT_PRIM) {

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

                    ((PrimEntry*) thunk->desc)->exec(root_frame_ptr);
                }                
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
                
                destroy_stack_frame(root_frame_ptr);
                return;
            }else{
                // Safe to destroy, the next call has no arguments
                destroy_stack_frame(root_frame_ptr);
                
                Desc* slice = get_slice(((VarEntry*) expr)->f, 0);
                
                if(slice->type == FT_FUN)
                {
                    expr = ((FunEntry*)slice)->body;
                    continue;
                }
                else
                {                    
                    set_return(root_frame_ptr, updateF(get_dst(root_frame_ptr), slice));
                    return;
                }
            }
        case CT_LIT:
300
            set_return(root_frame_ptr, &((LitEntry*) expr)->thunk);
301
302
            destroy_stack_frame(root_frame_ptr);
            return;               
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
303
304
        case CT_SELECT:
        {
305
            push_a(NULL);
306
            exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a);
307
            Thunk* pattern = pop_a();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
308

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

Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
337
338
339
340
341
342
343
344
345
346
            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
347

348
            push_a(&tmp);
349
            exec(((IfEntry*) expr)->cond, frame_ptr, stack_top_a);
350
            Thunk* cond = pop_a();
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
351
            
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
352
353
354
355
356
357
358
359
            if (readB(cond)) {
                expr = ((IfEntry*) expr)->texpr;
                continue;                
            }
            else {
                expr = ((IfEntry*) expr)->fexpr;
                continue;     
            }
360
        }     
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
361
362
363
        default:
            printf("Exec: Unhandled CODE type");
            exit(-1);
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
364
        }
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
365
    
Laszlo Domoszlai's avatar
Laszlo Domoszlai committed
366
    }
367
}