Current state of mal for Clojure West lighting talk.

1 files changed, 282 insertions, 0 deletions

diff --git a/c/step6_file.c b/c/step6_file.c
new file mode 100644
index 0000000..875c32c
--- /dev/null
+++ b/c/step6_file.c
@@ -0,0 +1,282 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <unistd.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include "types.h"
+#include "readline.h"
+#include "reader.h"
+#include "interop.h"
+
+// Declarations
+MalVal *EVAL(MalVal *ast, Env *env);
+
+// read
+MalVal *READ(char prompt[], char *str) {
+    char *line;
+    MalVal *ast;
+    if (str) {
+        line = str;
+    } else {
+        line = _readline(prompt);
+        if (!line) {
+            _error("EOF");
+            return NULL;
+        }
+    }
+    ast = read_str(line);
+    if (!str) { free(line); }
+    return ast;
+}
+
+// eval
+MalVal *eval_ast(MalVal *ast, Env *env) {
+    if (!ast || mal_error) return NULL;
+    if (ast->type == MAL_SYMBOL) {
+        //g_print("EVAL symbol: %s\n", ast->val.string);
+        return env_get(env, ast->val.string);
+    } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) {
+        //g_print("EVAL sequential: %s\n", _pr_str(ast,1));
+        MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env);
+        if (!el || mal_error) return NULL;
+        el->type = ast->type;
+        return el;
+    } else if (ast->type == MAL_HASH_MAP) {
+        //g_print("EVAL hash_map: %s\n", _pr_str(ast,1));
+        GHashTableIter iter;
+        gpointer key, value;
+        MalVal *seq = malval_new_list(MAL_LIST,
+                                    g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
+                                                        _count(ast)));
+        g_hash_table_iter_init (&iter, ast->val.hash_table);
+        while (g_hash_table_iter_next (&iter, &key, &value)) {
+            MalVal *kname = malval_new_string((char *)key);
+            g_array_append_val(seq->val.array, kname);
+            MalVal *new_val = EVAL((MalVal *)value, env);
+            g_array_append_val(seq->val.array, new_val);
+        }
+        return hash_map(seq);
+    } else {
+        //g_print("EVAL scalar: %s\n", _pr_str(ast,1));
+        return ast;
+    }
+}
+
+MalVal *EVAL(MalVal *ast, Env *env) {
+    while (TRUE) {
+        //g_print("EVAL: %s\n", _pr_str(ast,1));
+        if (!ast || mal_error) return NULL;
+        if (ast->type != MAL_LIST) {
+            return eval_ast(ast, env);
+        }
+        if (!ast || mal_error) return NULL;
+
+        // apply list
+        //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
+        int i, len;
+        if (_count(ast) == 0) { return ast; }
+        MalVal *a0 = _nth(ast, 0);
+        if ((a0->type & MAL_SYMBOL) &&
+            strcmp("def!", a0->val.string) == 0) {
+            //g_print("eval apply def!\n");
+            MalVal *a1 = _nth(ast, 1),
+                   *a2 = _nth(ast, 2);
+            MalVal *res = EVAL(a2, env);
+            env_set(env, a1->val.string, res);
+            return res;
+        } else if ((a0->type & MAL_SYMBOL) &&
+                   strcmp("let*", a0->val.string) == 0) {
+            //g_print("eval apply let*\n");
+            MalVal *a1 = _nth(ast, 1),
+                   *a2 = _nth(ast, 2),
+                   *key, *val;
+            assert_type(a1, MAL_LIST|MAL_VECTOR,
+                        "let* bindings must be list or vector");
+            len = _count(a1);
+            assert((len % 2) == 0, "odd number of let* bindings forms");
+            Env *let_env = new_env(env, NULL, NULL);
+            for(i=0; i<len; i+=2) {
+                key = g_array_index(a1->val.array, MalVal*, i);
+                val = g_array_index(a1->val.array, MalVal*, i+1);
+                assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
+                env_set(let_env, key->val.string, EVAL(val, let_env));
+            }
+            return EVAL(a2, let_env);
+        } else if ((a0->type & MAL_SYMBOL) &&
+                   strcmp("do", a0->val.string) == 0) {
+            //g_print("eval apply do\n");
+            eval_ast(_slice(ast, 1, _count(ast)-1), env);
+            ast = last(ast);
+            // Continue loop
+        } else if ((a0->type & MAL_SYMBOL) &&
+                   strcmp("if", a0->val.string) == 0) {
+            //g_print("eval apply if\n");
+            MalVal *a1 = _nth(ast, 1);
+            MalVal *cond = EVAL(a1, env);
+            if (!cond || mal_error) return NULL;
+            if (cond->type & (MAL_FALSE|MAL_NIL)) {
+                // eval false slot form
+                ast = _nth(ast, 3);
+                if (!ast) {
+                    return &mal_nil;
+                }
+            } else {
+                // eval true slot form
+                ast = _nth(ast, 2);
+            }
+            // Continue loop
+        } else if ((a0->type & MAL_SYMBOL) &&
+                   strcmp("fn*", a0->val.string) == 0) {
+            //g_print("eval apply fn*\n");
+            MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
+            mf->val.func.evaluator = EVAL;
+            mf->val.func.args = _nth(ast, 1);
+            mf->val.func.body = _nth(ast, 2);
+            mf->val.func.env = env;
+            return mf;
+        } else {
+            //g_print("eval apply\n");
+            MalVal *el = eval_ast(ast, env);
+            if (!el || mal_error) { return NULL; }
+            MalVal *f = first(el),
+                   *args = rest(el);
+            assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
+                        "cannot invoke '%s'", _pr_str(f,1));
+            if (f->type & MAL_FUNCTION_MAL) {
+                ast = f->val.func.body;
+                env = new_env(f->val.func.env, f->val.func.args, args);
+                // Continue loop
+            } else {
+                return apply(f, args);
+            }
+        }
+    }
+}
+
+// print
+char *PRINT(MalVal *exp) {
+    if (mal_error) {
+        fprintf(stderr, "Error: %s\n", mal_error->val.string);
+        malval_free(mal_error);
+        mal_error = NULL;
+        return NULL;
+    }
+    return _pr_str(exp,1);
+}
+
+// repl
+
+// read and eval
+MalVal *RE(Env *env, char *prompt, char *str) {
+    MalVal *ast, *exp;
+    ast = READ(prompt, str);
+    if (!ast || mal_error) return NULL;
+    exp = EVAL(ast, env);
+    if (ast != exp) {
+        malval_free(ast);    // Free input structure
+    }
+    return exp;
+}
+
+// Setup the initial REPL environment
+Env *repl_env;
+
+char *slurp_raw(char *path) {
+    char *data;
+    struct stat fst;
+    int fd = open(path, O_RDONLY),
+        sz;
+    if (fd < 0) {
+        abort("slurp failed to open '%s'", path);
+    }
+    if (fstat(fd, &fst) < 0) {
+        abort("slurp failed to stat '%s'", path);
+    }
+    data = malloc(fst.st_size+1);
+    sz = read(fd, data, fst.st_size);
+    if (sz < fst.st_size) {
+        abort("slurp failed to read '%s'", path);
+    }
+    data[sz] = '\0';
+    return data;
+}
+
+void init_repl_env() {
+    void _ref(char *name, MalVal*(*func)(MalVal*), int arg_cnt) {
+        void *(*f)(void *) = (void*(*)(void*))func;
+        env_set(repl_env, name, malval_new_function(f, arg_cnt, NULL));
+    }
+    repl_env = new_env(NULL, NULL, NULL);
+
+    int i;
+    for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) {
+        MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func;
+        _ref(types_ns[i].name, f, types_ns[i].arg_cnt);
+    }
+
+    MalVal *read_string(MalVal *str) {
+        assert_type(str, MAL_STRING, "read_string of non-string");
+        return read_str(str->val.string);
+    }
+    _ref("read-string", read_string, 1);
+
+    MalVal *do_eval(MalVal *ast) {
+        return EVAL(ast, repl_env);
+    }
+    _ref("eval", do_eval, 1);
+
+    MalVal *slurp(MalVal *path) {
+        assert_type(path, MAL_STRING, "slurp of non-string");
+        char *data = slurp_raw(path->val.string);
+        if (!data || mal_error) { return NULL; }
+        return malval_new_string(data);
+    }
+    _ref("slurp", slurp, 1);
+
+    MalVal *slurp_do(MalVal *path) {
+        assert_type(path, MAL_STRING, "slurp of non-string");
+        char *data = slurp_raw(path->val.string),
+             *wrapped_data;
+        if (!data || mal_error) { return NULL; }
+        wrapped_data = g_strdup_printf("(do %s)", data);
+        free(data);
+        return malval_new_string(wrapped_data);
+    }
+    _ref("slurp-do", slurp_do, 1);
+
+    RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
+    RE(repl_env, "",
+       "(def! load-file (fn* (f) (eval (read-string (slurp-do f)))))");
+}
+
+int main(int argc, char *argv[])
+{
+    MalVal *exp;
+    char *output;
+    char prompt[100];
+
+    // Set the initial prompt and environment
+    snprintf(prompt, sizeof(prompt), "user> ");
+    init_repl_env();
+ 
+    if (argc > 1) {
+        char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]);
+        RE(repl_env, "", cmd);
+    } else {
+        // REPL loop
+        for(;;) {
+            exp = RE(repl_env, prompt, NULL);
+            if (mal_error && strcmp("EOF", mal_error->val.string) == 0) {
+                return 0;
+            }
+            output = PRINT(exp);
+
+            if (output) { 
+                g_print("%s\n", output);
+                free(output);        // Free output string
+            }
+
+            //malval_free(exp);    // Free evaluated expression
+        }
+    }
+}