diff options
Diffstat (limited to 'php')
| -rw-r--r-- | php/Makefile | 16 | ||||
| -rw-r--r-- | php/core.php | 221 | ||||
| -rw-r--r-- | php/env.php | 56 | ||||
| -rw-r--r-- | php/printer.php | 53 | ||||
| -rw-r--r-- | php/reader.php | 26 | ||||
| -rw-r--r-- | php/step1_read_print.php | 1 | ||||
| -rw-r--r-- | php/step2_eval.php | 17 | ||||
| -rw-r--r-- | php/step3_env.php | 21 | ||||
| -rw-r--r-- | php/step4_if_fn_do.php | 25 | ||||
| -rw-r--r-- | php/step5_tco.php | 117 | ||||
| -rw-r--r-- | php/step6_file.php | 117 | ||||
| -rw-r--r-- | php/step7_quote.php | 141 | ||||
| -rw-r--r-- | php/step8_macros.php | 161 | ||||
| -rw-r--r-- | php/step9_interop.php | 165 | ||||
| -rw-r--r-- | php/stepA_more.php | 197 | ||||
| -rw-r--r-- | php/types.php | 420 |
16 files changed, 919 insertions, 835 deletions
diff --git a/php/Makefile b/php/Makefile new file mode 100644 index 0000000..e7ea51d --- /dev/null +++ b/php/Makefile @@ -0,0 +1,16 @@ + +TESTS = + +SOURCES = readline.php types.php reader.php printer.php \ + env.php core.php stepA_more.php + +.PHONY: stats tests $(TESTS) + +stats: $(SOURCES) + @wc $^ + +tests: $(TESTS) + +$(TESTS): + @echo "Running $@"; \ + php $@ || exit 1; \ diff --git a/php/core.php b/php/core.php new file mode 100644 index 0000000..16d34f8 --- /dev/null +++ b/php/core.php @@ -0,0 +1,221 @@ +<?php + +require_once 'types.php'; +require_once 'printer.php'; + +// Error/Exception functions +function mal_throw($obj) { throw new Error($obj); } + + +// String functions +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; +} + + +// Hash Map functions +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($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('_list', array_keys($hm->getArrayCopy())); +} +function vals($hm) { + return call_user_func_array('_list', array_values($hm->getArrayCopy())); +} + + +// Sequence functions +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 nth($seq, $idx) { + return $seq[$idx]; +} + +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 empty_Q($seq) { return $seq->count() === 0; } + +function scount($seq) { return ($seq === NULL ? 0 : $seq->count()); } + +function conj($src) { + $args = array_slice(func_get_args(), 1); + $tmp = $src->getArrayCopy(); + if (_list_Q($src)) { + foreach ($args as $arg) { array_unshift($tmp, $arg); } + $s = new ListClass(); + } else { + foreach ($args as $arg) { $tmp[] = $arg; } + $s = new VectorClass(); + } + $s->exchangeArray($tmp); + return $s; +} + +function apply($f) { + $args = array_slice(func_get_args(), 1); + $last_arg = array_pop($args)->getArrayCopy(); + return $f->apply(array_merge($args, $last_arg)); +} + +function map($f, $seq) { + $l = new ListClass(); + $l->exchangeArray(array_map($f, $seq->getArrayCopy())); + return $l; +} + + +// Metadata functions +function with_meta($obj, $m) { + $new_obj = clone $obj; + $new_obj->meta = $m; + return $new_obj; +} + +function meta($obj) { + return $obj->meta; +} + + +// Atom functions +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; +} + + +// core_ns is namespace of type functions +$core_ns = array( + '='=> function ($a, $b) { return _equal_Q($a, $b); }, + 'throw'=> function ($a) { return mal_throw($a); }, + 'nil?'=> function ($a) { return _nil_Q($a); }, + 'true?'=> function ($a) { return _true_Q($a); }, + 'false?'=> function ($a) { return _false_Q($a); }, + 'symbol'=> function () { return call_user_func_array('_symbol', func_get_args()); }, + 'symbol?'=> function ($a) { return _symbol_Q($a); }, + 'string?'=> function ($a) { return _string_Q($a); }, + '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()); }, + '<'=> function ($a, $b) { return $a < $b; }, + '<='=> function ($a, $b) { return $a <= $b; }, + '>'=> function ($a, $b) { return $a > $b; }, + '>='=> function ($a, $b) { return $a >= $b; }, + '+'=> 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); }, + + 'list'=> function () { return call_user_func_array('_list', func_get_args()); }, + 'list?'=> function ($a) { return _list_Q($a); }, + 'vector'=> function () { return call_user_func_array('_vector', func_get_args()); }, + 'vector?'=> function ($a) { return _vector_Q($a); }, + 'hash-map' => function () { return call_user_func_array('_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); }, + + 'sequential?'=> function ($a) { return _sequential_Q($a); }, + 'cons'=> function ($a, $b) { return cons($a, $b); }, + 'concat'=> function () { return call_user_func_array('concat', func_get_args()); }, + 'nth'=> function ($a, $b) { return nth($a, $b); }, + 'first'=> function ($a) { return first($a); }, + 'rest'=> function ($a) { return rest($a); }, + 'empty?'=> function ($a) { return empty_Q($a); }, + 'count'=> function ($a) { return scount($a); }, + 'conj'=> function () { return call_user_func_array('conj', func_get_args()); }, + 'apply'=> function () { return call_user_func_array('apply', func_get_args()); }, + 'map'=> function ($a, $b) { return map($a, $b); }, + + 'with-meta'=> function ($a, $b) { return with_meta($a, $b); }, + 'meta'=> function ($a) { return meta($a); }, + 'atom'=> function ($a) { return _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()); }, +); + + +?> diff --git a/php/env.php b/php/env.php new file mode 100644 index 0000000..61bedaf --- /dev/null +++ b/php/env.php @@ -0,0 +1,56 @@ +<?php + +require_once 'types.php'; + +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('_list', array_slice($exprs, $i)); + } else { + $lst = _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]; + } + } +} + +?> diff --git a/php/printer.php b/php/printer.php new file mode 100644 index 0000000..3839931 --- /dev/null +++ b/php/printer.php @@ -0,0 +1,53 @@ +<?php + +require_once 'types.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)); + } +} + +?> diff --git a/php/reader.php b/php/reader.php index 0524b31..83e0cff 100644 --- a/php/reader.php +++ b/php/reader.php @@ -10,9 +10,11 @@ class Reader { $this->position = 0; } public function next() { + if ($this->position >= count($this->tokens)) { return null; } return $this->tokens[$this->position++]; } public function peek() { + if ($this->position >= count($this->tokens)) { return null; } return $this->tokens[$this->position]; } } @@ -45,18 +47,18 @@ function read_atom($reader) { } elseif ($token === "false") { return false; } else { - return new_symbol($token); + return _symbol($token); } } -function read_list($reader, $constr='new_list', $start='(', $end=')') { +function read_list($reader, $constr='_list', $start='(', $end=')') { $ast = $constr(); $token = $reader->next(); if ($token !== $start) { throw new Exception("expected '" . $start . "'"); } while (($token = $reader->peek()) !== $end) { - if ($token === "") { + if ($token === "" || $token === null) { throw new Exception("expected '" . $end . "', got EOF"); } $ast[] = read_form($reader); @@ -66,39 +68,39 @@ function read_list($reader, $constr='new_list', $start='(', $end=')') { } function read_hash_map($reader) { - $lst = read_list($reader, 'new_list', '{', '}'); - return call_user_func_array('new_hash_map', $lst->getArrayCopy()); + $lst = read_list($reader, '_list', '{', '}'); + return call_user_func_array('_hash_map', $lst->getArrayCopy()); } function read_form($reader) { $token = $reader->peek(); switch ($token) { case '\'': $reader->next(); - return new_list(new_symbol('quote'), + return _list(_symbol('quote'), read_form($reader)); case '`': $reader->next(); - return new_list(new_symbol('quasiquote'), + return _list(_symbol('quasiquote'), read_form($reader)); case '~': $reader->next(); - return new_list(new_symbol('unquote'), + return _list(_symbol('unquote'), read_form($reader)); case '~@': $reader->next(); - return new_list(new_symbol('splice-unquote'), + return _list(_symbol('splice-unquote'), read_form($reader)); case '^': $reader->next(); $meta = read_form($reader); - return new_list(new_symbol('with-meta'), + return _list(_symbol('with-meta'), read_form($reader), $meta); case '@': $reader->next(); - return new_list(new_symbol('deref'), + return _list(_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 '[': return read_list($reader, '_vector', '[', ']'); case '}': throw new Exception("unexpected '}'"); case '{': return read_hash_map($reader); diff --git a/php/step1_read_print.php b/php/step1_read_print.php index 01334e0..808ea09 100644 --- a/php/step1_read_print.php +++ b/php/step1_read_print.php @@ -3,6 +3,7 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; // read function READ($str) { diff --git a/php/step2_eval.php b/php/step2_eval.php index c9c3562..0ef184a 100644 --- a/php/step2_eval.php +++ b/php/step2_eval.php @@ -3,6 +3,7 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; // read function READ($str) { @@ -11,18 +12,18 @@ function READ($str) { // eval function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env[$ast->value]; - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -33,7 +34,7 @@ function eval_ast($ast, $env) { } function MAL_EVAL($ast, $env) { - if (!list_Q($ast)) { + if (!_list_Q($ast)) { return eval_ast($ast, $env); } diff --git a/php/step3_env.php b/php/step3_env.php index 15d7c5c..83ced32 100644 --- a/php/step3_env.php +++ b/php/step3_env.php @@ -3,6 +3,8 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; // read function READ($str) { @@ -11,18 +13,18 @@ function READ($str) { // eval function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -33,13 +35,14 @@ function eval_ast($ast, $env) { } function MAL_EVAL($ast, $env) { - if (!list_Q($ast)) { + #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); + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); diff --git a/php/step4_if_fn_do.php b/php/step4_if_fn_do.php index 3b9593d..25ca7c5 100644 --- a/php/step4_if_fn_do.php +++ b/php/step4_if_fn_do.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,18 +14,18 @@ function READ($str) { // eval function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -34,13 +37,13 @@ function eval_ast($ast, $env) { function MAL_EVAL($ast, $env) { #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!list_Q($ast)) { + if (!_list_Q($ast)) { return eval_ast($ast, $env); } // apply list $a0 = $ast[0]; - $a0v = (symbol_Q($a0) ? $a0->value : $a0); + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); @@ -88,8 +91,8 @@ function rep($str) { 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); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } // Defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); diff --git a/php/step5_tco.php b/php/step5_tco.php index 54d7699..0bf55ee 100644 --- a/php/step5_tco.php +++ b/php/step5_tco.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,18 +14,18 @@ function READ($str) { // eval function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -34,54 +37,56 @@ function eval_ast($ast, $env) { 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); - } + #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 _function('MAL_EVAL', 'native', + _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); + } + } + } } @@ -98,10 +103,10 @@ function rep($str) { } function _ref($k, $v) { global $repl_env; - $repl_env->set($k, new_function($v)); + $repl_env->set($k, _function($v)); } -// Import types functions -foreach ($types_ns as $k=>$v) { _ref($k, $v); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } // Defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); diff --git a/php/step6_file.php b/php/step6_file.php index 37ea3c6..965ff88 100644 --- a/php/step6_file.php +++ b/php/step6_file.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,18 +14,18 @@ function READ($str) { // eval function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -34,54 +37,56 @@ function eval_ast($ast, $env) { 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); - } + #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 _function('MAL_EVAL', 'native', + _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); + } + } + } } @@ -98,10 +103,10 @@ function rep($str) { } function _ref($k, $v) { global $repl_env; - $repl_env->set($k, new_function($v)); + $repl_env->set($k, _function($v)); } -// Import types functions -foreach ($types_ns as $k=>$v) { _ref($k, $v); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } _ref('read-string', 'read_str'); _ref('eval', function($ast) { diff --git a/php/step7_quote.php b/php/step7_quote.php index b035be0..450f2b5 100644 --- a/php/step7_quote.php +++ b/php/step7_quote.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,37 +14,37 @@ function READ($str) { // eval function is_pair($x) { - return sequential_Q($x) and count($x) > 0; + 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 _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]) && + } 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))); + return _list(_symbol("concat"), $ast[0][1], + quasiquote($ast->slice(1))); } else { - return new_list(new_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); + return _list(_symbol("cons"), quasiquote($ast[0]), + quasiquote($ast->slice(1))); } } function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -53,58 +56,60 @@ function eval_ast($ast, $env) { 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); - } + #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 _function('MAL_EVAL', 'native', + _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); + } + } + } } @@ -121,10 +126,10 @@ function rep($str) { } function _ref($k, $v) { global $repl_env; - $repl_env->set($k, new_function($v)); + $repl_env->set($k, _function($v)); } -// Import types functions -foreach ($types_ns as $k=>$v) { _ref($k, $v); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } _ref('read-string', 'read_str'); _ref('eval', function($ast) { diff --git a/php/step8_macros.php b/php/step8_macros.php index 28014cd..3dea855 100644 --- a/php/step8_macros.php +++ b/php/step8_macros.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,27 +14,27 @@ function READ($str) { // eval function is_pair($x) { - return sequential_Q($x) and count($x) > 0; + 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 _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]) && + } 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))); + return _list(_symbol("concat"), $ast[0][1], + quasiquote($ast->slice(1))); } else { - return new_list(new_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); + 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]) && + _symbol_Q($ast[0]) && $env->find($ast[0]->value) && $env->get($ast[0]->value)->ismacro; } @@ -46,18 +49,18 @@ function macroexpand($ast, $env) { } function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -69,67 +72,69 @@ function eval_ast($ast, $env) { 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); - } + #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 _function('MAL_EVAL', 'native', + _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); + } + } + } } @@ -146,10 +151,10 @@ function rep($str) { } function _ref($k, $v) { global $repl_env; - $repl_env->set($k, new_function($v)); + $repl_env->set($k, _function($v)); } -// Import types functions -foreach ($types_ns as $k=>$v) { _ref($k, $v); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } _ref('read-string', 'read_str'); _ref('eval', function($ast) { diff --git a/php/step9_interop.php b/php/step9_interop.php index 26e89f0..a699109 100644 --- a/php/step9_interop.php +++ b/php/step9_interop.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,27 +14,27 @@ function READ($str) { // eval function is_pair($x) { - return sequential_Q($x) and count($x) > 0; + 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 _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]) && + } 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))); + return _list(_symbol("concat"), $ast[0][1], + quasiquote($ast->slice(1))); } else { - return new_list(new_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); + 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]) && + _symbol_Q($ast[0]) && $env->find($ast[0]->value) && $env->get($ast[0]->value)->ismacro; } @@ -46,18 +49,18 @@ function macroexpand($ast, $env) { } function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -69,69 +72,71 @@ function eval_ast($ast, $env) { 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); - } + #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 _function('MAL_EVAL', 'native', + _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); + } + } + } } @@ -148,10 +153,10 @@ function rep($str) { } function _ref($k, $v) { global $repl_env; - $repl_env->set($k, new_function($v)); + $repl_env->set($k, _function($v)); } -// Import types functions -foreach ($types_ns as $k=>$v) { _ref($k, $v); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } _ref('read-string', 'read_str'); _ref('eval', function($ast) { diff --git a/php/stepA_more.php b/php/stepA_more.php index dd004cf..4b8a270 100644 --- a/php/stepA_more.php +++ b/php/stepA_more.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,27 +14,27 @@ function READ($str) { // eval function is_pair($x) { - return sequential_Q($x) and count($x) > 0; + 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 _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]) && + } 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))); + return _list(_symbol("concat"), $ast[0][1], + quasiquote($ast->slice(1))); } else { - return new_list(new_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); + 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]) && + _symbol_Q($ast[0]) && $env->find($ast[0]->value) && $env->get($ast[0]->value)->ismacro; } @@ -46,18 +49,18 @@ function macroexpand($ast, $env) { } function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -69,87 +72,89 @@ function eval_ast($ast, $env) { 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 { + #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); } - 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); - } + } 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 _function('MAL_EVAL', 'native', + _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); + } + } + } } @@ -166,10 +171,10 @@ function rep($str) { } function _ref($k, $v) { global $repl_env; - $repl_env->set($k, new_function($v)); + $repl_env->set($k, _function($v)); } -// Import types functions -foreach ($types_ns as $k=>$v) { _ref($k, $v); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } _ref('readline', 'mal_readline'); _ref('read-string', 'read_str'); diff --git a/php/types.php b/php/types.php index 4486a18..6094558 100644 --- a/php/types.php +++ b/php/types.php @@ -1,101 +1,30 @@ <?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; +// Errors/Exceptions +class Error extends Exception { + public $obj = null; + public function __construct($obj) { + parent::__construct("Mal Error", 0, null); + $this->obj = $obj; + } } -function with_meta($obj, $m) { - $new_obj = clone $obj; - $new_obj->meta = $m; - return $new_obj; -} -function meta($obj) { - return $obj->meta; -} +// General functions -function equal_Q($a, $b) { +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)))) { + if (!($ota === $otb or (_sequential_Q($a) and _sequential_Q($b)))) { return false; - } elseif (symbol_Q($a)) { + } elseif (_symbol_Q($a)) { #print "ota: $ota, otb: $otb\n"; return $a->value === $b->value; - } elseif (list_Q($a) or vector_Q($a)) { + } 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; } + if (!_equal_Q($a[$i], $b[$i])) { return false; } } return true; } else { @@ -103,14 +32,17 @@ function equal_Q($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); } +function _sequential_Q($seq) { return _list_Q($seq) or _vector_Q($seq); } -// symbols +// Scalars +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; @@ -118,10 +50,8 @@ class SymbolClass { $this->value = $value; } } - -function new_symbol($name) { return new SymbolClass($name); } - -function symbol_Q($obj) { return ($obj instanceof SymbolClass); } +function _symbol($name) { return new SymbolClass($name); } +function _symbol_Q($obj) { return ($obj instanceof SymbolClass); } // Functions @@ -152,11 +82,11 @@ class FunctionClass { } } -function new_function($func, $type='platform', $meta=NULL, $ismacro=False) { +function _function($func, $type='platform', $meta=NULL, $ismacro=False) { return new FunctionClass($func, $type, $meta, $ismacro); } +function _function_Q($obj) { return $obj instanceof FunctionClass; } -function function_Q($obj) { return $obj instanceof FunctionClass; } // Parent class of list, vector, hash-map // http://www.php.net/manual/en/class.arrayobject.php @@ -174,24 +104,49 @@ class SeqClass extends ArrayObject { } +// Lists +class ListClass extends SeqClass { + public $meta = NULL; +} + +function _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 _vector() { + $v = new VectorClass(); + $v->exchangeArray(func_get_args()); + return $v; +} +function _vector_Q($obj) { return $obj instanceof VectorClass; } + + // Hash Maps class HashMapClass extends ArrayObject { public $meta = NULL; } -function new_hash_map() { +function _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); + return call_user_func_array('_assoc_BANG', $args); } +function _hash_map_Q($obj) { return $obj instanceof HashMapClass; } -function hash_map_Q($obj) { return $obj instanceof HashMapClass; } - -function assoc_BANG($hm) { +function _assoc_BANG($hm) { $args = func_get_args(); if (count($args) % 2 !== 1) { throw new Exception("Odd number of assoc arguments"); @@ -208,14 +163,7 @@ function assoc_BANG($hm) { 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) { +function _dissoc_BANG($hm) { $args = func_get_args(); for ($i=1; $i<count($args); $i++) { $ktoken = $args[$i]; @@ -224,72 +172,8 @@ function dissoc_BANG($hm) { 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; @@ -297,193 +181,7 @@ class Atom { $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(); - if (list_Q($src)) { - foreach ($args as $arg) { array_unshift($tmp, $arg); } - $s = new ListClass(); - } else { - foreach ($args as $arg) { $tmp[] = $arg; } - $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 = array_slice(func_get_args(), 1); - $last_arg = array_pop($args)->getArrayCopy(); - return $f->apply(array_merge($args, $last_arg)); -} - -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 () { return call_user_func_array('apply', func_get_args()); }, - 'map'=> function ($a, $b) { return map($a, $b); } -); - +function _atom($val) { return new Atom($val); } +function _atom_Q($atm) { return $atm instanceof Atom; } ?> |