|
@ -0,0 +1,413 @@ |
|
|
|
|
|
#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; |
|
|
|
|
|
} |