blob: 5006aa3ae6fe1596248cf9c65a01ce781be86979 [file] [log] [blame]
swissChili7a6f5eb2021-04-13 16:46:02 -07001#include "lisp.h"
swissChili8cfb7c42021-04-18 21:17:58 -07002#include "plat/plat.h"
3
swissChili7a6f5eb2021-04-13 16:46:02 -07004#include <ctype.h>
5#include <stdbool.h>
6#include <stdio.h>
swissChilibed80922021-04-13 21:58:05 -07007#include <stdlib.h>
8#include <string.h>
swissChili7a6f5eb2021-04-13 16:46:02 -07009
swissChili9e57da42021-06-15 22:22:46 -070010struct alloc *first_a = NULL, *last_a = NULL;
swissChili7a6f5eb2021-04-13 16:46:02 -070011
swissChili8cfb7c42021-04-18 21:17:58 -070012value_t nil = 0b00101111; // magic ;)
swissChili923b5362021-05-09 20:31:43 -070013value_t t = 1 << 3;
swissChilibed80922021-04-13 21:58:05 -070014
swissChilib8fd4712021-06-23 15:32:04 -070015unsigned char max_pool = 0, current_pool = 0;
16
swissChili53472e82021-05-08 16:06:32 -070017void err(const char *msg)
swissChilibed80922021-04-13 21:58:05 -070018{
swissChili53472e82021-05-08 16:06:32 -070019 fprintf(stderr, "ERROR: %s\n", msg);
20 exit(1);
swissChilibed80922021-04-13 21:58:05 -070021}
22
swissChili53472e82021-05-08 16:06:32 -070023value_t intval(int i)
swissChili7a6f5eb2021-04-13 16:46:02 -070024{
swissChili8cfb7c42021-04-18 21:17:58 -070025 i <<= 2;
26 i |= INT_TAG;
27 return i;
28}
29
swissChili53472e82021-05-08 16:06:32 -070030value_t cons(value_t car, value_t cdr)
swissChili8cfb7c42021-04-18 21:17:58 -070031{
swissChili9e57da42021-06-15 22:22:46 -070032 struct cons_alloc *item = malloc_aligned(sizeof(struct cons_alloc));
33 struct cons *c = &item->cons;
swissChili7a6f5eb2021-04-13 16:46:02 -070034
swissChilibed80922021-04-13 21:58:05 -070035 c->car = car;
36 c->cdr = cdr;
37
swissChilie9fec8b2021-06-22 13:59:33 -070038 item->alloc.type_tag = CONS_TAG;
swissChilib8fd4712021-06-23 15:32:04 -070039 item->alloc.pool = current_pool;
swissChili7a6f5eb2021-04-13 16:46:02 -070040
swissChili53472e82021-05-08 16:06:32 -070041 if (last_a)
swissChili7a6f5eb2021-04-13 16:46:02 -070042 {
swissChili9e57da42021-06-15 22:22:46 -070043 item->alloc.prev = last_a;
swissChili7a6f5eb2021-04-13 16:46:02 -070044 last_a->next = item;
swissChili9e57da42021-06-15 22:22:46 -070045 item->alloc.next = NULL;
swissChilie9fec8b2021-06-22 13:59:33 -070046 last_a = item;
swissChili7a6f5eb2021-04-13 16:46:02 -070047 }
48 else
49 {
swissChili9e57da42021-06-15 22:22:46 -070050 item->alloc.prev = item->alloc.next = NULL;
swissChili7a6f5eb2021-04-13 16:46:02 -070051 first_a = last_a = item;
52 }
53
swissChilib3ca4fb2021-04-20 10:33:00 -070054 value_t v = (value_t)c;
swissChili8cfb7c42021-04-18 21:17:58 -070055 v |= CONS_TAG;
swissChili7a6f5eb2021-04-13 16:46:02 -070056
57 return v;
58}
59
swissChili53472e82021-05-08 16:06:32 -070060void skipws(struct istream *is)
swissChili7a6f5eb2021-04-13 16:46:02 -070061{
swissChilib8fd4712021-06-23 15:32:04 -070062start:
swissChili53472e82021-05-08 16:06:32 -070063 while (isspace(is->peek(is)))
64 is->get(is);
swissChilib8fd4712021-06-23 15:32:04 -070065
66 if (is->peek(is) == ';')
67 {
68 while (is->get(is) != '\n')
69 {}
70
71 // Only time I ever use labels is for stuff like this. Compiler would
72 // probably optimize this if I used recursion but I don't want to
73 // bother.
74 goto start;
75 }
swissChili7a6f5eb2021-04-13 16:46:02 -070076}
77
swissChili53472e82021-05-08 16:06:32 -070078bool isallowedchar(char c)
swissChili7a6f5eb2021-04-13 16:46:02 -070079{
swissChilibed80922021-04-13 21:58:05 -070080 return (c >= '#' && c <= '\'') || (c >= '*' && c <= '/') ||
81 (c >= '>' && c <= '@');
swissChili7a6f5eb2021-04-13 16:46:02 -070082}
83
swissChili53472e82021-05-08 16:06:32 -070084bool issymstart(char c)
swissChili7a6f5eb2021-04-13 16:46:02 -070085{
swissChili53472e82021-05-08 16:06:32 -070086 return isalpha(c) || isallowedchar(c);
swissChili7a6f5eb2021-04-13 16:46:02 -070087}
88
swissChili53472e82021-05-08 16:06:32 -070089bool issym(char c)
swissChili7a6f5eb2021-04-13 16:46:02 -070090{
swissChili53472e82021-05-08 16:06:32 -070091 return isalpha(c) || isallowedchar(c) || isdigit(c);
swissChili7a6f5eb2021-04-13 16:46:02 -070092}
93
swissChili53472e82021-05-08 16:06:32 -070094bool readsym(struct istream *is, value_t *val)
swissChili7a6f5eb2021-04-13 16:46:02 -070095{
swissChili53472e82021-05-08 16:06:32 -070096 skipws(is);
swissChili7a6f5eb2021-04-13 16:46:02 -070097
swissChili53472e82021-05-08 16:06:32 -070098 if (!issymstart(is->peek(is)))
swissChili7a6f5eb2021-04-13 16:46:02 -070099 return false;
100
101 int size = 8;
swissChili53472e82021-05-08 16:06:32 -0700102 char *s = malloc_aligned(size);
swissChili7a6f5eb2021-04-13 16:46:02 -0700103
swissChili53472e82021-05-08 16:06:32 -0700104 s[0] = is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700105
swissChili53472e82021-05-08 16:06:32 -0700106 for (int i = 1;; i++)
swissChili7a6f5eb2021-04-13 16:46:02 -0700107 {
swissChili53472e82021-05-08 16:06:32 -0700108 if (issym(is->peek(is)))
swissChili7a6f5eb2021-04-13 16:46:02 -0700109 {
swissChili53472e82021-05-08 16:06:32 -0700110 if (i >= size)
swissChili7a6f5eb2021-04-13 16:46:02 -0700111 {
112 size *= 2;
swissChili53472e82021-05-08 16:06:32 -0700113 s = realloc_aligned(s, size);
swissChili7a6f5eb2021-04-13 16:46:02 -0700114 }
115
swissChili53472e82021-05-08 16:06:32 -0700116 s[i] = is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700117 }
118 else
119 {
swissChili53472e82021-05-08 16:06:32 -0700120 s[i] = 0;
swissChilib3ca4fb2021-04-20 10:33:00 -0700121 *val = (value_t)s;
swissChili8cfb7c42021-04-18 21:17:58 -0700122 *val |= SYMBOL_TAG;
swissChili7a6f5eb2021-04-13 16:46:02 -0700123
124 return true;
125 }
126 }
127}
128
swissChili53472e82021-05-08 16:06:32 -0700129bool readstr(struct istream *is, value_t *val)
swissChili7a6f5eb2021-04-13 16:46:02 -0700130{
swissChili53472e82021-05-08 16:06:32 -0700131 skipws(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700132
swissChili53472e82021-05-08 16:06:32 -0700133 if (is->peek(is) != '"')
swissChili7a6f5eb2021-04-13 16:46:02 -0700134 return false;
135
136 bool escape = false;
137 int size = 8;
swissChili53472e82021-05-08 16:06:32 -0700138 char *s = malloc_aligned(size);
swissChili7a6f5eb2021-04-13 16:46:02 -0700139
swissChili53472e82021-05-08 16:06:32 -0700140 (void)is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700141
swissChili53472e82021-05-08 16:06:32 -0700142 for (int i = 0;; i++)
swissChili7a6f5eb2021-04-13 16:46:02 -0700143 {
swissChili53472e82021-05-08 16:06:32 -0700144 if (is->peek(is) != '"')
swissChili7a6f5eb2021-04-13 16:46:02 -0700145 {
swissChili53472e82021-05-08 16:06:32 -0700146 if (i >= size)
swissChili7a6f5eb2021-04-13 16:46:02 -0700147 {
swissChilibed80922021-04-13 21:58:05 -0700148 size *= 2;
swissChili53472e82021-05-08 16:06:32 -0700149 s = realloc_aligned(s, size);
swissChili7a6f5eb2021-04-13 16:46:02 -0700150 }
swissChilibed80922021-04-13 21:58:05 -0700151
swissChili53472e82021-05-08 16:06:32 -0700152 char c = is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700153
swissChili53472e82021-05-08 16:06:32 -0700154 if (escape && c == 'n')
swissChili7a6f5eb2021-04-13 16:46:02 -0700155 c = '\n';
swissChili53472e82021-05-08 16:06:32 -0700156 else if (escape && c == '\\')
swissChili7a6f5eb2021-04-13 16:46:02 -0700157 c = '\\';
158
swissChili53472e82021-05-08 16:06:32 -0700159 if (c == '\\' && !escape)
swissChili7a6f5eb2021-04-13 16:46:02 -0700160 {
161 escape = true;
162 i--; // will be incremented again, UGLY.
163 }
164 else
165 {
166 escape = false;
swissChili53472e82021-05-08 16:06:32 -0700167 s[i] = c;
swissChili7a6f5eb2021-04-13 16:46:02 -0700168 }
169 }
170 else
171 {
swissChili53472e82021-05-08 16:06:32 -0700172 is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700173
swissChilib3ca4fb2021-04-20 10:33:00 -0700174 *val = (value_t)s;
swissChili8cfb7c42021-04-18 21:17:58 -0700175 *val |= STRING_TAG;
swissChili7a6f5eb2021-04-13 16:46:02 -0700176
177 return true;
178 }
179 }
180}
181
swissChili53472e82021-05-08 16:06:32 -0700182void printval(value_t v, int depth)
swissChili7a6f5eb2021-04-13 16:46:02 -0700183{
swissChili53472e82021-05-08 16:06:32 -0700184 for (int i = 0; i < depth; i++)
185 printf(" ");
swissChili7a6f5eb2021-04-13 16:46:02 -0700186
swissChili53472e82021-05-08 16:06:32 -0700187 if (symbolp(v))
swissChili7a6f5eb2021-04-13 16:46:02 -0700188 {
swissChili53472e82021-05-08 16:06:32 -0700189 printf("'%s\n", (char *)(v ^ SYMBOL_TAG));
swissChili8cfb7c42021-04-18 21:17:58 -0700190 }
swissChili53472e82021-05-08 16:06:32 -0700191 else if (stringp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700192 {
swissChili53472e82021-05-08 16:06:32 -0700193 printf("\"%s\"\n", (char *)(v ^ STRING_TAG));
swissChili8cfb7c42021-04-18 21:17:58 -0700194 }
swissChili53472e82021-05-08 16:06:32 -0700195 else if (integerp(v))
swissChili6eee4f92021-04-20 09:34:30 -0700196 {
swissChili53472e82021-05-08 16:06:32 -0700197 printf("%d\n", v >> 2);
swissChili6eee4f92021-04-20 09:34:30 -0700198 }
swissChili53472e82021-05-08 16:06:32 -0700199 else if (consp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700200 {
swissChili53472e82021-05-08 16:06:32 -0700201 if (listp(v))
swissChilibed80922021-04-13 21:58:05 -0700202 {
swissChili53472e82021-05-08 16:06:32 -0700203 printf("list:\n");
swissChilibed80922021-04-13 21:58:05 -0700204
swissChili53472e82021-05-08 16:06:32 -0700205 for (value_t n = v; !nilp(n); n = cdr(n))
swissChilibed80922021-04-13 21:58:05 -0700206 {
swissChili53472e82021-05-08 16:06:32 -0700207 printval(car(n), depth + 1);
swissChilibed80922021-04-13 21:58:05 -0700208 }
209 }
210 else
211 {
swissChili53472e82021-05-08 16:06:32 -0700212 printf("cons:\n");
213 printval(car(v), depth + 1);
214 printval(cdr(v), depth + 1);
swissChilibed80922021-04-13 21:58:05 -0700215 }
swissChili8cfb7c42021-04-18 21:17:58 -0700216 }
swissChili53472e82021-05-08 16:06:32 -0700217 else if (nilp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700218 {
swissChili53472e82021-05-08 16:06:32 -0700219 printf("nil\n");
swissChili8cfb7c42021-04-18 21:17:58 -0700220 }
221 else
222 {
swissChili53472e82021-05-08 16:06:32 -0700223 printf("<unknown %d>\n", v);
swissChili7a6f5eb2021-04-13 16:46:02 -0700224 }
225}
226
swissChili53472e82021-05-08 16:06:32 -0700227bool readlist(struct istream *is, value_t *val)
swissChilibed80922021-04-13 21:58:05 -0700228{
swissChili53472e82021-05-08 16:06:32 -0700229 skipws(is);
swissChilibed80922021-04-13 21:58:05 -0700230
swissChili53472e82021-05-08 16:06:32 -0700231 if (is->peek(is) != '(')
swissChilibed80922021-04-13 21:58:05 -0700232 return false;
233
swissChili53472e82021-05-08 16:06:32 -0700234 is->get(is);
swissChilibed80922021-04-13 21:58:05 -0700235
swissChili53472e82021-05-08 16:06:32 -0700236 *val = readn(is);
swissChilibed80922021-04-13 21:58:05 -0700237
swissChili53472e82021-05-08 16:06:32 -0700238 if (is->peek(is) != ')')
swissChilibed80922021-04-13 21:58:05 -0700239 {
swissChili53472e82021-05-08 16:06:32 -0700240 is->showpos(is, stderr);
241 err("Unterminated list");
swissChilibed80922021-04-13 21:58:05 -0700242 return false;
243 }
swissChili53472e82021-05-08 16:06:32 -0700244 is->get(is);
swissChilibed80922021-04-13 21:58:05 -0700245
246 return true;
247}
248
swissChili53472e82021-05-08 16:06:32 -0700249bool readint(struct istream *is, value_t *val)
swissChili6eee4f92021-04-20 09:34:30 -0700250{
swissChilib6c858c2021-06-30 21:12:43 -0700251 skipws(is);
252
swissChili6eee4f92021-04-20 09:34:30 -0700253 int number = 0;
254
swissChili53472e82021-05-08 16:06:32 -0700255 if (!isdigit(is->peek(is)))
swissChili6eee4f92021-04-20 09:34:30 -0700256 return false;
257
swissChili53472e82021-05-08 16:06:32 -0700258 while (isdigit(is->peek(is)))
swissChili6eee4f92021-04-20 09:34:30 -0700259 {
260 number *= 10;
swissChili53472e82021-05-08 16:06:32 -0700261 number += is->get(is) - '0';
swissChili6eee4f92021-04-20 09:34:30 -0700262 }
263
swissChili53472e82021-05-08 16:06:32 -0700264 *val = intval(number);
swissChili6eee4f92021-04-20 09:34:30 -0700265 return true;
266}
267
swissChilib6c858c2021-06-30 21:12:43 -0700268bool readquote(struct istream *is, value_t *val)
269{
270 skipws(is);
271
272 char c = is->peek(is);
273
274 if (c == '\'' || c == '`' || c == ',')
275 {
276 is->get(is);
277
278 if (c == '`' && is->peek(is) == '@')
279 {
280 // This is actually a splice
281 is->get(is);
282 c = '@';
283 }
284
285 // Read the next form and wrap it in the appropriate function
286
287 value_t wrapped;
288 bool has_next = read1(is, &wrapped);
289
290 if (!has_next)
291 {
292 fprintf(stderr, "Expected a form after reader macro char %c\n", c);
293 is->showpos(is, stderr);
294 err("Invalid reader macro");
295 return false;
296 }
297
298 value_t symbol = nil;
299
300 switch (c)
301 {
302 case '\'':
303 symbol = symval("quote");
304 break;
305 case '`':
306 symbol = symval("backquote");
307 break;
308 case ',':
309 symbol = symval("unquote");
310 break;
311 case '@':
312 symbol = symval("splice");
313 break;
314 }
315
316 *val = cons(symbol, cons(wrapped, nil));
317
318 return true;
319 }
320 else
321 {
322 return false;
323 }
324}
325
swissChili53472e82021-05-08 16:06:32 -0700326bool read1(struct istream *is, value_t *val)
swissChili7a6f5eb2021-04-13 16:46:02 -0700327{
swissChilib6c858c2021-06-30 21:12:43 -0700328 // This could all be one big short-circuiting || but that is ugly.
329 if (readquote(is, val))
330 return true;
331
swissChili53472e82021-05-08 16:06:32 -0700332 if (readsym(is, val))
swissChili7a6f5eb2021-04-13 16:46:02 -0700333 return true;
334
swissChili53472e82021-05-08 16:06:32 -0700335 if (readstr(is, val))
swissChili7a6f5eb2021-04-13 16:46:02 -0700336 return true;
337
swissChili53472e82021-05-08 16:06:32 -0700338 if (readint(is, val))
swissChili6eee4f92021-04-20 09:34:30 -0700339 return true;
340
swissChili53472e82021-05-08 16:06:32 -0700341 if (readlist(is, val))
swissChilibed80922021-04-13 21:58:05 -0700342 return true;
343
swissChili7a6f5eb2021-04-13 16:46:02 -0700344 return false;
345}
346
swissChili53472e82021-05-08 16:06:32 -0700347value_t readn(struct istream *is)
swissChilibed80922021-04-13 21:58:05 -0700348{
swissChili8cfb7c42021-04-18 21:17:58 -0700349 value_t first = nil;
350 value_t *last = &first;
swissChilibed80922021-04-13 21:58:05 -0700351
swissChili8cfb7c42021-04-18 21:17:58 -0700352 value_t read_val;
swissChilibed80922021-04-13 21:58:05 -0700353
swissChili53472e82021-05-08 16:06:32 -0700354 while (read1(is, &read_val))
swissChilibed80922021-04-13 21:58:05 -0700355 {
swissChili53472e82021-05-08 16:06:32 -0700356 *last = cons(read_val, nil);
357 last = cdrref(*last);
swissChilibed80922021-04-13 21:58:05 -0700358 }
359
360 return first;
361}
362
swissChili53472e82021-05-08 16:06:32 -0700363bool startswith(struct istream *s, char *pattern)
swissChili7a6f5eb2021-04-13 16:46:02 -0700364{
swissChili53472e82021-05-08 16:06:32 -0700365 char *check = strdup(pattern);
366 s->read(s, check, strlen(pattern));
swissChili7a6f5eb2021-04-13 16:46:02 -0700367
swissChili53472e82021-05-08 16:06:32 -0700368 bool res = strcmp(check, pattern) == 0;
369 free(check);
swissChili7a6f5eb2021-04-13 16:46:02 -0700370
371 return res;
372}
swissChilibed80922021-04-13 21:58:05 -0700373
swissChili53472e82021-05-08 16:06:32 -0700374value_t strval(char *str)
swissChilibed80922021-04-13 21:58:05 -0700375{
swissChili8cfb7c42021-04-18 21:17:58 -0700376 value_t v;
377
swissChili53472e82021-05-08 16:06:32 -0700378 char *a = malloc_aligned(strlen(str) + 1);
swissChilib6c858c2021-06-30 21:12:43 -0700379 strcpy(a, str);
swissChilib3ca4fb2021-04-20 10:33:00 -0700380 v = (value_t)a;
swissChili8cfb7c42021-04-18 21:17:58 -0700381 v |= STRING_TAG;
swissChilibed80922021-04-13 21:58:05 -0700382
383 return v;
384}
385
swissChilib6c858c2021-06-30 21:12:43 -0700386value_t symval(char *str)
387{
388 value_t v;
389
390 char *a = malloc_aligned(strlen(str) + 1);
391 strcpy(a, str);
392 v = (value_t)a;
393 v |= SYMBOL_TAG;
394
395 return v;
396}
397
swissChili53472e82021-05-08 16:06:32 -0700398bool integerp(value_t v)
swissChilibed80922021-04-13 21:58:05 -0700399{
swissChili8cfb7c42021-04-18 21:17:58 -0700400 return (v & INT_MASK) == INT_TAG;
401}
swissChilibed80922021-04-13 21:58:05 -0700402
swissChili53472e82021-05-08 16:06:32 -0700403bool symbolp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700404{
405 return (v & HEAP_MASK) == SYMBOL_TAG;
406}
407
swissChili53472e82021-05-08 16:06:32 -0700408bool stringp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700409{
410 return (v & HEAP_MASK) == STRING_TAG;
411}
412
swissChili53472e82021-05-08 16:06:32 -0700413bool consp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700414{
415 return (v & HEAP_MASK) == CONS_TAG;
416}
417
swissChili9e57da42021-06-15 22:22:46 -0700418bool heapp(value_t v)
419{
420 return consp(v) || stringp(v) || symbolp(v);
421}
422
swissChili53472e82021-05-08 16:06:32 -0700423bool listp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700424{
425 value_t next = v;
426
swissChili53472e82021-05-08 16:06:32 -0700427 while (consp(next))
swissChilibed80922021-04-13 21:58:05 -0700428 {
swissChili53472e82021-05-08 16:06:32 -0700429 next = cdr(next);
swissChilibed80922021-04-13 21:58:05 -0700430 }
431
swissChili53472e82021-05-08 16:06:32 -0700432 return nilp(next);
swissChilibed80922021-04-13 21:58:05 -0700433}
434
swissChili53472e82021-05-08 16:06:32 -0700435value_t car(value_t v)
swissChilibed80922021-04-13 21:58:05 -0700436{
swissChili53472e82021-05-08 16:06:32 -0700437 if (!consp(v))
swissChilibed80922021-04-13 21:58:05 -0700438 return nil;
439
swissChili53472e82021-05-08 16:06:32 -0700440 return *carref(v);
swissChilibed80922021-04-13 21:58:05 -0700441}
442
swissChili53472e82021-05-08 16:06:32 -0700443value_t cdr(value_t v)
swissChilibed80922021-04-13 21:58:05 -0700444{
swissChili53472e82021-05-08 16:06:32 -0700445 if (!consp(v))
swissChilibed80922021-04-13 21:58:05 -0700446 return nil;
447
swissChili53472e82021-05-08 16:06:32 -0700448 return *cdrref(v);
swissChilibed80922021-04-13 21:58:05 -0700449}
450
swissChili53472e82021-05-08 16:06:32 -0700451value_t *carref(value_t v)
swissChilibed80922021-04-13 21:58:05 -0700452{
swissChili53472e82021-05-08 16:06:32 -0700453 if (!consp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700454 return NULL;
455
swissChilib3ca4fb2021-04-20 10:33:00 -0700456 struct cons *c = (void *)(v ^ CONS_TAG);
swissChili8cfb7c42021-04-18 21:17:58 -0700457 return &c->car;
swissChilibed80922021-04-13 21:58:05 -0700458}
swissChilica107a02021-04-14 12:07:30 -0700459
swissChili53472e82021-05-08 16:06:32 -0700460value_t *cdrref(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700461{
swissChili53472e82021-05-08 16:06:32 -0700462 if (!consp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700463 return NULL;
464
swissChilib3ca4fb2021-04-20 10:33:00 -0700465 struct cons *c = (void *)(v ^ CONS_TAG);
swissChili8cfb7c42021-04-18 21:17:58 -0700466 return &c->cdr;
467}
468
swissChili53472e82021-05-08 16:06:32 -0700469bool nilp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700470{
471 return v == nil;
472}
473
swissChili53472e82021-05-08 16:06:32 -0700474int length(value_t v)
swissChilica107a02021-04-14 12:07:30 -0700475{
476 int i = 0;
477
swissChili53472e82021-05-08 16:06:32 -0700478 for (; !nilp(v); v = cdr(v))
swissChilica107a02021-04-14 12:07:30 -0700479 i++;
480
481 return i;
482}
swissChilib3ca4fb2021-04-20 10:33:00 -0700483
swissChili53472e82021-05-08 16:06:32 -0700484value_t elt(value_t v, int index)
swissChilib3ca4fb2021-04-20 10:33:00 -0700485{
swissChili53472e82021-05-08 16:06:32 -0700486 for (int i = 0; i < index; i++)
swissChilib3ca4fb2021-04-20 10:33:00 -0700487 {
swissChili53472e82021-05-08 16:06:32 -0700488 v = cdr(v);
swissChilib3ca4fb2021-04-20 10:33:00 -0700489 }
490
swissChili53472e82021-05-08 16:06:32 -0700491 return car(v);
swissChilib3ca4fb2021-04-20 10:33:00 -0700492}
swissChili8fc5e2f2021-04-22 13:45:10 -0700493
swissChili53472e82021-05-08 16:06:32 -0700494bool symstreq(value_t sym, char *str)
swissChili8fc5e2f2021-04-22 13:45:10 -0700495{
swissChili53472e82021-05-08 16:06:32 -0700496 if ((sym & HEAP_MASK) != SYMBOL_TAG)
swissChili8fc5e2f2021-04-22 13:45:10 -0700497 return false;
498
swissChili53472e82021-05-08 16:06:32 -0700499 return strcmp((char *)(sym ^ SYMBOL_TAG), str) == 0;
swissChili8fc5e2f2021-04-22 13:45:10 -0700500}
swissChilib8fd4712021-06-23 15:32:04 -0700501
502unsigned char make_pool()
503{
504 return ++max_pool;
505}
506
507unsigned char push_pool(unsigned char pool)
508{
509 unsigned char old = current_pool;
510 current_pool = pool;
511 return old;
512}
513
514void pop_pool(unsigned char pool)
515{
516 current_pool = pool;
517}
518
519bool pool_alive(unsigned char pool)
520{
521 return pool != 0;
522}