diff options
Diffstat (limited to 'src/lyn.c')
| -rw-r--r-- | src/lyn.c | 315 |
1 files changed, 60 insertions, 255 deletions
@@ -11,288 +11,73 @@ #include <lyn/parser.h> #include <lyn/debug.h> -static int builtin_let(struct lyn *lyn, struct vec args) +int eval_group(struct lyn *lyn, struct lyn_value value) { - assert(vec_len(&args) == 3); + fprintf(lyn->output, "(begin"); - struct lyn_value name = lyn_at(args, 1); - assert(name.kind == LYN_ID); - - struct lyn_value value = lyn_at(args, 2); - if (lyn_eval(lyn, value)) - return -1; - - value = lyn_res(lyn); - assert(value.kind == LYN_INT); - - return lyn_create_symbol(lyn, name.s, lyn_var(value)); -} - -static int builtin_set(struct lyn *lyn, struct vec args) -{ - assert(vec_len(&args) == 3); - - struct lyn_value name = lyn_at(args, 1); - assert(name.kind == LYN_ID); - - struct lyn_value value = lyn_at(args, 2); - if (lyn_eval(lyn, value)) - return -1; - - value = lyn_res(lyn); - assert(value.kind == LYN_INT); - - return lyn_replace_symbol(lyn, name.s, lyn_var(value)); -} - -static int builtin_for(struct lyn *lyn, struct vec args) -{ - assert(vec_len(&args) == 5); - - struct lyn_value init = lyn_at(args, 1); - struct lyn_value cond = lyn_at(args, 2); - struct lyn_value post = lyn_at(args, 3); - struct lyn_value body = lyn_at(args, 4); - - if (lyn_eval(lyn, init)) - return -1; - -top: - if (lyn_eval(lyn, cond)) - return -1; - - struct lyn_value check = lyn_res(lyn); - assert(check.kind == LYN_INT); - - if (check.i) { - if (lyn_eval(lyn, body)) - return -1; - - if (lyn_eval(lyn, post)) + lyn->depth++; + foreach_vec(gi, value.args) { + fprintf(lyn->output, "\n%*s(", 2 * lyn->depth, " "); + struct lyn_value arg = lyn_at(value.args, gi); + if (lyn_eval(lyn, arg)) return -1; - goto top; + fprintf(lyn->output, ")"); } + fprintf(lyn->output, "\n%*s)", 2 * lyn->depth, " "); + lyn->depth--; return 0; } -static int builtin_println(struct lyn *lyn, struct vec args) +int eval_apply(struct lyn *lyn, struct lyn_value value) { - assert(vec_len(&args) == 2); - - struct lyn_value value = lyn_at(args, 1); - if (lyn_eval(lyn, value)) - return -1; - - value = lyn_res(lyn); - assert(value.kind == LYN_INT); - - printf("%lld\n", value.i); - return 0; -} - -static int builtin_lt(struct lyn *lyn, struct vec args) -{ - assert(vec_len(&args) == 3); - struct lyn_value left = lyn_at(args, 1); - struct lyn_value right = lyn_at(args, 2); - - if (lyn_eval(lyn, left)) - return -1; - - left = lyn_res(lyn); - assert(left.kind == LYN_INT); - - if (lyn_eval(lyn, right)) - return -1; - - right = lyn_res(lyn); - assert(right.kind == LYN_INT); - - lyn_return(lyn, gen_int(left.i < right.i)); - return 0; -} - -static int builtin_plus(struct lyn *lyn, struct vec args) -{ - assert(vec_len(&args) == 3); - struct lyn_value left = lyn_at(args, 1); - struct lyn_value right = lyn_at(args, 2); - - if (lyn_eval(lyn, left)) - return -1; - - left = lyn_res(lyn); - assert(left.kind == LYN_INT); - - if (lyn_eval(lyn, right)) - return -1; - - right = lyn_res(lyn); - assert(right.kind == LYN_INT); - - lyn_return(lyn, gen_int(left.i + right.i)); - return 0; -} - -struct lyn lyn_create() -{ - return (struct lyn){}; -} - -int lyn_create_scope(struct lyn *lyn) -{ - struct lyn_scope *scope = calloc(1, sizeof(struct lyn_scope)); - if (!scope) - return -1; - - scope->visible = lookup_create(sizeof(struct lyn_symbol)); - scope->parent = lyn->cur; - - if (!lyn->root) - lyn->root = scope; - - lyn->cur = scope; - return 0; -} - -static struct lyn_symbol *scope_find(struct lyn_scope *scope, const char *name) -{ - return lookup_at(&scope->visible, name); -} - -static struct lyn_symbol *scopes_find(struct lyn_scope *scope, const char *name) -{ - while (scope) { - struct lyn_symbol *s = scope_find(scope, name); - if (s) - return s; - - scope = scope->parent; - } - - return NULL; -} - -static int scope_add(struct lyn_scope *scope, const char *name, struct lyn_symbol symb) -{ - if (!lookup_insert(&scope->visible, name, &symb)) { - error("%s exists in scope\n", name); - return -1; - } - - return 0; -} - -int lyn_create_symbol(struct lyn *lyn, const char *name, struct lyn_symbol symb) -{ - return scope_add(lyn->cur, name, symb); -} - -struct lyn_symbol *lyn_lookup_symbol(struct lyn *lyn, const char *name) -{ - return scopes_find(lyn->cur, name); -} - -int lyn_replace_symbol(struct lyn *lyn, const char *name, struct lyn_symbol symb) -{ - struct lyn_symbol *s = scopes_find(lyn->cur, name); - if (!s) - return -1; - - *s = symb; - return 0; -} - -int lyn_init(struct lyn *lyn) -{ - if (lyn_create_scope(lyn)) - return -1; - - if (lyn_create_symbol(lyn, "let", lyn_syntax(builtin_let))) - return -1; - - if (lyn_create_symbol(lyn, "for", lyn_syntax(builtin_for))) - return -1; - - if (lyn_create_symbol(lyn, "set", lyn_syntax(builtin_set))) - return -1; - - if (lyn_create_symbol(lyn, "println", lyn_proc(builtin_println))) - return -1; - - if (lyn_create_symbol(lyn, "<", lyn_proc(builtin_lt))) - return -1; - - if (lyn_create_symbol(lyn, "+", lyn_proc(builtin_plus))) - return -1; - - return 0; -} - -static int eval_group(struct lyn *lyn, struct lyn_value group) -{ - assert(group.kind == LYN_GROUP); - foreach_vec(gi, group.args) { - struct lyn_value arg = lyn_at(group.args, gi); + fprintf(lyn->output, "("); + foreach_vec(ai, value.args) { + struct lyn_value arg = lyn_at(value.args, ai); if (lyn_eval(lyn, arg)) return -1; } + fprintf(lyn->output, ")"); return 0; } -static int eval_apply(struct lyn *lyn, struct lyn_value apply) +int eval_cmd(struct lyn *lyn, struct lyn_value value) { - assert(apply.kind == LYN_APPLY); - foreach_vec(ai, apply.args) { - struct lyn_value arg = lyn_at(apply.args, ai); + foreach_vec(ci, value.args) { + struct lyn_value arg = lyn_at(value.args, ci); if (lyn_eval(lyn, arg)) return -1; - } + /* don't print a space after the last argument */ + if (ci < vec_len(&value.args) - 1) + fprintf(lyn->output, " "); + } return 0; } -int lyn_apply_cmd(struct lyn *lyn, struct lyn_symbol *cmd, struct vec args) +int eval_str(struct lyn *lyn, struct lyn_value value) { - switch (cmd->kind) { - case LYN_BUILTIN_SYNTAX: return cmd->call(lyn, args); - case LYN_BUILTIN_PROC: return cmd->call(lyn, args); - default: abort(); - } - + fprintf(lyn->output, "%s", value.s); return 0; } -static int eval_cmd(struct lyn *lyn, struct lyn_value cmd) +int eval_int(struct lyn *lyn, struct lyn_value value) { - assert(cmd.kind == LYN_CMD); - - struct lyn_value name = lyn_at(cmd.args, 0); - - /* to start with */ - struct lyn_symbol *symb = lyn_lookup_symbol(lyn, name.s); - assert(symb); - - return lyn_apply_cmd(lyn, symb, cmd.args); + fprintf(lyn->output, "%lld", value.i); + return 0; } -static int eval_int(struct lyn *lyn, struct lyn_value i) +int eval_float(struct lyn *lyn, struct lyn_value value) { - assert(i.kind == LYN_INT); - lyn_return(lyn, i); + fprintf(lyn->output, "%f", value.d); return 0; } -static int eval_id(struct lyn *lyn, struct lyn_value id) +int eval_id(struct lyn *lyn, struct lyn_value value) { - assert(id.kind == LYN_ID); - struct lyn_symbol *symb = lyn_lookup_symbol(lyn, id.s); - assert(symb && symb->kind == LYN_VAR); - - lyn_return(lyn, symb->value); + fprintf(lyn->output, "%s", value.s); return 0; } @@ -301,10 +86,11 @@ int lyn_eval(struct lyn *lyn, struct lyn_value value) switch (value.kind) { case LYN_GROUP: return eval_group(lyn, value); case LYN_APPLY: return eval_apply(lyn, value); + case LYN_STR: return eval_str(lyn, value); case LYN_CMD: return eval_cmd(lyn, value); case LYN_INT: return eval_int(lyn, value); case LYN_ID: return eval_id(lyn, value); - default: error("unhandled case in interp eval"); break; + default: error("unhandled case during 'eval'"); break; } return -1; @@ -325,7 +111,31 @@ int lyn_eval_str(struct lyn *lyn, const char *name, const char *str) return -1; ast_dump(0, ast); - return lyn_eval(lyn, ast); + + lyn->output = fopen("/tmp/output.scm", "w"); + if (!lyn->output) { + error("failed opening output file\n"); + return -1; + } + + fprintf(lyn->output, "(define-syntax-rule (expand expr) expr)\n"); + fprintf(lyn->output, "(define (get expr) expr)\n"); + + int ret = 0; + foreach_vec(ii, ast.args) { + fprintf(lyn->output, "("); + struct lyn_value v = lyn_at(ast.args, ii); + if ((ret = lyn_eval(lyn, v))) + break; + + fprintf(lyn->output, ")\n"); + } + fclose(lyn->output); + + if (ret) + return ret; + + return system("guile /tmp/output.scm"); } /** @@ -380,14 +190,9 @@ int lyn_eval_file(struct lyn *lyn, const char *fname) return ret; } -void lyn_return(struct lyn *lyn, struct lyn_value ast) -{ - lyn->res = ast; -} - -struct lyn_value lyn_res(struct lyn *lyn) +struct lyn lyn_create() { - return lyn->res; + return (struct lyn){}; } void lyn_destroy(struct lyn *lyn) |