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;
}
lval *builtin_var(lenv *e, lval *a, char *func)
{
LASSERT_TYPE("def", a, 0, LVAL_QEXPR);
lval *syms = a->cell[0];
for (int i = 0; i < syms->count; i++)
{
LASSERT(a, (syms->cell[i]->type == LVAL_SYM),
"Function 'def' cannot define non-symbol"
"\n got %s expected %s",
ltype_name(syms->cell[i]->type), ltype_name(LVAL_SYM));
}
LASSERT(a, (syms->count == a->count-1),
"Function 'def' passed too many arguments for symbols"
"\n got %i expected %i",
syms->count, a->count-1);
for (int i = 0; i < syms->count; i++)
{
if (strcmp(func, "def") == 0)
{
lenv_def(e, syms->cell[i], a->cell[i + 1]);
}
if (strcmp(func, "=") == 0)
{
lenv_put(e, syms->cell[i], a->cell[i + 1]);
}
}
lval_del(a);
return lval_sexpr();
}
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_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* builtin_var(lenv* e, lval* a, char* func)
{
LASSERT_TYPE(func, a, 0, LVAL_QEXPR);
lval* syms = a->cell[0];
for (int i = 0; i < syms->count; i++)
LASSERT(a, syms->cell[i]->type == LVAL_SYM,
"Function '%s' cannot define a non-symbol. Got %s, Expected %s.",
func, ltype_name(syms->cell[i]->type), ltype_name(LVAL_SYM));
LASSERT(a, syms->count == a->count - 1,
"Function '%s' passed too many arguments for symbols. Got %i, Expected %i.",
func, syms->count, a->count - 1);
for (int i = 0; i < syms->count; i++)
{
if (strcmp(func, "def") == 0)
lenv_def(e, syms->cell[i], a->cell[i+1]);
if (strcmp(func, "=") == 0)
lenv_put(e, syms->cell[i], a->cell[i+1]);
}
lval_del(a);
return lval_sexpr();
}
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 * ast_read(mpc_ast_t *t) {
int i;
lval *x;
if (strstr(t->tag, "number")) return ast_read_num(t);
if (strstr(t->tag, "symbol")) {
if (!strcmp(t->contents, "true")) {
return lval_boolean(1);
}
else if (!strcmp(t->contents, "false")) {
return lval_boolean(0);
}
else {
return lval_sym(t->contents);
}
}
if (strstr(t->tag, "string")) {
ssize_t sz = strlen(t->contents) + 1 - 2 /* quotes */;
char *unescaped = malloc(sz);
memcpy(unescaped, t->contents+1, sz);
unescaped[sz-1] = '\0';
unescaped = mpcf_unescape(unescaped);
x = lval_str(unescaped);
free(unescaped);
return x;
}
if (strstr(t->tag, "comment")) return NULL;
if (strstr(t->tag, "qexpr")) {
x = lval_qexpr();
}
else {
assert(
(strcmp(t->tag, ">") == 0) ||
strstr(t->tag, "sexpr")
);
x = lval_sexpr();
}
for (i = 0; i < t->children_num; ++i) {
lval *v;
if (
(strlen(t->children[i]->contents) == 1) &&
strstr("(){}", t->children[i]->contents)
) continue;
if (!strcmp(t->children[i]->tag, "regex")) continue;
v = ast_read(t->children[i]);
if(v) lval_append(x, v);
}
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;
}
lval* builtin_print(lenv* e, lval* a) {
//Print each argument followed by a space
for (int i = 0; i < a->count; i++) {
lval_print(a->cell[i]); putchar(' ');
}
//Print a newline and delete args
putchar('\n');
lval_del(a);
return lval_sexpr();
}
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)
{
// 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_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;
}
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_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 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);
}
}
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);
}
}
lval* builtin_env(lenv* e, lval* a) {
lenv_iter(e);
return lval_sexpr();
}
