diff options
Diffstat (limited to 'src/bootstrap/primitives.c')
-rw-r--r-- | src/bootstrap/primitives.c | 151 |
1 files changed, 151 insertions, 0 deletions
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c new file mode 100644 index 0000000..50a2dfb --- /dev/null +++ b/src/bootstrap/primitives.c | |||
@@ -0,0 +1,151 @@ | |||
1 | void | ||
2 | display(Object *root) { | ||
3 | if (root == NULL) { | ||
4 | return; | ||
5 | } | ||
6 | |||
7 | switch (root->type) { | ||
8 | case OBJ_TYPE_FIXNUM: { | ||
9 | printf("%zd", root->fixnum); | ||
10 | } break; | ||
11 | case OBJ_TYPE_BOOL: { | ||
12 | if (root->boolean) { | ||
13 | printf("true"); | ||
14 | } else { | ||
15 | printf("false"); | ||
16 | } | ||
17 | } break; | ||
18 | case OBJ_TYPE_NIL: { | ||
19 | printf("()"); | ||
20 | } break; | ||
21 | case OBJ_TYPE_STRING: { | ||
22 | printf("\"%.*s\"", (int)root->string_n, root->string); | ||
23 | } break; | ||
24 | case OBJ_TYPE_SYMBOL: { | ||
25 | printf(":%.*s", (int)root->symbol_n, root->symbol); | ||
26 | } break; | ||
27 | case OBJ_TYPE_PAIR: { | ||
28 | printf("("); | ||
29 | display_pair(root); | ||
30 | printf(")"); | ||
31 | } break; | ||
32 | default: { | ||
33 | printf("TYPE NOT IMPLEMENTED FOR DISPLAY."); | ||
34 | } break; | ||
35 | } | ||
36 | } | ||
37 | |||
38 | Object * | ||
39 | eval(Object *root) { | ||
40 | if (root == NULL) { | ||
41 | return NULL; | ||
42 | } | ||
43 | |||
44 | switch (root->type) { | ||
45 | case OBJ_TYPE_FIXNUM: | ||
46 | case OBJ_TYPE_BOOL: | ||
47 | case OBJ_TYPE_NIL: | ||
48 | case OBJ_TYPE_STRING: | ||
49 | case OBJ_TYPE_SYMBOL: { | ||
50 | return root; | ||
51 | } break; | ||
52 | case OBJ_TYPE_PAIR: { | ||
53 | if (root->car->type == OBJ_TYPE_SYMBOL) { | ||
54 | Object *value = find_environment_symbol(root->car); | ||
55 | if (value == NULL) { | ||
56 | printf("error: symbol not found: `"); | ||
57 | display(root->car); | ||
58 | printf("`\n"); | ||
59 | return NULL; | ||
60 | } | ||
61 | if (value->type == OBJ_TYPE_PROCEDURE) { | ||
62 | return value->proc(root->cdr); | ||
63 | } | ||
64 | } | ||
65 | } break; | ||
66 | default: { | ||
67 | printf("error: can't eval type %d.\n", root->type); | ||
68 | } break; | ||
69 | } | ||
70 | |||
71 | return NULL; | ||
72 | } | ||
73 | |||
74 | Object * | ||
75 | proc_add(Object *args) { | ||
76 | ssize_t tot = 0; | ||
77 | while (args->type == OBJ_TYPE_PAIR) { | ||
78 | Object *car = eval(args->car); | ||
79 | if (car->type != OBJ_TYPE_FIXNUM) { | ||
80 | fprintf(stderr, "addition not supported for type %d\n", car->type); | ||
81 | return NULL; | ||
82 | } | ||
83 | tot += car->fixnum; | ||
84 | args = args->cdr; | ||
85 | } | ||
86 | return make_fixnum(tot); | ||
87 | } | ||
88 | |||
89 | Object * | ||
90 | proc_sub(Object *args) { | ||
91 | if (args->type != OBJ_TYPE_PAIR) { | ||
92 | fprintf(stderr, "substraction not supported for type %d\n", args->type); | ||
93 | return NULL; | ||
94 | } | ||
95 | |||
96 | // Extract first parameter. | ||
97 | Object *car = eval(args->car); | ||
98 | args = args->cdr; | ||
99 | ssize_t tot = car->fixnum; | ||
100 | |||
101 | while (args->type == OBJ_TYPE_PAIR) { | ||
102 | Object *car = eval(args->car); | ||
103 | if (car->type != OBJ_TYPE_FIXNUM) { | ||
104 | fprintf(stderr, "substraction not supported for type %d\n", car->type); | ||
105 | return NULL; | ||
106 | } | ||
107 | tot -= car->fixnum; | ||
108 | args = args->cdr; | ||
109 | } | ||
110 | return make_fixnum(tot); | ||
111 | } | ||
112 | |||
113 | Object * | ||
114 | proc_mul(Object *args) { | ||
115 | ssize_t tot = 1; | ||
116 | while (args->type == OBJ_TYPE_PAIR) { | ||
117 | Object *car = eval(args->car); | ||
118 | if (car->type != OBJ_TYPE_FIXNUM) { | ||
119 | fprintf(stderr, "multiply not supported for type %d\n", car->type); | ||
120 | return NULL; | ||
121 | } | ||
122 | tot *= car->fixnum; | ||
123 | args = args->cdr; | ||
124 | } | ||
125 | return make_fixnum(tot); | ||
126 | } | ||
127 | |||
128 | Object * | ||
129 | proc_div(Object *args) { | ||
130 | if (args->type != OBJ_TYPE_PAIR) { | ||
131 | fprintf(stderr, "substraction not supported for type %d\n", args->type); | ||
132 | return NULL; | ||
133 | } | ||
134 | |||
135 | // Extract first parameter. | ||
136 | Object *car = eval(args->car); | ||
137 | args = args->cdr; | ||
138 | ssize_t tot = car->fixnum; | ||
139 | |||
140 | while (args->type == OBJ_TYPE_PAIR) { | ||
141 | Object *car = eval(args->car); | ||
142 | if (car->type != OBJ_TYPE_FIXNUM) { | ||
143 | fprintf(stderr, "div not supported for type %d\n", car->type); | ||
144 | return NULL; | ||
145 | } | ||
146 | tot /= car->fixnum; | ||
147 | args = args->cdr; | ||
148 | } | ||
149 | return make_fixnum(tot); | ||
150 | } | ||
151 | |||