blob: f1a02ed266c6c65e2faab2ea023813fe9d232b29 [file] [log] [blame]
swissChili7a6f5eb2021-04-13 16:46:02 -07001#include "lisp.h"
swissChili6d02af42021-08-05 19:49:01 -07002#include "error.h"
swissChili8cfb7c42021-04-18 21:17:58 -07003#include "plat/plat.h"
4
swissChili7a6f5eb2021-04-13 16:46:02 -07005#include <ctype.h>
6#include <stdbool.h>
7#include <stdio.h>
swissChilibed80922021-04-13 21:58:05 -07008#include <stdlib.h>
9#include <string.h>
swissChili7e1393c2021-07-07 12:59:12 -070010#include <stdarg.h>
swissChili7a6f5eb2021-04-13 16:46:02 -070011
swissChili9e57da42021-06-15 22:22:46 -070012struct alloc *first_a = NULL, *last_a = NULL;
swissChili7a6f5eb2021-04-13 16:46:02 -070013
swissChili8cfb7c42021-04-18 21:17:58 -070014value_t nil = 0b00101111; // magic ;)
swissChili923b5362021-05-09 20:31:43 -070015value_t t = 1 << 3;
swissChilibed80922021-04-13 21:58:05 -070016
swissChilib8fd4712021-06-23 15:32:04 -070017unsigned char max_pool = 0, current_pool = 0;
18
swissChili53472e82021-05-08 16:06:32 -070019value_t intval(int i)
swissChili7a6f5eb2021-04-13 16:46:02 -070020{
swissChili8cfb7c42021-04-18 21:17:58 -070021 i <<= 2;
22 i |= INT_TAG;
23 return i;
24}
25
swissChilif1ba8c12021-07-02 18:45:38 -070026void add_this_alloc(struct alloc *a, int tag)
27{
28 a->type_tag = tag;
29 a->pool = current_pool;
30
31 if (last_a)
32 {
33 a->prev = last_a;
34 last_a->next = a;
35 a->next = NULL;
36 last_a = a;
37 }
38 else
39 {
40 a->prev = a->next = NULL;
41 first_a = last_a = a;
42 }
43}
44
swissChili53472e82021-05-08 16:06:32 -070045value_t cons(value_t car, value_t cdr)
swissChili8cfb7c42021-04-18 21:17:58 -070046{
swissChili9e57da42021-06-15 22:22:46 -070047 struct cons_alloc *item = malloc_aligned(sizeof(struct cons_alloc));
48 struct cons *c = &item->cons;
swissChili7a6f5eb2021-04-13 16:46:02 -070049
swissChilibed80922021-04-13 21:58:05 -070050 c->car = car;
51 c->cdr = cdr;
swissChili2999dd12021-07-02 14:19:53 -070052 c->line = 0;
53 c->name = NULL;
swissChilibed80922021-04-13 21:58:05 -070054
swissChilib3ca4fb2021-04-20 10:33:00 -070055 value_t v = (value_t)c;
swissChili8cfb7c42021-04-18 21:17:58 -070056 v |= CONS_TAG;
swissChili7a6f5eb2021-04-13 16:46:02 -070057
swissChilif1ba8c12021-07-02 18:45:38 -070058 add_this_alloc(&item->alloc, CONS_TAG);
59
swissChili7a6f5eb2021-04-13 16:46:02 -070060 return v;
61}
62
swissChili53472e82021-05-08 16:06:32 -070063void skipws(struct istream *is)
swissChili7a6f5eb2021-04-13 16:46:02 -070064{
swissChilib8fd4712021-06-23 15:32:04 -070065start:
swissChili53472e82021-05-08 16:06:32 -070066 while (isspace(is->peek(is)))
67 is->get(is);
swissChilib8fd4712021-06-23 15:32:04 -070068
69 if (is->peek(is) == ';')
70 {
71 while (is->get(is) != '\n')
swissChiliddc97542021-07-04 11:47:42 -070072 {
73 }
swissChilib8fd4712021-06-23 15:32:04 -070074
75 // Only time I ever use labels is for stuff like this. Compiler would
76 // probably optimize this if I used recursion but I don't want to
77 // bother.
78 goto start;
79 }
swissChili7a6f5eb2021-04-13 16:46:02 -070080}
81
swissChili53472e82021-05-08 16:06:32 -070082bool isallowedchar(char c)
swissChili7a6f5eb2021-04-13 16:46:02 -070083{
swissChilibed80922021-04-13 21:58:05 -070084 return (c >= '#' && c <= '\'') || (c >= '*' && c <= '/') ||
swissChili53e7cd12021-08-02 21:55:53 -070085 (c >= '<' && c <= '@');
swissChili7a6f5eb2021-04-13 16:46:02 -070086}
87
swissChili53472e82021-05-08 16:06:32 -070088bool issymstart(char c)
swissChili7a6f5eb2021-04-13 16:46:02 -070089{
swissChili53472e82021-05-08 16:06:32 -070090 return isalpha(c) || isallowedchar(c);
swissChili7a6f5eb2021-04-13 16:46:02 -070091}
92
swissChili53472e82021-05-08 16:06:32 -070093bool issym(char c)
swissChili7a6f5eb2021-04-13 16:46:02 -070094{
swissChili53472e82021-05-08 16:06:32 -070095 return isalpha(c) || isallowedchar(c) || isdigit(c);
swissChili7a6f5eb2021-04-13 16:46:02 -070096}
97
swissChili6d02af42021-08-05 19:49:01 -070098struct error readsym(struct istream *is, value_t *val)
swissChili7a6f5eb2021-04-13 16:46:02 -070099{
swissChili6d02af42021-08-05 19:49:01 -0700100 E_INIT();
101
swissChili53472e82021-05-08 16:06:32 -0700102 skipws(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700103
swissChili53472e82021-05-08 16:06:32 -0700104 if (!issymstart(is->peek(is)))
swissChili6d02af42021-08-05 19:49:01 -0700105 THROWSAFE(EEXPECTED);
swissChili7a6f5eb2021-04-13 16:46:02 -0700106
107 int size = 8;
swissChilif1ba8c12021-07-02 18:45:38 -0700108 struct alloc *a = malloc_aligned(size + sizeof(struct alloc));
swissChilif1ba8c12021-07-02 18:45:38 -0700109
110 char *s = (char *)(a + 1);
swissChili7a6f5eb2021-04-13 16:46:02 -0700111
swissChili53472e82021-05-08 16:06:32 -0700112 s[0] = is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700113
swissChili53472e82021-05-08 16:06:32 -0700114 for (int i = 1;; i++)
swissChili7a6f5eb2021-04-13 16:46:02 -0700115 {
swissChili53e7cd12021-08-02 21:55:53 -0700116 if (i >= size)
117 {
118 size *= 2;
119 a = realloc_aligned(a, size + sizeof(struct alloc));
120 s = (char *)(a + 1);
121 }
122
swissChili53472e82021-05-08 16:06:32 -0700123 if (issym(is->peek(is)))
swissChili7a6f5eb2021-04-13 16:46:02 -0700124 {
swissChili53472e82021-05-08 16:06:32 -0700125 s[i] = is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700126 }
127 else
128 {
swissChili53472e82021-05-08 16:06:32 -0700129 s[i] = 0;
swissChilib3ca4fb2021-04-20 10:33:00 -0700130 *val = (value_t)s;
swissChili8cfb7c42021-04-18 21:17:58 -0700131 *val |= SYMBOL_TAG;
swissChili7a6f5eb2021-04-13 16:46:02 -0700132
swissChili53e7cd12021-08-02 21:55:53 -0700133 add_this_alloc(a, SYMBOL_TAG);
swissChili6d02af42021-08-05 19:49:01 -0700134
135 OKAY();
swissChili7a6f5eb2021-04-13 16:46:02 -0700136 }
137 }
138}
139
swissChili6d02af42021-08-05 19:49:01 -0700140struct error readstr(struct istream *is, value_t *val)
swissChili7a6f5eb2021-04-13 16:46:02 -0700141{
swissChili6d02af42021-08-05 19:49:01 -0700142 E_INIT();
143
swissChili53472e82021-05-08 16:06:32 -0700144 skipws(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700145
swissChili53472e82021-05-08 16:06:32 -0700146 if (is->peek(is) != '"')
swissChili6d02af42021-08-05 19:49:01 -0700147 THROWSAFE(EEXPECTED);
swissChili7a6f5eb2021-04-13 16:46:02 -0700148
149 bool escape = false;
150 int size = 8;
swissChilif1ba8c12021-07-02 18:45:38 -0700151
152 struct alloc *a = malloc_aligned(size + sizeof(struct alloc));
swissChilif1ba8c12021-07-02 18:45:38 -0700153
154 char *s = (char *)(a + 1);
swissChili7a6f5eb2021-04-13 16:46:02 -0700155
swissChili53472e82021-05-08 16:06:32 -0700156 (void)is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700157
swissChili53472e82021-05-08 16:06:32 -0700158 for (int i = 0;; i++)
swissChili7a6f5eb2021-04-13 16:46:02 -0700159 {
swissChili53472e82021-05-08 16:06:32 -0700160 if (is->peek(is) != '"')
swissChili7a6f5eb2021-04-13 16:46:02 -0700161 {
swissChili53472e82021-05-08 16:06:32 -0700162 if (i >= size)
swissChili7a6f5eb2021-04-13 16:46:02 -0700163 {
swissChilibed80922021-04-13 21:58:05 -0700164 size *= 2;
swissChilif1ba8c12021-07-02 18:45:38 -0700165 a = realloc_aligned(a, size + sizeof(struct alloc));
166 s = (char *)(a + 1);
swissChili7a6f5eb2021-04-13 16:46:02 -0700167 }
swissChilibed80922021-04-13 21:58:05 -0700168
swissChili53472e82021-05-08 16:06:32 -0700169 char c = is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700170
swissChili53472e82021-05-08 16:06:32 -0700171 if (escape && c == 'n')
swissChili7a6f5eb2021-04-13 16:46:02 -0700172 c = '\n';
swissChili53472e82021-05-08 16:06:32 -0700173 else if (escape && c == '\\')
swissChili7a6f5eb2021-04-13 16:46:02 -0700174 c = '\\';
175
swissChili53472e82021-05-08 16:06:32 -0700176 if (c == '\\' && !escape)
swissChili7a6f5eb2021-04-13 16:46:02 -0700177 {
178 escape = true;
179 i--; // will be incremented again, UGLY.
180 }
181 else
182 {
183 escape = false;
swissChili53472e82021-05-08 16:06:32 -0700184 s[i] = c;
swissChili7a6f5eb2021-04-13 16:46:02 -0700185 }
186 }
187 else
188 {
swissChili7e1393c2021-07-07 12:59:12 -0700189 s[i] = '\0';
swissChili53472e82021-05-08 16:06:32 -0700190 is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700191
swissChilib3ca4fb2021-04-20 10:33:00 -0700192 *val = (value_t)s;
swissChili8cfb7c42021-04-18 21:17:58 -0700193 *val |= STRING_TAG;
swissChili7a6f5eb2021-04-13 16:46:02 -0700194
swissChili53e7cd12021-08-02 21:55:53 -0700195 add_this_alloc(a, STRING_TAG);
swissChili6d02af42021-08-05 19:49:01 -0700196
197 OKAY();
swissChili7a6f5eb2021-04-13 16:46:02 -0700198 }
199 }
200}
201
swissChili53472e82021-05-08 16:06:32 -0700202void printval(value_t v, int depth)
swissChili7a6f5eb2021-04-13 16:46:02 -0700203{
swissChili53472e82021-05-08 16:06:32 -0700204 for (int i = 0; i < depth; i++)
205 printf(" ");
swissChili7a6f5eb2021-04-13 16:46:02 -0700206
swissChili53472e82021-05-08 16:06:32 -0700207 if (symbolp(v))
swissChili7a6f5eb2021-04-13 16:46:02 -0700208 {
swissChili53472e82021-05-08 16:06:32 -0700209 printf("'%s\n", (char *)(v ^ SYMBOL_TAG));
swissChili8cfb7c42021-04-18 21:17:58 -0700210 }
swissChili53472e82021-05-08 16:06:32 -0700211 else if (stringp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700212 {
swissChili53472e82021-05-08 16:06:32 -0700213 printf("\"%s\"\n", (char *)(v ^ STRING_TAG));
swissChili8cfb7c42021-04-18 21:17:58 -0700214 }
swissChili53472e82021-05-08 16:06:32 -0700215 else if (integerp(v))
swissChili6eee4f92021-04-20 09:34:30 -0700216 {
swissChili53472e82021-05-08 16:06:32 -0700217 printf("%d\n", v >> 2);
swissChili6eee4f92021-04-20 09:34:30 -0700218 }
swissChili53472e82021-05-08 16:06:32 -0700219 else if (consp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700220 {
swissChili53472e82021-05-08 16:06:32 -0700221 if (listp(v))
swissChilibed80922021-04-13 21:58:05 -0700222 {
swissChili53472e82021-05-08 16:06:32 -0700223 printf("list:\n");
swissChilibed80922021-04-13 21:58:05 -0700224
swissChili53472e82021-05-08 16:06:32 -0700225 for (value_t n = v; !nilp(n); n = cdr(n))
swissChilibed80922021-04-13 21:58:05 -0700226 {
swissChili53472e82021-05-08 16:06:32 -0700227 printval(car(n), depth + 1);
swissChilibed80922021-04-13 21:58:05 -0700228 }
229 }
230 else
231 {
swissChili53472e82021-05-08 16:06:32 -0700232 printf("cons:\n");
233 printval(car(v), depth + 1);
234 printval(cdr(v), depth + 1);
swissChilibed80922021-04-13 21:58:05 -0700235 }
swissChili8cfb7c42021-04-18 21:17:58 -0700236 }
swissChili53472e82021-05-08 16:06:32 -0700237 else if (nilp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700238 {
swissChili53472e82021-05-08 16:06:32 -0700239 printf("nil\n");
swissChili8cfb7c42021-04-18 21:17:58 -0700240 }
swissChiliddc97542021-07-04 11:47:42 -0700241 else if (closurep(v))
242 {
243 struct closure *c = (void *)(v ^ CLOSURE_TAG);
244 printf("closure %p taking %d argument(s) and capturing %d value(s)\n",
swissChili15f1cae2021-07-05 19:08:47 -0700245 c->function, c->args->num_required, c->num_captured);
swissChiliddc97542021-07-04 11:47:42 -0700246 }
swissChili8cfb7c42021-04-18 21:17:58 -0700247 else
248 {
swissChili53472e82021-05-08 16:06:32 -0700249 printf("<unknown %d>\n", v);
swissChili7a6f5eb2021-04-13 16:46:02 -0700250 }
251}
252
swissChili6d02af42021-08-05 19:49:01 -0700253struct error readlist(struct istream *is, value_t *val)
swissChilibed80922021-04-13 21:58:05 -0700254{
swissChili6d02af42021-08-05 19:49:01 -0700255 E_INIT();
256 NEARIS(is);
257
swissChili53472e82021-05-08 16:06:32 -0700258 skipws(is);
swissChilibed80922021-04-13 21:58:05 -0700259
swissChili53472e82021-05-08 16:06:32 -0700260 if (is->peek(is) != '(')
swissChili6d02af42021-08-05 19:49:01 -0700261 THROWSAFE(EEXPECTED);
swissChilibed80922021-04-13 21:58:05 -0700262
swissChili53472e82021-05-08 16:06:32 -0700263 is->get(is);
swissChilibed80922021-04-13 21:58:05 -0700264
swissChili53472e82021-05-08 16:06:32 -0700265 *val = readn(is);
swissChilibed80922021-04-13 21:58:05 -0700266
swissChili53e7cd12021-08-02 21:55:53 -0700267 skipws(is);
268
swissChili53472e82021-05-08 16:06:32 -0700269 if (is->peek(is) != ')')
swissChilibed80922021-04-13 21:58:05 -0700270 {
swissChili6d02af42021-08-05 19:49:01 -0700271 NEARIS(is);
272 THROW(EEXPECTED, "Unterminated list");
swissChilibed80922021-04-13 21:58:05 -0700273 }
swissChili53472e82021-05-08 16:06:32 -0700274 is->get(is);
swissChilibed80922021-04-13 21:58:05 -0700275
swissChili6d02af42021-08-05 19:49:01 -0700276 OKAY();
swissChilibed80922021-04-13 21:58:05 -0700277}
278
swissChili6d02af42021-08-05 19:49:01 -0700279struct error readint(struct istream *is, value_t *val)
swissChili6eee4f92021-04-20 09:34:30 -0700280{
swissChili6d02af42021-08-05 19:49:01 -0700281 E_INIT();
282
swissChilib6c858c2021-06-30 21:12:43 -0700283 skipws(is);
284
swissChili6eee4f92021-04-20 09:34:30 -0700285 int number = 0;
286
swissChili53472e82021-05-08 16:06:32 -0700287 if (!isdigit(is->peek(is)))
swissChili6d02af42021-08-05 19:49:01 -0700288 THROWSAFE(EEXPECTED);
swissChili6eee4f92021-04-20 09:34:30 -0700289
swissChili53472e82021-05-08 16:06:32 -0700290 while (isdigit(is->peek(is)))
swissChili6eee4f92021-04-20 09:34:30 -0700291 {
292 number *= 10;
swissChili53472e82021-05-08 16:06:32 -0700293 number += is->get(is) - '0';
swissChili6eee4f92021-04-20 09:34:30 -0700294 }
295
swissChili53472e82021-05-08 16:06:32 -0700296 *val = intval(number);
swissChili6d02af42021-08-05 19:49:01 -0700297 OKAY();
swissChili6eee4f92021-04-20 09:34:30 -0700298}
299
swissChili6d02af42021-08-05 19:49:01 -0700300struct error readquote(struct istream *is, value_t *val)
swissChilib6c858c2021-06-30 21:12:43 -0700301{
swissChili6d02af42021-08-05 19:49:01 -0700302 E_INIT();
303
swissChilib6c858c2021-06-30 21:12:43 -0700304 skipws(is);
305
306 char c = is->peek(is);
307
swissChili74348422021-07-04 13:23:24 -0700308 if (c == '\'' || c == '`' || c == ',' || c == '#')
swissChilib6c858c2021-06-30 21:12:43 -0700309 {
310 is->get(is);
311
swissChili74348422021-07-04 13:23:24 -0700312 if (c == ',' && is->peek(is) == '@')
swissChilib6c858c2021-06-30 21:12:43 -0700313 {
314 // This is actually a splice
315 is->get(is);
316 c = '@';
317 }
swissChili74348422021-07-04 13:23:24 -0700318 else if (c == '#' && is->peek(is) == '\'')
319 {
320 is->get(is);
321 }
swissChilib6c858c2021-06-30 21:12:43 -0700322
323 // Read the next form and wrap it in the appropriate function
324
325 value_t wrapped;
swissChili6d02af42021-08-05 19:49:01 -0700326 NEARIS(is);
swissChilib6c858c2021-06-30 21:12:43 -0700327
swissChili36f2c692021-08-08 14:31:44 -0700328 struct error read_error = read1(is, &wrapped);
329 TRY_ELSE(read_error, EEXPECTED, "Expected a form after reader macro char %c", c);
swissChilib6c858c2021-06-30 21:12:43 -0700330
331 value_t symbol = nil;
332
333 switch (c)
334 {
335 case '\'':
336 symbol = symval("quote");
337 break;
338 case '`':
339 symbol = symval("backquote");
340 break;
341 case ',':
342 symbol = symval("unquote");
343 break;
344 case '@':
swissChili6b47b6d2021-06-30 22:08:55 -0700345 symbol = symval("unquote-splice");
swissChilib6c858c2021-06-30 21:12:43 -0700346 break;
swissChili74348422021-07-04 13:23:24 -0700347 case '#':
348 symbol = symval("function");
349 break;
350 default:
swissChili6d02af42021-08-05 19:49:01 -0700351 NEARIS(is);
352 THROW(EINVALID, "Invalid reader macro char %c", c);
swissChilib6c858c2021-06-30 21:12:43 -0700353 }
354
355 *val = cons(symbol, cons(wrapped, nil));
356
swissChili6d02af42021-08-05 19:49:01 -0700357 OKAY();
swissChilib6c858c2021-06-30 21:12:43 -0700358 }
359 else
360 {
swissChili6d02af42021-08-05 19:49:01 -0700361 THROWSAFE(EEXPECTED);
swissChilib6c858c2021-06-30 21:12:43 -0700362 }
363}
364
swissChili6d02af42021-08-05 19:49:01 -0700365struct error read1(struct istream *is, value_t *val)
swissChili7a6f5eb2021-04-13 16:46:02 -0700366{
swissChili6d02af42021-08-05 19:49:01 -0700367 E_INIT();
swissChilib6c858c2021-06-30 21:12:43 -0700368
swissChili6d02af42021-08-05 19:49:01 -0700369 NEARIS(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700370
swissChili6d02af42021-08-05 19:49:01 -0700371 OKAY_IF(readquote(is, val));
372 OKAY_IF(readsym(is, val));
373 OKAY_IF(readstr(is, val));
374 OKAY_IF(readint(is, val));
375 OKAY_IF(readlist(is, val));
swissChili7a6f5eb2021-04-13 16:46:02 -0700376
swissChili6d02af42021-08-05 19:49:01 -0700377 THROWSAFE(EEXPECTED);
swissChili7a6f5eb2021-04-13 16:46:02 -0700378}
379
swissChili2999dd12021-07-02 14:19:53 -0700380void set_cons_info(value_t cons, int line, char *name)
381{
382 if (!consp(cons))
383 return;
384
385 struct cons *ca = (void *)(cons ^ CONS_TAG);
386
387 ca->line = line;
388 ca->name = name;
389}
390
swissChili53472e82021-05-08 16:06:32 -0700391value_t readn(struct istream *is)
swissChilibed80922021-04-13 21:58:05 -0700392{
swissChili8cfb7c42021-04-18 21:17:58 -0700393 value_t first = nil;
394 value_t *last = &first;
swissChilibed80922021-04-13 21:58:05 -0700395
swissChili8cfb7c42021-04-18 21:17:58 -0700396 value_t read_val;
swissChilibed80922021-04-13 21:58:05 -0700397
swissChili6d02af42021-08-05 19:49:01 -0700398 while (IS_OKAY(read1(is, &read_val)))
swissChilibed80922021-04-13 21:58:05 -0700399 {
swissChili2999dd12021-07-02 14:19:53 -0700400 int line;
401 char *file;
402
403 is->getpos(is, &line, &file);
swissChili53472e82021-05-08 16:06:32 -0700404 *last = cons(read_val, nil);
swissChili2999dd12021-07-02 14:19:53 -0700405 set_cons_info(*last, line, file);
406
swissChili53472e82021-05-08 16:06:32 -0700407 last = cdrref(*last);
swissChilibed80922021-04-13 21:58:05 -0700408 }
409
410 return first;
411}
412
swissChili53472e82021-05-08 16:06:32 -0700413bool startswith(struct istream *s, char *pattern)
swissChili7a6f5eb2021-04-13 16:46:02 -0700414{
swissChili53472e82021-05-08 16:06:32 -0700415 char *check = strdup(pattern);
416 s->read(s, check, strlen(pattern));
swissChili7a6f5eb2021-04-13 16:46:02 -0700417
swissChili53472e82021-05-08 16:06:32 -0700418 bool res = strcmp(check, pattern) == 0;
419 free(check);
swissChili7a6f5eb2021-04-13 16:46:02 -0700420
421 return res;
422}
swissChilibed80922021-04-13 21:58:05 -0700423
swissChilif1ba8c12021-07-02 18:45:38 -0700424static value_t strptrval(char *str, int tag)
swissChilibed80922021-04-13 21:58:05 -0700425{
swissChili8cfb7c42021-04-18 21:17:58 -0700426 value_t v;
427
swissChilif1ba8c12021-07-02 18:45:38 -0700428 struct alloc *al = malloc_aligned(strlen(str) + 1 + sizeof(struct alloc));
429 add_this_alloc(al, SYMBOL_TAG);
430
431 char *a = (char *)(al + 1);
432
swissChilib6c858c2021-06-30 21:12:43 -0700433 strcpy(a, str);
swissChilib3ca4fb2021-04-20 10:33:00 -0700434 v = (value_t)a;
swissChilif1ba8c12021-07-02 18:45:38 -0700435 v |= tag;
swissChilibed80922021-04-13 21:58:05 -0700436
437 return v;
438}
439
swissChilif1ba8c12021-07-02 18:45:38 -0700440value_t strval(char *str)
441{
442 return strptrval(str, STRING_TAG);
443}
444
swissChilib6c858c2021-06-30 21:12:43 -0700445value_t symval(char *str)
446{
swissChilif1ba8c12021-07-02 18:45:38 -0700447 return strptrval(str, SYMBOL_TAG);
swissChilib6c858c2021-06-30 21:12:43 -0700448}
449
swissChili53472e82021-05-08 16:06:32 -0700450bool integerp(value_t v)
swissChilibed80922021-04-13 21:58:05 -0700451{
swissChili8cfb7c42021-04-18 21:17:58 -0700452 return (v & INT_MASK) == INT_TAG;
453}
swissChilibed80922021-04-13 21:58:05 -0700454
swissChili53472e82021-05-08 16:06:32 -0700455bool symbolp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700456{
457 return (v & HEAP_MASK) == SYMBOL_TAG;
458}
459
swissChili53472e82021-05-08 16:06:32 -0700460bool stringp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700461{
462 return (v & HEAP_MASK) == STRING_TAG;
463}
464
swissChili53472e82021-05-08 16:06:32 -0700465bool consp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700466{
467 return (v & HEAP_MASK) == CONS_TAG;
468}
469
swissChili9e57da42021-06-15 22:22:46 -0700470bool heapp(value_t v)
471{
swissChiliddc97542021-07-04 11:47:42 -0700472 return consp(v) || stringp(v) || symbolp(v) || closurep(v);
473}
474
475bool closurep(value_t v)
476{
477 return (v & HEAP_MASK) == CLOSURE_TAG;
swissChili9e57da42021-06-15 22:22:46 -0700478}
479
swissChili53472e82021-05-08 16:06:32 -0700480bool listp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700481{
482 value_t next = v;
483
swissChili53472e82021-05-08 16:06:32 -0700484 while (consp(next))
swissChilibed80922021-04-13 21:58:05 -0700485 {
swissChili53472e82021-05-08 16:06:32 -0700486 next = cdr(next);
swissChilibed80922021-04-13 21:58:05 -0700487 }
488
swissChili53472e82021-05-08 16:06:32 -0700489 return nilp(next);
swissChilibed80922021-04-13 21:58:05 -0700490}
491
swissChili53472e82021-05-08 16:06:32 -0700492value_t car(value_t v)
swissChilibed80922021-04-13 21:58:05 -0700493{
swissChili53472e82021-05-08 16:06:32 -0700494 if (!consp(v))
swissChilibed80922021-04-13 21:58:05 -0700495 return nil;
496
swissChili53472e82021-05-08 16:06:32 -0700497 return *carref(v);
swissChilibed80922021-04-13 21:58:05 -0700498}
499
swissChili53472e82021-05-08 16:06:32 -0700500value_t cdr(value_t v)
swissChilibed80922021-04-13 21:58:05 -0700501{
swissChili53472e82021-05-08 16:06:32 -0700502 if (!consp(v))
swissChilibed80922021-04-13 21:58:05 -0700503 return nil;
504
swissChili53472e82021-05-08 16:06:32 -0700505 return *cdrref(v);
swissChilibed80922021-04-13 21:58:05 -0700506}
507
swissChili53472e82021-05-08 16:06:32 -0700508value_t *carref(value_t v)
swissChilibed80922021-04-13 21:58:05 -0700509{
swissChili53472e82021-05-08 16:06:32 -0700510 if (!consp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700511 return NULL;
512
swissChilib3ca4fb2021-04-20 10:33:00 -0700513 struct cons *c = (void *)(v ^ CONS_TAG);
swissChili8cfb7c42021-04-18 21:17:58 -0700514 return &c->car;
swissChilibed80922021-04-13 21:58:05 -0700515}
swissChilica107a02021-04-14 12:07:30 -0700516
swissChili53472e82021-05-08 16:06:32 -0700517value_t *cdrref(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700518{
swissChili53472e82021-05-08 16:06:32 -0700519 if (!consp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700520 return NULL;
521
swissChilib3ca4fb2021-04-20 10:33:00 -0700522 struct cons *c = (void *)(v ^ CONS_TAG);
swissChili8cfb7c42021-04-18 21:17:58 -0700523 return &c->cdr;
524}
525
swissChili53472e82021-05-08 16:06:32 -0700526bool nilp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700527{
528 return v == nil;
529}
530
swissChili53472e82021-05-08 16:06:32 -0700531int length(value_t v)
swissChilica107a02021-04-14 12:07:30 -0700532{
533 int i = 0;
534
swissChili53472e82021-05-08 16:06:32 -0700535 for (; !nilp(v); v = cdr(v))
swissChilica107a02021-04-14 12:07:30 -0700536 i++;
537
538 return i;
539}
swissChilib3ca4fb2021-04-20 10:33:00 -0700540
swissChili53472e82021-05-08 16:06:32 -0700541value_t elt(value_t v, int index)
swissChilib3ca4fb2021-04-20 10:33:00 -0700542{
swissChili53472e82021-05-08 16:06:32 -0700543 for (int i = 0; i < index; i++)
swissChilib3ca4fb2021-04-20 10:33:00 -0700544 {
swissChili53472e82021-05-08 16:06:32 -0700545 v = cdr(v);
swissChilib3ca4fb2021-04-20 10:33:00 -0700546 }
547
swissChili53472e82021-05-08 16:06:32 -0700548 return car(v);
swissChilib3ca4fb2021-04-20 10:33:00 -0700549}
swissChili8fc5e2f2021-04-22 13:45:10 -0700550
swissChili53472e82021-05-08 16:06:32 -0700551bool symstreq(value_t sym, char *str)
swissChili8fc5e2f2021-04-22 13:45:10 -0700552{
swissChili53472e82021-05-08 16:06:32 -0700553 if ((sym & HEAP_MASK) != SYMBOL_TAG)
swissChili8fc5e2f2021-04-22 13:45:10 -0700554 return false;
555
swissChili53472e82021-05-08 16:06:32 -0700556 return strcmp((char *)(sym ^ SYMBOL_TAG), str) == 0;
swissChili8fc5e2f2021-04-22 13:45:10 -0700557}
swissChilib8fd4712021-06-23 15:32:04 -0700558
559unsigned char make_pool()
560{
561 return ++max_pool;
562}
563
564unsigned char push_pool(unsigned char pool)
565{
566 unsigned char old = current_pool;
567 current_pool = pool;
568 return old;
569}
570
571void pop_pool(unsigned char pool)
572{
573 current_pool = pool;
574}
575
576bool pool_alive(unsigned char pool)
577{
578 return pool != 0;
579}
swissChilif1ba8c12021-07-02 18:45:38 -0700580
swissChili36f2c692021-08-08 14:31:44 -0700581void add_to_pool(value_t form)
582{
583 if (!heapp(form))
584 return;
585
586 struct alloc *a = (void *)(form & ~0b111);
587 a[-1].pool = current_pool;
588}
589
swissChilif1ba8c12021-07-02 18:45:38 -0700590int cons_line(value_t val)
591{
592 if (!consp(val))
593 return 0;
594
595 struct cons *c = (void *)(val ^ CONS_TAG);
596
597 return c->line;
598}
599
600char *cons_file(value_t val)
601{
602 if (!consp(val))
603 return NULL;
604
605 struct cons *c = (void *)(val ^ CONS_TAG);
606
607 return c->name;
608}
swissChiliddc97542021-07-04 11:47:42 -0700609
swissChili15f1cae2021-07-05 19:08:47 -0700610value_t create_closure(void *code, struct args *args, int ncaptures)
swissChiliddc97542021-07-04 11:47:42 -0700611{
612 struct closure_alloc *ca = malloc_aligned(sizeof(struct closure_alloc) +
613 ncaptures * sizeof(value_t));
614
615 ca->closure.function = code;
swissChili15f1cae2021-07-05 19:08:47 -0700616 ca->closure.args = args;
swissChiliddc97542021-07-04 11:47:42 -0700617 ca->closure.num_captured = ncaptures;
618
619 add_this_alloc(&ca->alloc, CLOSURE_TAG);
620
621 return (value_t)(&ca->closure) | CLOSURE_TAG;
622}
623
624void set_closure_capture_variable(int index, value_t value, value_t closure)
625{
626 if (!closurep(closure))
627 return;
628
629 struct closure *c = (void *)(closure ^ CLOSURE_TAG);
630
631 c->data[index] = value;
632}
swissChili15f1cae2021-07-05 19:08:47 -0700633
634value_t cxdr(value_t v, int index)
635{
636 if (!listp(v) || index >= length(v))
637 return nil;
638
639 for (int i = 0; i < index; i++)
640 {
641 v = cdr(v);
642 }
643
644 return v;
645}
646
647value_t *cxdrref(value_t *v, int index)
648{
649 if (!listp(*v) || index >= length(*v))
650 return NULL;
651
652 value_t *p = v;
653
654 for (int i = 0; i < index; i++)
655 {
656 p = cdrref(*p);
657 }
658
659 return p;
660}
661
662value_t deep_copy(value_t val)
663{
664 if (integerp(val) || val == nil || val == t)
665 {
666 return val;
667 }
668 else if (symbolp(val))
669 {
670 return symval((char *)(val ^ SYMBOL_TAG));
671 }
672 else if (stringp(val))
673 {
674 return strval((char *)(val ^ STRING_TAG));
675 }
676 else if (consp(val))
677 {
678 return cons(deep_copy(car(val)), deep_copy(cdr(val)));
679 }
680 else if (closurep(val))
681 {
682 struct closure *c = (void *)(val ^ CLOSURE_TAG);
683 value_t new = create_closure(c->function, c->args, c->num_captured);
684 struct closure *new_c = (void *)(new ^ CLOSURE_TAG);
685
686 for (int i = 0; i < c->num_captured; i++)
687 {
688 new_c->data[i] = deep_copy(c->data[i]);
689 }
690
691 return new;
692 }
693 else
694 {
swissChili6d02af42021-08-05 19:49:01 -0700695 fprintf(stderr, "Don't know how to deep copy this, sorry... please report this bug :)");
696 return nil;
swissChili15f1cae2021-07-05 19:08:47 -0700697 }
698}
swissChilia7568dc2021-08-08 16:52:52 -0700699
700value_t *nilptr(value_t val)
701{
702 if (!listp(val))
703 return NULL;
704
705 if (nilp(val))
706 return NULL;
707
708 value_t *p;
709
710 for (p = cdrref(val); !nilp(*p); p = cdrref(*p))
711 {
712 }
713
714 return p;
715}
716
717value_t merge2(value_t front, value_t back)
718{
719 if (!listp(front) || !listp(back))
720 return nil;
721
722 if (nilp(front))
723 return back;
724 else
725 *nilptr(front) = back;
726
727 return front;
728}