#include #include #include #include "../mpc/mpc.h" /* If we are on Windows compile these functions */ #ifdef _WIN32 #include 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 #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 < (size_t) 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(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(lval* a, char* func) { /* Check for builtin functions */ if (strcmp("list", func) == 0) {return builtin_list(a);} if (strcmp("head", func) == 0) {return builtin_head(a);} if (strcmp("tail", func) == 0) {return builtin_tail(a);} if (strcmp("join", func) == 0) {return builtin_join(a);} if (strcmp("eval", func) == 0) {return builtin_eval(a);} if (strcmp("cons", func) == 0) {return builtin_cons(a);} if (strcmp("len", func) == 0) {return builtin_len(a);} if (strcmp("init", func) == 0) {return builtin_init(a);} /* Check for operators */ if (strstr("+-*/%^", func) || strcmp("min", func) == 0 || strcmp("max", func) == 0) { return builtin_op(a, func); } lval_del(a); return lval_err("Unknown function!"); } 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; } lval* builtin_head(lval* a) { /* Check error conditions */ LASSERT(a, a->count == 1, "Function 'head' passed too many arguments!"); LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'head' passed incorrect type!"); LASSERT(a, a->cell[0]->count != 0, "Function 'head' passed {}!"); /* Otherwise take first argument */ lval* v = lval_take(a, 0); /* Delete all elements that are not head and return */ while (v-> count > 1) { lval_del(lval_pop(v, 1)); } return v; } lval* builtin_tail(lval* a) { /* Check error conditions */ LASSERT(a, a->count == 1, "Function 'tail' passed too many arguments!"); LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'tail' passed incorrect type!"); LASSERT(a, a->cell[0]->count != 0, "Function 'tail' passed {}!"); /* Otherwise take first argument */ lval* v = lval_take(a, 0); /* Delete first element and return */ lval_del(lval_pop(v, 0)); return v; } lval* builtin_list(lval* a) { a->type = LVAL_QEXPR; return a; } lval* builtin_eval(lval* a) { /* Check error conditions */ LASSERT(a, a->count == 1, "Function 'eval' passed too many arguments!"); LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'eval' passed incorrect type!"); lval* x = lval_take(a, 0); x->type = LVAL_SEXPR; return lval_eval(x); } lval* builtin_join(lval* a) { /* Check error conditions */ for (size_t i = 0; i < a->count; i++) { LASSERT(a, a->cell[i]->type == LVAL_QEXPR, "Function 'join' passed incorrect type!"); } lval* x = lval_pop(a, 0); while (a->count) { x = lval_join(x, lval_pop(a, 0)); } lval_del(a); return x; } lval* lval_join(lval* x, lval* y) { /* For each cell in y add it to x */ while (y->count) { x = lval_add(x, lval_pop(y, 0)); } /* Delete the empty y and return x */ lval_del(y); return x; } lval* builtin_cons(lval* a) { /* Check error conditions */ LASSERT(a, a->count == 2 , "Function 'cons' takes exactly 2 arguments!"); LASSERT(a, a->cell[1]->type == LVAL_QEXPR, "Function 'cons' passed incorrect type!"); lval* v = lval_qexpr(); v = lval_add(v, lval_pop(a, 0)); lval* y = lval_pop(a, 0); while (y->count) { v = lval_add(v, lval_pop(y, 0)); } lval_del(a); lval_del(y); return v; } lval* builtin_len(lval* a) { /* Check error conditions */ LASSERT(a, a->count == 1, "Function 'len' passed too many arguments!"); LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'len' passed incorrect type!"); lval* v = lval_num(a->cell[0]->count); return v; } lval* builtin_init(lval* a) { /* Check error conditions */ LASSERT(a, a->count == 1, "Function 'init' passed too many arguments!"); LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'init' passed incorrect type!"); LASSERT(a, a->cell[0]->count != 0, "Function 'init' passed {}!"); /* Otherwise take first argument */ lval* v = lval_take(a, 0); /* Delete last element and return */ lval_del(lval_pop(v, v->count-1)); return v; } 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() { /* 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("", 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(6, Number, Symbol, Sexpr, Qexpr, Expr, Lispy); return 0; }