forked from idris-lang/Idris-dev
-
Notifications
You must be signed in to change notification settings - Fork 2
/
ctest.c
106 lines (92 loc) · 1.92 KB
/
ctest.c
1
2
3
4
5
6
7
8
9
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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
#include <idris_rts.h>
void plus(VM* vm, VAL* oldbase) {
INITFRAME;
RESERVE(2);
ADDTOP(2);
switch(TAG(LOC(0))) {
case 0:
PROJECT(vm, LOC(0), 2, 0);
RVAL = LOC(1);
TOPBASE(0);
REBASE;
break;
case 1:
PROJECT(vm, LOC(0), 2, 1);
RESERVE(2);
TOP(0) = LOC(2);
TOP(1) = LOC(1);
STOREOLD;
BASETOP(0);
ADDTOP(2);
CALL(plus);
LOC(3) = RVAL;
RVAL = MKCON(vm, 1, 1, LOC(3));
TOPBASE(0);
REBASE;
break;
}
}
void natToInt(VM* vm, VAL* oldbase) {
INITFRAME;
RESERVE(3);
ADDTOP(3);
switch(TAG(LOC(0))) {
case 0:
PROJECT(vm, LOC(0), 2, 0);
RVAL = MKINT(0);
TOPBASE(0);
REBASE;
break;
case 1:
PROJECT(vm, LOC(0), 1, 1);
RESERVE(1);
TOP(0) = LOC(1);
STOREOLD;
BASETOP(0);
ADDTOP(1);
CALL(natToInt);
LOC(2) = RVAL;
RVAL = ADD(LOC(2), MKINT(1));
TOPBASE(0);
REBASE;
break;
}
}
int do_main(VM* vm, VAL* oldbase) {
INITFRAME;
RESERVE(2);
ADDTOP(2);
LOC(0) = MKCON(vm, 0, 0);
LOC(0) = MKCON(vm, 1, 1, LOC(0));
LOC(0) = MKCON(vm, 1, 1, LOC(0));
dumpVal(LOC(0));
printf("\n");
LOC(1) = MKCON(vm, 0, 0);
LOC(1) = MKCON(vm, 1, 1, LOC(1));
LOC(1) = MKCON(vm, 1, 1, LOC(1));
RESERVE(2);
TOP(0) = LOC(0);
TOP(1) = LOC(1);
STOREOLD;
BASETOP(0);
ADDTOP(2);
CALL(plus);
LOC(0) = RVAL;
RESERVE(1);
TOP(0) = LOC(0);
SLIDE(vm, 1);
TOPBASE(1);
TAILCALL(natToInt);
/* STOREOLD;
BASETOP(0);
ADDTOP(1);
CALL(natToInt);
TOPBASE(0);
REBASE; */
}
int main() {
VM* vm = init_vm(100,100);
do_main(vm, NULL);
printf("%ld\n", GETINT(RVAL));
printf("%d %d %d\n", vm->valstack, vm->valstack_base, vm->valstack_top);
}