// print an lval
void lval_print(lval *v)
{
switch (v->type)
{
case LVAL_NUM:
printf("%li", v->num);
break;
case LVAL_ERR:
printf("Error: %s", v->err);
break;
case LVAL_SYM:
printf("%s", v->sym);
break;
case LVAL_FUN:
if (v->builtin)
{
printf("<builtin>");
}
else
{
printf("(\\ ");
lval_print(v->formals);
putchar(' ');
lval_print(v->body);
putchar(')');
}
break;
case LVAL_SEXPR:
lval_expr_print(v, '(', ')');
break;
case LVAL_QEXPR:
lval_expr_print(v, '{', '}');
break;
}
}
int lval_print(lval* v)
{
switch (v->type)
{
case LVAL_NUM:
printf("%li", v->num);
break;
case LVAL_ERR:
printf("Error: %s", v->err);
break;
case LVAL_SYM:
printf("%s", v->sym);
break;
case LVAL_STR:
lval_print_str(v, "\"", "\"");
break;
case LVAL_FUN:
if (v->builtin) {
printf("<builtin '%s'>", v->sym);
} else {
printf("(\\ ");
lval_print(v->formals);
putchar(' ');
lval_print(v->body);
putchar(')');
}
break;
case LVAL_SEXPR:
return lval_print_expr(v, '(', ')');
case LVAL_QEXPR:
return lval_print_expr(v, '{', '}');
default:
return 0;
}
return 1;
}
void lval_expr_print(lval* v, char open, char close) {
putchar(open);
for (int i = 0; i < v->count; i++) {
lval_print(v->cell[i]);
if (i != (v->count-1)) {
putchar(' ');
}
}
putchar(close);
}
void lval_print(struct lval* v) {
switch (v->type) {
case LVAL_ERR:
printf("Error: %s", v->err);
break;
case LVAL_NUM:
printf("%li", v->num);
break;
case LVAL_SYM:
printf("%s", v->sym);
break;
case LVAL_BOOL:
printf(v->flag ? "#t" : "#f");
break;
case LVAL_FUN:
switch (v->fun_type) {
case LVAL_FUN_BUILTIN:
printf("<fn %s>", v->name);
break;
case LVAL_FUN_LAMBDA:
printf("(\\ ");
lval_print(v->args);
putchar(' ');
lval_print(v->body);
putchar(')');
break;
}
break;
case LVAL_SEXP:
case LVAL_QEXP:
putchar(v->type == LVAL_SEXP ? '(' : '{');
for (int i = 0; i < v->count; i++) {
lval_print(v->cell[i]);
if (i != (v->count - 1)) putchar(' ');
}
putchar(v->type == LVAL_SEXP ? ')' : '}');
break;
}
}
static void lval_expr_print(lval *v, char open, char close) {
putchar(open);
for (int i = 0; i < v->count; i++) {
lval_print(v->cell[i]);
/* don't print trailing space if last element */
if (i != (v->count - 1)) {
putchar(' ');
}
}
putchar(close);
}
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();
}
void lval_expr_print(lval* val, char* open, char* close) {
printf("%s", open);
for(int i = 0; i < val->cell_count ; i++) {
lval_print(val->cell_list[i]);
if (i != val->cell_count-1) {
putchar(' ');
}
}
printf("%s", close);
}
void lval_print(lval* val) {
switch(val->type) {
case LVAL_NUM: printf("%g", val->data.num); break;
case LVAL_SYM: printf("%s", val->data.sym); break;
case LVAL_STR: lval_print_str(val); break;
case LVAL_S_EXPR: lval_expr_print(val, "(", ")"); break;
case LVAL_Q_EXPR: lval_expr_print(val, "{", "}"); break;
case LVAL_EXIT: printf("exit"); break;
case LVAL_OK: printf("ok"); break;
case LVAL_FUNC: ;
lval_func* func = val->data.func;
if (func->builtin != NULL) {
printf("<%s>", func->name);
} else {
printf("(<lambda> ");
lval_print(func->formals);
putchar(' ');
lval_print(func->body);
putchar(')');
}
break;
case LVAL_ERR:
switch(val->data.err.num) {
case LERR_DIV_ZERO: fprintf(stderr, "Divide By Zero"); break;
case LERR_BAD_NUM: fprintf(stderr,"Bad Number"); break;
case LERR_BAD_OP: fprintf(stderr,"Invalid Operator"); break;
case LERR_BAD_SYM: fprintf(stderr,"Unknown/Invalid Symbol"); break;
case LERR_OTHER: fprintf(stderr,"Unknown/Other Error"); break;
case LERR_SYNTAX: fprintf(stderr,"Syntax Error"); break;
case LERR_USER: fprintf(stderr,"Runtime Error"); break;
default: fprintf(stderr,"Unknown Error"); break;
}
if (val->data.err.detail != NULL) {
fprintf(stderr,": %s", val->data.err.detail);
}
break;
}
}
void lval_expr_print(lval* v, char open, char close) {
putchar(open);
for (int 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(' ');
}
}
putchar(close);
}
void lval_expr_print(lval *v, char open, char close)
{
putchar(open);
for (int i = 0; i < v->count; i++)
{
// print value
lval_print(v->cell[i]);
// do not print trailing space
if (i != (v->count - 1))
{
putchar(' ');
}
}
putchar(close);
}
int lval_print_expr(lval* v, char open, char close)
{
if (v->count > 0) {
putchar(open);
for (int i = 0; i < v->count; i++) {
lval_print(v->cell[i]);
if (i != (v->count - 1)) {
putchar(' ');
}
}
putchar(close);
return 1;
}
return 0;
}
struct lval* lval_builtin_env(struct lenv* e, struct lval* v) {
LNUMARGS(v, 0, "env");
for (int i = 0; i < e->count; i++) {
printf("%s - ", e->syms[i]);
lval_print(e->vals[i]);
printf("\n");
}
if (e->parent) {
printf("parent:\n");
lval_builtin_env(e->parent, v);
}
return lval_sexp();
}
/* Print an "lval" followed by a newline */
void lval_println(lval v) { lval_print(v); putchar('\n'); }
void lval_println(lval* v)
{
if (lval_print(v)) {
putchar('\n');
}
}
static void lval_println(lval *v) {
lval_print(v);
putchar('\n');
}
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_println(lval* val) {
lval_print(val);
putchar('\n');
}
