blob: 6a008f1dcd6bc2a50b7b0c80bce6d55c985f22bb [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
swissChilibed80922021-04-13 21:58:05 -070010#define MIN(a, b) (a) > (b) ? (b) : (a)
swissChili7a6f5eb2021-04-13 16:46:02 -070011
12struct alloc_list *first_a = NULL, *last_a = NULL;
13
swissChili8cfb7c42021-04-18 21:17:58 -070014value_t nil = 0b00101111; // magic ;)
swissChilibed80922021-04-13 21:58:05 -070015
16void err (const char *msg)
17{
18 fprintf (stderr, "ERROR: %s\n", msg);
swissChilib3ca4fb2021-04-20 10:33:00 -070019 exit (1);
swissChilibed80922021-04-13 21:58:05 -070020}
21
swissChili8cfb7c42021-04-18 21:17:58 -070022value_t intval (int i)
swissChili7a6f5eb2021-04-13 16:46:02 -070023{
swissChili8cfb7c42021-04-18 21:17:58 -070024 i <<= 2;
25 i |= INT_TAG;
26 return i;
27}
28
29value_t cons (value_t car, value_t cdr)
30{
31 struct cons *c = malloc_aligned (sizeof (struct cons));
swissChili7a6f5eb2021-04-13 16:46:02 -070032
swissChilibed80922021-04-13 21:58:05 -070033 c->car = car;
34 c->cdr = cdr;
35
swissChili7a6f5eb2021-04-13 16:46:02 -070036 struct alloc_list *item = malloc (sizeof (struct alloc_list));
37 item->type = T_CONS;
swissChili8cfb7c42021-04-18 21:17:58 -070038 item->cons_val = c;
swissChili7a6f5eb2021-04-13 16:46:02 -070039
40 if ( last_a )
41 {
42 item->prev = last_a;
43 last_a->next = item;
44 item->next = NULL;
45 }
46 else
47 {
48 item->prev = item->next = NULL;
49 first_a = last_a = item;
50 }
51
swissChilib3ca4fb2021-04-20 10:33:00 -070052 value_t v = (value_t)c;
swissChili8cfb7c42021-04-18 21:17:58 -070053 v |= CONS_TAG;
swissChili7a6f5eb2021-04-13 16:46:02 -070054
55 return v;
56}
57
58void skipws (struct istream *is)
59{
60 while ( isspace (is->peek (is)) )
61 is->get (is);
62}
63
64bool isallowedchar (char c)
65{
swissChilibed80922021-04-13 21:58:05 -070066 return (c >= '#' && c <= '\'') || (c >= '*' && c <= '/') ||
67 (c >= '>' && c <= '@');
swissChili7a6f5eb2021-04-13 16:46:02 -070068}
69
70bool issymstart (char c)
71{
72 return isalpha (c) || isallowedchar (c);
73}
74
75bool issym (char c)
76{
77 return isalpha (c) || isallowedchar (c) || isdigit (c);
78}
79
swissChili8cfb7c42021-04-18 21:17:58 -070080bool readsym (struct istream *is, value_t *val)
swissChili7a6f5eb2021-04-13 16:46:02 -070081{
82 skipws (is);
83
84 if ( !issymstart (is->peek (is)) )
85 return false;
86
87 int size = 8;
swissChili8cfb7c42021-04-18 21:17:58 -070088 char *s = malloc_aligned (size);
swissChili7a6f5eb2021-04-13 16:46:02 -070089
swissChilibed80922021-04-13 21:58:05 -070090 s[ 0 ] = is->get (is);
swissChili7a6f5eb2021-04-13 16:46:02 -070091
swissChilibed80922021-04-13 21:58:05 -070092 for ( int i = 1;; i++ )
swissChili7a6f5eb2021-04-13 16:46:02 -070093 {
94 if ( issym (is->peek (is)) )
95 {
96 if ( i >= size )
97 {
98 size *= 2;
swissChili8cfb7c42021-04-18 21:17:58 -070099 s = realloc_aligned (s, size);
swissChili7a6f5eb2021-04-13 16:46:02 -0700100 }
101
swissChilibed80922021-04-13 21:58:05 -0700102 s[ i ] = is->get (is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700103 }
104 else
105 {
swissChilibed80922021-04-13 21:58:05 -0700106 s[ i ] = 0;
swissChilib3ca4fb2021-04-20 10:33:00 -0700107 *val = (value_t)s;
swissChili8cfb7c42021-04-18 21:17:58 -0700108 *val |= SYMBOL_TAG;
swissChili7a6f5eb2021-04-13 16:46:02 -0700109
110 return true;
111 }
112 }
113}
114
swissChili8cfb7c42021-04-18 21:17:58 -0700115bool readstr (struct istream *is, value_t *val)
swissChili7a6f5eb2021-04-13 16:46:02 -0700116{
117 skipws (is);
118
119 if ( is->peek (is) != '"' )
120 return false;
121
122 bool escape = false;
123 int size = 8;
swissChili8cfb7c42021-04-18 21:17:58 -0700124 char *s = malloc_aligned (size);
swissChili7a6f5eb2021-04-13 16:46:02 -0700125
swissChilibed80922021-04-13 21:58:05 -0700126 (void)is->get (is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700127
swissChilibed80922021-04-13 21:58:05 -0700128 for ( int i = 0;; i++ )
swissChili7a6f5eb2021-04-13 16:46:02 -0700129 {
130 if ( is->peek (is) != '"' )
131 {
132 if ( i >= size )
133 {
swissChilibed80922021-04-13 21:58:05 -0700134 size *= 2;
swissChili8cfb7c42021-04-18 21:17:58 -0700135 s = realloc_aligned (s, size);
swissChili7a6f5eb2021-04-13 16:46:02 -0700136 }
swissChilibed80922021-04-13 21:58:05 -0700137
swissChili7a6f5eb2021-04-13 16:46:02 -0700138 char c = is->get (is);
139
140 if ( escape && c == 'n' )
141 c = '\n';
142 else if ( escape && c == '\\' )
143 c = '\\';
144
145 if ( c == '\\' && !escape )
146 {
147 escape = true;
148 i--; // will be incremented again, UGLY.
149 }
150 else
151 {
152 escape = false;
swissChilibed80922021-04-13 21:58:05 -0700153 s[ i ] = c;
swissChili7a6f5eb2021-04-13 16:46:02 -0700154 }
155 }
156 else
157 {
158 is->get (is);
159
swissChilib3ca4fb2021-04-20 10:33:00 -0700160 *val = (value_t)s;
swissChili8cfb7c42021-04-18 21:17:58 -0700161 *val |= STRING_TAG;
swissChili7a6f5eb2021-04-13 16:46:02 -0700162
163 return true;
164 }
165 }
166}
167
swissChili8cfb7c42021-04-18 21:17:58 -0700168void printval (value_t v, int depth)
swissChili7a6f5eb2021-04-13 16:46:02 -0700169{
170 for ( int i = 0; i < depth; i++ )
swissChilibed80922021-04-13 21:58:05 -0700171 printf (" ");
swissChili7a6f5eb2021-04-13 16:46:02 -0700172
swissChili8cfb7c42021-04-18 21:17:58 -0700173 if ( symbolp (v) )
swissChili7a6f5eb2021-04-13 16:46:02 -0700174 {
swissChilib3ca4fb2021-04-20 10:33:00 -0700175 printf ("'%s\n", (char *)(v ^ SYMBOL_TAG));
swissChili8cfb7c42021-04-18 21:17:58 -0700176 }
177 else if ( stringp (v) )
178 {
swissChilib3ca4fb2021-04-20 10:33:00 -0700179 printf ("\"%s\"\n", (char *)(v ^ STRING_TAG));
swissChili8cfb7c42021-04-18 21:17:58 -0700180 }
swissChili6eee4f92021-04-20 09:34:30 -0700181 else if ( integerp (v) )
182 {
183 printf ("%d\n", v >> 2);
184 }
swissChili8cfb7c42021-04-18 21:17:58 -0700185 else if ( consp (v) )
186 {
swissChilibed80922021-04-13 21:58:05 -0700187 if ( listp (v) )
188 {
189 printf ("list:\n");
190
swissChili8cfb7c42021-04-18 21:17:58 -0700191 for ( value_t n = v; !nilp (n); n = cdr (n) )
swissChilibed80922021-04-13 21:58:05 -0700192 {
193 printval (car (n), depth + 1);
194 }
195 }
196 else
197 {
198 printf ("cons:\n");
swissChili8cfb7c42021-04-18 21:17:58 -0700199 printval (car (v), depth + 1);
200 printval (cdr (v), depth + 1);
swissChilibed80922021-04-13 21:58:05 -0700201 }
swissChili8cfb7c42021-04-18 21:17:58 -0700202 }
203 else if ( nilp (v) )
204 {
swissChilibed80922021-04-13 21:58:05 -0700205 printf ("nil\n");
swissChili8cfb7c42021-04-18 21:17:58 -0700206 }
207 else
208 {
209 printf ("<unknown %d>\n", v);
swissChili7a6f5eb2021-04-13 16:46:02 -0700210 }
211}
212
swissChili8cfb7c42021-04-18 21:17:58 -0700213bool readlist (struct istream *is, value_t *val)
swissChilibed80922021-04-13 21:58:05 -0700214{
215 skipws (is);
216
217 if ( is->peek (is) != '(' )
218 return false;
219
220 is->get (is);
221
222 *val = readn (is);
223
224 if ( is->peek (is) != ')' )
225 {
226 is->showpos (is, stderr);
227 err ("Unterminated list");
228 return false;
229 }
230 is->get (is);
231
232 return true;
233}
234
swissChili6eee4f92021-04-20 09:34:30 -0700235bool readint (struct istream *is, value_t *val)
236{
237 int number = 0;
238
239 if ( !isdigit (is->peek (is)) )
240 return false;
241
242 while ( isdigit (is->peek (is)) )
243 {
244 number *= 10;
245 number += is->get (is) - '0';
246 }
247
248 *val = intval (number);
249 return true;
250}
251
swissChili8cfb7c42021-04-18 21:17:58 -0700252bool read1 (struct istream *is, value_t *val)
swissChili7a6f5eb2021-04-13 16:46:02 -0700253{
254 if ( readsym (is, val) )
255 return true;
256
257 if ( readstr (is, val) )
258 return true;
259
swissChili6eee4f92021-04-20 09:34:30 -0700260 if ( readint (is, val) )
261 return true;
262
swissChilibed80922021-04-13 21:58:05 -0700263 if ( readlist (is, val) )
264 return true;
265
swissChili7a6f5eb2021-04-13 16:46:02 -0700266 return false;
267}
268
swissChili8cfb7c42021-04-18 21:17:58 -0700269value_t readn (struct istream *is)
swissChilibed80922021-04-13 21:58:05 -0700270{
swissChili8cfb7c42021-04-18 21:17:58 -0700271 value_t first = nil;
272 value_t *last = &first;
swissChilibed80922021-04-13 21:58:05 -0700273
swissChili8cfb7c42021-04-18 21:17:58 -0700274 value_t read_val;
swissChilibed80922021-04-13 21:58:05 -0700275
276 while ( read1 (is, &read_val) )
277 {
278 *last = cons (read_val, nil);
swissChili8cfb7c42021-04-18 21:17:58 -0700279 last = cdrref (*last);
swissChilibed80922021-04-13 21:58:05 -0700280 }
281
282 return first;
283}
284
swissChili7a6f5eb2021-04-13 16:46:02 -0700285struct stristream_private
286{
287 char *val;
288 int i;
289 int length;
swissChilibed80922021-04-13 21:58:05 -0700290 int line;
291 int fromleft;
292 int linestart;
swissChili7a6f5eb2021-04-13 16:46:02 -0700293};
294
295int stristream_peek (struct istream *is)
296{
297 struct stristream_private *p = is->data;
298
299 if ( p->i < p->length )
300 return p->val[ p->i ];
301 else
302 return -1;
303}
304
305int stristream_get (struct istream *is)
306{
307 struct stristream_private *p = is->data;
308
309 if ( p->i < p->length )
swissChilibed80922021-04-13 21:58:05 -0700310 {
311 char c = p->val[ p->i++ ];
312
313 p->fromleft++;
314
315 if ( c == '\n' )
316 {
317 p->fromleft = 1;
318 p->line++;
319 p->linestart = p->i;
320 }
321
322 return c;
323 }
swissChili7a6f5eb2021-04-13 16:46:02 -0700324 else
325 return -1;
swissChili7a6f5eb2021-04-13 16:46:02 -0700326}
327
328int stristream_read (struct istream *s, char *buffer, int size)
329{
330 struct stristream_private *p = s->data;
331
332 int len = MIN (size, p->length - p->i);
333 memcpy (buffer, p->val, len);
334 return len;
335}
336
swissChilibed80922021-04-13 21:58:05 -0700337void stristream_showpos (struct istream *s, FILE *out)
338{
339 struct stristream_private *p = s->data;
340
341 fprintf (out, "line: %d, char %d\n", p->line, p->fromleft);
342
343 int end = p->length;
344
345 for ( int i = p->linestart; i < p->length; i++ )
346 {
347 if ( p->val[ i ] == '\n' )
348 {
349 end = i;
350 break;
351 }
352 }
353
354 fprintf (out, " | %.*s\n", end - p->linestart, p->val + p->linestart);
355 fprintf (out, " | ");
356 for ( int i = 0; i < p->fromleft - 1; i++ )
357 fprintf (out, " ");
358
359 fprintf (out, "\033[31m^\033[0m\n");
360}
361
swissChili7a6f5eb2021-04-13 16:46:02 -0700362struct istream *new_stristream (char *str, int length)
363{
364 struct istream *is = malloc (sizeof (struct istream));
365 struct stristream_private *p = malloc (sizeof (struct stristream_private));
366
367 p->val = strndup (str, length);
368 p->i = 0;
369 p->length = length;
swissChilibed80922021-04-13 21:58:05 -0700370 p->line = 1;
371 p->fromleft = 1;
372 p->linestart = 0;
swissChili7a6f5eb2021-04-13 16:46:02 -0700373
374 is->data = p;
375 is->get = stristream_get;
376 is->peek = stristream_peek;
377 is->read = stristream_read;
swissChilibed80922021-04-13 21:58:05 -0700378 is->showpos = stristream_showpos;
swissChili7a6f5eb2021-04-13 16:46:02 -0700379
380 return is;
381}
382
swissChilibed80922021-04-13 21:58:05 -0700383void del_stristream (struct istream *stristream)
swissChili7a6f5eb2021-04-13 16:46:02 -0700384{
385 struct stristream_private *p = stristream->data;
386 free (p->val);
387 free (p);
388 free (stristream);
389}
390
391struct istream *new_stristream_nt (char *str)
392{
swissChilibed80922021-04-13 21:58:05 -0700393 return new_stristream (str, strlen (str));
swissChili7a6f5eb2021-04-13 16:46:02 -0700394}
395
swissChilibed80922021-04-13 21:58:05 -0700396bool startswith (struct istream *s, char *pattern)
swissChili7a6f5eb2021-04-13 16:46:02 -0700397{
swissChilibed80922021-04-13 21:58:05 -0700398 char *check = strdup (pattern);
swissChili7a6f5eb2021-04-13 16:46:02 -0700399 s->read (s, check, strlen (pattern));
400
401 bool res = strcmp (check, pattern) == 0;
402 free (check);
403
404 return res;
405}
swissChilibed80922021-04-13 21:58:05 -0700406
swissChili8cfb7c42021-04-18 21:17:58 -0700407value_t strval (char *str)
swissChilibed80922021-04-13 21:58:05 -0700408{
swissChili8cfb7c42021-04-18 21:17:58 -0700409 value_t v;
410
411 char *a = malloc_aligned (strlen (str) + 1);
swissChilib3ca4fb2021-04-20 10:33:00 -0700412 v = (value_t)a;
swissChili8cfb7c42021-04-18 21:17:58 -0700413 v |= STRING_TAG;
swissChilibed80922021-04-13 21:58:05 -0700414
415 return v;
416}
417
swissChili8cfb7c42021-04-18 21:17:58 -0700418bool integerp (value_t v)
swissChilibed80922021-04-13 21:58:05 -0700419{
swissChili8cfb7c42021-04-18 21:17:58 -0700420 return (v & INT_MASK) == INT_TAG;
421}
swissChilibed80922021-04-13 21:58:05 -0700422
swissChili8cfb7c42021-04-18 21:17:58 -0700423bool symbolp (value_t v)
424{
425 return (v & HEAP_MASK) == SYMBOL_TAG;
426}
427
428bool stringp (value_t v)
429{
430 return (v & HEAP_MASK) == STRING_TAG;
431}
432
433bool consp (value_t v)
434{
435 return (v & HEAP_MASK) == CONS_TAG;
436}
437
438bool listp (value_t v)
439{
440 value_t next = v;
441
442 while ( consp (next) )
swissChilibed80922021-04-13 21:58:05 -0700443 {
swissChili8cfb7c42021-04-18 21:17:58 -0700444 next = cdr (next);
swissChilibed80922021-04-13 21:58:05 -0700445 }
446
swissChili8cfb7c42021-04-18 21:17:58 -0700447 return nilp (next);
swissChilibed80922021-04-13 21:58:05 -0700448}
449
swissChili8cfb7c42021-04-18 21:17:58 -0700450value_t car (value_t v)
swissChilibed80922021-04-13 21:58:05 -0700451{
swissChili8cfb7c42021-04-18 21:17:58 -0700452 if ( !consp (v) )
swissChilibed80922021-04-13 21:58:05 -0700453 return nil;
454
swissChili8cfb7c42021-04-18 21:17:58 -0700455 return *carref (v);
swissChilibed80922021-04-13 21:58:05 -0700456}
457
swissChili8cfb7c42021-04-18 21:17:58 -0700458value_t cdr (value_t v)
swissChilibed80922021-04-13 21:58:05 -0700459{
swissChili8cfb7c42021-04-18 21:17:58 -0700460 if ( !consp (v) )
swissChilibed80922021-04-13 21:58:05 -0700461 return nil;
462
swissChili8cfb7c42021-04-18 21:17:58 -0700463 return *cdrref (v);
swissChilibed80922021-04-13 21:58:05 -0700464}
465
swissChili8cfb7c42021-04-18 21:17:58 -0700466value_t *carref (value_t v)
swissChilibed80922021-04-13 21:58:05 -0700467{
swissChili8cfb7c42021-04-18 21:17:58 -0700468 if ( !consp (v) )
469 return NULL;
470
swissChilib3ca4fb2021-04-20 10:33:00 -0700471 struct cons *c = (void *)(v ^ CONS_TAG);
swissChili8cfb7c42021-04-18 21:17:58 -0700472 return &c->car;
swissChilibed80922021-04-13 21:58:05 -0700473}
swissChilica107a02021-04-14 12:07:30 -0700474
swissChili8cfb7c42021-04-18 21:17:58 -0700475value_t *cdrref (value_t v)
476{
477 if ( !consp (v) )
478 return NULL;
479
swissChilib3ca4fb2021-04-20 10:33:00 -0700480 struct cons *c = (void *)(v ^ CONS_TAG);
swissChili8cfb7c42021-04-18 21:17:58 -0700481 return &c->cdr;
482}
483
484bool nilp (value_t v)
485{
486 return v == nil;
487}
488
489int length (value_t v)
swissChilica107a02021-04-14 12:07:30 -0700490{
491 int i = 0;
492
swissChilif3e7f182021-04-20 13:57:22 -0700493 for ( ; !nilp (v); v = cdr (v) )
swissChilica107a02021-04-14 12:07:30 -0700494 i++;
495
496 return i;
497}
swissChilib3ca4fb2021-04-20 10:33:00 -0700498
499value_t elt (value_t v, int index)
500{
swissChilif3e7f182021-04-20 13:57:22 -0700501 for ( int i = 0; i < index; i++ )
swissChilib3ca4fb2021-04-20 10:33:00 -0700502 {
503 v = cdr (v);
504 }
505
506 return car (v);
507}