lval* lval_call(lenv* env, lval* function, lval* args) { lval_func* func = function->data.func; if (func->builtin != NULL) { return func->builtin(env, args); } //Check arg counts LASSERT(args, func->formals->cell_count <= args->cell_count, LERR_SYNTAX, "lambda: insufficient arguments. Expected %ld got %ld", func->formals->cell_count, args->cell_count); for(int i = 0; i < func->formals->cell_count; i++) { lenv_put(func->env, func->formals->cell_list[i], args->cell_list[i]); } if (func->va != NULL) { lval* vaArgs = lval_q_expr(); for(int i = func->formals->cell_count; i < args->cell_count; i ++ ) { lval_add(vaArgs, lval_copy(args->cell_list[i])); } lenv_put(func->env, func->va, vaArgs); lval_delete(vaArgs); } lval_delete(args); func->env->parent = env; return eval(func->env, lval_add(lval_s_expr(), lval_copy(func->body))); }
int main(int argc, char* *argv){ init_parser(); lenv *e = lenv_new(); lenv_add_builtins(e); if (access(STD_LIB, F_OK) != -1){ lval *err = builtin_load(e, lval_add(lval_sexpr(), lval_str((char *)STD_LIB))); if (err->type == LVAL_ERR) lval_println(err); lval_del(err); } else { printf("Can't find stdlib at %s.\n", STD_LIB); } if (argc > 1){ for (int i = 1; i < argc; i++){ lval *args = lval_add(lval_sexpr(), lval_str(argv[i])); lval *x = builtin_load(e, args); if (x->type == LVAL_ERR) lval_println(x); lval_del(x); } } else { puts("Aroma Version v0.0.0.1"); puts("Press Ctrl+C to Exit."); char *input = NULL; mpc_result_t r; while (true){ input = readline(">>> "); if (strlen(input) < 1) { continue; } add_history(input); if (mpc_parse("<stdin>", input, Lispy, &r)){ /* mpc_ast_print(r.output); */ lval *x = lval_eval(e, lval_read(r.output)); lval_println(x); lval_del(x); mpc_ast_delete(r.output); } else { mpc_err_print(r.error); mpc_err_delete(r.error); } /* printf("%s\n", input); */ free(input); } } lenv_del(e); cleanup_parser(); return 0; }
int main(int argc, char** argv){ puts("yafl Version 0.0.1"); puts("Press CTRL+C to Exit\n"); gen_parsers(); lenv* e = lenv_new(); lenv_add_builtins(e); lval* core = lval_add(lval_sexpr(), lval_str("src/yfl/core.yfl")); //printf("gets here"); lval* core_loaded = builtin_load(e, core); if(core_loaded->type == LVAL_ERR) {lval_println(core_loaded);} lval_del(core_loaded); if(argc >= 2){ //execute file for(int i = 1; i < argc; i++){ lval* args = lval_add(lval_sexpr(), lval_str(argv[i])); lval* x = builtin_load(e, args); if(x->type == LVAL_ERR) { lval_println(x); } lval_del(x); } } else{ //Start REPL while(1){ char* input = readline("yafl> "); add_history(input); mpc_result_t r; if(mpc_parse("<stdin>", input, Yafl, &r)){ lval* x = lval_eval(e, lval_read(r.output)); lval_println(x); lval_del(x); mpc_ast_delete(r.output); }else{ mpc_err_print(r.error); mpc_err_delete(r.error); } free(input); } } teardown_parsers(); return 0; }
struct lval* lval_join(struct lval* v, struct lval* x) { while (x->count) { v = lval_add(v, lval_pop(x, 0)); } lval_del(x); return v; }
struct lval* lval_read(mpc_ast_t* node) { // Upwrap top-level form as a single expression if (strcmp(node->tag, ">") == 0) { return lval_read(node->children[1]); } if (strstr(node->tag, "number")) { return lval_read_num(node->contents); } if (strstr(node->tag, "symbol")) { return lval_sym(node->contents); } if (strstr(node->tag, "bool")) { return lval_read_bool(node->contents); } struct lval* x; if (strstr(node->tag, "sexp")) { x = lval_sexp(); } else if (strstr(node->tag, "qexp")) { x = lval_qexp(); } else { return lval_err("Unexpected node: %s", node->tag); } for (int i = 0; i < node->children_num; i++) { if (read_ignore(node->children[i])) continue; x = lval_add(x, lval_read(node->children[i])); } return x; }
lval* lval_call(lenv* e, lval* f, lval* a){ if(f->builtin) { return f->builtin(e,a); } int given = a->count; int total = f->formals->count; while(a->count){ if(f->formals->count == 0){ lval_del(a); return lval_err("too many args. expected %i, got %i", total, given); } lval* sym = lval_pop(f->formals, 0); if(strcmp(sym->sym, "&") == 0){ if(f->formals->count != 1){ lval_del(a); return lval_err("too many args after '&'. only 1 allowed"); } lval* nsym = lval_pop(f->formals, 0); lenv_put(f->env, nsym, builtin_list(e, a)); lval_del(sym); lval_del(nsym); break; } lval* val = lval_pop(a, 0); lenv_put(f->env, sym, val); lval_del(sym); lval_del(val); } lval_del(a); if(f->formals->count >0 && strcmp(f->formals->cell[0]->sym, "&") == 0){ if(f->formals->count != 2){ return lval_err("'&' should be followed by a single arg"); } lval_del(lval_pop(f->formals, 0)); lval* sym = lval_pop(f->formals, 0); lval* val = lval_qexpr(); lenv_put(f->env, sym, val); lval_del(sym); lval_del(val); } if(f->formals->count == 0){ f->env->par = e; return builtin_eval(f->env, lval_add(lval_sexpr(), lval_copy(f->body))); }else{ return lval_copy(f); } }
lval* lval_join(lval* a, lval* b) { while(b->cell_count > 0) { lval_add(a, lval_pop(b,0)); } lval_delete(b); return a; }
lval* lval_join(lval* x, lval* y) { while (y->count) { x = lval_add(x, lval_pop(y, 0)); } lval_del(y); return x; }
lval* lval_join(lval* x, lval* y) { for (int i = 0; i > y->count; i++) { x = lval_add(x, y->cell[i]); } free(y->cell); free(y); return x; }
lval_t *lval_join(lval_t *a, lval_t *b) { /* Move all items from b -> a */ while (b->count > 0) { lval_add(a, lval_pop(b, 0)); } lval_del(b); return a; }
struct lval* lval_builtin_cons(struct lenv* e, struct lval* v) { LNUMARGS(v, 2, "cons"); LTYPE(v, LVAL_QEXP, 1, "cons"); // New q-exp with first arg struct lval* x = lval_qexp(); lval_add(x, lval_pop(v, 0)); // Old q-exp from second arg struct lval* q = lval_take(v, 0); while (q->count) { lval_add(x, lval_pop(q, 0)); } lval_del(q); return lval_eval(e, 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; }
//Appends element to beginning of list lval* builtin_cons(lenv* e, lval* a) { LASSERT_NUM("cons", a, 2); LASSERT_TYPE("cons", a, 1, LVAL_QEXPR); lval* x = lval_qexpr(); x = lval_add(x, lval_pop(a, 0)); x = lval_join(x, lval_pop(a, 0)); lval_del(a); return x; }
struct lval* lval_eval_call(struct lenv* e, struct lval* f, struct lval* args) { if (f->fun_type == LVAL_FUN_BUILTIN) { return f->builtin(e, args); } int given = args->count; int total = f->args->count; while (args->count) { if (f->args->count == 0) { lval_del(args); return lval_err( "Too many arguments. Got %i, expected %i.", given, total ); } struct lval* sym = lval_pop(f->args, 0); if (strcmp(sym->sym, "&") == 0) { // varargs lval_del(sym); sym = lval_pop(f->args, 0); lenv_put(f->env, sym->sym, lval_builtin_list(e, args)); lval_del(sym); break; } struct lval* val = lval_pop(args, 0); lenv_put(f->env, sym->sym, val); lval_del(sym); lval_del(val); } lval_del(args); if (f->args->count > 0) { if (strcmp(f->args->cell[0]->sym, "&") != 0) { return lval_copy(f); } // Got all args except varargs, so produce empty list struct lval* val = lval_qexp(); lenv_put(f->env, f->args->cell[1]->sym, val); lval_del(val); } f->env->parent = e; struct lval* sexp = lval_sexp(); lval_add(sexp, lval_copy(f->body)); return lval_builtin_eval(f->env, sexp); }
struct lval* lval_builtin_if(struct lenv* e, struct lval* v) { LNUMARGS(v, 3, "if"); LTYPE(v, LVAL_BOOL, 0, "if"); LTYPE(v, LVAL_QEXP, 1, "if"); LTYPE(v, LVAL_QEXP, 2, "if"); int result = v->cell[0]->flag; struct lval* x = lval_sexp(); lval_add(x, lval_take(v, result ? 1 : 2)); return lval_builtin_eval(e, x); }
lval *lval_read(mpc_ast_t *t) { if (strstr(t->tag, "long")) { return lval_read_long(t); } if (strstr(t->tag, "double")) { return lval_read_double(t); } if (strstr(t->tag, "symbol")) { return lval_sym(t->contents); } lval *x = NULL; if (strcmp(t->tag, ">") == 0) { x = lval_sexpr(); } if (strstr(t->tag, "sexpr")) { x = lval_sexpr(); } if (strstr(t->tag, "qexpr")) { x = lval_qexpr(); } for (int i = 0; i < t->children_num; i++) { mpc_ast_t *child = t->children[i]; char *contents = child->contents; if (strcmp(contents, "(") == 0) { continue; } if (strcmp(contents, ")") == 0) { continue; } if (strcmp(contents, "{") == 0) { continue; } if (strcmp(contents, "}") == 0) { continue; } if (strcmp(child->tag, "regex") == 0) { continue; } x = lval_add(x, lval_read(child)); } return x; }
lval* lval_read(mpc_ast_t* t) { if (strstr(t->tag, "number")) { return lval_read_num(t); } if (strstr(t->tag, "symbol")) { return lval_sym(t->contents); } lval* x = NULL; if (strcmp(t->tag, ">") == 0) { x = lval_sexpr(); } if (strstr(t->tag, "sexpr")) { x = lval_sexpr(); } if (strstr(t->tag, "qexpr")) { x = lval_qexpr(); } for (int 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; }
int main(int argc, char** argv) { init_parser(); /* initialize environment */ lenv* e = lenv_new(); lenv_add_builtins(e); /* load standard library functions */ lval* x = builtin_load(e, lval_add(lval_sexpr(), lval_str("prelude.lsp"))); if (x->type == LVAL_ERR) { lval_println(x); } lval_del(x); if (argc >= 2) { /* read from command line */ parse_args(e, argc, argv); } else { /* interactive prompt */ say_hello(); while (1) { char* input = prompt(); lval* x = parse(input); if (x != NULL) { x = lval_eval(e, x); lval_println(x); lval_del(x); } free(input); } } /* cleanup */ lenv_del(e); free_parser(); return 0; }
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) { x = lval_sexpr(); } if (strstr(t->tag, "sexpr")) { x = lval_sexpr(); } /* Fill this list with any valid expression contained within */ for (int 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_read(mpc_ast_t* t) { if (strstr(t->tag, "number")) { return lval_read_num(t); } if (strstr(t->tag, "symbol")) { return lval_symbol(t->contents); } if (strstr(t->tag, "string")) { return lval_read_str(t); } // if root (>) or sexpr, cearte an empty lval_sexpr. lval *x = NULL; if (strcmp(t->tag, ">") == 0) { x = lval_sexpr(); } if (strstr(t->tag, "sexpr")) { x = lval_sexpr(); } if (strstr(t->tag, "qexpr")) { x = lval_qexpr(); } for (int 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; } if (strstr(t->children[i]->tag, "comment")) { continue; } x = lval_add(x, lval_read(t->children[i])); } return x; }
lval *lval_read(mpc_ast_t *t) { // convert symbols and nums to lvals if (strstr(t->tag, "number")) { return lval_read_num(t); } if (strstr(t->tag, "symbol")) { return lval_sym(t->contents); } // if root or sexpr creat empty list lval *x = NULL; if (strcmp(t->tag, ">") == 0) { x = lval_sexpr(); } if (strstr(t->tag, "sexpr")) { x = lval_sexpr(); } if (strstr(t->tag, "qexpr")) { x = lval_qexpr(); } // fill list with any valid expr contained within for (int 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_call(lenv* e, lval* f, lval* a) { if (f->builtin) { return f->builtin(e, a); } int given = a->count; int total = f->formals->count; while (a->count) { if (f->formals->count == 0) { lval_del(a); return lval_err( "Function passed too many arguments. " "Got %i, Expected %i.", given, total); } lval* sym = lval_pop(f->formals, 0); lval* val = lval_pop(a, 0); lenv_put(f->env, sym, val); lval_del(sym); lval_del(val); } lval_del(a); if (f->formals->count == 0) { f->env->par = e; return builtin_eval( f->env, lval_add(lval_sexpr(), lval_copy(f->body))); } else { return lval_copy(f); } }
int main(int argc, char** argv) { // Initialization parser_init(); lenv* env = lenv_new(); builtins_init(env); if (argc >= 2) { // Loop over file names for (int i = 1; i < argc; i++) { lval* args = lval_add(lval_sexpr(), lval_str(argv[i])); lval* result = builtin_load(env, args); if (result->type == LVAL_ERR) { lval_println(env, result); } lval_del(result); } } else { // Welcome message puts("MLisp Version 0.1dev"); puts("Enter 'quit' to exit\n"); while (1) { char* input = read_input(); add_history(input); if (input == NULL || strstr(input, "exit") || strstr(input, "quit")) { puts("Bye!"); if (input != NULL) { xfree(input); } break; } lval* result = NULL; mpc_err_t* parser_error = NULL; if (parse("<stdin>", input, env, &result, &parser_error)) { if (!(result->type == LVAL_SEXPR && result->count == 0)) { char* repr = lval_repr(env, result); printf("%s\n", repr); xfree(repr); } lval_del(result); } else { mpc_err_print(parser_error); mpc_err_delete(parser_error); } xfree(input); } } lenv_del(env); // Undefine and delete our parsers parser_cleanup(); return 0; }
lval *lval_call(lenv *e, lval *f, lval *a) { if (f->builtin) { return f->builtin(e, a); } int given = a->count; int total = f->formals->count; while (a->count) { if (f->formals->count == 0) { lval_del(a); return lval_err("Function passed too many arguments\n" " got %i expected %i", given, total); } lval *sym = lval_pop(f->formals, 0); if (strcmp(sym->sym, "&") == 0) { if (f->formals->count != 1) { lval_del(a); return lval_err("Function format invalid\n" " symbol '&' not followed by single symbol"); } lval *nsym = lval_pop(f->formals, 0); lenv_put(f->env, nsym, builtin_list(e, a)); lval_del(sym); lval_del(nsym); break; } lval *val = lval_pop(a, 0); lenv_put(f->env, sym, val); lval_del(sym); lval_del(val); } lval_del(a); if (f->formals->count > 0 && strcmp(f->formals->cell[0]->sym, "&") == 0) { if (f->formals->count != 2) { return lval_err("Function format invalid\n" " symbol '&' not followed by single symbol"); } lval_del(lval_pop(f->formals, 0)); lval *sym = lval_pop(f->formals, 0); lval *val = lval_qexpr(); lval_del(sym); lval_del(val); } if (f->formals->count == 0) { f->env->par = e; return builtin_eval(f->env, lval_add(lval_sexpr(), lval_copy(f->body))); } else { return lval_copy(f); } }
lval *lval_call(lenv *e, lval *f, lval *a){ if (f->builtin){ return f->builtin(e, a); } int given = a->count; int required = f->formals->count; while (a->count){ if (f->formals->count == 0){ lval_del(a); return lval_err("Function passed too many arguments." "Expected %d, got %d.", required, given); } lval *sym = lval_pop(f->formals, 0); if (strcmp(sym->sym, "&") == 0){ /* Ensure & is followed by another symbol */ if (f->formals->count != 1){ lval_del(a); return lval_err("& not followed by single symbol"); } /* Bound next formal to remaining arguments */ lval *nsym = lval_pop(f->formals, 0); lenv_set(f->env, nsym, builtin_list(e, a)); lval_del(sym); lval_del(nsym); break; } /* Take out the argument */ lval *val = lval_pop(a, 0); /* Bound to sym */ lenv_set(f->env, sym, val); lval_del(sym); lval_del(val); } lval_del(a); /* If & remaining in argument list, bound to () */ if (f->formals->count > 0 && strcmp(f->formals->cell[0]->sym, "&") == 0){ /* Ensure & is not passed invalidly */ if(f->formals->count != 2){ return lval_err("& not followed by single symbol"); } /* Delete & */ lval_del(lval_pop(f->formals, 0)); /* pop next formal */ lval *sym = lval_pop(f->formals, 0); lval *empty = lval_qexpr(); lenv_set(f->env, sym, empty); lval_del(sym); lval_del(empty); } if (f->formals->count == 0){ f->env->parent = e; return builtin_eval(f->env, lval_add(lval_sexpr(), lval_copy(f->body))); } else { return lval_copy(f); } }
int main(int argc, char** argv) { printf("KLisp Version %s\n", VERSION); //Init environment lenv* env = lenv_new(); lenv_add_builtin_funcs(env); setup_parsers(); //Attempt to import/run files specified on the command line if (argc > 1) { for(int i = 1; i < argc; i++) { lval* loadargs = lval_add(lval_s_expr(), lval_str(argv[i])); lval* result = builtin_load(env, loadargs); if (result->type == LVAL_ERR) { lval_println(result); } lval_delete(result); } } int exitcode = EXIT_SUCCESS; while(1) { char *input = readline("> "); if (NULL == input) { break; } add_history(input); mpc_ast_t* ast_result = tokenize(input); free(input); if (ast_result != NULL) { //Parse the ast lval* result = parse(ast_result); if (result == NULL) { result = lval_err(LERR_OTHER); } //Evaluate result = eval(env, result); BOOL exit = FALSE; if (result != NULL && result->type == LVAL_EXIT) { exit = TRUE; exitcode = result->data.exitcode; } else { //print the result lval_println(result); } //Cleanup lval_delete(result); mpc_ast_delete(ast_result); if (exit == TRUE) {; break; } } } lenv_delete(env); cleanup_parsers(); return (exitcode); }
lval* lval_call(lenv* e, lval* f, lval* a) { /* If Builtin then simply apply that */ if (f->builtin) { return f->builtin(e, a); } /* Record Argument Counts */ int given = a->count; int total = f->formals->count; /* While arguments still remain to be processed */ while (a->count) { /* If we've ran out of formal arguments to bind */ if (f->formals->count == 0) { lval_del(a); return lval_err("Function passed too many arguments. Got %i, Expected %i.", given, total); } /* Pop the first symbol from the formals */ lval* sym = lval_pop(f->formals, 0); /* Special Case to deal with '&' */ if (strcmp(sym->sym, "&") == 0) { /* Ensure '&' is followed by another symbol */ if (f->formals->count != 1) { lval_del(a); return lval_err("Function format invalid. Symbol '&' not followed by single symbol."); } /* Next formal should be bound to remaining arguments */ lval* nsym = lval_pop(f->formals, 0); lenv_put(f->env, nsym, builtin_list(e, a)); lval_del(sym); lval_del(nsym); break; } /* Pop the next argument from the list */ lval* val = lval_pop(a, 0); /* Bind a copy into the function's environment */ lenv_put(f->env, sym, val); /* Delete symbol and value */ lval_del(sym); lval_del(val); } /* Argument list is now bound so can be cleaned up */ lval_del(a); /* If '&' remains in formal list it should be bound to empty list */ if (f->formals->count > 0 && strcmp(f->formals->cell[0]->sym, "&") == 0) { /* Check to ensure that & is not passed invalidly. */ if (f->formals->count != 2) { return lval_err("Function format invalid. Symbol '&' not followed by single symbol."); } /* Pop and delete '&' symbol */ lval_del(lval_pop(f->formals, 0)); /* Pop next symbol and create empty list */ lval* sym = lval_pop(f->formals, 0); lval* val = lval_qexpr(); /* Bind to environment and delete */ lenv_put(f->env, sym, val); lval_del(sym); lval_del(val); } /* If all formals have been bound evaluate */ if (f->formals->count == 0) { /* Set Function Environment parent to current evaluation Environment */ f->env->par = e; /* Evaluate and return */ return builtin_eval(f->env, lval_add(lval_sexpr(), lval_copy(f->body))); } else { /* Otherwise return partially evaluated function */ return lval_copy(f); } }
lval* lval_call(lenv* e, lval* f, lval* a) { if (f->builtin) { return f->builtin(e, a); } int given = a->count; int total = f->formals->count; while (a->count) { if (f->formals->count == 0) { lval_del(a); return lval_err("Function passed too many arguments. Expected %i, Got %i.", total, given); } lval* sym = lval_pop(f->formals, 0); // Variadic operator if (strcmp(sym->sym, "&") == 0){ if (f->formals->count != 1) { lval_del(a); return lval_err("Function format invalid. " "Symbol '&' not followed by a single symbol"); } lval* nsym = lval_pop(f->formals, 0); lenv_put(f->env, nsym, builtin_list(e, a)); lval_del(sym); lval_del(nsym); break; } lval* val = lval_pop(a, 0); lenv_put(f->env, sym, val); lval_del(val); lval_del(sym); } lval_del(a); // If '&' remains in formal list bind to empty list if (f->formals->count > 0 && strcmp(f->formals->cell[0]->sym, "&") == 0) { if (f->formals->count != 2) { return lval_err("Function format invalid. " "Symbol '&' not followed by a single symbol"); } lval_del(lval_pop(f->formals, 0)); lval* sym = lval_pop(f->formals, 0); lval* val = lval_qexpr(); lenv_put(f->env, sym, val); lval_del(val); lval_del(sym); } if (f->formals->count == 0) { f->env->par = e; return builtin_eval(f->env, lval_add(lval_sexpr(), lval_copy(f->body))); } else { return lval_copy(f); } }