From 90f618cbe7ac7740accf501a75be6972bd95be1a Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Sat, 28 Feb 2015 11:09:54 -0600 Subject: All: rename stepA_interop to stepA_mal Also, add missed postscript interop tests. --- php/stepA_interop.php | 229 -------------------------------------------------- 1 file changed, 229 deletions(-) delete mode 100644 php/stepA_interop.php (limited to 'php/stepA_interop.php') diff --git a/php/stepA_interop.php b/php/stepA_interop.php deleted file mode 100644 index 1dc3b04..0000000 --- a/php/stepA_interop.php +++ /dev/null @@ -1,229 +0,0 @@ - 0; -} - -function quasiquote($ast) { - if (!is_pair($ast)) { - return _list(_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 _list(_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); - } else { - return _list(_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]) && - $env->get($ast[0])->ismacro; -} - -function macroexpand($ast, $env) { - while (is_macro_call($ast, $env)) { - $mac = $env->get($ast[0]); - $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); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { - $el = _vector(); - } - foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } - return $el; - } elseif (_hash_map_Q($ast)) { - $new_hm = _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], $res); - case "let*": - $a1 = $ast[1]; - $let_env = new Env($env); - for ($i=0; $i < count($a1); $i+=2) { - $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); - } - $ast = $ast[2]; - $env = $let_env; - break; // Continue loop (TCO) - case "quote": - return $ast[1]; - case "quasiquote": - $ast = quasiquote($ast[1]); - break; // Continue loop (TCO) - case "defmacro!": - $func = MAL_EVAL($ast[2], $env); - $func->ismacro = true; - return $env->set($ast[1], $func); - case "macroexpand": - return macroexpand($ast[1], $env); - case "php*": - $res = eval($ast[1]); - switch (gettype($res)) { - case "array": - if ($res !== array_values($res)) { - $new_res = _hash_map(); - $new_res->exchangeArray($res); - return $new_res; - } else { - return call_user_func_array('_list', $res); - } - default: - return $res; - } - 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; // Continue loop (TCO) - 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; // Continue loop (TCO) - case "fn*": - return _function('MAL_EVAL', 'native', - $ast[2], $env, $ast[1]); - default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); - if ($f->type === 'native') { - $ast = $f->ast; - $env = $f->gen_env($args); - // Continue loop (TCO) - } 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)); -} - -// core.php: defined using PHP -foreach ($core_ns as $k=>$v) { - $repl_env->set(_symbol($k), _function($v)); -} -$repl_env->set(_symbol('eval'), _function(function($ast) { - global $repl_env; return MAL_EVAL($ast, $repl_env); -})); -$_argv = _list(); -for ($i=2; $i < count($argv); $i++) { - $_argv->append($argv[$i]); -} -$repl_env->set(_symbol('*ARGV*'), $_argv); - -// core.mal: defined using the language itself -rep("(def! *host-language* \"php\")"); -rep("(def! not (fn* (a) (if a false true)))"); -rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); -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))))))))"); - -if (count($argv) > 1) { - rep('(load-file "' . $argv[1] . '")'); - exit(0); -} - -// repl loop -rep("(println (str \"Mal [\" *host-language* \"]\"))"); -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); - -?> -- cgit v1.2.3