blob: 51a3270d86c0bb974b31b75ac8dcc28ae1653caa [file] [log] [blame]
swissChili7a6f5eb2021-04-13 16:46:02 -07001#include "lisp.h"
swissChili7a6f5eb2021-04-13 16:46:02 -07002#include <ctype.h>
3#include <stdbool.h>
4#include <stdio.h>
swissChilibed80922021-04-13 21:58:05 -07005#include <stdlib.h>
6#include <string.h>
swissChili7a6f5eb2021-04-13 16:46:02 -07007
swissChilibed80922021-04-13 21:58:05 -07008#define MIN(a, b) (a) > (b) ? (b) : (a)
swissChili7a6f5eb2021-04-13 16:46:02 -07009
10struct alloc_list *first_a = NULL, *last_a = NULL;
11
swissChilibed80922021-04-13 21:58:05 -070012struct value nil = {.tag = {.type = T_NIL}};
13
14void err (const char *msg)
15{
16 fprintf (stderr, "ERROR: %s\n", msg);
17}
18
swissChili7a6f5eb2021-04-13 16:46:02 -070019struct value cons (struct value car, struct value cdr)
20{
21 struct cons *c = malloc (sizeof (struct cons));
22
swissChilibed80922021-04-13 21:58:05 -070023 c->car = car;
24 c->cdr = cdr;
25
swissChili7a6f5eb2021-04-13 16:46:02 -070026 struct alloc_list *item = malloc (sizeof (struct alloc_list));
27 item->type = T_CONS;
28 item->data.cons_val = c;
29
30 if ( last_a )
31 {
32 item->prev = last_a;
33 last_a->next = item;
34 item->next = NULL;
35 }
36 else
37 {
38 item->prev = item->next = NULL;
39 first_a = last_a = item;
40 }
41
42 struct value v;
43 v.tag.type = T_CONS;
44 v.value.cons_val = c;
45
46 return v;
47}
48
49void skipws (struct istream *is)
50{
51 while ( isspace (is->peek (is)) )
52 is->get (is);
53}
54
55bool isallowedchar (char c)
56{
swissChilibed80922021-04-13 21:58:05 -070057 return (c >= '#' && c <= '\'') || (c >= '*' && c <= '/') ||
58 (c >= '>' && c <= '@');
swissChili7a6f5eb2021-04-13 16:46:02 -070059}
60
61bool issymstart (char c)
62{
63 return isalpha (c) || isallowedchar (c);
64}
65
66bool issym (char c)
67{
68 return isalpha (c) || isallowedchar (c) || isdigit (c);
69}
70
71bool readsym (struct istream *is, struct value *val)
72{
73 skipws (is);
74
75 if ( !issymstart (is->peek (is)) )
76 return false;
77
78 int size = 8;
79 char *s = malloc (size);
80
swissChilibed80922021-04-13 21:58:05 -070081 s[ 0 ] = is->get (is);
swissChili7a6f5eb2021-04-13 16:46:02 -070082
swissChilibed80922021-04-13 21:58:05 -070083 for ( int i = 1;; i++ )
swissChili7a6f5eb2021-04-13 16:46:02 -070084 {
85 if ( issym (is->peek (is)) )
86 {
87 if ( i >= size )
88 {
89 size *= 2;
90 s = realloc (s, size);
91 }
92
swissChilibed80922021-04-13 21:58:05 -070093 s[ i ] = is->get (is);
swissChili7a6f5eb2021-04-13 16:46:02 -070094 }
95 else
96 {
swissChilibed80922021-04-13 21:58:05 -070097 s[ i ] = 0;
swissChili7a6f5eb2021-04-13 16:46:02 -070098 val->tag.type = T_SYMBOL;
99 val->tag.length = i - 1;
100 val->value.symbol_val = s;
101
102 return true;
103 }
104 }
105}
106
107bool readstr (struct istream *is, struct value *val)
108{
109 skipws (is);
110
111 if ( is->peek (is) != '"' )
112 return false;
113
114 bool escape = false;
115 int size = 8;
116 char *s = malloc (size);
117
swissChilibed80922021-04-13 21:58:05 -0700118 (void)is->get (is);
swissChili7a6f5eb2021-04-13 16:46:02 -0700119
swissChilibed80922021-04-13 21:58:05 -0700120 for ( int i = 0;; i++ )
swissChili7a6f5eb2021-04-13 16:46:02 -0700121 {
122 if ( is->peek (is) != '"' )
123 {
124 if ( i >= size )
125 {
swissChilibed80922021-04-13 21:58:05 -0700126 size *= 2;
127 s = realloc (s, size);
swissChili7a6f5eb2021-04-13 16:46:02 -0700128 }
swissChilibed80922021-04-13 21:58:05 -0700129
swissChili7a6f5eb2021-04-13 16:46:02 -0700130 char c = is->get (is);
131
132 if ( escape && c == 'n' )
133 c = '\n';
134 else if ( escape && c == '\\' )
135 c = '\\';
136
137 if ( c == '\\' && !escape )
138 {
139 escape = true;
140 i--; // will be incremented again, UGLY.
141 }
142 else
143 {
144 escape = false;
swissChilibed80922021-04-13 21:58:05 -0700145 s[ i ] = c;
swissChili7a6f5eb2021-04-13 16:46:02 -0700146 }
147 }
148 else
149 {
150 is->get (is);
151
152 val->tag.type = T_STRING;
153 val->tag.length = i;
154 val->value.string_val = s;
155
156 return true;
157 }
158 }
159}
160
161void printval (struct value v, int depth)
162{
163 for ( int i = 0; i < depth; i++ )
swissChilibed80922021-04-13 21:58:05 -0700164 printf (" ");
swissChili7a6f5eb2021-04-13 16:46:02 -0700165
swissChilibed80922021-04-13 21:58:05 -0700166 switch ( v.tag.type )
swissChili7a6f5eb2021-04-13 16:46:02 -0700167 {
168 case T_SYMBOL:
169 printf ("'%s\n", v.value.symbol_val);
170 return;
171 case T_STRING:
172 printf ("\"%s\"\n", v.value.string_val);
173 return;
swissChilibed80922021-04-13 21:58:05 -0700174 case T_CONS:
175 if ( listp (v) )
176 {
177 printf ("list:\n");
178
swissChilica107a02021-04-14 12:07:30 -0700179 for ( struct value n = v; !nilp (n); n = cdr (n) )
swissChilibed80922021-04-13 21:58:05 -0700180 {
181 printval (car (n), depth + 1);
182 }
183 }
184 else
185 {
186 printf ("cons:\n");
187 printval (v.value.cons_val->car, depth + 1);
188 printval (v.value.cons_val->cdr, depth + 1);
189 }
190 break;
191 case T_NIL:
192 printf ("nil\n");
193 break;
swissChili7a6f5eb2021-04-13 16:46:02 -0700194 default:
195 printf ("<unknown %d>\n", v.tag.type);
196 }
197}
198
swissChilibed80922021-04-13 21:58:05 -0700199bool readlist (struct istream *is, struct value *val)
200{
201 skipws (is);
202
203 if ( is->peek (is) != '(' )
204 return false;
205
206 is->get (is);
207
208 *val = readn (is);
209
210 if ( is->peek (is) != ')' )
211 {
212 is->showpos (is, stderr);
213 err ("Unterminated list");
214 return false;
215 }
216 is->get (is);
217
218 return true;
219}
220
swissChili7a6f5eb2021-04-13 16:46:02 -0700221bool read1 (struct istream *is, struct value *val)
222{
223 if ( readsym (is, val) )
224 return true;
225
226 if ( readstr (is, val) )
227 return true;
228
swissChilibed80922021-04-13 21:58:05 -0700229 if ( readlist (is, val) )
230 return true;
231
swissChili7a6f5eb2021-04-13 16:46:02 -0700232 return false;
233}
234
swissChilibed80922021-04-13 21:58:05 -0700235struct value readn (struct istream *is)
236{
237 struct value first = nil;
238 struct value *last = &first;
239
240 struct value read_val;
241
242 while ( read1 (is, &read_val) )
243 {
244 *last = cons (read_val, nil);
245 last = &last->value.cons_val->cdr;
246 }
247
248 return first;
249}
250
swissChili7a6f5eb2021-04-13 16:46:02 -0700251struct stristream_private
252{
253 char *val;
254 int i;
255 int length;
swissChilibed80922021-04-13 21:58:05 -0700256 int line;
257 int fromleft;
258 int linestart;
swissChili7a6f5eb2021-04-13 16:46:02 -0700259};
260
261int stristream_peek (struct istream *is)
262{
263 struct stristream_private *p = is->data;
264
265 if ( p->i < p->length )
266 return p->val[ p->i ];
267 else
268 return -1;
269}
270
271int stristream_get (struct istream *is)
272{
273 struct stristream_private *p = is->data;
274
275 if ( p->i < p->length )
swissChilibed80922021-04-13 21:58:05 -0700276 {
277 char c = p->val[ p->i++ ];
278
279 p->fromleft++;
280
281 if ( c == '\n' )
282 {
283 p->fromleft = 1;
284 p->line++;
285 p->linestart = p->i;
286 }
287
288 return c;
289 }
swissChili7a6f5eb2021-04-13 16:46:02 -0700290 else
291 return -1;
swissChili7a6f5eb2021-04-13 16:46:02 -0700292}
293
294int stristream_read (struct istream *s, char *buffer, int size)
295{
296 struct stristream_private *p = s->data;
297
298 int len = MIN (size, p->length - p->i);
299 memcpy (buffer, p->val, len);
300 return len;
301}
302
swissChilibed80922021-04-13 21:58:05 -0700303void stristream_showpos (struct istream *s, FILE *out)
304{
305 struct stristream_private *p = s->data;
306
307 fprintf (out, "line: %d, char %d\n", p->line, p->fromleft);
308
309 int end = p->length;
310
311 for ( int i = p->linestart; i < p->length; i++ )
312 {
313 if ( p->val[ i ] == '\n' )
314 {
315 end = i;
316 break;
317 }
318 }
319
320 fprintf (out, " | %.*s\n", end - p->linestart, p->val + p->linestart);
321 fprintf (out, " | ");
322 for ( int i = 0; i < p->fromleft - 1; i++ )
323 fprintf (out, " ");
324
325 fprintf (out, "\033[31m^\033[0m\n");
326}
327
swissChili7a6f5eb2021-04-13 16:46:02 -0700328struct istream *new_stristream (char *str, int length)
329{
330 struct istream *is = malloc (sizeof (struct istream));
331 struct stristream_private *p = malloc (sizeof (struct stristream_private));
332
333 p->val = strndup (str, length);
334 p->i = 0;
335 p->length = length;
swissChilibed80922021-04-13 21:58:05 -0700336 p->line = 1;
337 p->fromleft = 1;
338 p->linestart = 0;
swissChili7a6f5eb2021-04-13 16:46:02 -0700339
340 is->data = p;
341 is->get = stristream_get;
342 is->peek = stristream_peek;
343 is->read = stristream_read;
swissChilibed80922021-04-13 21:58:05 -0700344 is->showpos = stristream_showpos;
swissChili7a6f5eb2021-04-13 16:46:02 -0700345
346 return is;
347}
348
swissChilibed80922021-04-13 21:58:05 -0700349void del_stristream (struct istream *stristream)
swissChili7a6f5eb2021-04-13 16:46:02 -0700350{
351 struct stristream_private *p = stristream->data;
352 free (p->val);
353 free (p);
354 free (stristream);
355}
356
357struct istream *new_stristream_nt (char *str)
358{
swissChilibed80922021-04-13 21:58:05 -0700359 return new_stristream (str, strlen (str));
swissChili7a6f5eb2021-04-13 16:46:02 -0700360}
361
swissChilibed80922021-04-13 21:58:05 -0700362bool startswith (struct istream *s, char *pattern)
swissChili7a6f5eb2021-04-13 16:46:02 -0700363{
swissChilibed80922021-04-13 21:58:05 -0700364 char *check = strdup (pattern);
swissChili7a6f5eb2021-04-13 16:46:02 -0700365 s->read (s, check, strlen (pattern));
366
367 bool res = strcmp (check, pattern) == 0;
368 free (check);
369
370 return res;
371}
swissChilibed80922021-04-13 21:58:05 -0700372
373struct value strval (char *str)
374{
375 struct value v;
376 v.tag.type = T_STRING;
377 v.tag.length = strlen (str);
378 v.value.string_val = str;
379
380 return v;
381}
382
383bool listp (struct value v)
384{
385 struct value *next = &v;
386
swissChilica107a02021-04-14 12:07:30 -0700387 while ( next->tag.type == T_CONS && cdr (*next).tag.type == T_CONS )
swissChilibed80922021-04-13 21:58:05 -0700388 {
389 next = &next->value.cons_val->cdr;
390 }
391
392 return next->value.cons_val->cdr.tag.type == T_NIL;
393}
394
395struct value car (struct value v)
396{
397 if ( v.tag.type != T_CONS )
398 return nil;
399
400 return v.value.cons_val->car;
401}
402
403struct value cdr (struct value v)
404{
405 if ( v.tag.type != T_CONS )
406 return nil;
407
408 return v.value.cons_val->cdr;
409}
410
411bool nilp (struct value v)
412{
413 return v.tag.type == T_NIL;
414}
swissChilica107a02021-04-14 12:07:30 -0700415
416int length (struct value v)
417{
418 int i = 0;
419
420 FOREACH (item, v)
421 i++;
422
423 return i;
424}