|
|
- #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 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;
- }
-
-
- /* Free memory of an lval and all its members */
- void lval_del(lval* v) {
-
- switch (v->type) {
- /* Do nothing special for number type */
- case LVAL_NUM:
- 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:
- 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;
- 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();
- }
-
- /* 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;
- /* 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;
- }
-
- }
-
-
- /* 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) {
- lval_del(a);
- return lval_err("Cannot operate on non-number!");
- }
- }
-
- /* 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) {
- x->num = -x->num;
- }
-
- /* While there are still elements remaining */
- while (a->count > 0) {
- /* Pop the next element */
- lval* y = lval_pop(a, 0);
-
- 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);}
- }
-
- 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* 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, 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, Expr, Lispy);
-
- return 0;
- }
|