blob: 6299e0354dbdf9560091e4acc4399d0037dd9e76 [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{
swissChilic0acce42022-07-31 13:38:17 -070028 a->mark = -1;
swissChilif1ba8c12021-07-02 18:45:38 -070029 a->type_tag = tag;
30 a->pool = current_pool;
31
32 if (last_a)
33 {
34 a->prev = last_a;
35 last_a->next = a;
36 a->next = NULL;
37 last_a = a;
38 }
39 else
40 {
41 a->prev = a->next = NULL;
42 first_a = last_a = a;
43 }
44}
45
swissChili53472e82021-05-08 16:06:32 -070046value_t cons(value_t car, value_t cdr)
swissChili8cfb7c42021-04-18 21:17:58 -070047{
swissChili9e57da42021-06-15 22:22:46 -070048 struct cons_alloc *item = malloc_aligned(sizeof(struct cons_alloc));
49 struct cons *c = &item->cons;
swissChili7a6f5eb2021-04-13 16:46:02 -070050
swissChilibed80922021-04-13 21:58:05 -070051 c->car = car;
52 c->cdr = cdr;
swissChili2999dd12021-07-02 14:19:53 -070053 c->line = 0;
54 c->name = NULL;
swissChilibed80922021-04-13 21:58:05 -070055
swissChilib3ca4fb2021-04-20 10:33:00 -070056 value_t v = (value_t)c;
swissChili8cfb7c42021-04-18 21:17:58 -070057 v |= CONS_TAG;
swissChili7a6f5eb2021-04-13 16:46:02 -070058
swissChilif1ba8c12021-07-02 18:45:38 -070059 add_this_alloc(&item->alloc, CONS_TAG);
60
swissChili7a6f5eb2021-04-13 16:46:02 -070061 return v;
62}
63
swissChili53472e82021-05-08 16:06:32 -070064void skipws(struct istream *is)
swissChili7a6f5eb2021-04-13 16:46:02 -070065{
swissChilib8fd4712021-06-23 15:32:04 -070066start:
swissChili53472e82021-05-08 16:06:32 -070067 while (isspace(is->peek(is)))
68 is->get(is);
swissChilib8fd4712021-06-23 15:32:04 -070069
70 if (is->peek(is) == ';')
71 {
72 while (is->get(is) != '\n')
swissChiliddc97542021-07-04 11:47:42 -070073 {
74 }
swissChilib8fd4712021-06-23 15:32:04 -070075
76 // Only time I ever use labels is for stuff like this. Compiler would
77 // probably optimize this if I used recursion but I don't want to
78 // bother.
79 goto start;
80 }
swissChili7a6f5eb2021-04-13 16:46:02 -070081}
82
swissChili53472e82021-05-08 16:06:32 -070083bool isallowedchar(char c)
swissChili7a6f5eb2021-04-13 16:46:02 -070084{
swissChilibed80922021-04-13 21:58:05 -070085 return (c >= '#' && c <= '\'') || (c >= '*' && c <= '/') ||
swissChili53e7cd12021-08-02 21:55:53 -070086 (c >= '<' && c <= '@');
swissChili7a6f5eb2021-04-13 16:46:02 -070087}
88
swissChili53472e82021-05-08 16:06:32 -070089bool issymstart(char c)
swissChili7a6f5eb2021-04-13 16:46:02 -070090{
swissChili53472e82021-05-08 16:06:32 -070091 return isalpha(c) || isallowedchar(c);
swissChili7a6f5eb2021-04-13 16:46:02 -070092}
93
swissChili53472e82021-05-08 16:06:32 -070094bool issym(char c)
swissChili7a6f5eb2021-04-13 16:46:02 -070095{
swissChili53472e82021-05-08 16:06:32 -070096 return isalpha(c) || isallowedchar(c) || isdigit(c);
swissChili7a6f5eb2021-04-13 16:46:02 -070097}
98
swissChili6d02af42021-08-05 19:49:01 -070099struct error readsym(struct istream *is, value_t *val)
swissChili7a6f5eb2021-04-13 16:46:02 -0700100{
swissChili6d02af42021-08-05 19:49:01 -0700101 E_INIT();
102
swissChili53472e82021-05-08 16:06:32 -0700103 skipws(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700104
swissChili53472e82021-05-08 16:06:32 -0700105 if (!issymstart(is->peek(is)))
swissChili6d02af42021-08-05 19:49:01 -0700106 THROWSAFE(EEXPECTED);
swissChili7a6f5eb2021-04-13 16:46:02 -0700107
108 int size = 8;
swissChilif1ba8c12021-07-02 18:45:38 -0700109 struct alloc *a = malloc_aligned(size + sizeof(struct alloc));
swissChilif1ba8c12021-07-02 18:45:38 -0700110
111 char *s = (char *)(a + 1);
swissChili7a6f5eb2021-04-13 16:46:02 -0700112
swissChili53472e82021-05-08 16:06:32 -0700113 s[0] = is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700114
swissChili53472e82021-05-08 16:06:32 -0700115 for (int i = 1;; i++)
swissChili7a6f5eb2021-04-13 16:46:02 -0700116 {
swissChili53e7cd12021-08-02 21:55:53 -0700117 if (i >= size)
118 {
119 size *= 2;
120 a = realloc_aligned(a, size + sizeof(struct alloc));
121 s = (char *)(a + 1);
122 }
123
swissChili53472e82021-05-08 16:06:32 -0700124 if (issym(is->peek(is)))
swissChili7a6f5eb2021-04-13 16:46:02 -0700125 {
swissChili53472e82021-05-08 16:06:32 -0700126 s[i] = is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700127 }
128 else
129 {
swissChili53472e82021-05-08 16:06:32 -0700130 s[i] = 0;
swissChilib3ca4fb2021-04-20 10:33:00 -0700131 *val = (value_t)s;
swissChili8cfb7c42021-04-18 21:17:58 -0700132 *val |= SYMBOL_TAG;
swissChili7a6f5eb2021-04-13 16:46:02 -0700133
swissChili53e7cd12021-08-02 21:55:53 -0700134 add_this_alloc(a, SYMBOL_TAG);
swissChili6d02af42021-08-05 19:49:01 -0700135
136 OKAY();
swissChili7a6f5eb2021-04-13 16:46:02 -0700137 }
138 }
139}
140
swissChili6d02af42021-08-05 19:49:01 -0700141struct error readstr(struct istream *is, value_t *val)
swissChili7a6f5eb2021-04-13 16:46:02 -0700142{
swissChili6d02af42021-08-05 19:49:01 -0700143 E_INIT();
144
swissChili53472e82021-05-08 16:06:32 -0700145 skipws(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700146
swissChili53472e82021-05-08 16:06:32 -0700147 if (is->peek(is) != '"')
swissChili6d02af42021-08-05 19:49:01 -0700148 THROWSAFE(EEXPECTED);
swissChili7a6f5eb2021-04-13 16:46:02 -0700149
150 bool escape = false;
151 int size = 8;
swissChilif1ba8c12021-07-02 18:45:38 -0700152
153 struct alloc *a = malloc_aligned(size + sizeof(struct alloc));
swissChilif1ba8c12021-07-02 18:45:38 -0700154
155 char *s = (char *)(a + 1);
swissChili7a6f5eb2021-04-13 16:46:02 -0700156
swissChili53472e82021-05-08 16:06:32 -0700157 (void)is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700158
swissChili53472e82021-05-08 16:06:32 -0700159 for (int i = 0;; i++)
swissChili7a6f5eb2021-04-13 16:46:02 -0700160 {
swissChili53472e82021-05-08 16:06:32 -0700161 if (is->peek(is) != '"')
swissChili7a6f5eb2021-04-13 16:46:02 -0700162 {
swissChili53472e82021-05-08 16:06:32 -0700163 if (i >= size)
swissChili7a6f5eb2021-04-13 16:46:02 -0700164 {
swissChilibed80922021-04-13 21:58:05 -0700165 size *= 2;
swissChilif1ba8c12021-07-02 18:45:38 -0700166 a = realloc_aligned(a, size + sizeof(struct alloc));
167 s = (char *)(a + 1);
swissChili7a6f5eb2021-04-13 16:46:02 -0700168 }
swissChilibed80922021-04-13 21:58:05 -0700169
swissChili53472e82021-05-08 16:06:32 -0700170 char c = is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700171
swissChili53472e82021-05-08 16:06:32 -0700172 if (escape && c == 'n')
swissChili7a6f5eb2021-04-13 16:46:02 -0700173 c = '\n';
swissChili53472e82021-05-08 16:06:32 -0700174 else if (escape && c == '\\')
swissChili7a6f5eb2021-04-13 16:46:02 -0700175 c = '\\';
176
swissChili53472e82021-05-08 16:06:32 -0700177 if (c == '\\' && !escape)
swissChili7a6f5eb2021-04-13 16:46:02 -0700178 {
179 escape = true;
180 i--; // will be incremented again, UGLY.
181 }
182 else
183 {
184 escape = false;
swissChili53472e82021-05-08 16:06:32 -0700185 s[i] = c;
swissChili7a6f5eb2021-04-13 16:46:02 -0700186 }
187 }
188 else
189 {
swissChili7e1393c2021-07-07 12:59:12 -0700190 s[i] = '\0';
swissChili53472e82021-05-08 16:06:32 -0700191 is->get(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700192
swissChilib3ca4fb2021-04-20 10:33:00 -0700193 *val = (value_t)s;
swissChili8cfb7c42021-04-18 21:17:58 -0700194 *val |= STRING_TAG;
swissChili7a6f5eb2021-04-13 16:46:02 -0700195
swissChili53e7cd12021-08-02 21:55:53 -0700196 add_this_alloc(a, STRING_TAG);
swissChili6d02af42021-08-05 19:49:01 -0700197
198 OKAY();
swissChili7a6f5eb2021-04-13 16:46:02 -0700199 }
200 }
201}
202
swissChilie0d4b902022-07-30 17:32:01 -0700203void printval_ol(value_t v)
swissChili7a6f5eb2021-04-13 16:46:02 -0700204{
swissChilie0d4b902022-07-30 17:32:01 -0700205// for (int i = 0; i < depth; i++)
206// printf(" ");
swissChili7a6f5eb2021-04-13 16:46:02 -0700207
swissChili53472e82021-05-08 16:06:32 -0700208 if (symbolp(v))
swissChili7a6f5eb2021-04-13 16:46:02 -0700209 {
swissChilie0d4b902022-07-30 17:32:01 -0700210 printf("%s", (char *)(v ^ SYMBOL_TAG));
swissChili8cfb7c42021-04-18 21:17:58 -0700211 }
swissChili53472e82021-05-08 16:06:32 -0700212 else if (stringp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700213 {
swissChilie0d4b902022-07-30 17:32:01 -0700214 printf("\"%s\"", (char *)(v ^ STRING_TAG));
swissChili8cfb7c42021-04-18 21:17:58 -0700215 }
swissChili53472e82021-05-08 16:06:32 -0700216 else if (integerp(v))
swissChili6eee4f92021-04-20 09:34:30 -0700217 {
swissChilie0d4b902022-07-30 17:32:01 -0700218 printf("%d", v >> 2);
swissChili6eee4f92021-04-20 09:34:30 -0700219 }
swissChili53472e82021-05-08 16:06:32 -0700220 else if (consp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700221 {
swissChili53472e82021-05-08 16:06:32 -0700222 if (listp(v))
swissChilibed80922021-04-13 21:58:05 -0700223 {
swissChilie0d4b902022-07-30 17:32:01 -0700224 printf("(");
225 printval_ol(car(v));
swissChilibed80922021-04-13 21:58:05 -0700226
swissChilie0d4b902022-07-30 17:32:01 -0700227 for (value_t n = cdr(v); !nilp(n); n = cdr(n))
swissChilibed80922021-04-13 21:58:05 -0700228 {
swissChilie0d4b902022-07-30 17:32:01 -0700229 printf(" ");
230 printval_ol(car(n));
swissChilibed80922021-04-13 21:58:05 -0700231 }
swissChilie0d4b902022-07-30 17:32:01 -0700232
233 printf(")");
swissChilibed80922021-04-13 21:58:05 -0700234 }
235 else
236 {
swissChilie0d4b902022-07-30 17:32:01 -0700237 printf("(");
238 printval_ol(car(v));
239 printf(" . ");
240 printval_ol(cdr(v));
241 printf(")");
swissChilibed80922021-04-13 21:58:05 -0700242 }
swissChili8cfb7c42021-04-18 21:17:58 -0700243 }
swissChili53472e82021-05-08 16:06:32 -0700244 else if (nilp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700245 {
swissChili53472e82021-05-08 16:06:32 -0700246 printf("nil\n");
swissChili8cfb7c42021-04-18 21:17:58 -0700247 }
swissChiliddc97542021-07-04 11:47:42 -0700248 else if (closurep(v))
249 {
250 struct closure *c = (void *)(v ^ CLOSURE_TAG);
swissChilie0d4b902022-07-30 17:32:01 -0700251 printf("<closure %p (%d) %d>",
swissChili15f1cae2021-07-05 19:08:47 -0700252 c->function, c->args->num_required, c->num_captured);
swissChiliddc97542021-07-04 11:47:42 -0700253 }
swissChili8cfb7c42021-04-18 21:17:58 -0700254 else
255 {
swissChilie0d4b902022-07-30 17:32:01 -0700256 printf("<unknown %d>", v);
swissChili7a6f5eb2021-04-13 16:46:02 -0700257 }
258}
259
swissChilie0d4b902022-07-30 17:32:01 -0700260void printval(value_t v, int depth)
261{
262 UNUSED(depth);
263 printval_ol(v);
264 printf("\n");
265}
266
swissChili6d02af42021-08-05 19:49:01 -0700267struct error readlist(struct istream *is, value_t *val)
swissChilibed80922021-04-13 21:58:05 -0700268{
swissChili6d02af42021-08-05 19:49:01 -0700269 E_INIT();
270 NEARIS(is);
271
swissChili53472e82021-05-08 16:06:32 -0700272 skipws(is);
swissChilibed80922021-04-13 21:58:05 -0700273
swissChili53472e82021-05-08 16:06:32 -0700274 if (is->peek(is) != '(')
swissChili6d02af42021-08-05 19:49:01 -0700275 THROWSAFE(EEXPECTED);
swissChilibed80922021-04-13 21:58:05 -0700276
swissChili53472e82021-05-08 16:06:32 -0700277 is->get(is);
swissChilibed80922021-04-13 21:58:05 -0700278
swissChili53472e82021-05-08 16:06:32 -0700279 *val = readn(is);
swissChilibed80922021-04-13 21:58:05 -0700280
swissChili53e7cd12021-08-02 21:55:53 -0700281 skipws(is);
282
swissChili53472e82021-05-08 16:06:32 -0700283 if (is->peek(is) != ')')
swissChilibed80922021-04-13 21:58:05 -0700284 {
swissChili6d02af42021-08-05 19:49:01 -0700285 NEARIS(is);
286 THROW(EEXPECTED, "Unterminated list");
swissChilibed80922021-04-13 21:58:05 -0700287 }
swissChili53472e82021-05-08 16:06:32 -0700288 is->get(is);
swissChilibed80922021-04-13 21:58:05 -0700289
swissChili6d02af42021-08-05 19:49:01 -0700290 OKAY();
swissChilibed80922021-04-13 21:58:05 -0700291}
292
swissChili6d02af42021-08-05 19:49:01 -0700293struct error readint(struct istream *is, value_t *val)
swissChili6eee4f92021-04-20 09:34:30 -0700294{
swissChili6d02af42021-08-05 19:49:01 -0700295 E_INIT();
296
swissChilib6c858c2021-06-30 21:12:43 -0700297 skipws(is);
298
swissChili6eee4f92021-04-20 09:34:30 -0700299 int number = 0;
300
swissChili53472e82021-05-08 16:06:32 -0700301 if (!isdigit(is->peek(is)))
swissChili6d02af42021-08-05 19:49:01 -0700302 THROWSAFE(EEXPECTED);
swissChili6eee4f92021-04-20 09:34:30 -0700303
swissChili53472e82021-05-08 16:06:32 -0700304 while (isdigit(is->peek(is)))
swissChili6eee4f92021-04-20 09:34:30 -0700305 {
306 number *= 10;
swissChili53472e82021-05-08 16:06:32 -0700307 number += is->get(is) - '0';
swissChili6eee4f92021-04-20 09:34:30 -0700308 }
309
swissChili53472e82021-05-08 16:06:32 -0700310 *val = intval(number);
swissChili6d02af42021-08-05 19:49:01 -0700311 OKAY();
swissChili6eee4f92021-04-20 09:34:30 -0700312}
313
swissChili6d02af42021-08-05 19:49:01 -0700314struct error readquote(struct istream *is, value_t *val)
swissChilib6c858c2021-06-30 21:12:43 -0700315{
swissChili6d02af42021-08-05 19:49:01 -0700316 E_INIT();
317
swissChilib6c858c2021-06-30 21:12:43 -0700318 skipws(is);
319
320 char c = is->peek(is);
321
swissChili74348422021-07-04 13:23:24 -0700322 if (c == '\'' || c == '`' || c == ',' || c == '#')
swissChilib6c858c2021-06-30 21:12:43 -0700323 {
324 is->get(is);
325
swissChili74348422021-07-04 13:23:24 -0700326 if (c == ',' && is->peek(is) == '@')
swissChilib6c858c2021-06-30 21:12:43 -0700327 {
328 // This is actually a splice
329 is->get(is);
330 c = '@';
331 }
swissChili74348422021-07-04 13:23:24 -0700332 else if (c == '#' && is->peek(is) == '\'')
333 {
334 is->get(is);
335 }
swissChilib6c858c2021-06-30 21:12:43 -0700336
337 // Read the next form and wrap it in the appropriate function
338
339 value_t wrapped;
swissChili6d02af42021-08-05 19:49:01 -0700340 NEARIS(is);
swissChilib6c858c2021-06-30 21:12:43 -0700341
swissChili36f2c692021-08-08 14:31:44 -0700342 struct error read_error = read1(is, &wrapped);
343 TRY_ELSE(read_error, EEXPECTED, "Expected a form after reader macro char %c", c);
swissChilib6c858c2021-06-30 21:12:43 -0700344
345 value_t symbol = nil;
346
347 switch (c)
348 {
349 case '\'':
350 symbol = symval("quote");
351 break;
352 case '`':
353 symbol = symval("backquote");
354 break;
355 case ',':
356 symbol = symval("unquote");
357 break;
358 case '@':
swissChili6b47b6d2021-06-30 22:08:55 -0700359 symbol = symval("unquote-splice");
swissChilib6c858c2021-06-30 21:12:43 -0700360 break;
swissChili74348422021-07-04 13:23:24 -0700361 case '#':
362 symbol = symval("function");
363 break;
364 default:
swissChili6d02af42021-08-05 19:49:01 -0700365 NEARIS(is);
366 THROW(EINVALID, "Invalid reader macro char %c", c);
swissChilib6c858c2021-06-30 21:12:43 -0700367 }
368
369 *val = cons(symbol, cons(wrapped, nil));
370
swissChili6d02af42021-08-05 19:49:01 -0700371 OKAY();
swissChilib6c858c2021-06-30 21:12:43 -0700372 }
373 else
374 {
swissChili6d02af42021-08-05 19:49:01 -0700375 THROWSAFE(EEXPECTED);
swissChilib6c858c2021-06-30 21:12:43 -0700376 }
377}
378
swissChili6d02af42021-08-05 19:49:01 -0700379struct error read1(struct istream *is, value_t *val)
swissChili7a6f5eb2021-04-13 16:46:02 -0700380{
swissChili6d02af42021-08-05 19:49:01 -0700381 E_INIT();
swissChilib6c858c2021-06-30 21:12:43 -0700382
swissChili6d02af42021-08-05 19:49:01 -0700383 NEARIS(is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700384
swissChili6d02af42021-08-05 19:49:01 -0700385 OKAY_IF(readquote(is, val));
386 OKAY_IF(readsym(is, val));
387 OKAY_IF(readstr(is, val));
388 OKAY_IF(readint(is, val));
389 OKAY_IF(readlist(is, val));
swissChili7a6f5eb2021-04-13 16:46:02 -0700390
swissChili6d02af42021-08-05 19:49:01 -0700391 THROWSAFE(EEXPECTED);
swissChili7a6f5eb2021-04-13 16:46:02 -0700392}
393
swissChili2999dd12021-07-02 14:19:53 -0700394void set_cons_info(value_t cons, int line, char *name)
395{
396 if (!consp(cons))
397 return;
398
399 struct cons *ca = (void *)(cons ^ CONS_TAG);
400
401 ca->line = line;
402 ca->name = name;
403}
404
swissChili53472e82021-05-08 16:06:32 -0700405value_t readn(struct istream *is)
swissChilibed80922021-04-13 21:58:05 -0700406{
swissChili8cfb7c42021-04-18 21:17:58 -0700407 value_t first = nil;
408 value_t *last = &first;
swissChilibed80922021-04-13 21:58:05 -0700409
swissChili8cfb7c42021-04-18 21:17:58 -0700410 value_t read_val;
swissChilibed80922021-04-13 21:58:05 -0700411
swissChili6d02af42021-08-05 19:49:01 -0700412 while (IS_OKAY(read1(is, &read_val)))
swissChilibed80922021-04-13 21:58:05 -0700413 {
swissChili2999dd12021-07-02 14:19:53 -0700414 int line;
415 char *file;
416
417 is->getpos(is, &line, &file);
swissChili53472e82021-05-08 16:06:32 -0700418 *last = cons(read_val, nil);
swissChili2999dd12021-07-02 14:19:53 -0700419 set_cons_info(*last, line, file);
420
swissChili53472e82021-05-08 16:06:32 -0700421 last = cdrref(*last);
swissChilibed80922021-04-13 21:58:05 -0700422 }
423
424 return first;
425}
426
swissChili53472e82021-05-08 16:06:32 -0700427bool startswith(struct istream *s, char *pattern)
swissChili7a6f5eb2021-04-13 16:46:02 -0700428{
swissChili53472e82021-05-08 16:06:32 -0700429 char *check = strdup(pattern);
430 s->read(s, check, strlen(pattern));
swissChili7a6f5eb2021-04-13 16:46:02 -0700431
swissChili53472e82021-05-08 16:06:32 -0700432 bool res = strcmp(check, pattern) == 0;
433 free(check);
swissChili7a6f5eb2021-04-13 16:46:02 -0700434
435 return res;
436}
swissChilibed80922021-04-13 21:58:05 -0700437
swissChilif1ba8c12021-07-02 18:45:38 -0700438static value_t strptrval(char *str, int tag)
swissChilibed80922021-04-13 21:58:05 -0700439{
swissChili8cfb7c42021-04-18 21:17:58 -0700440 value_t v;
441
swissChilif1ba8c12021-07-02 18:45:38 -0700442 struct alloc *al = malloc_aligned(strlen(str) + 1 + sizeof(struct alloc));
443 add_this_alloc(al, SYMBOL_TAG);
444
445 char *a = (char *)(al + 1);
446
swissChilib6c858c2021-06-30 21:12:43 -0700447 strcpy(a, str);
swissChilib3ca4fb2021-04-20 10:33:00 -0700448 v = (value_t)a;
swissChilif1ba8c12021-07-02 18:45:38 -0700449 v |= tag;
swissChilibed80922021-04-13 21:58:05 -0700450
451 return v;
452}
453
swissChilif1ba8c12021-07-02 18:45:38 -0700454value_t strval(char *str)
455{
456 return strptrval(str, STRING_TAG);
457}
458
swissChilib6c858c2021-06-30 21:12:43 -0700459value_t symval(char *str)
460{
swissChilif1ba8c12021-07-02 18:45:38 -0700461 return strptrval(str, SYMBOL_TAG);
swissChilib6c858c2021-06-30 21:12:43 -0700462}
463
swissChili53472e82021-05-08 16:06:32 -0700464bool integerp(value_t v)
swissChilibed80922021-04-13 21:58:05 -0700465{
swissChili8cfb7c42021-04-18 21:17:58 -0700466 return (v & INT_MASK) == INT_TAG;
467}
swissChilibed80922021-04-13 21:58:05 -0700468
swissChili53472e82021-05-08 16:06:32 -0700469bool symbolp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700470{
471 return (v & HEAP_MASK) == SYMBOL_TAG;
472}
473
swissChili53472e82021-05-08 16:06:32 -0700474bool stringp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700475{
476 return (v & HEAP_MASK) == STRING_TAG;
477}
478
swissChili53472e82021-05-08 16:06:32 -0700479bool consp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700480{
481 return (v & HEAP_MASK) == CONS_TAG;
482}
483
swissChili9e57da42021-06-15 22:22:46 -0700484bool heapp(value_t v)
485{
swissChiliddc97542021-07-04 11:47:42 -0700486 return consp(v) || stringp(v) || symbolp(v) || closurep(v);
487}
488
489bool closurep(value_t v)
490{
491 return (v & HEAP_MASK) == CLOSURE_TAG;
swissChili9e57da42021-06-15 22:22:46 -0700492}
493
swissChili53472e82021-05-08 16:06:32 -0700494bool listp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700495{
496 value_t next = v;
497
swissChili53472e82021-05-08 16:06:32 -0700498 while (consp(next))
swissChilibed80922021-04-13 21:58:05 -0700499 {
swissChili53472e82021-05-08 16:06:32 -0700500 next = cdr(next);
swissChilibed80922021-04-13 21:58:05 -0700501 }
502
swissChili53472e82021-05-08 16:06:32 -0700503 return nilp(next);
swissChilibed80922021-04-13 21:58:05 -0700504}
505
swissChili53472e82021-05-08 16:06:32 -0700506value_t car(value_t v)
swissChilibed80922021-04-13 21:58:05 -0700507{
swissChili53472e82021-05-08 16:06:32 -0700508 if (!consp(v))
swissChilibed80922021-04-13 21:58:05 -0700509 return nil;
510
swissChili53472e82021-05-08 16:06:32 -0700511 return *carref(v);
swissChilibed80922021-04-13 21:58:05 -0700512}
513
swissChili53472e82021-05-08 16:06:32 -0700514value_t cdr(value_t v)
swissChilibed80922021-04-13 21:58:05 -0700515{
swissChili53472e82021-05-08 16:06:32 -0700516 if (!consp(v))
swissChilibed80922021-04-13 21:58:05 -0700517 return nil;
518
swissChili53472e82021-05-08 16:06:32 -0700519 return *cdrref(v);
swissChilibed80922021-04-13 21:58:05 -0700520}
521
swissChili53472e82021-05-08 16:06:32 -0700522value_t *carref(value_t v)
swissChilibed80922021-04-13 21:58:05 -0700523{
swissChili53472e82021-05-08 16:06:32 -0700524 if (!consp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700525 return NULL;
526
swissChilib3ca4fb2021-04-20 10:33:00 -0700527 struct cons *c = (void *)(v ^ CONS_TAG);
swissChili8cfb7c42021-04-18 21:17:58 -0700528 return &c->car;
swissChilibed80922021-04-13 21:58:05 -0700529}
swissChilica107a02021-04-14 12:07:30 -0700530
swissChili53472e82021-05-08 16:06:32 -0700531value_t *cdrref(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700532{
swissChili53472e82021-05-08 16:06:32 -0700533 if (!consp(v))
swissChili8cfb7c42021-04-18 21:17:58 -0700534 return NULL;
535
swissChilib3ca4fb2021-04-20 10:33:00 -0700536 struct cons *c = (void *)(v ^ CONS_TAG);
swissChili8cfb7c42021-04-18 21:17:58 -0700537 return &c->cdr;
538}
539
swissChili53472e82021-05-08 16:06:32 -0700540bool nilp(value_t v)
swissChili8cfb7c42021-04-18 21:17:58 -0700541{
542 return v == nil;
543}
544
swissChili53472e82021-05-08 16:06:32 -0700545int length(value_t v)
swissChilica107a02021-04-14 12:07:30 -0700546{
547 int i = 0;
548
swissChili53472e82021-05-08 16:06:32 -0700549 for (; !nilp(v); v = cdr(v))
swissChilica107a02021-04-14 12:07:30 -0700550 i++;
551
552 return i;
553}
swissChilib3ca4fb2021-04-20 10:33:00 -0700554
swissChili53472e82021-05-08 16:06:32 -0700555value_t elt(value_t v, int index)
swissChilib3ca4fb2021-04-20 10:33:00 -0700556{
swissChili53472e82021-05-08 16:06:32 -0700557 for (int i = 0; i < index; i++)
swissChilib3ca4fb2021-04-20 10:33:00 -0700558 {
swissChili53472e82021-05-08 16:06:32 -0700559 v = cdr(v);
swissChilib3ca4fb2021-04-20 10:33:00 -0700560 }
561
swissChili53472e82021-05-08 16:06:32 -0700562 return car(v);
swissChilib3ca4fb2021-04-20 10:33:00 -0700563}
swissChili8fc5e2f2021-04-22 13:45:10 -0700564
swissChili53472e82021-05-08 16:06:32 -0700565bool symstreq(value_t sym, char *str)
swissChili8fc5e2f2021-04-22 13:45:10 -0700566{
swissChili53472e82021-05-08 16:06:32 -0700567 if ((sym & HEAP_MASK) != SYMBOL_TAG)
swissChili8fc5e2f2021-04-22 13:45:10 -0700568 return false;
569
swissChili53472e82021-05-08 16:06:32 -0700570 return strcmp((char *)(sym ^ SYMBOL_TAG), str) == 0;
swissChili8fc5e2f2021-04-22 13:45:10 -0700571}
swissChilib8fd4712021-06-23 15:32:04 -0700572
573unsigned char make_pool()
574{
575 return ++max_pool;
576}
577
578unsigned char push_pool(unsigned char pool)
579{
580 unsigned char old = current_pool;
581 current_pool = pool;
582 return old;
583}
584
585void pop_pool(unsigned char pool)
586{
587 current_pool = pool;
588}
589
590bool pool_alive(unsigned char pool)
591{
592 return pool != 0;
593}
swissChilif1ba8c12021-07-02 18:45:38 -0700594
swissChili36f2c692021-08-08 14:31:44 -0700595void add_to_pool(value_t form)
596{
597 if (!heapp(form))
598 return;
599
600 struct alloc *a = (void *)(form & ~0b111);
601 a[-1].pool = current_pool;
602}
603
swissChilic0acce42022-07-31 13:38:17 -0700604void del_alloc(struct alloc *alloc)
605{
606 if (alloc->type_tag == CLOSURE_TAG)
607 {
608 fprintf(stderr, "del_alloc closure\n");
609 struct closure_alloc *ca = alloc;
610 free(ca->closure.args);
611 }
612
613 free_aligned(alloc);
614}
615
swissChilif1ba8c12021-07-02 18:45:38 -0700616int cons_line(value_t val)
617{
618 if (!consp(val))
619 return 0;
620
621 struct cons *c = (void *)(val ^ CONS_TAG);
622
623 return c->line;
624}
625
626char *cons_file(value_t val)
627{
628 if (!consp(val))
629 return NULL;
630
631 struct cons *c = (void *)(val ^ CONS_TAG);
632
633 return c->name;
634}
swissChiliddc97542021-07-04 11:47:42 -0700635
swissChili15f1cae2021-07-05 19:08:47 -0700636value_t create_closure(void *code, struct args *args, int ncaptures)
swissChiliddc97542021-07-04 11:47:42 -0700637{
638 struct closure_alloc *ca = malloc_aligned(sizeof(struct closure_alloc) +
639 ncaptures * sizeof(value_t));
640
641 ca->closure.function = code;
swissChili15f1cae2021-07-05 19:08:47 -0700642 ca->closure.args = args;
swissChiliddc97542021-07-04 11:47:42 -0700643 ca->closure.num_captured = ncaptures;
644
645 add_this_alloc(&ca->alloc, CLOSURE_TAG);
646
647 return (value_t)(&ca->closure) | CLOSURE_TAG;
648}
649
650void set_closure_capture_variable(int index, value_t value, value_t closure)
651{
652 if (!closurep(closure))
653 return;
654
655 struct closure *c = (void *)(closure ^ CLOSURE_TAG);
656
657 c->data[index] = value;
658}
swissChili15f1cae2021-07-05 19:08:47 -0700659
660value_t cxdr(value_t v, int index)
661{
662 if (!listp(v) || index >= length(v))
663 return nil;
664
665 for (int i = 0; i < index; i++)
666 {
667 v = cdr(v);
668 }
669
670 return v;
671}
672
673value_t *cxdrref(value_t *v, int index)
674{
675 if (!listp(*v) || index >= length(*v))
676 return NULL;
677
678 value_t *p = v;
679
680 for (int i = 0; i < index; i++)
681 {
682 p = cdrref(*p);
683 }
684
685 return p;
686}
687
688value_t deep_copy(value_t val)
689{
690 if (integerp(val) || val == nil || val == t)
691 {
692 return val;
693 }
694 else if (symbolp(val))
695 {
696 return symval((char *)(val ^ SYMBOL_TAG));
697 }
698 else if (stringp(val))
699 {
700 return strval((char *)(val ^ STRING_TAG));
701 }
702 else if (consp(val))
703 {
704 return cons(deep_copy(car(val)), deep_copy(cdr(val)));
705 }
706 else if (closurep(val))
707 {
708 struct closure *c = (void *)(val ^ CLOSURE_TAG);
709 value_t new = create_closure(c->function, c->args, c->num_captured);
710 struct closure *new_c = (void *)(new ^ CLOSURE_TAG);
711
712 for (int i = 0; i < c->num_captured; i++)
713 {
714 new_c->data[i] = deep_copy(c->data[i]);
715 }
716
717 return new;
718 }
719 else
720 {
swissChili6d02af42021-08-05 19:49:01 -0700721 fprintf(stderr, "Don't know how to deep copy this, sorry... please report this bug :)");
722 return nil;
swissChili15f1cae2021-07-05 19:08:47 -0700723 }
724}
swissChilia7568dc2021-08-08 16:52:52 -0700725
726value_t *nilptr(value_t val)
727{
728 if (!listp(val))
729 return NULL;
730
731 if (nilp(val))
732 return NULL;
733
734 value_t *p;
735
736 for (p = cdrref(val); !nilp(*p); p = cdrref(*p))
737 {
738 }
739
740 return p;
741}
742
743value_t merge2(value_t front, value_t back)
744{
swissChilifc5c9412021-08-08 19:08:26 -0700745 if (!listp(front) && listp(back))
746 return cons(front, back);
swissChilia7568dc2021-08-08 16:52:52 -0700747
swissChilifc5c9412021-08-08 19:08:26 -0700748 if (listp(front) && !listp(back))
749 back = cons(back, nil);
750
751 *nilptr(front) = back;
swissChilia7568dc2021-08-08 16:52:52 -0700752
753 return front;
754}