diff options
| -rw-r--r-- | examples/guile.lyn | 18 | ||||
| -rw-r--r-- | examples/if.lyn | 15 | ||||
| -rw-r--r-- | examples/loop.lyn | 6 | ||||
| -rw-r--r-- | examples/primitive.lyn | 5 | ||||
| -rw-r--r-- | examples/sum.lyn | 18 | ||||
| -rw-r--r-- | include/lyn/lookup.h | 29 | ||||
| -rw-r--r-- | include/lyn/lyn.h | 13 | ||||
| -rw-r--r-- | src/lookup.c | 123 | ||||
| -rw-r--r-- | src/lyn.c | 315 | ||||
| -rw-r--r-- | src/main.c | 5 | ||||
| -rw-r--r-- | src/parser.y | 1 |
11 files changed, 82 insertions, 466 deletions
diff --git a/examples/guile.lyn b/examples/guile.lyn new file mode 100644 index 0000000..9d7f445 --- /dev/null +++ b/examples/guile.lyn @@ -0,0 +1,18 @@ +define-syntax-rule (for init condition post body) { + expand init + do () ((not (expand condition))) { + expand body + expand post + } +} + +define (sum n) { + define s 0 + for (define i 0) (< i n) (set! i (1+ i)) { + set! s (+ s i) + } + get s +} + +display (sum 1000000) +newline diff --git a/examples/if.lyn b/examples/if.lyn deleted file mode 100644 index 294a490..0000000 --- a/examples/if.lyn +++ /dev/null @@ -1,15 +0,0 @@ -# `if` macro, think of it as a statement I guess? -# else is used by the `if` command in C, presumably? -if {< i 10} { - println "a" -} {< i 20} { - println "b" -} else { - println "c" -} - -# `if` procedure, think of it as expr-if in other languages I guess -# note that all arguments get evaluated here, so if you have a slow function in -# one branch you should probably prefer `if` statements - -let x (do-if (< i 10) "a" (< i 20) "b" else "c") diff --git a/examples/loop.lyn b/examples/loop.lyn deleted file mode 100644 index 0304672..0000000 --- a/examples/loop.lyn +++ /dev/null @@ -1,6 +0,0 @@ -let sum 0 -for {let i 0} {< i 1000000} {set i (+ i 1)} { - set sum (+ sum i) -} - -println sum diff --git a/examples/primitive.lyn b/examples/primitive.lyn deleted file mode 100644 index 4ebcf74..0000000 --- a/examples/primitive.lyn +++ /dev/null @@ -1,5 +0,0 @@ -let x 0 -println x - -set x 1 -println x diff --git a/examples/sum.lyn b/examples/sum.lyn deleted file mode 100644 index 55338f6..0000000 --- a/examples/sum.lyn +++ /dev/null @@ -1,18 +0,0 @@ -syntax for {init cond post body} { - eval init - while {eval cond} { - eval body - eval post - } -} - -def sum {n} { - require n int - let s 0 - for {let i 0} {< i n} {set i (+ i 1)} { - set s (+ s i) - } - return s -} - -println (sum 1000000) diff --git a/include/lyn/lookup.h b/include/lyn/lookup.h deleted file mode 100644 index 577d450..0000000 --- a/include/lyn/lookup.h +++ /dev/null @@ -1,29 +0,0 @@ -#ifndef LYN_LOOKUP_H -#define LYN_LOOKUP_H - -#include <stddef.h> - -struct lookup_node { - unsigned long hash; - struct lookup_node *left, *right; - char data[]; /* should be max aligned */ -}; - -struct lookup { - size_t ns; - struct lookup_node *root; -}; - -struct lookup lookup_create(size_t s); -void lookup_destroy(struct lookup *l); - -void *lookup_insert(struct lookup *l, const char *key, const void *n); -void *lookup_at(struct lookup *l, const char *key); - -#define lookupt_insert(type, l, key, n)\ - (type *)lookup_insert(type, l, key, n) - -#define lookupt_at(type, l, key)\ - *(type *)lookup_at(&l, key) - -#endif /* LYN_LOOKUP_H */ diff --git a/include/lyn/lyn.h b/include/lyn/lyn.h index ff79979..40429c2 100644 --- a/include/lyn/lyn.h +++ b/include/lyn/lyn.h @@ -1,23 +1,16 @@ #ifndef LYN_H #define LYN_H +#include <stdio.h> #include <lyn/parser.h> -#include <lyn/lookup.h> #include <lyn/vec.h> #define lyn_at(v, i)\ vect_at(struct lyn_value, v, i) -struct lyn_scope { - struct lyn_scope *parent; - struct lookup visible; -}; - struct lyn { - struct lyn_scope *root; - struct lyn_scope *cur; - - struct lyn_value res; + FILE *output; + int depth; }; typedef int (*lyn_call)(struct lyn *lyn, struct vec args); diff --git a/src/lookup.c b/src/lookup.c deleted file mode 100644 index 377c505..0000000 --- a/src/lookup.c +++ /dev/null @@ -1,123 +0,0 @@ -#include <string.h> -#include <stdlib.h> -#include <lyn/lookup.h> - -struct lookup lookup_create(size_t s) -{ - return (struct lookup){.ns = s, .root = NULL}; -} - -unsigned long djb2(const unsigned char *str) -{ - unsigned long hash = 5381; - int c; - - while ((c = *str++)) - hash = ((hash << 5) + hash) + c; /* hash * 33 + c */ - - return hash; -} - -static size_t lookup_size(struct lookup *l, size_t key_len) -{ - return sizeof(struct lookup_node) + l->ns + key_len + 1; -} - -static struct lookup_node *create_node(struct lookup *l, unsigned long hash, const char *key, const void *n) -{ - size_t key_len = strlen(key); - struct lookup_node *new = malloc(lookup_size(l, key_len)); - if (!new) - return NULL; - - memcpy(new->data, n, l->ns); - strcpy(new->data + l->ns, key); - new->hash = hash; - new->left = NULL; - new->right = NULL; - return new; -} - -void *lookup_insert(struct lookup *l, const char *key, const void *n) -{ - enum {INSERT_LEFT, INSERT_RIGHT} side = INSERT_LEFT; - - unsigned long hash = djb2((const unsigned char *)key); - if (!l->root) { - struct lookup_node *new = create_node(l, hash, key, n); - if (!new) - return NULL; - - l->root = new; - return &new->data; - } - - struct lookup_node *cmp = l->root; - while (cmp) { - if (cmp->hash == hash) { - if (strcmp(cmp->data + l->ns, key) == 0) - return NULL; - - if (cmp->left) { - cmp = cmp->left; - continue; - } - - side = INSERT_LEFT; - break; - } - else if (cmp->hash < hash) { - if (cmp->left) { - cmp = cmp->left; - continue; - } - - side = INSERT_LEFT; - break; - } - else if (cmp->hash > hash) { - if (cmp->right) { - cmp = cmp->right; - continue; - } - - side = INSERT_RIGHT; - break; - } - } - - struct lookup_node *new = create_node(l, hash, key, n); - if (!new) - return NULL; - - if (side == INSERT_LEFT) - cmp->left = new; - else if (side == INSERT_RIGHT) - cmp->right = new; - else - abort(); - - return &new->data; -} - -void *lookup_at(struct lookup *l, const char *key) -{ - unsigned long hash = djb2((const unsigned char *)key); - struct lookup_node *n = l->root; - while (n) { - if (n->hash == hash) { - if (strcmp(n->data + l->ns, key) == 0) - return &n->data; - - n = n->left; - } - else if (n->hash < hash) { - n = n->left; - } - else if (n->hash > hash) { - n = n->right; - } - } - - return NULL; -} @@ -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) @@ -9,11 +9,6 @@ int main(int argc, char *argv[]) } struct lyn lyn = lyn_create(); - if (lyn_init(&lyn)) { - lyn_destroy(&lyn); - return -1; - } - int ret = lyn_eval_file(&lyn, argv[1]); lyn_destroy(&lyn); return ret; diff --git a/src/parser.y b/src/parser.y index 742bc5f..7b49eb8 100644 --- a/src/parser.y +++ b/src/parser.y @@ -164,6 +164,7 @@ cmds input : cmds {$1.kind = LYN_GROUP; parser->tree = $1;} + | error {parser->failed = true;} %% |