Current state of mal for Clojure West lighting talk.

1 files changed, 213 insertions, 0 deletions

diff --git a/php/stepA_more.php b/php/stepA_more.php
new file mode 100644
index 0000000..cac80ed
--- /dev/null
+++ b/php/stepA_more.php
@@ -0,0 +1,213 @@
+<?php
+
+require_once 'readline.php';
+require_once 'types.php';
+require_once 'reader.php';
+
+// read
+function READ($str) {
+    return read_str($str);
+}
+
+// eval
+function is_pair($x) {
+    return sequential_Q($x) and count($x) > 0;
+}
+
+function quasiquote($ast) {
+    if (!is_pair($ast)) {
+        return new_list(new_symbol("quote"), $ast);
+    } elseif (symbol_Q($ast[0]) && $ast[0]->value === 'unquote') {
+        return $ast[1];
+    } elseif (is_pair($ast[0]) && symbol_Q($ast[0][0]) &&
+              $ast[0][0]->value === 'splice-unquote') {
+        return new_list(new_symbol("concat"), $ast[0][1],
+                        quasiquote($ast->slice(1)));
+    } else {
+        return new_list(new_symbol("cons"), quasiquote($ast[0]),
+                        quasiquote($ast->slice(1)));
+    }
+}
+
+function is_macro_call($ast, $env) {
+    return is_pair($ast) &&
+           symbol_Q($ast[0]) &&
+           $env->find($ast[0]->value) &&
+           $env->get($ast[0]->value)->ismacro;
+}
+
+function macroexpand($ast, $env) {
+    while (is_macro_call($ast, $env)) {
+        $mac = $env->get($ast[0]->value);
+        $args = array_slice($ast->getArrayCopy(),1);
+        $ast = $mac->apply($args);
+    }
+    return $ast;
+}
+
+function eval_ast($ast, $env) {
+    if (symbol_Q($ast)) {
+        return $env->get($ast->value);
+    } elseif (list_Q($ast) || vector_Q($ast)) {
+        if (list_Q($ast)) {
+            $el = new_list();
+        } else {
+            $el = new_vector();
+        }
+        foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); }
+        return $el;
+    } elseif (hash_map_Q($ast)) {
+        $new_hm = new_hash_map();
+        foreach (array_keys($ast->getArrayCopy()) as $key) {
+            $new_hm[$key] = MAL_EVAL($ast[$key], $env);
+        }
+        return $new_hm;
+    } else {
+        return $ast;
+    }
+}
+
+function MAL_EVAL($ast, $env) {
+    while (true) {
+        #echo "MAL_EVAL: " . _pr_str($ast) . "\n";
+        if (!list_Q($ast)) {
+            return eval_ast($ast, $env);
+        }
+
+        // apply list
+        $ast = macroexpand($ast, $env);
+        if (!list_Q($ast)) { return $ast; }
+
+        $a0 = $ast[0];
+        $a0v = (symbol_Q($a0) ? $a0->value : $a0);
+        switch ($a0v) {
+        case "def!":
+            $res = MAL_EVAL($ast[2], $env);
+            return $env->set($ast[1]->value, $res);
+        case "let*":
+            $a1 = $ast[1];
+            $let_env = new Env($env);
+            for ($i=0; $i < count($a1); $i+=2) {
+                $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env));
+            }
+            return MAL_EVAL($ast[2], $let_env);
+        case "quote":
+            return $ast[1];
+        case "quasiquote":
+            return MAL_EVAL(quasiquote($ast[1]), $env);
+        case "defmacro!":
+            $func = MAL_EVAL($ast[2], $env);
+            $func->ismacro = true;
+            return $env->set($ast[1]->value, $func);
+        case "macroexpand":
+            return macroexpand($ast[1], $env);
+        case "php*":
+            return eval($ast[1]);
+        case "try*":
+            $a1 = $ast[1];
+            $a2 = $ast[2];
+            if ($a2[0]->value === "catch*") {
+                try {
+                    return MAL_EVAL($a1, $env);
+                } catch (Error $e) {
+                    $catch_env = new Env($env, array($a2[1]),
+                                               array($e->obj));
+                    return MAL_EVAL($a2[2], $catch_env);
+                } catch (Exception $e) {
+                    $catch_env = new Env($env, array($a2[1]),
+                                               array($e->getMessage()));
+                    return MAL_EVAL($a2[2], $catch_env);
+                }
+            } else {
+                return MAL_EVAL($a1, $env);
+            }
+        case "do":
+            eval_ast($ast->slice(1, -1), $env);
+            $ast = $ast[count($ast)-1];
+            break;
+        case "if":
+            $cond = MAL_EVAL($ast[1], $env);
+            if ($cond === NULL || $cond === false) {
+                if (count($ast) === 4) { $ast = $ast[3]; }
+                else                   { $ast = NULL; }
+            } else {
+                $ast = $ast[2];
+            }
+            break;
+        case "fn*":
+            return new_function('MAL_EVAL', 'native',
+                                new_hash_map('exp', $ast[2],
+                                             'env', $env,
+                                             'params', $ast[1]));
+        default:
+            $el = eval_ast($ast, $env);
+            $f = $el[0];
+            $args = array_slice($el->getArrayCopy(), 1);
+            if ($f->type === 'native') {
+                $ast = $f->meta['exp'];
+                $env = new Env($f->meta['env'], $f->meta['params'], $args);
+            } else {
+                return $f->apply($args);
+            }
+        }
+    }
+}
+
+// print
+function MAL_PRINT($exp) {
+    return _pr_str($exp, True) . "\n";
+}
+
+// repl
+$repl_env = new Env(NULL);
+function rep($str) {
+    global $repl_env;
+    return MAL_PRINT(MAL_EVAL(READ($str), $repl_env));
+}
+function _ref($k, $v) {
+    global $repl_env;
+    $repl_env->set($k, new_function($v));
+}
+// Import types functions
+foreach ($types_ns as $k=>$v) { _ref($k, $v); }
+
+_ref('readline', 'mal_readline');
+_ref('read-string', 'read_str');
+_ref('eval', function($ast) {
+    global $repl_env; return MAL_EVAL($ast, $repl_env);
+});
+_ref('slurp', function($f) {
+    return file_get_contents($f);
+});
+_ref('slurp-do', function($f) {
+    return "(do " . file_get_contents($f) . ")";
+});
+
+// Defined using the language itself
+rep("(def! not (fn* (a) (if a false true)))");
+rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))");
+rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))");
+rep("(def! load-file (fn* (f) (eval (read-string (slurp-do f)))))");
+
+if (count($argv) > 1) {
+    for ($i=1; $i < count($argv); $i++) {
+        rep('(load-file "' . $argv[$i] . '")');
+    }
+} else {
+    do {
+        try {
+            $line = mal_readline("user> ");
+            if ($line === NULL) { break; }
+            if ($line !== "") {
+                print(rep($line));
+            }
+        } catch (BlankException $e) {
+            continue;
+        } catch (Exception $e) {
+            echo "Error: " . $e->getMessage() . "\n";
+            echo $e->getTraceAsString() . "\n";
+        }
+    } while (true);
+}
+
+?>