diff options
Diffstat (limited to 'src/bootstrap/primitives.c')
-rw-r--r-- | src/bootstrap/primitives.c | 134 |
1 files changed, 103 insertions, 31 deletions
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index 50a2dfb..f72e484 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c | |||
@@ -1,3 +1,19 @@ | |||
1 | void display(Object *root); | ||
2 | |||
3 | void | ||
4 | display_pair(Object *root) { | ||
5 | display(root->car); | ||
6 | if (root->cdr->type == OBJ_TYPE_PAIR) { | ||
7 | printf(" "); | ||
8 | display_pair(root->cdr); | ||
9 | } else if (root->cdr->type == OBJ_TYPE_NIL) { | ||
10 | return; | ||
11 | } else { | ||
12 | printf(" . "); | ||
13 | display(root->cdr); | ||
14 | } | ||
15 | } | ||
16 | |||
1 | void | 17 | void |
2 | display(Object *root) { | 18 | display(Object *root) { |
3 | if (root == NULL) { | 19 | if (root == NULL) { |
@@ -29,26 +45,31 @@ display(Object *root) { | |||
29 | display_pair(root); | 45 | display_pair(root); |
30 | printf(")"); | 46 | printf(")"); |
31 | } break; | 47 | } break; |
32 | default: { | 48 | case OBJ_TYPE_PROCEDURE: { |
33 | printf("TYPE NOT IMPLEMENTED FOR DISPLAY."); | 49 | printf("#{procedure}"); |
34 | } break; | 50 | } break; |
35 | } | 51 | } |
36 | } | 52 | } |
37 | 53 | ||
38 | Object * | 54 | Object * |
39 | eval(Object *root) { | 55 | eval(Object *root) { |
40 | if (root == NULL) { | ||
41 | return NULL; | ||
42 | } | ||
43 | |||
44 | switch (root->type) { | 56 | switch (root->type) { |
45 | case OBJ_TYPE_FIXNUM: | 57 | case OBJ_TYPE_FIXNUM: |
46 | case OBJ_TYPE_BOOL: | 58 | case OBJ_TYPE_BOOL: |
47 | case OBJ_TYPE_NIL: | 59 | case OBJ_TYPE_NIL: |
48 | case OBJ_TYPE_STRING: | 60 | case OBJ_TYPE_STRING: { |
49 | case OBJ_TYPE_SYMBOL: { | ||
50 | return root; | 61 | return root; |
51 | } break; | 62 | } break; |
63 | case OBJ_TYPE_SYMBOL: { | ||
64 | Object *value = find_environment_symbol(root); | ||
65 | if (value == NULL) { | ||
66 | printf("error: symbol not found: `"); | ||
67 | display(root); | ||
68 | printf("`\n"); | ||
69 | return obj_nil; | ||
70 | } | ||
71 | return value; | ||
72 | } break; | ||
52 | case OBJ_TYPE_PAIR: { | 73 | case OBJ_TYPE_PAIR: { |
53 | if (root->car->type == OBJ_TYPE_SYMBOL) { | 74 | if (root->car->type == OBJ_TYPE_SYMBOL) { |
54 | Object *value = find_environment_symbol(root->car); | 75 | Object *value = find_environment_symbol(root->car); |
@@ -56,7 +77,7 @@ eval(Object *root) { | |||
56 | printf("error: symbol not found: `"); | 77 | printf("error: symbol not found: `"); |
57 | display(root->car); | 78 | display(root->car); |
58 | printf("`\n"); | 79 | printf("`\n"); |
59 | return NULL; | 80 | return obj_nil; |
60 | } | 81 | } |
61 | if (value->type == OBJ_TYPE_PROCEDURE) { | 82 | if (value->type == OBJ_TYPE_PROCEDURE) { |
62 | return value->proc(root->cdr); | 83 | return value->proc(root->cdr); |
@@ -67,18 +88,32 @@ eval(Object *root) { | |||
67 | printf("error: can't eval type %d.\n", root->type); | 88 | printf("error: can't eval type %d.\n", root->type); |
68 | } break; | 89 | } break; |
69 | } | 90 | } |
70 | 91 | return obj_nil; | |
71 | return NULL; | ||
72 | } | 92 | } |
73 | 93 | ||
74 | Object * | 94 | Object * |
75 | proc_add(Object *args) { | 95 | proc_add(Object *args) { |
76 | ssize_t tot = 0; | 96 | // Extract first parameter. |
97 | Object *car = eval(args->car); | ||
98 | if (car == NULL) { | ||
99 | fprintf(stderr, "error: not enough arguments\n"); | ||
100 | return obj_nil; | ||
101 | } | ||
102 | if (car->type != OBJ_TYPE_FIXNUM) { | ||
103 | fprintf(stderr, "addition not supported for type %d\n", car->type); | ||
104 | return obj_nil; | ||
105 | } | ||
106 | args = args->cdr; | ||
107 | ssize_t tot = car->fixnum; | ||
108 | |||
77 | while (args->type == OBJ_TYPE_PAIR) { | 109 | while (args->type == OBJ_TYPE_PAIR) { |
78 | Object *car = eval(args->car); | 110 | Object *car = eval(args->car); |
111 | if (car == NULL) { | ||
112 | car = obj_nil; | ||
113 | } | ||
79 | if (car->type != OBJ_TYPE_FIXNUM) { | 114 | if (car->type != OBJ_TYPE_FIXNUM) { |
80 | fprintf(stderr, "addition not supported for type %d\n", car->type); | 115 | fprintf(stderr, "addition not supported for type %d\n", car->type); |
81 | return NULL; | 116 | return obj_nil; |
82 | } | 117 | } |
83 | tot += car->fixnum; | 118 | tot += car->fixnum; |
84 | args = args->cdr; | 119 | args = args->cdr; |
@@ -88,21 +123,27 @@ proc_add(Object *args) { | |||
88 | 123 | ||
89 | Object * | 124 | Object * |
90 | proc_sub(Object *args) { | 125 | 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. | 126 | // Extract first parameter. |
97 | Object *car = eval(args->car); | 127 | Object *car = eval(args->car); |
128 | if (car == NULL) { | ||
129 | fprintf(stderr, "error: not enough arguments\n"); | ||
130 | return obj_nil; | ||
131 | } | ||
132 | if (car->type != OBJ_TYPE_FIXNUM) { | ||
133 | fprintf(stderr, "error: sub not supported for type %d\n", car->type); | ||
134 | return obj_nil; | ||
135 | } | ||
98 | args = args->cdr; | 136 | args = args->cdr; |
99 | ssize_t tot = car->fixnum; | 137 | ssize_t tot = car->fixnum; |
100 | 138 | ||
101 | while (args->type == OBJ_TYPE_PAIR) { | 139 | while (args->type == OBJ_TYPE_PAIR) { |
102 | Object *car = eval(args->car); | 140 | car = eval(args->car); |
141 | if (car == NULL) { | ||
142 | car = obj_nil; | ||
143 | } | ||
103 | if (car->type != OBJ_TYPE_FIXNUM) { | 144 | if (car->type != OBJ_TYPE_FIXNUM) { |
104 | fprintf(stderr, "substraction not supported for type %d\n", car->type); | 145 | fprintf(stderr, "error: sub not supported for type %d\n", car->type); |
105 | return NULL; | 146 | return obj_nil; |
106 | } | 147 | } |
107 | tot -= car->fixnum; | 148 | tot -= car->fixnum; |
108 | args = args->cdr; | 149 | args = args->cdr; |
@@ -112,12 +153,27 @@ proc_sub(Object *args) { | |||
112 | 153 | ||
113 | Object * | 154 | Object * |
114 | proc_mul(Object *args) { | 155 | proc_mul(Object *args) { |
115 | ssize_t tot = 1; | 156 | // Extract first parameter. |
157 | Object *car = eval(args->car); | ||
158 | if (car == NULL) { | ||
159 | fprintf(stderr, "error: not enough arguments\n"); | ||
160 | return obj_nil; | ||
161 | } | ||
162 | if (car->type != OBJ_TYPE_FIXNUM) { | ||
163 | fprintf(stderr, "error: mult not supported for type %d\n", car->type); | ||
164 | return obj_nil; | ||
165 | } | ||
166 | args = args->cdr; | ||
167 | ssize_t tot = car->fixnum; | ||
168 | |||
116 | while (args->type == OBJ_TYPE_PAIR) { | 169 | while (args->type == OBJ_TYPE_PAIR) { |
117 | Object *car = eval(args->car); | 170 | Object *car = eval(args->car); |
171 | if (car == NULL) { | ||
172 | car = obj_nil; | ||
173 | } | ||
118 | if (car->type != OBJ_TYPE_FIXNUM) { | 174 | if (car->type != OBJ_TYPE_FIXNUM) { |
119 | fprintf(stderr, "multiply not supported for type %d\n", car->type); | 175 | fprintf(stderr, "error: mult not supported for type %d\n", car->type); |
120 | return NULL; | 176 | return obj_nil; |
121 | } | 177 | } |
122 | tot *= car->fixnum; | 178 | tot *= car->fixnum; |
123 | args = args->cdr; | 179 | args = args->cdr; |
@@ -127,21 +183,27 @@ proc_mul(Object *args) { | |||
127 | 183 | ||
128 | Object * | 184 | Object * |
129 | proc_div(Object *args) { | 185 | 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. | 186 | // Extract first parameter. |
136 | Object *car = eval(args->car); | 187 | Object *car = eval(args->car); |
188 | if (car == NULL) { | ||
189 | fprintf(stderr, "error: not enough arguments\n"); | ||
190 | return obj_nil; | ||
191 | } | ||
137 | args = args->cdr; | 192 | args = args->cdr; |
138 | ssize_t tot = car->fixnum; | 193 | ssize_t tot = car->fixnum; |
139 | 194 | ||
140 | while (args->type == OBJ_TYPE_PAIR) { | 195 | while (args->type == OBJ_TYPE_PAIR) { |
141 | Object *car = eval(args->car); | 196 | Object *car = eval(args->car); |
197 | if (car == NULL) { | ||
198 | car = obj_nil; | ||
199 | } | ||
142 | if (car->type != OBJ_TYPE_FIXNUM) { | 200 | if (car->type != OBJ_TYPE_FIXNUM) { |
143 | fprintf(stderr, "div not supported for type %d\n", car->type); | 201 | fprintf(stderr, "error: div not supported for type %d\n", car->type); |
144 | return NULL; | 202 | return obj_nil; |
203 | } | ||
204 | if (car->fixnum == 0) { | ||
205 | fprintf(stderr, "error: division by zero\n"); | ||
206 | return obj_nil; | ||
145 | } | 207 | } |
146 | tot /= car->fixnum; | 208 | tot /= car->fixnum; |
147 | args = args->cdr; | 209 | args = args->cdr; |
@@ -149,3 +211,13 @@ proc_div(Object *args) { | |||
149 | return make_fixnum(tot); | 211 | return make_fixnum(tot); |
150 | } | 212 | } |
151 | 213 | ||
214 | Object * | ||
215 | proc_display(Object *args) { | ||
216 | if (args == NULL) { | ||
217 | return obj_nil; | ||
218 | } | ||
219 | if (args->type == OBJ_TYPE_PAIR) { | ||
220 | display(eval(args->car)); | ||
221 | } | ||
222 | return obj_nil; | ||
223 | } | ||