diff options
Diffstat (limited to 'php')
| -rw-r--r-- | php/reader.php | 115 | ||||
| -rw-r--r-- | php/readline.php | 34 | ||||
| -rw-r--r-- | php/step0_repl.php | 33 | ||||
| -rw-r--r-- | php/step1_read_print.php | 42 | ||||
| -rw-r--r-- | php/step2_eval.php | 77 | ||||
| -rw-r--r-- | php/step3_env.php | 94 | ||||
| -rw-r--r-- | php/step4_if_fn_do.php | 112 | ||||
| -rw-r--r-- | php/step5_tco.php | 124 | ||||
| -rw-r--r-- | php/step6_file.php | 142 | ||||
| -rw-r--r-- | php/step7_quote.php | 165 | ||||
| -rw-r--r-- | php/step8_macros.php | 190 | ||||
| -rw-r--r-- | php/step9_interop.php | 192 | ||||
| -rw-r--r-- | php/stepA_more.php | 213 | ||||
| -rw-r--r-- | php/types.php | 488 |
14 files changed, 2021 insertions, 0 deletions
diff --git a/php/reader.php b/php/reader.php new file mode 100644 index 0000000..0524b31 --- /dev/null +++ b/php/reader.php @@ -0,0 +1,115 @@ +<?php + +require_once 'types.php'; + +class Reader { + protected $tokens = array(); + protected $position = 0; + public function __construct($tokens) { + $this->tokens = $tokens; + $this->position = 0; + } + public function next() { + return $this->tokens[$this->position++]; + } + public function peek() { + return $this->tokens[$this->position]; + } +} + +class BlankException extends Exception { +} + +function _real_token($s) { + return $s !== '' && $s[0] !== ';'; +} + +function tokenize($str) { + $pat = "/[\s,]*(~@|[\[\]{}()'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;.*|[^\s\[\]{}('\"`,;)]*)/"; + preg_match_all($pat, $str, $matches); + return array_values(array_filter($matches[1], '_real_token')); +} + +function read_atom($reader) { + $token = $reader->next(); + if (preg_match("/^-?[0-9]+$/", $token)) { + return intval($token, 10); + } elseif ($token[0] === "\"") { + $str = substr($token, 1, -1); + $str = preg_replace('/\\\\"/', '"', $str); + return $str; + } elseif ($token === "nil") { + return NULL; + } elseif ($token === "true") { + return true; + } elseif ($token === "false") { + return false; + } else { + return new_symbol($token); + } +} + +function read_list($reader, $constr='new_list', $start='(', $end=')') { + $ast = $constr(); + $token = $reader->next(); + if ($token !== $start) { + throw new Exception("expected '" . $start . "'"); + } + while (($token = $reader->peek()) !== $end) { + if ($token === "") { + throw new Exception("expected '" . $end . "', got EOF"); + } + $ast[] = read_form($reader); + } + $reader->next(); + return $ast; +} + +function read_hash_map($reader) { + $lst = read_list($reader, 'new_list', '{', '}'); + return call_user_func_array('new_hash_map', $lst->getArrayCopy()); +} + +function read_form($reader) { + $token = $reader->peek(); + switch ($token) { + case '\'': $reader->next(); + return new_list(new_symbol('quote'), + read_form($reader)); + case '`': $reader->next(); + return new_list(new_symbol('quasiquote'), + read_form($reader)); + case '~': $reader->next(); + return new_list(new_symbol('unquote'), + read_form($reader)); + case '~@': $reader->next(); + return new_list(new_symbol('splice-unquote'), + read_form($reader)); + case '^': $reader->next(); + $meta = read_form($reader); + return new_list(new_symbol('with-meta'), + read_form($reader), + $meta); + + case '@': $reader->next(); + return new_list(new_symbol('deref'), + read_form($reader)); + + case ')': throw new Exception("unexpected ')'"); + case '(': return read_list($reader); + case ']': throw new Exception("unexpected ']'"); + case '[': return read_list($reader, 'new_vector', '[', ']'); + case '}': throw new Exception("unexpected '}'"); + case '{': return read_hash_map($reader); + + default: return read_atom($reader); + } +} + +function read_str($str) { + $tokens = tokenize($str); + if (count($tokens) === 0) { throw new BlankException(); } + return read_form(new Reader($tokens)); +} + +?> diff --git a/php/readline.php b/php/readline.php new file mode 100644 index 0000000..28d720d --- /dev/null +++ b/php/readline.php @@ -0,0 +1,34 @@ +<?php + +$HISTORY_FILE = "/home/joelm/.mal-history"; + +function mal_readline($prompt) { + global $HISTORY_FILE; + static $history_loaded = false; + + // Load the history file + if (! $history_loaded) { + $history_loaded = true; + if ($file = fopen($HISTORY_FILE, "r")) { + while (!feof($file)) { + $line = fgets($file); + if ($line) { readline_add_history($line); } + } + fclose($file); + } + } + + $line = readline($prompt); + if ($line === false) { return NULL; } + readline_add_history($line); + + // Append to the history file + if ($file = fopen($HISTORY_FILE, "a")) { + fputs($file, $line . "\n"); + fclose($file); + } + + return $line; +} + +?> diff --git a/php/step0_repl.php b/php/step0_repl.php new file mode 100644 index 0000000..64b086b --- /dev/null +++ b/php/step0_repl.php @@ -0,0 +1,33 @@ +<?php + +require_once 'readline.php'; + +// read +function READ($str) { + return $str; +} + +// eval +function MAL_EVAL($ast, $env) { + return eval($ast); +} + +// print +function MAL_PRINT($exp) { + return var_export($exp, true) . "\n"; +} + +// repl +function rep($str) { + return MAL_PRINT(MAL_EVAL(READ($str), array())); +} + +do { + $line = mal_readline("user> "); + if ($line === NULL) { break; } + if (!empty($line)) { + print(rep($line)); + } +} while (true); + +?> diff --git a/php/step1_read_print.php b/php/step1_read_print.php new file mode 100644 index 0000000..01334e0 --- /dev/null +++ b/php/step1_read_print.php @@ -0,0 +1,42 @@ +<?php + +require_once 'readline.php'; +require_once 'types.php'; +require_once 'reader.php'; + +// read +function READ($str) { + return read_str($str); +} + +// eval +function MAL_EVAL($ast, $env) { + return $ast; +} + +// print +function MAL_PRINT($exp) { + return _pr_str($exp, True) . "\n"; +} + +// repl +function rep($str) { + return MAL_PRINT(MAL_EVAL(READ($str), array())); +} + +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/step2_eval.php b/php/step2_eval.php new file mode 100644 index 0000000..c9c3562 --- /dev/null +++ b/php/step2_eval.php @@ -0,0 +1,77 @@ +<?php + +require_once 'readline.php'; +require_once 'types.php'; +require_once 'reader.php'; + +// read +function READ($str) { + return read_str($str); +} + +// eval +function eval_ast($ast, $env) { + if (symbol_Q($ast)) { + return $env[$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) { + if (!list_Q($ast)) { + return eval_ast($ast, $env); + } + + // apply list + $el = eval_ast($ast, $env); + $f = $el[0]; + return call_user_func_array($f, array_slice($el->getArrayCopy(), 1)); +} + +// print +function MAL_PRINT($exp) { + return _pr_str($exp, True) . "\n"; +} + +// repl +$repl_env = array(); +function rep($str) { + global $repl_env; + return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); +} +$repl_env['+'] = function ($a, $b) { return intval($a + $b,10); }; +$repl_env['-'] = function ($a, $b) { return intval($a - $b,10); }; +$repl_env['*'] = function ($a, $b) { return intval($a * $b,10); }; +$repl_env['/'] = function ($a, $b) { return intval($a / $b,10); }; + +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/step3_env.php b/php/step3_env.php new file mode 100644 index 0000000..15d7c5c --- /dev/null +++ b/php/step3_env.php @@ -0,0 +1,94 @@ +<?php + +require_once 'readline.php'; +require_once 'types.php'; +require_once 'reader.php'; + +// read +function READ($str) { + return read_str($str); +} + +// eval +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) { + if (!list_Q($ast)) { + return eval_ast($ast, $env); + } + + // apply list + $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); + default: + $el = eval_ast($ast, $env); + $f = $el[0]; + return call_user_func_array($f, array_slice($el->getArrayCopy(), 1)); + } +} + +// 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, $v); } + +_ref('+', function ($a, $b) { return intval($a + $b,10); }); +_ref('-', function ($a, $b) { return intval($a - $b,10); }); +_ref('*', function ($a, $b) { return intval($a * $b,10); }); +_ref('/', function ($a, $b) { return intval($a / $b,10); }); + +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/step4_if_fn_do.php b/php/step4_if_fn_do.php new file mode 100644 index 0000000..3b9593d --- /dev/null +++ b/php/step4_if_fn_do.php @@ -0,0 +1,112 @@ +<?php + +require_once 'readline.php'; +require_once 'types.php'; +require_once 'reader.php'; + +// read +function READ($str) { + return read_str($str); +} + +// eval +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) { + #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; + if (!list_Q($ast)) { + return eval_ast($ast, $env); + } + + // apply list + $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 "do": + #$el = eval_ast(array_slice($ast->getArrayCopy(), 1), $env); + $el = eval_ast($ast->slice(1), $env); + return $el[count($el)-1]; + case "if": + $cond = MAL_EVAL($ast[1], $env); + if ($cond === NULL || $cond === false) { + if (count($ast) === 4) { return MAL_EVAL($ast[3], $env); } + else { return NULL; } + } else { + return MAL_EVAL($ast[2], $env); + } + case "fn*": + return function() use ($env, $ast) { + $fn_env = new Env($env, $ast[1], func_get_args()); + return MAL_EVAL($ast[2], $fn_env); + }; + default: + $el = eval_ast($ast, $env); + $f = $el[0]; + return call_user_func_array($f, array_slice($el->getArrayCopy(), 1)); + } +} + +// 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, $v); } +// Import types functions +foreach ($types_ns as $k=>$v) { _ref($k, $v); } + +// Defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); + +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/step5_tco.php b/php/step5_tco.php new file mode 100644 index 0000000..54d7699 --- /dev/null +++ b/php/step5_tco.php @@ -0,0 +1,124 @@ +<?php + +require_once 'readline.php'; +require_once 'types.php'; +require_once 'reader.php'; + +// read +function READ($str) { + return read_str($str); +} + +// eval +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 + $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 "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); } + +// Defined using the language itself +rep("(def! not (fn* (a) (if a false true)))"); + +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/step6_file.php b/php/step6_file.php new file mode 100644 index 0000000..8e923e1 --- /dev/null +++ b/php/step6_file.php @@ -0,0 +1,142 @@ +<?php + +require_once 'readline.php'; +require_once 'types.php'; +require_once 'reader.php'; + +// read +function READ($str) { + return read_str($str); +} + +// eval +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 + $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 "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('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("(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); +} + +?> diff --git a/php/step7_quote.php b/php/step7_quote.php new file mode 100644 index 0000000..2ccd130 --- /dev/null +++ b/php/step7_quote.php @@ -0,0 +1,165 @@ +<?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 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 + $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 "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('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("(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); +} + +?> diff --git a/php/step8_macros.php b/php/step8_macros.php new file mode 100644 index 0000000..20e0f6a --- /dev/null +++ b/php/step8_macros.php @@ -0,0 +1,190 @@ +<?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 "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('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("(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); +} + +?> diff --git a/php/step9_interop.php b/php/step9_interop.php new file mode 100644 index 0000000..fd7c1d7 --- /dev/null +++ b/php/step9_interop.php @@ -0,0 +1,192 @@ +<?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 "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('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("(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); +} + +?> 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); +} + +?> diff --git a/php/types.php b/php/types.php new file mode 100644 index 0000000..0c4ab33 --- /dev/null +++ b/php/types.php @@ -0,0 +1,488 @@ +<?php + +function _pr_str($obj, $print_readably=True) { + if (list_Q($obj)) { + $ret = array(); + foreach ($obj as $e) { + array_push($ret, _pr_str($e, $print_readably)); + } + return "(" . implode(" ", $ret) . ")"; + } elseif (vector_Q($obj)) { + $ret = array(); + foreach ($obj as $e) { + array_push($ret, _pr_str($e, $print_readably)); + } + return "[" . implode(" ", $ret) . "]"; + } elseif (hash_map_Q($obj)) { + $ret = array(); + foreach (array_keys($obj->getArrayCopy()) as $k) { + $ret[] = _pr_str($k, $print_readably); + $ret[] = _pr_str($obj[$k], $print_readably); + } + return "{" . implode(" ", $ret) . "}"; + } elseif (is_string($obj)) { + if ($print_readably) { + $obj = preg_replace('/"/', '\\"', preg_replace('/\\\\/', '\\\\\\\\', $obj)); + return '"' . $obj . '"'; + } else { + return $obj; + } + } elseif (is_integer($obj)) { + return $obj; + } elseif ($obj === NULL) { + return "nil"; + } elseif ($obj === true) { + return "true"; + } elseif ($obj === false) { + return "false"; + } elseif (symbol_Q($obj)) { + return $obj->value; + } elseif (atom_Q($obj)) { + return "(atom " . _pr_str($obj->value, $print_readably) . ")"; + } elseif (function_Q($obj)) { + return "(fn* [...] ...)"; + } elseif (is_callable($obj)) { // only step4 and below + return "#<function ...>"; + } else { + throw new Exception("_pr_str unknown type: " . gettype($obj)); + } +} + +function pr_str() { + $ps = array_map(function ($obj) { return _pr_str($obj, True); }, + func_get_args()); + return implode(" ", $ps); +} + +function str() { + $ps = array_map(function ($obj) { return _pr_str($obj, False); }, + func_get_args()); + return implode("", $ps); +} + +function prn() { + $ps = array_map(function ($obj) { return _pr_str($obj, True); }, + func_get_args()); + print implode(" ", $ps) . "\n"; + return null; +} + +function println() { + $ps = array_map(function ($obj) { return _pr_str($obj, False); }, + func_get_args()); + print implode(" ", $ps) . "\n"; + return null; +} + +function with_meta($obj, $m) { + $new_obj = clone $obj; + $new_obj->meta = $m; + return $new_obj; +} + +function meta($obj) { + return $obj->meta; +} + +function equal_Q($a, $b) { + $ota = gettype($a) === "object" ? get_class($a) : gettype($a); + $otb = gettype($b) === "object" ? get_class($b) : gettype($b); + if (!($ota === $otb or (sequential_Q($a) and sequential_Q($b)))) { + return false; + } elseif (symbol_Q($a)) { + #print "ota: $ota, otb: $otb\n"; + return $a->value === $b->value; + } elseif (list_Q($a) or vector_Q($a)) { + if ($a->count() !== $b->count()) { return false; } + for ($i=0; $i<$a->count(); $i++) { + if (!equal_Q($a[$i], $b[$i])) { return false; } + } + return true; + } else { + return $a === $b; + } +} + +// nil, true, false, string +function nil_Q($obj) { return $obj === NULL; } +function true_Q($obj) { return $obj === true; } +function false_Q($obj) { return $obj === false; } +function string_Q($obj) { return is_string($obj); } + + +// symbols +class SymbolClass { + public $value = NULL; + public $meta = NULL; + public function __construct($value) { + $this->value = $value; + } +} + +function new_symbol($name) { return new SymbolClass($name); } + +function symbol_Q($obj) { return ($obj instanceof SymbolClass); } + + +// Functions +class FunctionClass { + public $func = NULL; + public $type = 'native'; // 'native' or 'platform' + public $meta = NULL; + public $ismacro = False; + public function __construct($func, $type, $meta=NULL, $ismacro=False) { + $this->func = $func; + $this->type = $type; + $this->meta = $meta; + $this->ismacro = $ismacro; + } + public function __invoke() { + $args = func_get_args(); + if ($this->type === 'native') { + $fn_env = new Env($this->meta['env'], + $this->meta['params'], $args); + $evalf = $this->func; + return $evalf($this->meta['exp'], $fn_env); + } else { + return call_user_func_array($this->func, $args); + } + } + public function apply($args) { + return call_user_func_array(array(&$this, '__invoke'),$args); + } +} + +function new_function($func, $type='platform', $meta=NULL, $ismacro=False) { + return new FunctionClass($func, $type, $meta, $ismacro); +} + +function function_Q($obj) { return $obj instanceof FunctionClass; } + +// Parent class of list, vector, hash-map +// http://www.php.net/manual/en/class.arrayobject.php +class SeqClass extends ArrayObject { + public function slice($start, $length=NULL) { + $sc = new $this(); + if ($start >= count($this)) { + $arr = array(); + } else { + $arr = array_slice($this->getArrayCopy(), $start, $length); + } + $sc->exchangeArray($arr); + return $sc; + } +} + + +// Hash Maps +class HashMapClass extends ArrayObject { + public $meta = NULL; +} + +function new_hash_map() { + $args = func_get_args(); + if (count($args) % 2 === 1) { + throw new Exception("Odd number of hash map arguments"); + } + $hm = new HashMapClass(); + array_unshift($args, $hm); + return call_user_func_array('assoc_BANG', $args); +} + +function hash_map_Q($obj) { return $obj instanceof HashMapClass; } + +function assoc_BANG($hm) { + $args = func_get_args(); + if (count($args) % 2 !== 1) { + throw new Exception("Odd number of assoc arguments"); + } + for ($i=1; $i<count($args); $i+=2) { + $ktoken = $args[$i]; + $vtoken = $args[$i+1]; + // TODO: support more than string keys + if (gettype($ktoken) !== "string") { + throw new Exception("expected hash-map key string, got: " . gettype($ktoken)); + } + $hm[$ktoken] = $vtoken; + } + return $hm; +} + +function assoc($src_hm) { + $args = func_get_args(); + $hm = clone $src_hm; + $args[0] = $hm; + return call_user_func_array('assoc_BANG', $args); +} + +function dissoc_BANG($hm) { + $args = func_get_args(); + for ($i=1; $i<count($args); $i++) { + $ktoken = $args[$i]; + unset($hm[$ktoken]); + } + return $hm; +} + +function dissoc($src_hm) { + $args = func_get_args(); + $hm = clone $src_hm; + $args[0] = $hm; + return call_user_func_array('dissoc_BANG', $args); +} + +function get($hm, $k) { + if ($hm && $hm->offsetExists($k)) { + return $hm[$k]; + } else { + return NULL; + } +} + +function contains_Q($hm, $k) { return array_key_exists($k, $hm); } + +function keys($hm) { + return call_user_func_array('new_list', array_keys($hm->getArrayCopy())); +} +function vals($hm) { + return call_user_func_array('new_list', array_values($hm->getArrayCopy())); +} + + +// errors/exceptions +class Error extends Exception { + public $obj = null; + public function __construct($obj) { + parent::__construct("Mal Error", 0, null); + $this->obj = $obj; + } +} + +function mal_throw($obj) { throw new Error($obj); } + + +// lists +class ListClass extends SeqClass { + public $meta = NULL; +} + +function new_list() { + $v = new ListClass(); + $v->exchangeArray(func_get_args()); + return $v; +} + +function list_Q($obj) { return $obj instanceof ListClass; } + +// vectors +class VectorClass extends SeqClass { + public $meta = NULL; +} + +function new_vector() { + $v = new VectorClass(); + $v->exchangeArray(func_get_args()); + return $v; +} + +function vector_Q($obj) { return $obj instanceof VectorClass; } + + +// Atoms + +class Atom { + public $value = NULL; + public $meta = NULL; + public function __construct($value) { + $this->value = $value; + } +} +function new_atom($val) { return new Atom($val); } +function atom_Q($atm) { return $atm instanceof Atom; } +function deref($atm) { return $atm->value; } +function reset_BANG($atm, $val) { return $atm->value = $val; } +function swap_BANG($atm, $f) { + $args = array_slice(func_get_args(),2); + array_unshift($args, $atm->value); + $atm->value = call_user_func_array($f, $args); + return $atm->value; +} + + +// Sequence operations +function sequential_Q($seq) { return list_Q($seq) or vector_Q($seq); } + +function scount($seq) { return ($seq === NULL ? 0 : $seq->count()); } + +function empty_Q($seq) { return $seq->count() === 0; } + +function cons($a, $b) { + $tmp = $b->getArrayCopy(); + array_unshift($tmp, $a); + $l = new ListClass(); + $l->exchangeArray($tmp); + return $l; +} + +function concat() { + $args = func_get_args(); + $tmp = array(); + foreach ($args as $arg) { + $tmp = array_merge($tmp, $arg->getArrayCopy()); + } + $l = new ListClass(); + $l->exchangeArray($tmp); + return $l; +} + +function conj($src) { + $args = array_slice(func_get_args(), 1); + $tmp = $src->getArrayCopy(); + foreach ($args as $arg) { + $tmp[] = $arg; + } + if (list_Q($src)) { + $s = new ListClass(); + } else { + $s = new VectorClass(); + } + $s->exchangeArray($tmp); + return $s; +} + +function first($seq) { + if (count($seq) === 0) { + return NULL; + } else { + return $seq[0]; + } +} + +function rest($seq) { + $l = new ListClass(); + $l->exchangeArray(array_slice($seq->getArrayCopy(), 1)); + return $l; +} + +function nth($seq, $idx) { + return $seq[$idx]; +} + +function apply($f, $args) { + return $f->apply($args->getArrayCopy()); +} + +function map($f, $seq) { + $l = new ListClass(); + $l->exchangeArray(array_map($f, $seq->getArrayCopy())); + return $l; +} + + +// Environment +class Env { + public $data = array(); + public $outer = NULL; + public function __construct($outer, $binds=NULL, $exprs=NULL) { + $this->outer = $outer; + if ($binds) { + if (sequential_Q($exprs)) { + $exprs = $exprs->getArrayCopy(); + } + for ($i=0; $i<count($binds); $i++) { + if ($binds[$i]->value === "&") { + if ($exprs !== NULL && $i < count($exprs)) { + $lst = call_user_func_array('new_list', array_slice($exprs, $i)); + } else { + $lst = new_list(); + } + $this->data[$binds[$i+1]->value] = $lst; + break; + } else { + if ($exprs !== NULL && $i < count($exprs)) { + $this->data[$binds[$i]->value] = $exprs[$i]; + } else { + $this->data[$binds[$i]->value] = NULL; + } + } + } + } + } + public function find($key) { + if (array_key_exists($key, $this->data)) { + return $this; + } elseif ($this->outer) { + return $this->outer->find($key); + } else { + return NULL; + } + } + public function set($key, $value) { + $this->data[$key] = $value; + return $value; + } + public function get($key) { + $env = $this->find($key); + if (!$env) { + throw new Exception("'" . $key . "' not found"); + } else { + return $env->data[$key]; + } + } +} + +// types_ns is namespace of type functions +$types_ns = array( + 'pr-str'=> function () { return call_user_func_array('pr_str', func_get_args()); }, + 'str'=> function () { return call_user_func_array('str', func_get_args()); }, + 'prn'=> function () { return call_user_func_array('prn', func_get_args()); }, + 'println'=>function () { return call_user_func_array('println', func_get_args()); }, + 'with-meta'=> function ($a, $b) { return with_meta($a, $b); }, + 'meta'=> function ($a) { return meta($a); }, + '='=> function ($a, $b) { return equal_Q($a, $b); }, + 'nil?'=> function ($a) { return nil_Q($a); }, + 'true?'=> function ($a) { return true_Q($a); }, + 'false?'=> function ($a) { return false_Q($a); }, + '+'=> function ($a, $b) { return intval($a + $b,10); }, + '-'=> function ($a, $b) { return intval($a - $b,10); }, + '*'=> function ($a, $b) { return intval($a * $b,10); }, + '/'=> function ($a, $b) { return intval($a / $b,10); }, + '<'=> function ($a, $b) { return $a < $b; }, + '<='=> function ($a, $b) { return $a <= $b; }, + '>'=> function ($a, $b) { return $a > $b; }, + '>='=> function ($a, $b) { return $a >= $b; }, + 'symbol?'=> function ($a) { return symbol_Q($a); }, + 'string?'=> function ($a) { return string_Q($a); }, + 'hash-map' => function () { return call_user_func_array('new_hash_map', func_get_args()); }, + 'map?'=> function ($a) { return hash_map_Q($a); }, + 'assoc' => function () { return call_user_func_array('assoc', func_get_args()); }, + 'dissoc' => function () { return call_user_func_array('dissoc', func_get_args()); }, + 'get' => function ($a, $b) { return get($a, $b); }, + 'contains?' => function ($a, $b) { return contains_Q($a, $b); }, + 'keys' => function ($a) { return keys($a); }, + 'vals' => function ($a) { return vals($a); }, + 'throw'=> function ($a) { return mal_throw($a); }, + 'list'=> function () { return call_user_func_array('new_list', func_get_args()); }, + 'list?'=> function ($a) { return list_Q($a); }, + 'vector'=> function () { return call_user_func_array('new_vector', func_get_args()); }, + 'vector?'=> function ($a) { return vector_Q($a); }, + 'atom'=> function ($a) { return new_atom($a); }, + 'atom?'=> function ($a) { return atom_Q($a); }, + 'deref'=> function ($a) { return deref($a); }, + 'reset!'=> function ($a, $b) { return reset_BANG($a, $b); }, + 'swap!'=> function () { return call_user_func_array('swap_BANG', func_get_args()); }, + 'sequential?'=> function ($a) { return sequential_Q($a); }, + 'count'=> function ($a) { return scount($a); }, + 'empty?'=> function ($a) { return empty_Q($a); }, + 'cons'=> function ($a, $b) { return cons($a, $b); }, + 'concat'=> function () { return call_user_func_array('concat', func_get_args()); }, + 'conj'=> function () { return call_user_func_array('conj', func_get_args()); }, + 'first'=> function ($a) { return first($a); }, + 'rest'=> function ($a) { return rest($a); }, + 'nth'=> function ($a, $b) { return nth($a, $b); }, + 'apply'=> function ($a, $b) { return apply($a, $b); }, + 'map'=> function ($a, $b) { return map($a, $b); } +); + + +?> |