Browse Source

Add 1st code of chapter 10; parse Qexpressions

T. Meissner 7 months ago
parent
commit
e03863667c
3 changed files with 558 additions and 0 deletions
  1. 13
    0
      chapter_10/Makefile
  2. 483
    0
      chapter_10/lispy.c
  3. 62
    0
      chapter_10/lispy.h

+ 13
- 0
chapter_10/Makefile View File

@@ -0,0 +1,13 @@
1
+MPC_DIR := ../mpc
2
+
3
+
4
+all: lispy
5
+
6
+
7
+%: %.c
8
+	cc -std=c11 -Wall $@.c ${MPC_DIR}/mpc.c -ledit -o $@
9
+
10
+
11
+.PHONY: clean
12
+clean:
13
+	rm -rf lispy

+ 483
- 0
chapter_10/lispy.c View File

@@ -0,0 +1,483 @@
1
+#include <stdio.h>
2
+#include <stdlib.h>
3
+#include <assert.h>
4
+#include "../mpc/mpc.h"
5
+
6
+
7
+/* If we are on Windows compile these functions */
8
+#ifdef _WIN32
9
+#include <string.h>
10
+
11
+static char buffer[2048];
12
+
13
+/* Fake readline function */
14
+char* readline(char* prompt) {
15
+    fputs(prompt, stdout);
16
+    fgets(buffer, 2048, stdin);
17
+    char* cpy = malloc(strlen(buffer)+1);
18
+    assert(cpy != NULL)
19
+    strcpy(cpy, buffer);
20
+    cpy[strlen(cpy)-1] = '\0';
21
+    return cpy;
22
+}
23
+
24
+/* Fake add_history function */
25
+void add_history(char* unused) {}
26
+
27
+/* Otherwise include the editline headers
28
+   could use __APPLE__ for detection of OSX */
29
+#else
30
+#include <editline/readline.h>
31
+#endif
32
+
33
+/* Include type and function declarations */
34
+#include "lispy.h"
35
+
36
+
37
+/* Construct a pointer to a new number lval */
38
+lval* lval_num(long x) {
39
+    lval* v = malloc(sizeof(lval));
40
+    assert(v != NULL);
41
+    v->type = LVAL_NUM;
42
+    v->num = x;
43
+    return v;
44
+}
45
+
46
+
47
+/* Construct a pointer to a new decimal lval */
48
+lval* lval_dec(double x) {
49
+    lval* v = malloc(sizeof(lval));
50
+    assert(v != NULL);
51
+    v->type = LVAL_DEC;
52
+    v->dec = x;
53
+    return v;
54
+}
55
+
56
+
57
+/* Construct a pointer to a new error lval */
58
+lval* lval_err(char* m) {
59
+    lval* v = malloc(sizeof(lval));
60
+    assert(v != NULL);
61
+    v->type = LVAL_ERR;
62
+    v->err = malloc(strlen(m)+1);
63
+    assert(v->err != NULL);
64
+    strcpy(v->err, m);
65
+    return v;
66
+}
67
+
68
+
69
+/* Construct a pointer to a new symbol lval */
70
+lval* lval_sym(char* s) {
71
+    lval* v = malloc(sizeof(lval));
72
+    assert(v != NULL);
73
+    v->type = LVAL_SYM;
74
+    v->sym = malloc(strlen(s)+1);
75
+    assert(v->sym != NULL);
76
+    strcpy(v->sym, s);
77
+    return v;
78
+}
79
+
80
+
81
+/* Construct a pointer to a new empty sexpr lval */
82
+lval* lval_sexpr(void) {
83
+    lval* v = malloc(sizeof(lval));
84
+    assert(v != NULL);
85
+    v->type = LVAL_SEXPR;
86
+    v->count = 0;
87
+    v->cell = NULL;
88
+    return v;
89
+}
90
+
91
+
92
+/* Construct a pointer to a new empty qexpr lval */
93
+lval* lval_qexpr(void) {
94
+    lval* v = malloc(sizeof(lval));
95
+    assert(v != NULL);
96
+    v->type = LVAL_QEXPR;
97
+    v->count = 0;
98
+    v->cell = NULL;
99
+    return v;
100
+}
101
+
102
+
103
+/* Free memory of an lval and all its members */
104
+void lval_del(lval* v) {
105
+
106
+    switch (v->type) {
107
+        /* Do nothing special for number / decimal type */
108
+        case LVAL_NUM:
109
+        case LVAL_DEC:
110
+            break;
111
+
112
+        /* For err or sym free the string data */
113
+        case LVAL_ERR:
114
+            free(v->err);
115
+            break;
116
+        case LVAL_SYM:
117
+            free(v->sym);
118
+            break;
119
+
120
+        /* If sexpr then delete all elements inside */
121
+        case LVAL_SEXPR:
122
+        case LVAL_QEXPR:
123
+            for (size_t i = 0; i < v->count; i++) {
124
+                lval_del(v->cell[i]);
125
+            }
126
+            /* Also free the memory allocated to contain
127
+               the pointers */
128
+            free(v->cell);
129
+            break;
130
+    }
131
+    /* Free the memory allocated for the lval struct itself */
132
+    free(v);
133
+}
134
+
135
+
136
+lval* lval_read_num(mpc_ast_t* t) {
137
+    errno = 0;
138
+    if (strstr(t->contents, ".")) {
139
+        double x = strtod(t->contents, NULL);
140
+        return errno != ERANGE ? lval_dec(x)
141
+                               : lval_err("Invalid number");
142
+    } else {
143
+        long x = strtol(t->contents, NULL, 10);
144
+        return errno != ERANGE ? lval_num(x)
145
+                               : lval_err("Invalid number");
146
+    }
147
+}
148
+
149
+
150
+lval* lval_read(mpc_ast_t* t) {
151
+
152
+    /* If symbol or number return conversion to that type */
153
+    if (strstr(t->tag, "number")) {
154
+        return lval_read_num(t);
155
+    }
156
+    if (strstr(t->tag, "symbol")) {
157
+        return lval_sym(t->contents);
158
+    }
159
+
160
+    /* If root (>) or sexpr then create empty list */
161
+    lval* x = NULL;
162
+    if (strcmp(t->tag, ">") == 0 || strstr(t->tag, "sexpr")) {
163
+        x = lval_sexpr();
164
+    }
165
+
166
+    /* If qexpr create then empty list */
167
+    if (strstr(t->tag, "qexpr")) {
168
+        x = lval_qexpr();
169
+    }
170
+
171
+    /* Fill this list with any valid expression
172
+       contained within */
173
+    for (size_t i = 0; i < t->children_num; i++) {
174
+        if (strcmp(t->children[i]->contents, "(") == 0) {
175
+            continue;
176
+        }
177
+        if (strcmp(t->children[i]->contents, ")") == 0) {
178
+            continue;
179
+        }
180
+        if (strcmp(t->children[i]->contents, "{") == 0) {
181
+            continue;
182
+        }
183
+        if (strcmp(t->children[i]->contents, "}") == 0) {
184
+            continue;
185
+        }
186
+        if (strcmp(t->children[i]->tag, "regex") == 0) {
187
+            continue;
188
+        }
189
+        x = lval_add(x, lval_read(t->children[i]));
190
+    }
191
+
192
+    return x;
193
+}
194
+
195
+
196
+lval* lval_add(lval* v, lval* x) {
197
+    v->count++;
198
+    v->cell = realloc(v->cell, sizeof(lval*) * v->count);
199
+    assert(v->cell != NULL);
200
+    v->cell[v->count-1] = x;
201
+    return v;
202
+}
203
+
204
+
205
+void lval_expr_print(lval* v, char open, char close) {
206
+    /* Opening char */
207
+    putchar(open);
208
+
209
+    for (size_t i = 0; i < v->count; i++) {
210
+        /* Print value contained within */
211
+        lval_print(v->cell[i]);
212
+        /* Don't print trailing space if last element */
213
+        if (i != (v->count-1)) {
214
+            putchar(' ');
215
+        }
216
+    }
217
+    /* Opening char */
218
+    putchar(close);
219
+}
220
+
221
+
222
+/* Print an lval */
223
+void lval_print(lval* v) {
224
+
225
+    switch (v->type) {
226
+        /* In the case the type is a number print it
227
+           Then break out of the switch */
228
+        case LVAL_NUM:
229
+            printf("%li", v->num);
230
+            break;
231
+        case LVAL_DEC:
232
+            printf("%.2f", v->dec);
233
+            break;
234
+        /* In the case the type is an error */
235
+        case LVAL_ERR:
236
+            printf("Error: %s", v->err);
237
+            break;
238
+        case LVAL_SYM:
239
+            printf("%s", v->sym);
240
+            break;
241
+        case LVAL_SEXPR:
242
+            lval_expr_print(v, '(', ')');
243
+            break;
244
+        case LVAL_QEXPR:
245
+            lval_expr_print(v, '{', '}');
246
+            break;
247
+    }
248
+
249
+}
250
+
251
+
252
+/* Print an lval followed by a newline */
253
+void lval_println(lval* v) {
254
+    lval_print(v);
255
+    putchar('\n');
256
+}
257
+
258
+
259
+lval* lval_eval_sexpr(lval* v) {
260
+
261
+    /* Evaluate children */
262
+    for (size_t i = 0; i < v->count; i++) {
263
+        v->cell[i] = lval_eval(v->cell[i]);
264
+    }
265
+
266
+    /* Error checking */
267
+    for (size_t i = 0; i < v->count; i++) {
268
+        if (v->cell[i]->type == LVAL_ERR) {
269
+            return lval_take(v, i);
270
+        }
271
+    }
272
+
273
+    /* Empty expression */
274
+    if (v->count == 0) {
275
+        return v;
276
+    }
277
+
278
+    /* Single expression */
279
+    if (v->count == 1) {
280
+        return lval_take(v, 0);
281
+    }
282
+
283
+    /* Ensure first element is symbol */
284
+    lval* f = lval_pop(v, 0);
285
+    if (f->type != LVAL_SYM) {
286
+        lval_del(f);
287
+        lval_del(v);
288
+        return lval_err("S-expression does not start with symbol!");
289
+    }
290
+
291
+    /* Call builtin with operator */
292
+    lval* result = builtin_op(v, f->sym);
293
+    lval_del(f);
294
+    return result;
295
+
296
+}
297
+
298
+
299
+lval* lval_eval(lval* v) {
300
+
301
+    /* Evaluate sexpressions */
302
+    if (v->type == LVAL_SEXPR) {
303
+        return lval_eval_sexpr(v);
304
+    }
305
+
306
+    /* All other lval types remain the same */
307
+    return v;
308
+
309
+}
310
+
311
+
312
+lval* lval_pop(lval* v, size_t i) {
313
+
314
+    /* Fine the item at i */
315
+    lval* x = v->cell[i];
316
+
317
+    /* Shift memory after the item at i over the top */
318
+    memmove(&v->cell[i], &v->cell[i+1],
319
+            sizeof(lval*) * (v->count-i-1));
320
+
321
+    /* Decrease the count of items in the list */
322
+    v->count--;
323
+
324
+    /* Reallocate the memory used */
325
+    v->cell = realloc(v->cell, sizeof(lval*) * v->count);
326
+    assert(v->cell != NULL);
327
+
328
+    return x;
329
+
330
+}
331
+
332
+lval* lval_take(lval* v, size_t i) {
333
+
334
+    lval* x = lval_pop(v, i);
335
+    lval_del(v);
336
+    return x;
337
+
338
+}
339
+
340
+
341
+lval* builtin_op(lval* a, char* op) {
342
+
343
+    /* Ensure all arguments are numbers */
344
+    for (size_t i = 0; i < a->count; i++) {
345
+        if (a->cell[i]->type != LVAL_NUM && a->cell[i]->type != LVAL_DEC) {
346
+            lval_del(a);
347
+            return lval_err("Cannot operate on non-number/non-decimal!");
348
+        }
349
+    }
350
+
351
+    /* Pop the 1st element */
352
+    lval* x = lval_pop(a, 0);
353
+
354
+    /* If no arguments and sub then perform unary negation */
355
+    if (strcmp(op, "-") == 0 &&  a->count == 0) {
356
+        if (x->type == LVAL_NUM) {
357
+            x->num = -x->num;
358
+        } else {
359
+            x->dec = -x->dec;
360
+        }
361
+    }
362
+
363
+    /* While there are still elements remaining */
364
+    while (a->count > 0) {
365
+        /* Pop the next element */
366
+        lval* y = lval_pop(a, 0);
367
+        if (x->type == LVAL_NUM && y->type == LVAL_NUM) {
368
+            if (strcmp(op, "+") == 0) {x->num += y->num;}
369
+            if (strcmp(op, "-") == 0) {x->num -= y->num;}
370
+            if (strcmp(op, "*") == 0) {x->num *= y->num;}
371
+            if (strcmp(op, "/") == 0) {
372
+                /* If second operand is zero return error */
373
+                if (y->num == 0) {
374
+                    lval_del(x);
375
+                    lval_del(y);
376
+                    x = lval_err("Division by zero!");
377
+                    break;
378
+                }
379
+                x->num /= y->num;
380
+            }
381
+            if (strcmp(op, "%") == 0) {x->num %= y->num;}
382
+            if (strcmp(op, "^") == 0) {x->num = (pow(x->num, y->num));}
383
+            if (strcmp(op, "min") == 0) {x->num = min(x->num, y->num);}
384
+            if (strcmp(op, "max") == 0) {x->num = max(x->num, y->num);}
385
+        } else {
386
+            /* Cast integer number into double if necessary */
387
+            double b = x->type == LVAL_NUM ? (double) x->num : x->dec;
388
+            double c = y->type == LVAL_NUM ? (double) y->num : y->dec;
389
+            /* Perform all operations on double */
390
+            if (strcmp(op, "+") == 0) {b += c;}
391
+            if (strcmp(op, "-") == 0) {b -= c;}
392
+            if (strcmp(op, "*") == 0) {b *= c;}
393
+            if (strcmp(op, "/") == 0) {
394
+                /* If second operand is zero return error */
395
+                if (c == 0) {
396
+                    lval_del(x);
397
+                    lval_del(y);
398
+                    x = lval_err("Division by zero!");
399
+                    break;
400
+                }
401
+                b /= c;
402
+            }
403
+            if (strcmp(op, "%") == 0) {b = fmod(b, c);}
404
+            if (strcmp(op, "^") == 0) {b = (pow(b, c));}
405
+            if (strcmp(op, "min") == 0) {b = fmin(b, c);}
406
+            if (strcmp(op, "max") == 0) {b = fmax(b, c);}
407
+            x->type = LVAL_DEC;
408
+            x->dec = b;
409
+        }
410
+    }
411
+
412
+    lval_del(a);
413
+    return x;
414
+
415
+}
416
+
417
+
418
+long min(long x, long y) {
419
+    if (x <= y) {
420
+        return x;
421
+    } else {
422
+        return y;
423
+    }
424
+}
425
+
426
+
427
+long max(long x, long y) {
428
+    if (x >= y) {
429
+        return x;
430
+    } else {
431
+        return y;
432
+    }
433
+}
434
+
435
+
436
+int main(int argc, char const *argv[]) {
437
+
438
+    /* Create some parsers */
439
+    mpc_parser_t* Number = mpc_new("number");
440
+    mpc_parser_t* Symbol = mpc_new("symbol");
441
+    mpc_parser_t* Sexpr = mpc_new("sexpr");
442
+    mpc_parser_t* Qexpr = mpc_new("qexpr");
443
+    mpc_parser_t* Expr = mpc_new("expr");
444
+    mpc_parser_t* Lispy = mpc_new("lispy");
445
+
446
+    /* Define them with the following language */
447
+    mpca_lang(MPCA_LANG_DEFAULT, parser,
448
+        Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
449
+
450
+    /* Print version and exit information */
451
+    puts(lispy_version);
452
+    puts("Press Ctrl+c to exit\n");
453
+
454
+    /* In a never ending loop */
455
+    while (1) {
456
+        /* Output our prompt and get input */
457
+        char* input = readline("lispy> ");
458
+
459
+        /* Add input to history */
460
+        add_history(input);
461
+
462
+        /* Attempt to parse the user input */
463
+        mpc_result_t r;
464
+        if (mpc_parse("<stdin>", input, Lispy, &r)) {
465
+            /* On success evaluate the user input */
466
+            lval* x = lval_eval(lval_read(r.output));
467
+            lval_println(x);
468
+            lval_del(x);
469
+        } else {
470
+            /* Otherwise print the error */
471
+            mpc_err_print(r.error);
472
+            mpc_err_delete(r.error);
473
+        }
474
+
475
+        /* Free retrieved input */
476
+        free(input);
477
+    }
478
+
479
+    /* Undefine and delete our parsers */
480
+    mpc_cleanup(5, Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
481
+
482
+    return 0;
483
+}

+ 62
- 0
chapter_10/lispy.h View File

@@ -0,0 +1,62 @@
1
+static char* lispy_version = "Lispy version 0.0.0.0.6";
2
+
3
+
4
+/* Parser language defintion */
5
+static char* parser =
6
+"                                                        \
7
+    number   : /-?[0-9]+([.][0-9]*|[0-9]*)/ ;            \
8
+    symbol : '+' | '-' | '*' | '/' | '%' | '^' |         \
9
+    \"min\" | \"max\" ;                                  \
10
+    sexpr    : '(' <expr>* ')' ;                         \
11
+    qexpr    : '{' <expr>* '}' ;                         \
12
+    expr     : <number> | <symbol> | <sexpr> | <qexpr>;  \
13
+    lispy    : /^/ <expr>* /$/ ;                         \
14
+";
15
+
16
+
17
+/* Declare new lval struct */
18
+typedef struct lval {
19
+    int type;
20
+    long num;
21
+    double dec;
22
+    /* Error & symbol types have some string data */
23
+    char* err;
24
+    char* sym;
25
+    /* Counter & pointer to a list of lval */
26
+    size_t count;
27
+    struct lval** cell;
28
+} lval;
29
+
30
+
31
+/* Create enumeration of possible lval types */
32
+enum {LVAL_NUM, LVAL_DEC, LVAL_SYM, LVAL_SEXPR, LVAL_QEXPR, LVAL_ERR};
33
+
34
+/* lval constructor functions */
35
+lval* lval_num(long x);
36
+lval* lval_dec(double x);
37
+lval* lval_err(char* m);
38
+lval* lval_sym(char* s);
39
+lval* lval_sexpr(void);
40
+lval* lval_qexpr(void);
41
+
42
+/* lval destructor function */
43
+void lval_del(lval* v);
44
+
45
+/* lval manipulating functions */
46
+lval* lval_add(lval* v, lval* x);
47
+lval* lval_pop(lval* v, size_t i);
48
+lval* lval_take(lval* v, size_t i);
49
+
50
+lval* lval_read_num(mpc_ast_t* t);
51
+lval* lval_read(mpc_ast_t* t);
52
+lval* lval_eval_sexpr(lval* v);
53
+lval* lval_eval(lval* v);
54
+
55
+void lval_expr_print(lval* v, char open, char close);
56
+void lval_print(lval* v);
57
+void lval_println(lval* v);
58
+
59
+long min(long x, long y);
60
+long max(long x, long y);
61
+
62
+lval* builtin_op(lval* a, char* op);