function MAL_EVAL($ast, $env) { #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; if (!_list_Q($ast)) { return eval_ast($ast, $env); } if ($ast->count() === 0) { return $ast; } // 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], $res); case "let*": $a1 = $ast[1]; $let_env = new Env($env); for ($i = 0; $i < count($a1); $i += 2) { $let_env->set($a1[$i], MAL_EVAL($a1[$i + 1], $let_env)); } 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)); } }
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)); }
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 (strpos($obj, chr(0x7f)) === 0) { return ":" . substr($obj, 1); } elseif ($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 MAL_EVAL($ast, $env) { #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; if (!_list_Q($ast)) { return eval_ast($ast, $env); } if ($ast->count() === 0) { return $ast; } // 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], $res); case "let*": $a1 = $ast[1]; $let_env = new Env($env); for ($i = 0; $i < count($a1); $i += 2) { $let_env->set($a1[$i], MAL_EVAL($a1[$i + 1], $let_env)); } 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)); } }
function _sequential_Q($seq) { return _list_Q($seq) or _vector_Q($seq); }
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 eval_ast($ast, $env); } if ($ast->count() === 0) { return $ast; } $a0 = $ast[0]; $a0v = _symbol_Q($a0) ? $a0->value : $a0; switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); return $env->set($ast[1], $res); case "let*": $a1 = $ast[1]; $let_env = new Env($env); for ($i = 0; $i < count($a1); $i += 2) { $let_env->set($a1[$i], MAL_EVAL($a1[$i + 1], $let_env)); } $ast = $ast[2]; $env = $let_env; break; // Continue loop (TCO) // Continue loop (TCO) case "quote": return $ast[1]; case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) // Continue loop (TCO) case "defmacro!": $func = MAL_EVAL($ast[2], $env); $func->ismacro = true; return $env->set($ast[1], $func); case "macroexpand": return macroexpand($ast[1], $env); case "do": eval_ast($ast->slice(1, -1), $env); $ast = $ast[count($ast) - 1]; break; // Continue loop (TCO) // Continue loop (TCO) case "if": $cond = MAL_EVAL($ast[1], $env); if ($cond === NULL || $cond === false) { if (count($ast) === 4) { $ast = $ast[3]; } else { $ast = NULL; } } else { $ast = $ast[2]; } break; // Continue loop (TCO) // Continue loop (TCO) case "fn*": return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); default: $el = eval_ast($ast, $env); $f = $el[0]; $args = array_slice($el->getArrayCopy(), 1); if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); // Continue loop (TCO) } else { return $f->apply($args); } } } }
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 eval_ast($ast, $env); } if ($ast->count() === 0) { return $ast; } $a0 = $ast[0]; $a0v = _symbol_Q($a0) ? $a0->value : $a0; switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); return $env->set($ast[1], $res); case "let*": $a1 = $ast[1]; $let_env = new Env($env); for ($i = 0; $i < count($a1); $i += 2) { $let_env->set($a1[$i], MAL_EVAL($a1[$i + 1], $let_env)); } $ast = $ast[2]; $env = $let_env; break; // Continue loop (TCO) // Continue loop (TCO) case "quote": return $ast[1]; case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) // Continue loop (TCO) case "defmacro!": $func = MAL_EVAL($ast[2], $env); $func->ismacro = true; return $env->set($ast[1], $func); case "macroexpand": return macroexpand($ast[1], $env); case "php*": $res = eval($ast[1]); switch (gettype($res)) { case "array": if ($res !== array_values($res)) { $new_res = _hash_map(); $new_res->exchangeArray($res); return $new_res; } else { return call_user_func_array('_list', $res); } default: return $res; } case "try*": $a1 = $ast[1]; $a2 = $ast[2]; if ($a2[0]->value === "catch*") { try { return MAL_EVAL($a1, $env); } catch (Error $e) { $catch_env = new Env($env, array($a2[1]), array($e->obj)); return MAL_EVAL($a2[2], $catch_env); } catch (Exception $e) { $catch_env = new Env($env, array($a2[1]), array($e->getMessage())); return MAL_EVAL($a2[2], $catch_env); } } else { return MAL_EVAL($a1, $env); } case "do": eval_ast($ast->slice(1, -1), $env); $ast = $ast[count($ast) - 1]; break; // Continue loop (TCO) // Continue loop (TCO) case "if": $cond = MAL_EVAL($ast[1], $env); if ($cond === NULL || $cond === false) { if (count($ast) === 4) { $ast = $ast[3]; } else { $ast = NULL; } } else { $ast = $ast[2]; } break; // Continue loop (TCO) // Continue loop (TCO) case "fn*": return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); default: $el = eval_ast($ast, $env); $f = $el[0]; $args = array_slice($el->getArrayCopy(), 1); if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); // Continue loop (TCO) } else { return $f->apply($args); } } } }
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 seq($src) { if (_list_Q($src)) { if (count($src) == 0) { return NULL; } return $src; } elseif (_vector_Q($src)) { if (count($src) == 0) { return NULL; } $tmp = $src->getArrayCopy(); $s = new ListClass(); $s->exchangeArray($tmp); return $s; } elseif (_string_Q($src)) { if (strlen($src) == 0) { return NULL; } $tmp = str_split($src); $s = new ListClass(); $s->exchangeArray($tmp); return $s; } elseif (_nil_Q($src)) { return NULL; } else { throw new Exception("seq: called on non-sequence"); } return $s; }