Add 1st code of chapter 10; parse Qexpressions

chapter_10/Makefile

@@ -0,0 +1,13 @@
+MPC_DIR := ../mpc
+
+
+all: lispy
+
+
+%: %.c
+	cc -std=c11 -Wall $@.c ${MPC_DIR}/mpc.c -ledit -o $@
+
+
+.PHONY: clean
+clean:
+	rm -rf lispy

chapter_10/lispy.c

@@ -0,0 +1,483 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+#include "../mpc/mpc.h"
+
+
+/* If we are on Windows compile these functions */
+#ifdef _WIN32
+#include <string.h>
+
+static char buffer[2048];
+
+/* Fake readline function */
+char* readline(char* prompt) {
+    fputs(prompt, stdout);
+    fgets(buffer, 2048, stdin);
+    char* cpy = malloc(strlen(buffer)+1);
+    assert(cpy != NULL)
+    strcpy(cpy, buffer);
+    cpy[strlen(cpy)-1] = '\0';
+    return cpy;
+}
+
+/* Fake add_history function */
+void add_history(char* unused) {}
+
+/* Otherwise include the editline headers
+   could use __APPLE__ for detection of OSX */
+#else
+#include <editline/readline.h>
+#endif
+
+/* Include type and function declarations */
+#include "lispy.h"
+
+
+/* Construct a pointer to a new number lval */
+lval* lval_num(long x) {
+    lval* v = malloc(sizeof(lval));
+    assert(v != NULL);
+    v->type = LVAL_NUM;
+    v->num = x;
+    return v;
+}
+
+
+/* Construct a pointer to a new decimal lval */
+lval* lval_dec(double x) {
+    lval* v = malloc(sizeof(lval));
+    assert(v != NULL);
+    v->type = LVAL_DEC;
+    v->dec = x;
+    return v;
+}
+
+
+/* Construct a pointer to a new error lval */
+lval* lval_err(char* m) {
+    lval* v = malloc(sizeof(lval));
+    assert(v != NULL);
+    v->type = LVAL_ERR;
+    v->err = malloc(strlen(m)+1);
+    assert(v->err != NULL);
+    strcpy(v->err, m);
+    return v;
+}
+
+
+/* Construct a pointer to a new symbol lval */
+lval* lval_sym(char* s) {
+    lval* v = malloc(sizeof(lval));
+    assert(v != NULL);
+    v->type = LVAL_SYM;
+    v->sym = malloc(strlen(s)+1);
+    assert(v->sym != NULL);
+    strcpy(v->sym, s);
+    return v;
+}
+
+
+/* Construct a pointer to a new empty sexpr lval */
+lval* lval_sexpr(void) {
+    lval* v = malloc(sizeof(lval));
+    assert(v != NULL);
+    v->type = LVAL_SEXPR;
+    v->count = 0;
+    v->cell = NULL;
+    return v;
+}
+
+
+/* Construct a pointer to a new empty qexpr lval */
+lval* lval_qexpr(void) {
+    lval* v = malloc(sizeof(lval));
+    assert(v != NULL);
+    v->type = LVAL_QEXPR;
+    v->count = 0;
+    v->cell = NULL;
+    return v;
+}
+
+
+/* Free memory of an lval and all its members */
+void lval_del(lval* v) {
+
+    switch (v->type) {
+        /* Do nothing special for number / decimal type */
+        case LVAL_NUM:
+        case LVAL_DEC:
+            break;
+
+        /* For err or sym free the string data */
+        case LVAL_ERR:
+            free(v->err);
+            break;
+        case LVAL_SYM:
+            free(v->sym);
+            break;
+
+        /* If sexpr then delete all elements inside */
+        case LVAL_SEXPR:
+        case LVAL_QEXPR:
+            for (size_t i = 0; i < v->count; i++) {
+                lval_del(v->cell[i]);
+            }
+            /* Also free the memory allocated to contain
+               the pointers */
+            free(v->cell);
+            break;
+    }
+    /* Free the memory allocated for the lval struct itself */
+    free(v);
+}
+
+
+lval* lval_read_num(mpc_ast_t* t) {
+    errno = 0;
+    if (strstr(t->contents, ".")) {
+        double x = strtod(t->contents, NULL);
+        return errno != ERANGE ? lval_dec(x)
+                               : lval_err("Invalid number");
+    } else {
+        long x = strtol(t->contents, NULL, 10);
+        return errno != ERANGE ? lval_num(x)
+                               : lval_err("Invalid number");
+    }
+}
+
+
+lval* lval_read(mpc_ast_t* t) {
+
+    /* If symbol or number return conversion to that type */
+    if (strstr(t->tag, "number")) {
+        return lval_read_num(t);
+    }
+    if (strstr(t->tag, "symbol")) {
+        return lval_sym(t->contents);
+    }
+
+    /* If root (>) or sexpr then create empty list */
+    lval* x = NULL;
+    if (strcmp(t->tag, ">") == 0 || strstr(t->tag, "sexpr")) {
+        x = lval_sexpr();
+    }
+
+    /* If qexpr create then empty list */
+    if (strstr(t->tag, "qexpr")) {
+        x = lval_qexpr();
+    }
+
+    /* Fill this list with any valid expression
+       contained within */
+    for (size_t i = 0; i < t->children_num; i++) {
+        if (strcmp(t->children[i]->contents, "(") == 0) {
+            continue;
+        }
+        if (strcmp(t->children[i]->contents, ")") == 0) {
+            continue;
+        }
+        if (strcmp(t->children[i]->contents, "{") == 0) {
+            continue;
+        }
+        if (strcmp(t->children[i]->contents, "}") == 0) {
+            continue;
+        }
+        if (strcmp(t->children[i]->tag, "regex") == 0) {
+            continue;
+        }
+        x = lval_add(x, lval_read(t->children[i]));
+    }
+
+    return x;
+}
+
+
+lval* lval_add(lval* v, lval* x) {
+    v->count++;
+    v->cell = realloc(v->cell, sizeof(lval*) * v->count);
+    assert(v->cell != NULL);
+    v->cell[v->count-1] = x;
+    return v;
+}
+
+
+void lval_expr_print(lval* v, char open, char close) {
+    /* Opening char */
+    putchar(open);
+
+    for (size_t i = 0; i < v->count; i++) {
+        /* Print value contained within */
+        lval_print(v->cell[i]);
+        /* Don't print trailing space if last element */
+        if (i != (v->count-1)) {
+            putchar(' ');
+        }
+    }
+    /* Opening char */
+    putchar(close);
+}
+
+
+/* Print an lval */
+void lval_print(lval* v) {
+
+    switch (v->type) {
+        /* In the case the type is a number print it
+           Then break out of the switch */
+        case LVAL_NUM:
+            printf("%li", v->num);
+            break;
+        case LVAL_DEC:
+            printf("%.2f", v->dec);
+            break;
+        /* In the case the type is an error */
+        case LVAL_ERR:
+            printf("Error: %s", v->err);
+            break;
+        case LVAL_SYM:
+            printf("%s", v->sym);
+            break;
+        case LVAL_SEXPR:
+            lval_expr_print(v, '(', ')');
+            break;
+        case LVAL_QEXPR:
+            lval_expr_print(v, '{', '}');
+            break;
+    }
+
+}
+
+
+/* Print an lval followed by a newline */
+void lval_println(lval* v) {
+    lval_print(v);
+    putchar('\n');
+}
+
+
+lval* lval_eval_sexpr(lval* v) {
+
+    /* Evaluate children */
+    for (size_t i = 0; i < v->count; i++) {
+        v->cell[i] = lval_eval(v->cell[i]);
+    }
+
+    /* Error checking */
+    for (size_t i = 0; i < v->count; i++) {
+        if (v->cell[i]->type == LVAL_ERR) {
+            return lval_take(v, i);
+        }
+    }
+
+    /* Empty expression */
+    if (v->count == 0) {
+        return v;
+    }
+
+    /* Single expression */
+    if (v->count == 1) {
+        return lval_take(v, 0);
+    }
+
+    /* Ensure first element is symbol */
+    lval* f = lval_pop(v, 0);
+    if (f->type != LVAL_SYM) {
+        lval_del(f);
+        lval_del(v);
+        return lval_err("S-expression does not start with symbol!");
+    }
+
+    /* Call builtin with operator */
+    lval* result = builtin_op(v, f->sym);
+    lval_del(f);
+    return result;
+
+}
+
+
+lval* lval_eval(lval* v) {
+
+    /* Evaluate sexpressions */
+    if (v->type == LVAL_SEXPR) {
+        return lval_eval_sexpr(v);
+    }
+
+    /* All other lval types remain the same */
+    return v;
+
+}
+
+
+lval* lval_pop(lval* v, size_t i) {
+
+    /* Fine the item at i */
+    lval* x = v->cell[i];
+
+    /* Shift memory after the item at i over the top */
+    memmove(&v->cell[i], &v->cell[i+1],
+            sizeof(lval*) * (v->count-i-1));
+
+    /* Decrease the count of items in the list */
+    v->count--;
+
+    /* Reallocate the memory used */
+    v->cell = realloc(v->cell, sizeof(lval*) * v->count);
+    assert(v->cell != NULL);
+
+    return x;
+
+}
+
+lval* lval_take(lval* v, size_t i) {
+
+    lval* x = lval_pop(v, i);
+    lval_del(v);
+    return x;
+
+}
+
+
+lval* builtin_op(lval* a, char* op) {
+
+    /* Ensure all arguments are numbers */
+    for (size_t i = 0; i < a->count; i++) {
+        if (a->cell[i]->type != LVAL_NUM && a->cell[i]->type != LVAL_DEC) {
+            lval_del(a);
+            return lval_err("Cannot operate on non-number/non-decimal!");
+        }
+    }
+
+    /* Pop the 1st element */
+    lval* x = lval_pop(a, 0);
+
+    /* If no arguments and sub then perform unary negation */
+    if (strcmp(op, "-") == 0 &&  a->count == 0) {
+        if (x->type == LVAL_NUM) {
+            x->num = -x->num;
+        } else {
+            x->dec = -x->dec;
+        }
+    }
+
+    /* While there are still elements remaining */
+    while (a->count > 0) {
+        /* Pop the next element */
+        lval* y = lval_pop(a, 0);
+        if (x->type == LVAL_NUM && y->type == LVAL_NUM) {
+            if (strcmp(op, "+") == 0) {x->num += y->num;}
+            if (strcmp(op, "-") == 0) {x->num -= y->num;}
+            if (strcmp(op, "*") == 0) {x->num *= y->num;}
+            if (strcmp(op, "/") == 0) {
+                /* If second operand is zero return error */
+                if (y->num == 0) {
+                    lval_del(x);
+                    lval_del(y);
+                    x = lval_err("Division by zero!");
+                    break;
+                }
+                x->num /= y->num;
+            }
+            if (strcmp(op, "%") == 0) {x->num %= y->num;}
+            if (strcmp(op, "^") == 0) {x->num = (pow(x->num, y->num));}
+            if (strcmp(op, "min") == 0) {x->num = min(x->num, y->num);}
+            if (strcmp(op, "max") == 0) {x->num = max(x->num, y->num);}
+        } else {
+            /* Cast integer number into double if necessary */
+            double b = x->type == LVAL_NUM ? (double) x->num : x->dec;
+            double c = y->type == LVAL_NUM ? (double) y->num : y->dec;
+            /* Perform all operations on double */
+            if (strcmp(op, "+") == 0) {b += c;}
+            if (strcmp(op, "-") == 0) {b -= c;}
+            if (strcmp(op, "*") == 0) {b *= c;}
+            if (strcmp(op, "/") == 0) {
+                /* If second operand is zero return error */
+                if (c == 0) {
+                    lval_del(x);
+                    lval_del(y);
+                    x = lval_err("Division by zero!");
+                    break;
+                }
+                b /= c;
+            }
+            if (strcmp(op, "%") == 0) {b = fmod(b, c);}
+            if (strcmp(op, "^") == 0) {b = (pow(b, c));}
+            if (strcmp(op, "min") == 0) {b = fmin(b, c);}
+            if (strcmp(op, "max") == 0) {b = fmax(b, c);}
+            x->type = LVAL_DEC;
+            x->dec = b;
+        }
+    }
+
+    lval_del(a);
+    return x;
+
+}
+
+
+long min(long x, long y) {
+    if (x <= y) {
+        return x;
+    } else {
+        return y;
+    }
+}
+
+
+long max(long x, long y) {
+    if (x >= y) {
+        return x;
+    } else {
+        return y;
+    }
+}
+
+
+int main(int argc, char const *argv[]) {
+
+    /* Create some parsers */
+    mpc_parser_t* Number = mpc_new("number");
+    mpc_parser_t* Symbol = mpc_new("symbol");
+    mpc_parser_t* Sexpr = mpc_new("sexpr");
+    mpc_parser_t* Qexpr = mpc_new("qexpr");
+    mpc_parser_t* Expr = mpc_new("expr");
+    mpc_parser_t* Lispy = mpc_new("lispy");
+
+    /* Define them with the following language */
+    mpca_lang(MPCA_LANG_DEFAULT, parser,
+        Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
+
+    /* Print version and exit information */
+    puts(lispy_version);
+    puts("Press Ctrl+c to exit\n");
+
+    /* In a never ending loop */
+    while (1) {
+        /* Output our prompt and get input */
+        char* input = readline("lispy> ");
+
+        /* Add input to history */
+        add_history(input);
+
+        /* Attempt to parse the user input */
+        mpc_result_t r;
+        if (mpc_parse("<stdin>", input, Lispy, &r)) {
+            /* On success evaluate the user input */
+            lval* x = lval_eval(lval_read(r.output));
+            lval_println(x);
+            lval_del(x);
+        } else {
+            /* Otherwise print the error */
+            mpc_err_print(r.error);
+            mpc_err_delete(r.error);
+        }
+
+        /* Free retrieved input */
+        free(input);
+    }
+
+    /* Undefine and delete our parsers */
+    mpc_cleanup(5, Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
+
+    return 0;
+}

chapter_10/lispy.h

@@ -0,0 +1,62 @@
+static char* lispy_version = "Lispy version 0.0.0.0.6";
+
+
+/* Parser language defintion */
+static char* parser =
+"                                                        \
+    number   : /-?[0-9]+([.][0-9]*|[0-9]*)/ ;            \
+    symbol : '+' | '-' | '*' | '/' | '%' | '^' |         \
+    \"min\" | \"max\" ;                                  \
+    sexpr    : '(' <expr>* ')' ;                         \
+    qexpr    : '{' <expr>* '}' ;                         \
+    expr     : <number> | <symbol> | <sexpr> | <qexpr>;  \
+    lispy    : /^/ <expr>* /$/ ;                         \
+";
+
+
+/* Declare new lval struct */
+typedef struct lval {
+    int type;
+    long num;
+    double dec;
+    /* Error & symbol types have some string data */
+    char* err;
+    char* sym;
+    /* Counter & pointer to a list of lval */
+    size_t count;
+    struct lval** cell;
+} lval;
+
+
+/* Create enumeration of possible lval types */
+enum {LVAL_NUM, LVAL_DEC, LVAL_SYM, LVAL_SEXPR, LVAL_QEXPR, LVAL_ERR};
+
+/* lval constructor functions */
+lval* lval_num(long x);
+lval* lval_dec(double x);
+lval* lval_err(char* m);
+lval* lval_sym(char* s);
+lval* lval_sexpr(void);
+lval* lval_qexpr(void);
+
+/* lval destructor function */
+void lval_del(lval* v);
+
+/* lval manipulating functions */
+lval* lval_add(lval* v, lval* x);
+lval* lval_pop(lval* v, size_t i);
+lval* lval_take(lval* v, size_t i);
+
+lval* lval_read_num(mpc_ast_t* t);
+lval* lval_read(mpc_ast_t* t);
+lval* lval_eval_sexpr(lval* v);
+lval* lval_eval(lval* v);
+
+void lval_expr_print(lval* v, char open, char close);
+void lval_print(lval* v);
+void lval_println(lval* v);
+
+long min(long x, long y);
+long max(long x, long y);
+
+lval* builtin_op(lval* a, char* op);