From 2ab1e5845c213a9951bee46a0c991202e6c46d5c Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Sat, 28 Feb 2015 10:35:04 -0600 Subject: Multiple: interop enhancements. --- php/stepA_interop.php | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'php') diff --git a/php/stepA_interop.php b/php/stepA_interop.php index 8c67c66..1dc3b04 100644 --- a/php/stepA_interop.php +++ b/php/stepA_interop.php @@ -109,7 +109,19 @@ function MAL_EVAL($ast, $env) { case "macroexpand": return macroexpand($ast[1], $env); case "php*": - return eval($ast[1]); + $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]; -- cgit v1.2.3 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/Makefile | 2 +- php/stepA_interop.php | 229 -------------------------------------------- php/stepA_mal.php | 229 ++++++++++++++++++++++++++++++++++++++++++++ php/tests/stepA_interop.mal | 25 ----- php/tests/stepA_mal.mal | 25 +++++ 5 files changed, 255 insertions(+), 255 deletions(-) delete mode 100644 php/stepA_interop.php create mode 100644 php/stepA_mal.php delete mode 100644 php/tests/stepA_interop.mal create mode 100644 php/tests/stepA_mal.mal (limited to 'php') diff --git a/php/Makefile b/php/Makefile index d9fd2d4..659e89c 100644 --- a/php/Makefile +++ b/php/Makefile @@ -2,7 +2,7 @@ TESTS = SOURCES_BASE = readline.php types.php reader.php printer.php -SOURCES_LISP = env.php core.php stepA_interop.php +SOURCES_LISP = env.php core.php stepA_mal.php SOURCES = $(SOURCES_BASE) $(SOURCES_LISP) .PHONY: stats tests $(TESTS) 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); - -?> diff --git a/php/stepA_mal.php b/php/stepA_mal.php new file mode 100644 index 0000000..1dc3b04 --- /dev/null +++ b/php/stepA_mal.php @@ -0,0 +1,229 @@ + 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); + +?> diff --git a/php/tests/stepA_interop.mal b/php/tests/stepA_interop.mal deleted file mode 100644 index 15f8a94..0000000 --- a/php/tests/stepA_interop.mal +++ /dev/null @@ -1,25 +0,0 @@ -;; Testing basic php interop - -(php* "return 7;") -;=>7 - -(php* "return '7';") -;=>"7" - -(php* "return array(7,8,9);") -;=>(7 8 9) - -(php* "return array(\"abc\" => 789);") -;=>{"abc" 789} - -(php* "print \"hello\n\";") -; hello -;=>nil - -(php* "global $foo; $foo=8;") -(php* "global $foo; return $foo;") -;=>8 - -(php* "global $f; $f = function($v) { return 1+$v; };") -(php* "global $f; return array_map($f, array(1,2,3));") -;=>(2 3 4) diff --git a/php/tests/stepA_mal.mal b/php/tests/stepA_mal.mal new file mode 100644 index 0000000..15f8a94 --- /dev/null +++ b/php/tests/stepA_mal.mal @@ -0,0 +1,25 @@ +;; Testing basic php interop + +(php* "return 7;") +;=>7 + +(php* "return '7';") +;=>"7" + +(php* "return array(7,8,9);") +;=>(7 8 9) + +(php* "return array(\"abc\" => 789);") +;=>{"abc" 789} + +(php* "print \"hello\n\";") +; hello +;=>nil + +(php* "global $foo; $foo=8;") +(php* "global $foo; return $foo;") +;=>8 + +(php* "global $f; $f = function($v) { return 1+$v; };") +(php* "global $f; return array_map($f, array(1,2,3));") +;=>(2 3 4) -- cgit v1.2.3