tail call optimization for function calls

This commit is contained in:
Pekka Laiho 2020-06-05 15:33:52 +07:00
parent 8cf2dbeeec
commit 7331cbe874
2 changed files with 42 additions and 19 deletions

View File

@ -3,18 +3,8 @@ 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) { while (true) {
// Not list or empty list // Not list or empty list
@ -108,7 +98,7 @@ class Evaller
} }
} }
return new UserFunc(function (...$args) use ($bindings, $ast, $env) { $closure = 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); $i++) {
@ -116,7 +106,9 @@ class Evaller
} }
return $this->eval($ast->get(2), $newEnv); return $this->eval($ast->get(2), $newEnv);
}); };
return new UserFunc($closure, $ast->get(2), $env, $bindings);
} elseif ($ast->get(0)->getName() == 'if') { } elseif ($ast->get(0)->getName() == 'if') {
if ($ast->count() < 3 || $ast->count() > 4) { if ($ast->count() < 3 || $ast->count() > 4) {
throw new MadLispException("if requires 2 or 3 arguments"); throw new MadLispException("if requires 2 or 3 arguments");
@ -125,11 +117,9 @@ class Evaller
$result = $this->eval($ast->get(1), $env); $result = $this->eval($ast->get(1), $env);
if ($result == true) { if ($result == true) {
echo "if tco\n";
$ast = $ast->get(2); $ast = $ast->get(2);
continue; continue;
} elseif ($ast->count() == 4) { } elseif ($ast->count() == 4) {
echo "if tco\n";
$ast = $ast->get(3); $ast = $ast->get(3);
continue; continue;
} else { } else {
@ -192,14 +182,18 @@ class Evaller
// Get new evaluated list // Get new evaluated list
$ast = $this->evalAst($ast, $env); $ast = $this->evalAst($ast, $env);
// Call first argument as function // First item is function, rest are arguments
$func = $ast->get(0); $func = $ast->get(0);
if (!($func instanceof Func)) { $args = array_slice($ast->getData(), 1);
if ($func instanceof CoreFunc) {
return $func->call($args);
} elseif ($func instanceof UserFunc) {
$ast = $func->getAst();
$env = $func->getEnv($args);
} else {
throw new MadLispException("eval: first item of list is not function"); throw new MadLispException("eval: first item of list is not function");
} }
$args = array_slice($ast->getData(), 1);
return $func->call($args);
} }
} }

View File

@ -1,7 +1,36 @@
<?php <?php
namespace MadLisp; namespace MadLisp;
use Closure;
class UserFunc extends Func class UserFunc extends Func
{ {
protected $ast;
protected Env $tempEnv;
protected array $bindings;
public function __construct(Closure $closure, $ast, Env $tempEnv, array $bindings)
{
parent::__construct($closure, null);
$this->ast = $ast;
$this->tempEnv = $tempEnv;
$this->bindings = $bindings;
}
public function getAst()
{
return $this->ast;
}
public function getEnv(array $args)
{
$newEnv = new Env($this->tempEnv);
for ($i = 0; $i < count($this->bindings); $i++) {
$newEnv->set($this->bindings[$i]->getName(), $args[$i] ?? null);
}
return $newEnv;
}
} }