master
expl.c
1#include <ctype.h>
2#include <stdio.h>
3#include <stdlib.h>
4#include <string.h>
5
6#include "expl.h"
7
8#define current(p) ((p)->src[(p)->pos])
9#define peek(p) ((p)->src[(p)->pos + 1])
10#define is(p, c) (current(p) == (c))
11#define end(p) (is(p, '\0'))
12#define advance(p) ((p)->pos++)
13#define length(p, s) ((p)->pos - (s))
14
15typedef enum {
16 EXPRESSION_TYPE_ATOM,
17 EXPRESSION_TYPE_STRING,
18 EXPRESSION_TYPE_LIST,
19
20 EXPRESSION_TYPE_COUNT
21} expression_type;
22
23typedef struct environment environment;
24typedef struct function function;
25typedef struct parser parser;
26
27struct expl {
28 environment* env;
29 expression* programs;
30};
31
32struct environment {
33 char* name;
34 expl_value value;
35 environment* next;
36};
37
38struct function {
39 expl_native native;
40 expression* args;
41 expression* body;
42 void* data;
43};
44
45struct expression {
46 char* value;
47 expression_type type;
48 expression* child;
49 expression* next;
50};
51
52struct parser {
53 const char* src;
54 size_t pos;
55 expl_error err;
56};
57
58static int define(environment** env, const char* name, expl_value value);
59static expression* parse_expression(parser* p);
60static expression* list(parser* p);
61static expl_value* lookup(environment* env, const char* name);
62expression* parse(const char* source);
63static expression* value(parser* p, expression_type type);
64
65static expl_value eval(expression* n, environment** env);
66static expl_value eval_call(expression* args, environment** env);
67static expl_value eval_fn(expression* args, environment** env);
68static expl_value eval_user(function* f, int argc, expl_value* argv, environment** env);
69
70static void skip_space(parser* p);
71static char* _strndup(const char* src, size_t len);
72static void unescape(char* src);
73
74static expression* new_node(expression_type type);
75static void free_node(expression* node);
76static void free_environment(environment* env);
77
78static int
79define(environment** env, const char* name, expl_value value)
80{
81 environment* b = malloc(sizeof(*b));
82 if (!b)
83 return 0;
84
85 b->name = _strndup(name, strlen(name));
86 if (!b->name) {
87 free(b);
88 return 0;
89 }
90
91 b->value = value;
92 b->next = *env;
93 *env = b;
94
95 return 1;
96}
97
98static expression*
99parse_expression(parser* p)
100{
101 skip_space(p);
102 switch (current(p)) {
103 case '"':
104 return value(p, EXPRESSION_TYPE_STRING);
105 case '(':
106 return list(p);
107 case ')':
108 case '\0':
109 p->err = EXPL_ERR_UNEXPECTED_TOKEN;
110 return NULL;
111 default:
112 return value(p, EXPRESSION_TYPE_ATOM);
113 }
114}
115
116static expression*
117list(parser* p)
118{
119 expression* node = NULL;
120 expression** next = NULL;
121
122 advance(p);
123
124 node = new_node(EXPRESSION_TYPE_LIST);
125 if (!node) {
126 p->err = EXPL_ERR_OUT_OF_MEMORY;
127 return NULL;
128 }
129
130 next = &node->child;
131
132 skip_space(p);
133 while (!is(p, ')') && !end(p)) {
134 *next = parse_expression(p);
135 if (!*next) {
136 free_node(node);
137 return NULL;
138 }
139
140 next = &(*next)->next;
141 skip_space(p);
142 }
143
144 if (end(p)) {
145 p->err = EXPL_ERR_EXPECTED_LIST;
146 free_node(node);
147 return NULL;
148 }
149
150 advance(p);
151 return node;
152}
153
154static expl_value*
155lookup(environment* env, const char* name)
156{
157 while (env) {
158 if (strcmp(env->name, name) == 0)
159 return &env->value;
160 env = env->next;
161 }
162
163 return NULL;
164}
165
166expression*
167parse(const char* source)
168{
169 parser p = { 0 };
170 expression* head = NULL;
171 expression** next = &head;
172
173 if (!source)
174 return NULL;
175 p.src = source;
176
177 skip_space(&p);
178 while (!end(&p)) {
179 *next = parse_expression(&p);
180 if (!*next) {
181 free_node(head);
182 return NULL;
183 }
184
185 next = &(*next)->next;
186 skip_space(&p);
187 }
188
189 return head;
190}
191
192static expression*
193value(parser* p, expression_type type)
194{
195 expression* node = NULL;
196 size_t start = 0;
197
198 if (type == EXPRESSION_TYPE_STRING)
199 advance(p);
200
201 start = p->pos;
202
203 if (type == EXPRESSION_TYPE_STRING) {
204 while (!is(p, '"') && !end(p)) {
205 if (is(p, '\\') && peek(p))
206 advance(p);
207 advance(p);
208 }
209
210 if (end(p)) {
211 p->err = EXPL_ERR_EXPECTED_STRING;
212 return NULL;
213 }
214 }
215 else {
216 while (!end(p) &&
217 !strchr("();\"", current(p)) &&
218 !isspace((unsigned char)current(p)))
219 advance(p);
220 }
221
222 if (start == p->pos && type == EXPRESSION_TYPE_ATOM) {
223 p->err = EXPL_ERR_EXPECTED_ATOM;
224 return NULL;
225 }
226
227 node = new_node(type);
228 if (!node) {
229 p->err = EXPL_ERR_OUT_OF_MEMORY;
230 return NULL;
231 }
232
233 node->value = _strndup(p->src + start, length(p, start));
234 if (!node->value) {
235 free_node(node);
236 p->err = EXPL_ERR_OUT_OF_MEMORY;
237 return NULL;
238 }
239
240 if (type == EXPRESSION_TYPE_STRING) {
241 unescape(node->value);
242 advance(p);
243 }
244
245 return node;
246}
247
248static expl_value
249eval(expression* n, environment** env)
250{
251 expl_value result = { 0 };
252 expl_value* v;
253 char* end;
254
255 if (!n)
256 return result;
257
258 switch (n->type) {
259 case EXPRESSION_TYPE_STRING:
260 result.type = EXPL_VALUE_STRING;
261 result.as.string = n->value;
262 return result;
263
264 case EXPRESSION_TYPE_ATOM:
265 result.as.number = strtod(n->value, &end);
266 if (end != n->value && !*end) {
267 result.type = EXPL_VALUE_NUMBER;
268 return result;
269 }
270
271 v = lookup(*env, n->value);
272 if (v)
273 return *v;
274 return result;
275
276 case EXPRESSION_TYPE_LIST:
277 return eval_call(n, env);
278
279 default:
280 return result;
281 }
282}
283
284static expl_value
285eval_call(expression* n, environment** env)
286{
287 expl_value result = { 0 };
288 expl_value* fn = NULL;
289 expl_value* argv = NULL;
290 expression* arg = NULL;
291 function* f = NULL;
292 int argc = 0;
293 int i = 0;
294
295 if (!n->child || n->child->type != EXPRESSION_TYPE_ATOM)
296 return result;
297
298 /* defined function */
299 if (!strcmp(n->child->value, "fn"))
300 return eval_fn(n->child->next, env);
301
302 fn = lookup(*env, n->child->value);
303 if (!fn || fn->type != EXPL_VALUE_FUNCTION)
304 return result;
305
306 for (arg = n->child->next; arg; arg = arg->next)
307 argc++;
308
309 /* allocate argv */
310 if (argc) {
311 argv = malloc(argc * sizeof(*argv));
312 if (!argv)
313 return result;
314 }
315
316 /* evaluate arguments */
317 for (arg = n->child->next; arg; arg = arg->next)
318 argv[i++] = eval(arg, env);
319
320 /* call */
321 f = fn->as.function;
322 if (f->native)
323 result = f->native(argc, argv, f->data);
324 else
325 result = eval_user(f, argc, argv, env);
326
327 free(argv);
328 return result;
329}
330
331static expl_value
332eval_fn(expression* args, environment** env)
333{
334 expl_value result = { 0 };
335 expression* name = NULL;
336 function* f = NULL;
337
338 name = args;
339 if (!name || name->type != EXPRESSION_TYPE_ATOM ||
340 !name->next || !name->next->next ||
341 name->next->type != EXPRESSION_TYPE_LIST)
342 return result;
343
344 f = malloc(sizeof(*f));
345 if (!f)
346 return result;
347
348 f->native = NULL;
349 f->args = name->next->child;
350 f->body = name->next->next;
351
352 result.type = EXPL_VALUE_FUNCTION;
353 result.as.function = f;
354
355 if (!define(env, name->value, result)) {
356 free(f);
357 result.type = EXPL_VALUE_NIL;
358 }
359
360 return result;
361}
362
363static expl_value
364eval_user(function* f, int argc, expl_value* argv, environment** env)
365{
366 environment* local = *env;
367 expression* param = f->args;
368 environment* next = NULL;
369 expression* body = NULL;
370 expl_value result = { 0 };
371 int i;
372
373 for (i = 0; i < argc && param; i++) {
374 if (!define(&local, param->value, argv[i]))
375 break;
376 param = param->next;
377 }
378
379 if (i == argc && !param) {
380 for (body = f->body; body; body = body->next)
381 result = eval(body, &local);
382 }
383
384 while (local != *env) {
385 next = local->next;
386 free(local->name);
387 free(local);
388 local = next;
389 }
390
391 return result;
392}
393
394static void
395skip_space(parser* p)
396{
397 for (;;) {
398 if (is(p, ';')) {
399 while (!is(p, '\n') && !end(p))
400 advance(p);
401 }
402 else if (isspace((unsigned char)current(p)))
403 advance(p);
404 else
405 break;
406 }
407}
408
409static char*
410_strndup(const char* src, size_t len)
411{
412 char* str = malloc(len + 1);
413 if (!str)
414 return NULL;
415
416 memcpy(str, src, len);
417 str[len] = '\0';
418
419 return str;
420}
421
422static void
423unescape(char* src)
424{
425 char* dst = src;
426
427 while (*src) {
428 if (*src == '\\' && src[1]) {
429 src++;
430 switch (*src) {
431 case 'n': *dst++ = '\n'; break;
432 case 't': *dst++ = '\t'; break;
433 case 'r': *dst++ = '\r'; break;
434 case '\\': *dst++ = '\\'; break;
435 case '"': *dst++ = '"'; break;
436 default:
437 *dst++ = '\\';
438 *dst++ = *src;
439 }
440 }
441 else {
442 *dst++ = *src;
443 }
444
445 src++;
446 }
447
448 *dst = '\0';
449}
450
451static expression*
452new_node(expression_type type)
453{
454 expression* node = calloc(1, sizeof(*node));
455 if (!node)
456 return NULL;
457 node->type = type;
458 return node;
459}
460
461static void
462free_node(expression* node)
463{
464 if (!node)
465 return;
466
467 free(node->value);
468 free_node(node->child);
469 free_node(node->next);
470 free(node);
471}
472
473static void
474free_environment(environment* env)
475{
476 while (env) {
477 environment* next = env->next;
478
479 if (env->value.type == EXPL_VALUE_FUNCTION)
480 free(env->value.as.function);
481
482 free(env->name);
483 free(env);
484 env = next;
485 }
486}
487
488expl* expl_init(void)
489{
490 return calloc(1, sizeof(expl));
491}
492
493void expl_close(expl* ctx)
494{
495 if (!ctx)
496 return;
497
498 free_environment(ctx->env);
499 free_node(ctx->programs);
500 free(ctx);
501}
502
503int
504expl_register(expl* ctx, const char* name, expl_native fn, void* data)
505{
506 function* f = NULL;
507 expl_value value = { 0 };
508
509 if (!f || !ctx || !name || !fn)
510 return 0;
511
512 f = calloc(1, sizeof(*f));
513 f->native = fn;
514 f->data = data;
515
516 value.type = EXPL_VALUE_FUNCTION;
517 value.as.function = f;
518
519 if (!define(&ctx->env, name, value)) {
520 free(f);
521 return 0;
522 }
523
524 return 1;
525}
526
527expl_value
528expl_run(expl* ctx, const char* source)
529{
530 expl_value result = { 0 };
531 expression* program = NULL;
532 expression* n = NULL;
533
534 if (!ctx || !source)
535 return result;
536
537 program = parse(source);
538 if (!program)
539 return result;
540
541 for (n = program; n; n = n->next)
542 result = eval(n, &ctx->env);
543
544 if (ctx->programs) {
545 n = ctx->programs;
546 while (n->next)
547 n = n->next;
548 n->next = program;
549 }
550 else
551 ctx->programs = program;
552
553 return result;
554}
555
