start tail call optimization

This commit is contained in:
Pekka Laiho 2020-06-04 21:26:00 +07:00
parent 291a7d6521
commit cb1a03e9bd

View File

@ -3,8 +3,20 @@ namespace MadLisp;
class Evaller class Evaller
{ {
private $p = null;
public function eval($ast, Env $env) public function eval($ast, Env $env)
{ {
// Debug
if ($this->p == null) {
$this->p = new Printer();
}
print("eval: ");
$this->p->print($ast);
print("\n");
while (true) {
// Not list or empty list // Not list or empty list
if (!($ast instanceof MList)) { if (!($ast instanceof MList)) {
return $this->evalAst($ast, $env); return $this->evalAst($ast, $env);
@ -19,14 +31,15 @@ class Evaller
return true; return true;
} }
for ($i = 1; $i < $ast->count(); $i++) { for ($i = 1; $i < $ast->count() - 1; $i++) {
$value = $this->eval($ast->get($i), $env); $value = $this->eval($ast->get($i), $env);
if ($value == false) { if ($value == false) {
return $value; return $value;
} }
} }
return $value; $ast = $ast->get($ast->count() - 1);
continue; // tco
} elseif ($ast->get(0)->getName() == 'case') { } elseif ($ast->get(0)->getName() == 'case') {
if ($ast->count() < 2) { if ($ast->count() < 2) {
throw new MadLispException("case requires at least 1 argument"); throw new MadLispException("case requires at least 1 argument");
@ -61,11 +74,12 @@ class Evaller
throw new MadLispException("do requires at least 1 argument"); throw new MadLispException("do requires at least 1 argument");
} }
for ($i = 1; $i < $ast->count(); $i++) { for ($i = 1; $i < $ast->count() - 1; $i++) {
$value = $this->eval($ast->get($i), $env); $this->eval($ast->get($i), $env);
} }
return $value; $ast = $ast->get($ast->count() - 1);
continue; // tco
} elseif ($ast->get(0)->getName() == 'env') { } elseif ($ast->get(0)->getName() == 'env') {
if ($ast->count() >= 2) { if ($ast->count() >= 2) {
if (!($ast->get(1) instanceof Symbol)) { if (!($ast->get(1) instanceof Symbol)) {
@ -109,9 +123,13 @@ class Evaller
$result = $this->eval($ast->get(1), $env); $result = $this->eval($ast->get(1), $env);
if ($result == true) { if ($result == true) {
return $this->eval($ast->get(2), $env); echo "if tco\n";
$ast = $ast->get(2);
continue;
} elseif ($ast->count() == 4) { } elseif ($ast->count() == 4) {
return $this->eval($ast->get(3), $env); echo "if tco\n";
$ast = $ast->get(3);
continue;
} else { } else {
return null; return null;
} }
@ -143,20 +161,23 @@ class Evaller
$newEnv->set($key->getName(), $val); $newEnv->set($key->getName(), $val);
} }
return $this->eval($ast->get(2), $newEnv); $ast = $ast->get(2);
$env = $newEnv;
continue; // tco
} elseif ($ast->get(0)->getName() == 'or') { } elseif ($ast->get(0)->getName() == 'or') {
if ($ast->count() == 1) { if ($ast->count() == 1) {
return false; return false;
} }
for ($i = 1; $i < $ast->count(); $i++) { for ($i = 1; $i < $ast->count() - 1; $i++) {
$value = $this->eval($ast->get($i), $env); $value = $this->eval($ast->get($i), $env);
if ($value == true) { if ($value == true) {
return $value; return $value;
} }
} }
return $value; $ast = $ast->get($ast->count() - 1);
continue; // tco
} elseif ($ast->get(0)->getName() == 'quote') { } elseif ($ast->get(0)->getName() == 'quote') {
if ($ast->count() != 2) { if ($ast->count() != 2) {
throw new MadLispException("quote requires exactly 1 argument"); throw new MadLispException("quote requires exactly 1 argument");
@ -178,6 +199,7 @@ class Evaller
$args = array_slice($ast->getData(), 1); $args = array_slice($ast->getData(), 1);
return $func->call($args); return $func->call($args);
} }
}
private function evalAst($ast, Env $env) private function evalAst($ast, Env $env)
{ {