lval * ast_load_eval(char* fn, lenv *env) {
lval *r;
mpc_result_t parsed;
lval *ast;
lval *result;
if (mpc_parse_contents(fn, Lispy, &parsed)) {
ast = ast_read(parsed.output);
mpc_ast_delete(parsed.output);
while (ast->expr->count) {
result = lval_eval(expr_pop(ast->expr, 0), env);
if (result->type == LVAL_ERR) lval_println(result);
lval_del(result);
}
lval_del(ast);
r = lval_sexpr();
}
else {
char *err = mpc_err_string(parsed.error);
mpc_err_delete(parsed.error);
r = lval_err(err);
free(err);
}
return r;
}
lval *lval_eval_sexpr(lenv *e, lval *v){
for (int i = 0; i < v->count; i++){
v->cell[i] = lval_eval(e, v->cell[i]);
}
for (int i = 0; i< v->count; i++){
if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); }
}
if (v->count == 0){ return v; }
if (v->count == 1){ return lval_take(v, 0); }
lval *f = lval_pop(v, 0);
if (f->type != LVAL_FUNC){
lval *err = lval_err("S-Expression starts with incorrect type. "
"Expected %s, got %s",
ltype_name(LVAL_FUNC), ltype_name(f->type));
lval_del(f);
lval_del(v);
return err;
}
lval *result = lval_call(e, f, v);
lval_del(f);
return result;
}
lval* lval_eval_sexpr(lval* v) {
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type != LVAL_ERR) {
v->cell[i] = lval_eval(v->cell[i]);
} else {
return lval_take(v, i);
}
}
if (v->count == 0) {
return v;
}
if (v->count == 1) {
return lval_take(v, 0);
}
lval* f = lval_pop(v, 0);
if (f->type != LVAL_SYM) {
lval_free(f);
lval_free(v);
return lval_err("S-Expression doesn't start with symbol!");
}
lval* result = builtin_op(v, f->sym);
lval_free(f);
return result;
}
lval* lval_eval_sexpr(lval* v){
/* Children, recursion */
for (int i = 0; i < v->count; i++) {
v->cell[i] = lval_eval(v->cell[i]);
if (v->cell[i]->type == LVAL_ERR) {
return lval_take(v, i);
}
}
/* Empty expresion */
if (v->count == 0) {
return v;
}
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("Not start with symbol!");
}
/* Call builtin with operator */
lval* result = builtin(v, f->sym);
lval_del(f);
return result;
}
struct lval* lval_eval_sexp(struct lenv* e, struct lval* v) {
for (int i = 0; i < v->count; i++) {
v->cell[i] = lval_eval(e, v->cell[i]);
}
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type == LVAL_ERR) {
return lval_take(v, i);
}
}
if (v->count == 0) return v;
struct lval* f = lval_pop(v, 0);
if (f->type != LVAL_FUN) {
struct lval* err = lval_err(
"Expected sexp to begin with %s, got %s",
lval_type_name(LVAL_FUN), lval_type_name(f->type));
lval_del(f);
lval_del(v);
return err;
}
struct lval* result = lval_eval_call(e, f, v);
lval_del(f);
return result;
}
lval* lval_eval_sexpr(lval* v) {
// eval all children to lval
for (int i = 0; i < v->count; i++) {
v->cell[i] = lval_eval(v->cell[i]);
}
// check lvals for errors
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); }
}
if (v->count == 0) { return v; }
if (v->count == 1) { return lval_take(v, 0); }
// ensure 1st element is a 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");
}
lval* result = builtin(v, f->sym);
lval_del(f);
return result;
}
lval* lval_eval_sexpr(lval* v) {
/* Evaluate Children */
for (int i = 0; i < v->count; i++) {
v->cell[i] = lval_eval(v->cell[i]);
}
/* Error Checking */
for (int 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;
}
int main(int argc, char **argv) {
mpc_parser_t *plisp = plisp_set_grammar();
puts("PLisp v.0.0.0.1."); //Pablo Lisp lol
puts("Press Ctrl-C to exit.");
global = new_lenv(128);
lenv_add_builtins(global);
while ((input = linenoise("mylsp> ")) != NULL) {
if (input[0] != '\0') {
mpc_result_t r;
linenoiseHistoryAdd(input);
if ((mpc_parse("<stdin>", input, plisp, &r))) {
lval *val = lval_eval(global, lval_read(r.output));
lval_println(val);
lval_del(val);
mpc_ast_delete(r.output);
} else {
mpc_err_print(r.error);
mpc_err_delete(r.error);
}
}
free(input);
}
lenv_del(global);
plisp_cleanup_grammar();
return 0;
}
lval *lval_eval_sexpr(lval *v) {
for (int i = 0; i < v->count; i++) {
v->cell[i] = lval_eval(v->cell[i]);
}
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type == LVAL_ERR) {
lval *err = lval_err(v->cell[i]->err);
lval_del(v);
return err;
}
}
if (v->count == 0) {
return v;
}
if (v->count == 1) {
return lval_take(v, 0);
}
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 a symbol");
}
lval *result = builtin(v, f->sym);
lval_del(f);
return result;
}
lval* builtin_eval(lval* a) {
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);
}
//Evaluate a list as an expression
lval* builtin_eval(lenv* e, lval* a) {
LASSERT_NUM("eval", a, 1);
LASSERT_TYPE("eval", a, 0, LVAL_QEXPR);
lval* x = lval_take(a, 0);
x->type = LVAL_SEXPR;
return lval_eval(e, x);
}
struct lval* lval_builtin_eval(struct lenv* e, struct lval* v) {
LNUMARGS(v, 1, "eval");
LTYPE(v, LVAL_QEXP, 0, "eval");
struct lval* x = lval_take(v, 0);
x->type = LVAL_SEXP;
return lval_eval(e, x);
}
lval* builtin_if(lenv* e, lval* a) {
LASSERT_NUM("if", a, 3);
LASSERT_TYPE("if", a, 0, LVAL_NUM);
LASSERT_TYPE("if", a, 1, LVAL_QEXPR);
LASSERT_TYPE("if", a, 2, LVAL_QEXPR);
//Make both expressions evaluatable
lval* x;
a->cell[1]->type = LVAL_SEXPR;
a->cell[2]->type = LVAL_SEXPR;
if (a->cell[0]->num) {
x = lval_eval(e, lval_pop(a, 1));
} else {
x = lval_eval(e, lval_pop(a, 2));
}
lval_del(a);
return x;
}
lval* builtin_eval(lval* a) {
LASSERT(a, a->count == 1,
"eval takes one arg");
LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
"eval takes qexpr");
lval* x = lval_take(a, 0);
x->type = LVAL_SEXPR;
return lval_eval(x);
}
int main(int argc, char *argv[])
{
/* Create types */
mpc_parser_t *Number = mpc_new("number");
mpc_parser_t *Bool = mpc_new("bool");
mpc_parser_t *Symbol = mpc_new("symbol");
mpc_parser_t *Sexp = mpc_new("sexp");
mpc_parser_t *Qexp = mpc_new("qexp");
mpc_parser_t *Expr = mpc_new("expr");
mpc_parser_t *Smallisp = mpc_new("Smallisp");
/* Definintions */
mpca_lang(MPC_LANG_DEFAULT,
"number : /-?[0-9]+/ ; "
"bool : \"true\" | \"false\" ; "
"symbol : /[a-zA-Z0-9_+\\-*\\/=<>!&]+/; "
"sexp : '(' <expr>* ')'; "
"qexp : '{' <expr>* '}'; "
"expr : <number> | <bool> | <char> | <symbol> | <sexp> | <qexp>; "
"Smallisp : /^/ <sexp>* /$/ ; ",
Number, Bool, Symbol, Sexp, Qexp, Expr, Smallisp, NULL);
puts("Lispy version 0.0.0.7\n");
puts("Press Ctrl-C to exit\n");
lenv *env = lenv_new();
lenv_add_builtins(env);
while(1) {
char *input = readline("slisp> ");
add_history(input);
mpc_result_t r;
if (mpc_parse("<stdin>", input, Smallisp, &r)) {
/* On success print AST */
lval *result = lval_eval(env, lval_read(r.output));
lval_println(result);
lval_del(result);
mpc_ast_print(r.output);
mpc_ast_delete(r.output);
} else {
/* Print error */
mpc_err_print(r.error);
mpc_err_print(r.error);
}
free(input);
}
lenv_del(env);
mpc_cleanup(7, Number, Bool, Symbol, Sexp, Qexp, Expr, Smallisp);
return 0;
}
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;
}
void parse_input(char* input, mpc_parser_t* Lambo) {
mpc_result_t r;
if (mpc_parse("<stdin>", input, Lambo, &r)) {
lval* x = lval_eval(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);
}
}
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_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);
}
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* builtin_load(lenv* e, lval* a) {
LASSERT_NUM("load", a, 1);
LASSERT_TYPE("load", a, 0, LVAL_STR);
//Parse file given by string as filename
mpc_result_t r;
if (mpc_parse_contents(a->cell[0]->str, blisp, &r)) {
//Read Contents
lval* expr = lval_read(r.output);
mpc_ast_delete(r.output);
//Evaluate expressions on stack
while (expr->count) {
lval* x = lval_eval(e, lval_pop(expr, 0));
if (x->type == LVAL_ERR) {
lval_println(x);
}
lval_del(x);
}
//Delete expression and args
lval_del(expr);
lval_del(a);
//Return empty list
return lval_sexpr();
} else {
//Get error message as string and return as lval_err
char* err_msg = mpc_err_string(r.error);
mpc_err_delete(r.error);
lval* err = lval_err("Could not load Library %s", err_msg);
free(err_msg);
lval_del(a);
//Cleanup and return error
return err;
}
}
lval *lval_eval_sexpr(lenv *e, lval *v)
{
// eval children
for (int i = 0; i < v->count; i++)
{
v->cell[i] = lval_eval(e, v->cell[i]);
}
// error checking
for (int i = 0; i < v->count; i++)
{
if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); }
}
// empty expr
if (v->count == 0) { return v; }
// single expr
if (v->count == 1) { return lval_take(v, 0); }
// make sure first elem is symbol
lval *f = lval_pop(v, 0);
if (f->type != LVAL_FUN)
{
lval* err = lval_err(
"S-Expression starts with incorrect type"
"\n got %s expected %s",
ltype_name(f->type), ltype_name(LVAL_FUN));
lval_del(f); lval_del(v);
return err;
}
// call builtin with operator
lval *result = lval_call(e, f, v);
lval_del(f);
return result;
}
struct lval* lval_builtin_id(struct lenv* e, struct lval* v) {
LNUMARGS(v, 1, "id");
return lval_eval(e, lval_take(v, 0));
}
lval_t* builtin_eval(lenv_t* e, lval_t* a){
LASSERT(a, a->count==1, "Function 'eval' passed too many arguments!");
lval_t* x = lval_take(a, 0);
x->type = LVAL_SEXPR;
return lval_eval(e, x);
}
int main(int argc, char** 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 *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,
""
"number : /-?[0-9]+/ ;"
"symbol : '+' | '-' | '*' | '/' | '%' | '^' "
" | \"len\" | \"cons\""
" | \"list\" | \"head\" | \"tail\" | \"join\" | \"eval\" ;"
"sexpr : '(' <expr>* ')' ;"
"qexpr : '{' <expr>* '}' ;"
"expr : <number> | <symbol> | <sexpr> | <qexpr> ;"
"lispy : /^/ <expr>* /$/ ; "
"",
Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
/* Print Version and Exit Information */
puts("Lispy Version 0.0.0.0.1");
puts("Press Ctrl+c or Ctrl+d to Exit\n");
/* In a never ending loop */
while (1) {
/* Output our prompt and get input */
char* input = readline("lispy> ");
if (NULL == input) {
/* quit with Ctrl-d */
break;
}
/* Add input to history */
add_history(input);
/* Try to parse the user input */
mpc_result_t r;
if (mpc_parse("<stdin>", input, Lispy, &r)) {
/* On success evaluate AST */
lval *result = lval_eval(lval_read(r.output));
lval_println(result);
lval_del(result);
mpc_ast_delete(r.output);
} else {
mpc_err_print(r.error);
mpc_err_delete(r.error);
}
/* Free retrieved input */
free(input);
}
/* Undefine and delete the parsers */
mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
return 0;
}
int main(int argc, char** argv) { // {{{
// Create Parsers.
mpc_parser_t* Number = mpc_new("number");
mpc_parser_t* OperatorSymbol = mpc_new("operator_symbol");
mpc_parser_t* OperatorText = mpc_new("operator_text");
mpc_parser_t* Operator = mpc_new("operator");
mpc_parser_t* Sexpr = mpc_new("sexpr");
mpc_parser_t* Expr = mpc_new("expr");
mpc_parser_t* Lispy = mpc_new("lispy");
// Define polish notation language rules.
mpca_lang(MPCA_LANG_DEFAULT,
" number : /-?[0-9]+(\\.[0-9]+)?/ ;"
" operator_symbol : '+' | '-' | '*' | '/' | '%' | '^' ;"
" operator_text : \"add\" | \"sub\" | \"mul\" | \"div\" | \"mod\" "
" | \"max\" | \"min\" ;"
" operator : <operator_symbol> | <operator_text> ;"
" sexpr : '(' <expr>* ')' ;"
" expr : <number> | <operator> | <sexpr> ;"
" lispy : /^/ <expr>* /$/ ;",
Number, OperatorSymbol, OperatorText, Operator, Sexpr, Expr, Lispy
);
// Print version and exit information.
puts("Lispy Version 0.0.0.0.1");
puts("Press Ctrl+c to Exit\n");
// Never ending loop.
while (1) {
// Output our prompt to get input.
// The function strips the trailing newline character
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)) {
lval* result = lval_eval(lval_read(r.output));
lval_println(result);
lval_del(result);
mpc_ast_delete(r.output);
} else {
// Print the error.
mpc_err_print(r.error);
mpc_err_delete(r.error);
}
// Imported from stdlib.h, free retrived input.
free(input);
}
// Delete Parsers.
mpc_cleanup(
7,
Number, OperatorSymbol, OperatorText, Operator, Sexpr, Expr, Lispy
);
return 0;
} // }}}
int main(int argc, char** argv)
{
mpc_parser_t* Bool = mpc_new("bool");
mpc_parser_t* Number = mpc_new("number");
mpc_parser_t* Symbol = mpc_new("symbol");
mpc_parser_t* Sexp = mpc_new("sexp");
mpc_parser_t* Qexp = mpc_new("qexp");
mpc_parser_t* Expr = mpc_new("expr");
mpc_parser_t* Program = mpc_new("program");
mpca_lang(MPCA_LANG_DEFAULT,
" \
bool : /#[tf]/ ; \
number : /-?[0-9]+/ ; \
symbol : /[a-zA-Z0-9_+\\-*\\/\\\\=<>!&\\^?]+/ ; \
sexp : '(' <expr>* ')' ; \
qexp : '{' <expr>* '}' ; \
expr : <bool> | <number> | <symbol> | \
<sexp> | <qexp> ; \
program : /^/ <expr> /$/ ; \
",
Bool, Number, Symbol, Sexp, Qexp, Expr, Program);
puts("Welcome to gLenISP Version 0.0.0.1");
puts("You have 1000 parentheses remaining");
puts("Press Ctrl+c to Exit\n");
struct lenv* e = lenv_new();
lenv_add_builtins(e);
while (1) {
char* input = readline("glenisp> ");
if (input == NULL) {
break;
}
add_history(input);
mpc_result_t r;
if (mpc_parse("<stdin>", input, Program, &r)) {
//mpc_ast_print(r.output);
struct lval* x = lval_read(r.output);
mpc_ast_delete(r.output);
puts("Input:");
lval_print(x);
putchar('\n');
struct lval* r = lval_eval(e, x);
puts("Output:");
lval_print(r);
putchar('\n');
lval_del(r);
} else {
mpc_err_print(r.error);
mpc_err_delete(r.error);
}
free(input);
}
mpc_cleanup(6, Bool, Number, Symbol, Sexp, Qexp, Expr, Program);
return 0;
}
void _lval_eval_children(lenv* e, lval* v) {
for (int i = 0; i < v->count; i++) {
v->cell[i] = lval_eval(e, v->cell[i]);
}
}
