#include #include #include #include #include #include "mpc/mpc.h" #define VERBOSE 0 #define LISPVAL_ASSERT(cond, err) \ if (!(cond)) { return lispval_err(err); } // Types typedef struct lispval { int type; double num; char* err; char* sym; int count; struct lispval** cell; // list of lisval* } lispval; enum { LISPVAL_NUM, LISPVAL_ERR, LISPVAL_SYM, LISPVAL_SEXPR, LISPVAL_QEXPR, }; enum { LISPERR_DIV_ZERO, LISPERR_BAD_OP, LISPERR_BAD_NUM }; // Constructors lispval* lispval_num(double x) { lispval* v = malloc(sizeof(lispval)); v->type = LISPVAL_NUM; v->count = 0; v->num = x; return v; } lispval* lispval_err(char* message) { lispval* v = malloc(sizeof(lispval)); v->type = LISPVAL_ERR; v->count = 0; v->err = malloc(strlen(message) + 1); strcpy(v->err, message); return v; } lispval* lispval_sym(char* symbol) { lispval* v = malloc(sizeof(lispval)); v->type = LISPVAL_SYM; v->count = 0; v->sym = malloc(strlen(symbol) + 1); strcpy(v->sym, symbol); return v; } lispval* lispval_sexpr(void) { lispval* v = malloc(sizeof(lispval)); v->type = LISPVAL_SEXPR; v->count = 0; v->cell = NULL; return v; } lispval* lispval_qexpr(void) { lispval* v = malloc(sizeof(lispval)); v->type = LISPVAL_QEXPR; v->count = 0; v->cell = NULL; return v; } // Destructor void delete_lispval(lispval* v) { switch (v->type) { case LISPVAL_NUM: break; case LISPVAL_ERR: free(v->err); break; case LISPVAL_SYM: free(v->sym); break; case LISPVAL_SEXPR: case LISPVAL_QEXPR: for (int i = 0; i < v->count; i++) { delete_lispval(v->cell[i]); } free(v->cell); break; } free(v); } // Read ast into a lispval object lispval* lispval_append_child(lispval* parent, lispval* child) { parent->count = parent->count + 1; parent->cell = realloc(parent->cell, sizeof(lispval) * parent->count); parent->cell[parent->count - 1] = child; return parent; } lispval* read_lispval_num(mpc_ast_t* t) { errno = 0; double x = strtod(t->contents, NULL); return errno != ERANGE ? lispval_num(x) : lispval_err("Error: Invalid number."); } lispval* read_lispval(mpc_ast_t* t) { // Non-ignorable children // Relevant for the edge-case of considering the case where you // only have one top level item. int c = 0; int c_index = -1; for(int i=0; ichildren_num; i++){ mpc_ast_t* child = t->children[i]; if( ( strcmp(child->tag, "regex") != 0 ) || (strcmp(child->contents, "") != 0 ) || child->children_num != 0 ){ c++; c_index = i; } } if(VERBOSE) printf("\nNon ignorable children: %i", c); if (strstr(t->tag, "number")) { return read_lispval_num(t); } else if (strstr(t->tag, "symbol")) { return lispval_sym(t->contents); } else if ((strcmp(t->tag, ">") == 0) && (c==1)) { return read_lispval(t->children[c_index]); } else if ((strcmp(t->tag, ">") == 0) || strstr(t->tag, "sexpr") || strstr(t->tag, "qexpr")) { lispval* x; if((strcmp(t->tag, ">") == 0) || strstr(t->tag, "sexpr")){ x = lispval_sexpr(); } else if(strstr(t->tag, "qexpr")){ x = lispval_qexpr(); } else { return lispval_err("Error: Unreachable code state reached."); } for (int i = 0; i < (t->children_num); i++) { if (strcmp(t->children[i]->contents, "(") == 0) { continue; } else if (strcmp(t->children[i]->contents, ")") == 0) { continue; } else if (strcmp(t->children[i]->contents, "{") == 0) { continue; } else if (strcmp(t->children[i]->contents, "}") == 0) { continue; } else if (strcmp(t->children[i]->tag, "regex") == 0) { continue; } else { x = lispval_append_child(x, read_lispval(t->children[i])); } } return x; } else { lispval* err = lispval_err("Unknown AST type."); return err; } } // Print void print_lispval_tree(lispval* v, int indent_level) { char* indent = malloc(sizeof(char) * (indent_level + 1)); // ""; for (int i = 0; i < indent_level; i++) { indent[i] = ' '; } indent[indent_level] = '\0'; switch (v->type) { case LISPVAL_NUM: printf("\n%sNumber: %f", indent, v->num); break; case LISPVAL_ERR: printf("\n%sError: %s", indent, v->err); break; case LISPVAL_SYM: printf("\n%sSymbol: %s", indent, v->sym); break; case LISPVAL_SEXPR: printf("\n%sSExpr, with %d children:", indent, v->count); for (int i = 0; i < v->count; i++) { print_lispval_tree(v->cell[i], indent_level + 2); } break; case LISPVAL_QEXPR: printf("\n%sQExpr, with %d children:", indent, v->count); for (int i = 0; i < v->count; i++) { print_lispval_tree(v->cell[i], indent_level + 2); } break; default: printf("Error: unknown lispval type\n"); printf("%s", v->sym); } free(indent); } void print_lispval_parenthesis(lispval* v) { switch (v->type) { case LISPVAL_NUM: printf("%f ", v->num); break; case LISPVAL_ERR: printf("%s ", v->err); break; case LISPVAL_SYM: printf("%s ", v->sym); break; case LISPVAL_SEXPR: printf("( "); for (int i = 0; i < v->count; i++) { print_lispval_parenthesis(v->cell[i]); } printf(") "); break; case LISPVAL_QEXPR: printf("{ "); for (int i = 0; i < v->count; i++) { print_lispval_parenthesis(v->cell[i]); } printf("} "); break; default: printf("Error: unknown lispval type\n"); printf("%s", v->sym); } } void print_ast(mpc_ast_t* ast, int indent_level) { char* indent = malloc(sizeof(char) * (indent_level + 1)); // ""; for (int i = 0; i < indent_level; i++) { indent[i] = ' '; } indent[indent_level] = '\0'; printf("\n%sTag: %s", indent, ast->tag); printf("\n%sContents: %s", indent, strcmp(ast->contents, "") ? ast->contents : "None"); printf("\n%sNumber of children: %i", indent, ast->children_num); /* Print the children */ for (int i = 0; i < ast->children_num; i++) { mpc_ast_t* child_i = ast->children[i]; printf("\n%sChild #%d", indent, i); print_ast(child_i, indent_level + 2); } free(indent); } // Lispval helpers lispval* clone_lispval(lispval* old) { lispval* new; // print_lispval_tree(old, 0); // printf("\nCloning lispval of type %d\n", old->type); switch(old->type){ case LISPVAL_NUM: // printf("\n1"); // printf("\nnum: %f", old->num); // print_lispval_tree(old, 0); new = lispval_num(old->num); // printf("\nAssigned new"); // printf("\n count: %i", old->count); break; case LISPVAL_ERR: // printf("2"); new = lispval_err(old->err); break; case LISPVAL_SYM: // printf("3"); new = lispval_sym(old->sym); break; case LISPVAL_SEXPR: // printf("4"); new = lispval_sexpr(); break; case LISPVAL_QEXPR: // printf("\n5"); new = lispval_qexpr(); break; default: return lispval_err("Error: Cloning element of unknown type."); } // printf("\n6"); if(old->count > 0 && (old->type == LISPVAL_QEXPR || old->type == LISPVAL_SEXPR) ){ for (int i = 0; i < old->count; i++) { lispval* temp_child = old->cell[i]; lispval* child = clone_lispval(temp_child); lispval_append_child(new, child); } } return new; } lispval* pop_lispval(lispval* v, int i) { LISPVAL_ASSERT(v->type == LISPVAL_QEXPR || v->type == LISPVAL_SEXPR, "Error: function pop passed too many arguments"); lispval* r = v->cell[i]; /* Shift memory after the item at "i" over the top */ memmove(&v->cell[i], &v->cell[i + 1], sizeof(lispval*) * (v->count - i - 1)); /* Decrease the count of items in the list */ v->count--; /* Reallocate the memory used */ v->cell = realloc(v->cell, sizeof(lispval*) * v->count); return r; } lispval* take_lispval(lispval* v, int i) { // Unneeded. LISPVAL_ASSERT(v->type == LISPVAL_QEXPR || v->type == LISPVAL_SEXPR, "Error: function take_lispval passed too many arguments"); lispval* x = pop_lispval(v, i); delete_lispval(v); return x; } // Operations // Ops for q-expressions lispval* builtin_head(lispval* v){ // printf("Entering builtin_head with v->count = %d and v->cell[0]->type = %d\n", v->count, v->cell[0]->type); // head { 1 2 3 } // But actually, that gets processd into head ({ 1 2 3 }), hence the v->cell[0]->cell[0]; LISPVAL_ASSERT(v->count == 1, "Error: function head passed too many arguments"); LISPVAL_ASSERT(v->cell[0]->type == LISPVAL_QEXPR, "Error: Argument passed to head is not a q-expr, i.e., a bracketed list."); LISPVAL_ASSERT(v->cell[0]->count != 0, "Error: Argument passed to head is {}"); // printf("Passed assertions, v->cell[0]->count = %d\n", v->cell[0]->count); // print_lispval_parenthesis(v); // print_lispval_parenthesis(v->cell[0]); lispval* result = clone_lispval(v->cell[0]->cell[0]); // printf("Cloned lispval, result->type = %d\n", result->type); // lispval* result = pop_lispval(v->cell[0], 0); // ^ also possible // A bit unclear. Pop seems like it would depend on the size of the array. clone depends on the sie of head. // either way the original array will soon be deleted, so I could have used pop // but I wanted to write & use clone instead. return result; // Returns something that should be freed later: yes. // Returns something that doesn't share pointers with the input: yes. } lispval* builtin_tail(lispval* v) { // tail { 1 2 3 } LISPVAL_ASSERT(v->count ==1, "Error: function tail passed too many arguments"); lispval* old = v->cell[0]; LISPVAL_ASSERT(old->type == LISPVAL_QEXPR, "Error: Argument passed to tail is not a q-expr, i.e., a bracketed list."); LISPVAL_ASSERT(old->count != 0, "Error: Argument passed to tail is {}"); // lispval* head = pop_lispval(v->cell[0], 0); // print_lispval_parenthesis(v); // print_lispval_parenthesis(old); lispval* new = lispval_qexpr(); if(old->count == 1){ return new; } else if (old->count > 1 && old->type == LISPVAL_QEXPR) { for(int i=1; i<(old->count); i++){ // lispval_append_child(new, clone_lispval(old->cell[i])); lispval_append_child(new, old->cell[i]); } return clone_lispval(new); } else { return lispval_err("Error: Unreachable point reached in tail function"); } // Returns something that should be freed later: yes. // Returns something that doesn't share pointers with the input: yes. } lispval* builtin_list(lispval* v){ // list ( 1 2 3 ) LISPVAL_ASSERT(v->count ==1, "Error: function list passed too many arguments"); lispval* old = v->cell[0]; LISPVAL_ASSERT(old->type == LISPVAL_SEXPR, "Error: Argument passed to list is not an s-expr, i.e., a list with parenthesis."); lispval* new = clone_lispval(old); new->type=LISPVAL_QEXPR; return new; // Returns something that should be freed later: yes. // Returns something that is independent of the input: yes. } lispval* evaluate_lispval(lispval* l); lispval* builtin_eval(lispval* v){ // eval { + 1 2 3 } // not sure how this will end up working, but we'll see LISPVAL_ASSERT(v->count ==1, "Error: function eval passed too many arguments"); lispval* old = v->cell[0]; LISPVAL_ASSERT(old->type == LISPVAL_QEXPR, "Error: Argument passed to eval is not a q-expr, i.e., a bracketed list."); lispval* new = clone_lispval(old); new->type=LISPVAL_SEXPR; return evaluate_lispval(new); // Returns something that should be freed later: probably. // Returns something that is independent of the input: depends on the output of evaluate_lispval. } lispval* builtin_join(lispval* l){ // return lispval_err("Error: Join not ready yet."); // join { {1 2} {3 4} } print_lispval_parenthesis(l); LISPVAL_ASSERT(l->count ==1, "Error: function join passed too many arguments"); lispval* old = l->cell[0]; LISPVAL_ASSERT(old->type == LISPVAL_QEXPR, "Error: function join not passed q-expression"); lispval* result = lispval_qexpr(); for(int i=0; icount; i++){ lispval* temp = old->cell[i]; LISPVAL_ASSERT(temp->type == LISPVAL_QEXPR, "Error: function join not passed a q expression with other q-expressions"); for(int j=0; jcount; j++){ lispval_append_child(result, temp->cell[j]); } } return result; // Returns something that should be freed later: yes. // Returns something that is independent of the input: yes. } // Simple math ops lispval* builtin_math_ops(char* op, lispval* v) { // For now, ensure all args are numbers for (int i = 0; i < v->count; i++) { if (v->cell[i]->type != LISPVAL_NUM) { return lispval_err("Error: Operating on non-numbers. This can be caused by an input like (+ 1 2 (3 * 4)). Because the (3 * 4) doesn't have the correct operation order, it isn't simplified, and then + can't sum over it."); } } // Check how many elements if (v->count == 0) { return lispval_err("Error: No numbers on which to operate!"); } else if (v->count == 1) { if (strcmp(op, "-") == 0) { return lispval_num(-v->cell[0]->num); } else { return lispval_err("Error: Non minus unary operation"); } } else if (v->count >= 2) { lispval* x = clone_lispval(v->cell[0]);// pop_lispval(v, 0); for(int i=1;icount; i++){ lispval* y = v->cell[i]; 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 (y->num == 0) { delete_lispval(x); delete_lispval(y); return lispval_err("Error: Division By Zero!"); } x->num /= y->num; } } return x; } else { return lispval_err("Error: Incorrect number of args. Perhaps a lispval->count was wrongly initialized?"); } // Returns something that should be freed later: yes. // Returns something that is independent of the input: yes. } // Aggregate both math and operations over lists lispval* builtin_functions(char* func, lispval* v) { if (strcmp("list", func) == 0) { return builtin_list(v); } else if (strcmp("head", func) == 0) { return builtin_head(v); } else if (strcmp("tail", func) == 0) { return builtin_tail(v); } else if (strcmp("join", func) == 0) { return builtin_join(v); } else if (strcmp("eval", func) == 0) { return builtin_eval(v); } else if (strstr("+-/*", func)) { return builtin_math_ops(func, v); } else { return lispval_err("Unknown function"); } // Returns something that should be freed later: depends on eval // Returns something that is independent of the input: depends on eval } // Evaluate the lispval lispval* evaluate_lispval(lispval* l) { // Check if this is an s-expression if(l->type != LISPVAL_SEXPR) return l; // Evaluate the children if needed for (int i = 0; i < l->count; i++) { if (l->cell[i]->type == LISPVAL_SEXPR) { l->cell[i] = evaluate_lispval(l->cell[i]); } } // Check if any are errors. for (int i = 0; i < l->count; i++) { if (l->cell[i]->type == LISPVAL_ERR) { return clone_lispval(l->cell[i]); } } // Check if the first element is an operation. if (l->count >= 2 && ((l->cell[0])->type == LISPVAL_SYM)) { // lispval* op = pop_lispval(l, 0); lispval* operation = clone_lispval(l->cell[0]); lispval* operands = lispval_sexpr(); for(int i=1; icount; i++){ lispval_append_child(operands, l->cell[i]); } lispval* result = builtin_functions(operation->sym, operands); delete_lispval(operation); delete_lispval(operands); return result; } return l; } // Main int main(int argc, char** argv) { // Info puts("Mumble version 0.0.2\n"); puts("Press Ctrl+C/Ctrl+D to exit\n"); /* 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* Mumble = mpc_new("mumble"); /* Define them with the following Language */ mpca_lang(MPCA_LANG_DEFAULT, " \ number : /-?[0-9]+\\.?([0-9]+)?/ ; \ symbol : \"list\" | \"head\" | \"tail\" \ | \"eval\" | \"join\" \ | '+' | '-' | '*' | '/' ; \ sexpr : '(' * ')' ; \ qexpr : '{' * '}' ; \ expr : | | | ; \ mumble : /^/ * /$/ ; \ ", Number, Symbol, Sexpr, Qexpr, Expr, Mumble); // Initialize a repl int loop = 1; while (loop) { char* input = readline("mumble> "); if (input == NULL) { // ^ catches Ctrl+D loop = 0; } else { /* Attempt to Parse the user Input */ mpc_result_t result; if (mpc_parse("", input, Mumble, &result)) { /* On Success Print the AST */ // mpc_ast_print(result.output); /* Load AST from output */ mpc_ast_t* ast = result.output; // Print AST if VERBOSE if (VERBOSE) { printf("\nPrinting AST"); print_ast(ast, 0); } // Evaluate the AST // if(VERBOSE) printf("\n\nEvaluating the AST"); // lispval result = evaluate_ast(ast); lispval* l = read_lispval(ast); if (VERBOSE) { printf("\n\nPrinting initially parsed lispvalue"); printf("\nTree printing: "); print_lispval_tree(l, 2); printf("\nParenthesis printing: "); print_lispval_parenthesis(l); } lispval* result = evaluate_lispval(l); { printf("\n\nResult: "); print_lispval_parenthesis(result); printf("\n"); } delete_lispval(l); delete_lispval(result); } else { /* Otherwise Print the Error */ mpc_err_print(result.error); mpc_err_delete(result.error); } add_history(input); // can't add if input is NULL } puts(""); free(input); } /* Undefine and Delete our Parsers */ mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, Mumble); return 0; }