mirror of
https://github.com/peklaiho/madlisp.git
synced 2024-10-18 13:02:04 +00:00
start tail call optimization
This commit is contained in:
Pekka Laiho
parent
291a7d6521
commit
cb1a03e9bd
314
src/Evaller.php
314
src/Evaller.php
@ -3,180 +3,202 @@ namespace MadLisp;
|
|||||||
|
|
||||||
class Evaller
|
class Evaller
|
||||||
{
|
{
|
||||||
|
private $p = null;
|
||||||
|
|
||||||
public function eval($ast, Env $env)
|
public function eval($ast, Env $env)
|
||||||
{
|
{
|
||||||
// Not list or empty list
|
// Debug
|
||||||
if (!($ast instanceof MList)) {
|
if ($this->p == null) {
|
||||||
return $this->evalAst($ast, $env);
|
$this->p = new Printer();
|
||||||
} elseif ($ast->count() == 0) {
|
|
||||||
return $ast;
|
|
||||||
}
|
}
|
||||||
|
print("eval: ");
|
||||||
|
$this->p->print($ast);
|
||||||
|
print("\n");
|
||||||
|
|
||||||
// Handle special forms
|
while (true) {
|
||||||
if ($ast->get(0) instanceof Symbol) {
|
|
||||||
if ($ast->get(0)->getName() == 'and') {
|
|
||||||
if ($ast->count() == 1) {
|
|
||||||
return true;
|
|
||||||
}
|
|
||||||
|
|
||||||
for ($i = 1; $i < $ast->count(); $i++) {
|
// Not list or empty list
|
||||||
$value = $this->eval($ast->get($i), $env);
|
if (!($ast instanceof MList)) {
|
||||||
if ($value == false) {
|
return $this->evalAst($ast, $env);
|
||||||
return $value;
|
} elseif ($ast->count() == 0) {
|
||||||
|
return $ast;
|
||||||
|
}
|
||||||
|
|
||||||
|
// Handle special forms
|
||||||
|
if ($ast->get(0) instanceof Symbol) {
|
||||||
|
if ($ast->get(0)->getName() == 'and') {
|
||||||
|
if ($ast->count() == 1) {
|
||||||
|
return true;
|
||||||
}
|
}
|
||||||
}
|
|
||||||
|
|
||||||
return $value;
|
for ($i = 1; $i < $ast->count() - 1; $i++) {
|
||||||
} elseif ($ast->get(0)->getName() == 'case') {
|
$value = $this->eval($ast->get($i), $env);
|
||||||
if ($ast->count() < 2) {
|
if ($value == false) {
|
||||||
throw new MadLispException("case requires at least 1 argument");
|
return $value;
|
||||||
}
|
}
|
||||||
|
|
||||||
for ($i = 1; $i < $ast->count() - 1; $i += 2) {
|
|
||||||
$test = $this->eval($ast->get($i), $env);
|
|
||||||
if ($test == true) {
|
|
||||||
return $this->eval($ast->get($i + 1), $env);
|
|
||||||
}
|
}
|
||||||
}
|
|
||||||
|
|
||||||
// Last value, no test
|
$ast = $ast->get($ast->count() - 1);
|
||||||
if ($ast->count() % 2 == 0) {
|
continue; // tco
|
||||||
return $this->eval($ast->get($ast->count() - 1), $env);
|
} elseif ($ast->get(0)->getName() == 'case') {
|
||||||
} else {
|
if ($ast->count() < 2) {
|
||||||
return null;
|
throw new MadLispException("case requires at least 1 argument");
|
||||||
}
|
}
|
||||||
} elseif ($ast->get(0)->getName() == 'def') {
|
|
||||||
if ($ast->count() != 3) {
|
|
||||||
throw new MadLispException("def requires exactly 2 arguments");
|
|
||||||
}
|
|
||||||
|
|
||||||
if (!($ast->get(1) instanceof Symbol)) {
|
for ($i = 1; $i < $ast->count() - 1; $i += 2) {
|
||||||
throw new MadLispException("first argument to def is not symbol");
|
$test = $this->eval($ast->get($i), $env);
|
||||||
}
|
if ($test == true) {
|
||||||
|
return $this->eval($ast->get($i + 1), $env);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
$value = $this->eval($ast->get(2), $env);
|
// Last value, no test
|
||||||
return $env->set($ast->get(1)->getName(), $value);
|
if ($ast->count() % 2 == 0) {
|
||||||
} elseif ($ast->get(0)->getName() == 'do') {
|
return $this->eval($ast->get($ast->count() - 1), $env);
|
||||||
if ($ast->count() < 2) {
|
} else {
|
||||||
throw new MadLispException("do requires at least 1 argument");
|
return null;
|
||||||
}
|
}
|
||||||
|
} elseif ($ast->get(0)->getName() == 'def') {
|
||||||
|
if ($ast->count() != 3) {
|
||||||
|
throw new MadLispException("def requires exactly 2 arguments");
|
||||||
|
}
|
||||||
|
|
||||||
for ($i = 1; $i < $ast->count(); $i++) {
|
|
||||||
$value = $this->eval($ast->get($i), $env);
|
|
||||||
}
|
|
||||||
|
|
||||||
return $value;
|
|
||||||
} elseif ($ast->get(0)->getName() == 'env') {
|
|
||||||
if ($ast->count() >= 2) {
|
|
||||||
if (!($ast->get(1) instanceof Symbol)) {
|
if (!($ast->get(1) instanceof Symbol)) {
|
||||||
throw new MadLispException("first argument to env is not symbol");
|
throw new MadLispException("first argument to def is not symbol");
|
||||||
}
|
}
|
||||||
|
|
||||||
return $env->get($ast->get(1)->getName());
|
$value = $this->eval($ast->get(2), $env);
|
||||||
} else {
|
return $env->set($ast->get(1)->getName(), $value);
|
||||||
return $env;
|
} elseif ($ast->get(0)->getName() == 'do') {
|
||||||
}
|
if ($ast->count() < 2) {
|
||||||
} elseif ($ast->get(0)->getName() == 'fn') {
|
throw new MadLispException("do requires at least 1 argument");
|
||||||
if ($ast->count() != 3) {
|
}
|
||||||
throw new MadLispException("fn requires exactly 2 arguments");
|
|
||||||
}
|
for ($i = 1; $i < $ast->count() - 1; $i++) {
|
||||||
|
$this->eval($ast->get($i), $env);
|
||||||
if (!($ast->get(1) instanceof MList)) {
|
}
|
||||||
throw new MadLispException("first argument to fn is not list");
|
|
||||||
}
|
$ast = $ast->get($ast->count() - 1);
|
||||||
|
continue; // tco
|
||||||
$bindings = $ast->get(1)->getData();
|
} elseif ($ast->get(0)->getName() == 'env') {
|
||||||
foreach ($bindings as $bind) {
|
if ($ast->count() >= 2) {
|
||||||
if (!($bind instanceof Symbol)) {
|
if (!($ast->get(1) instanceof Symbol)) {
|
||||||
throw new MadLispException("binding key for fn is not symbol");
|
throw new MadLispException("first argument to env is not symbol");
|
||||||
|
}
|
||||||
|
|
||||||
|
return $env->get($ast->get(1)->getName());
|
||||||
|
} else {
|
||||||
|
return $env;
|
||||||
|
}
|
||||||
|
} elseif ($ast->get(0)->getName() == 'fn') {
|
||||||
|
if ($ast->count() != 3) {
|
||||||
|
throw new MadLispException("fn requires exactly 2 arguments");
|
||||||
|
}
|
||||||
|
|
||||||
|
if (!($ast->get(1) instanceof MList)) {
|
||||||
|
throw new MadLispException("first argument to fn is not list");
|
||||||
|
}
|
||||||
|
|
||||||
|
$bindings = $ast->get(1)->getData();
|
||||||
|
foreach ($bindings as $bind) {
|
||||||
|
if (!($bind instanceof Symbol)) {
|
||||||
|
throw new MadLispException("binding key for fn is not symbol");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return new UserFunc(function (...$args) use ($bindings, $ast, $env) {
|
||||||
|
$newEnv = new Env($env);
|
||||||
|
|
||||||
|
for ($i = 0; $i < count($bindings); $i++) {
|
||||||
|
$newEnv->set($bindings[$i]->getName(), $args[$i] ?? null);
|
||||||
|
}
|
||||||
|
|
||||||
|
return $this->eval($ast->get(2), $newEnv);
|
||||||
|
});
|
||||||
|
} elseif ($ast->get(0)->getName() == 'if') {
|
||||||
|
if ($ast->count() < 3 || $ast->count() > 4) {
|
||||||
|
throw new MadLispException("if requires 2 or 3 arguments");
|
||||||
|
}
|
||||||
|
|
||||||
|
$result = $this->eval($ast->get(1), $env);
|
||||||
|
|
||||||
|
if ($result == true) {
|
||||||
|
echo "if tco\n";
|
||||||
|
$ast = $ast->get(2);
|
||||||
|
continue;
|
||||||
|
} elseif ($ast->count() == 4) {
|
||||||
|
echo "if tco\n";
|
||||||
|
$ast = $ast->get(3);
|
||||||
|
continue;
|
||||||
|
} else {
|
||||||
|
return null;
|
||||||
|
}
|
||||||
|
} elseif ($ast->get(0)->getName() == 'let') {
|
||||||
|
if ($ast->count() != 3) {
|
||||||
|
throw new MadLispException("let requires exactly 2 arguments");
|
||||||
|
}
|
||||||
|
|
||||||
|
if (!($ast->get(1) instanceof MList)) {
|
||||||
|
throw new MadLispException("first argument to let is not list");
|
||||||
|
}
|
||||||
|
|
||||||
|
$bindings = $ast->get(1)->getData();
|
||||||
|
|
||||||
|
if (count($bindings) % 2 == 1) {
|
||||||
|
throw new MadLispException("uneven number of bindings for let");
|
||||||
}
|
}
|
||||||
}
|
|
||||||
|
|
||||||
return new UserFunc(function (...$args) use ($bindings, $ast, $env) {
|
|
||||||
$newEnv = new Env($env);
|
$newEnv = new Env($env);
|
||||||
|
|
||||||
for ($i = 0; $i < count($bindings); $i++) {
|
for ($i = 0; $i < count($bindings) - 1; $i += 2) {
|
||||||
$newEnv->set($bindings[$i]->getName(), $args[$i] ?? null);
|
$key = $bindings[$i];
|
||||||
|
|
||||||
|
if (!($key instanceof Symbol)) {
|
||||||
|
throw new MadLispException("binding key for let is not symbol");
|
||||||
|
}
|
||||||
|
|
||||||
|
$val = $this->eval($bindings[$i + 1], $newEnv);
|
||||||
|
$newEnv->set($key->getName(), $val);
|
||||||
}
|
}
|
||||||
|
|
||||||
return $this->eval($ast->get(2), $newEnv);
|
$ast = $ast->get(2);
|
||||||
});
|
$env = $newEnv;
|
||||||
} elseif ($ast->get(0)->getName() == 'if') {
|
continue; // tco
|
||||||
if ($ast->count() < 3 || $ast->count() > 4) {
|
} elseif ($ast->get(0)->getName() == 'or') {
|
||||||
throw new MadLispException("if requires 2 or 3 arguments");
|
if ($ast->count() == 1) {
|
||||||
}
|
return false;
|
||||||
|
|
||||||
$result = $this->eval($ast->get(1), $env);
|
|
||||||
|
|
||||||
if ($result == true) {
|
|
||||||
return $this->eval($ast->get(2), $env);
|
|
||||||
} elseif ($ast->count() == 4) {
|
|
||||||
return $this->eval($ast->get(3), $env);
|
|
||||||
} else {
|
|
||||||
return null;
|
|
||||||
}
|
|
||||||
} elseif ($ast->get(0)->getName() == 'let') {
|
|
||||||
if ($ast->count() != 3) {
|
|
||||||
throw new MadLispException("let requires exactly 2 arguments");
|
|
||||||
}
|
|
||||||
|
|
||||||
if (!($ast->get(1) instanceof MList)) {
|
|
||||||
throw new MadLispException("first argument to let is not list");
|
|
||||||
}
|
|
||||||
|
|
||||||
$bindings = $ast->get(1)->getData();
|
|
||||||
|
|
||||||
if (count($bindings) % 2 == 1) {
|
|
||||||
throw new MadLispException("uneven number of bindings for let");
|
|
||||||
}
|
|
||||||
|
|
||||||
$newEnv = new Env($env);
|
|
||||||
|
|
||||||
for ($i = 0; $i < count($bindings) - 1; $i += 2) {
|
|
||||||
$key = $bindings[$i];
|
|
||||||
|
|
||||||
if (!($key instanceof Symbol)) {
|
|
||||||
throw new MadLispException("binding key for let is not symbol");
|
|
||||||
}
|
}
|
||||||
|
|
||||||
$val = $this->eval($bindings[$i + 1], $newEnv);
|
for ($i = 1; $i < $ast->count() - 1; $i++) {
|
||||||
$newEnv->set($key->getName(), $val);
|
$value = $this->eval($ast->get($i), $env);
|
||||||
}
|
if ($value == true) {
|
||||||
|
return $value;
|
||||||
return $this->eval($ast->get(2), $newEnv);
|
}
|
||||||
} elseif ($ast->get(0)->getName() == 'or') {
|
|
||||||
if ($ast->count() == 1) {
|
|
||||||
return false;
|
|
||||||
}
|
|
||||||
|
|
||||||
for ($i = 1; $i < $ast->count(); $i++) {
|
|
||||||
$value = $this->eval($ast->get($i), $env);
|
|
||||||
if ($value == true) {
|
|
||||||
return $value;
|
|
||||||
}
|
}
|
||||||
}
|
|
||||||
|
|
||||||
return $value;
|
$ast = $ast->get($ast->count() - 1);
|
||||||
} elseif ($ast->get(0)->getName() == 'quote') {
|
continue; // tco
|
||||||
if ($ast->count() != 2) {
|
} elseif ($ast->get(0)->getName() == 'quote') {
|
||||||
throw new MadLispException("quote requires exactly 1 argument");
|
if ($ast->count() != 2) {
|
||||||
}
|
throw new MadLispException("quote requires exactly 1 argument");
|
||||||
|
}
|
||||||
|
|
||||||
return $ast->get(1);
|
return $ast->get(1);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// Get new evaluated list
|
||||||
|
$ast = $this->evalAst($ast, $env);
|
||||||
|
|
||||||
|
// Call first argument as function
|
||||||
|
$func = $ast->get(0);
|
||||||
|
if (!($func instanceof Func)) {
|
||||||
|
throw new MadLispException("eval: first item of list is not function");
|
||||||
|
}
|
||||||
|
|
||||||
|
$args = array_slice($ast->getData(), 1);
|
||||||
|
return $func->call($args);
|
||||||
}
|
}
|
||||||
|
|
||||||
// Get new evaluated list
|
|
||||||
$ast = $this->evalAst($ast, $env);
|
|
||||||
|
|
||||||
// Call first argument as function
|
|
||||||
$func = $ast->get(0);
|
|
||||||
if (!($func instanceof Func)) {
|
|
||||||
throw new MadLispException("eval: first item of list is not function");
|
|
||||||
}
|
|
||||||
|
|
||||||
$args = array_slice($ast->getData(), 1);
|
|
||||||
return $func->call($args);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
private function evalAst($ast, Env $env)
|
private function evalAst($ast, Env $env)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user