From cb1a03e9bd5db8c07baa5135dda31a6eca334565 Mon Sep 17 00:00:00 2001
From: Pekka Laiho <pekka.i.laiho@gmail.com>
Date: Thu, 4 Jun 2020 21:26:00 +0700
Subject: [PATCH] start tail call optimization

---
 src/Evaller.php | 314 ++++++++++++++++++++++++++----------------------
 1 file changed, 168 insertions(+), 146 deletions(-)

diff --git a/src/Evaller.php b/src/Evaller.php
index c896793..8627ea4 100644
--- a/src/Evaller.php
+++ b/src/Evaller.php
@@ -3,180 +3,202 @@ namespace MadLisp;
 
 class Evaller
 {
+    private $p = null;
+
     public function eval($ast, Env $env)
     {
-        // Not list or empty list
-        if (!($ast instanceof MList)) {
-            return $this->evalAst($ast, $env);
-        } elseif ($ast->count() == 0) {
-            return $ast;
+        // Debug
+        if ($this->p == null) {
+            $this->p = new Printer();
         }
+        print("eval: ");
+        $this->p->print($ast);
+        print("\n");
 
-        // Handle special forms
-        if ($ast->get(0) instanceof Symbol) {
-            if ($ast->get(0)->getName() == 'and') {
-                if ($ast->count() == 1) {
-                    return true;
-                }
+        while (true) {
 
-                for ($i = 1; $i < $ast->count(); $i++) {
-                    $value = $this->eval($ast->get($i), $env);
-                    if ($value == false) {
-                        return $value;
+            // Not list or empty list
+            if (!($ast instanceof MList)) {
+                return $this->evalAst($ast, $env);
+            } 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;
-            } elseif ($ast->get(0)->getName() == 'case') {
-                if ($ast->count() < 2) {
-                    throw new MadLispException("case requires at least 1 argument");
-                }
-
-                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);
+                    for ($i = 1; $i < $ast->count() - 1; $i++) {
+                        $value = $this->eval($ast->get($i), $env);
+                        if ($value == false) {
+                            return $value;
+                        }
                     }
-                }
 
-                // Last value, no test
-                if ($ast->count() % 2 == 0) {
-                    return $this->eval($ast->get($ast->count() - 1), $env);
-                } else {
-                    return null;
-                }
-            } elseif ($ast->get(0)->getName() == 'def') {
-                if ($ast->count() != 3) {
-                    throw new MadLispException("def requires exactly 2 arguments");
-                }
+                    $ast = $ast->get($ast->count() - 1);
+                    continue; // tco
+                } elseif ($ast->get(0)->getName() == 'case') {
+                    if ($ast->count() < 2) {
+                        throw new MadLispException("case requires at least 1 argument");
+                    }
 
-                if (!($ast->get(1) instanceof Symbol)) {
-                    throw new MadLispException("first argument to def is not symbol");
-                }
+                    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);
+                        }
+                    }
 
-                $value = $this->eval($ast->get(2), $env);
-                return $env->set($ast->get(1)->getName(), $value);
-            } elseif ($ast->get(0)->getName() == 'do') {
-                if ($ast->count() < 2) {
-                    throw new MadLispException("do requires at least 1 argument");
-                }
+                    // Last value, no test
+                    if ($ast->count() % 2 == 0) {
+                        return $this->eval($ast->get($ast->count() - 1), $env);
+                    } else {
+                        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)) {
-                        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());
-                } 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");
+                    $value = $this->eval($ast->get(2), $env);
+                    return $env->set($ast->get(1)->getName(), $value);
+                } elseif ($ast->get(0)->getName() == 'do') {
+                    if ($ast->count() < 2) {
+                        throw new MadLispException("do requires at least 1 argument");
+                    }
+
+                    for ($i = 1; $i < $ast->count() - 1; $i++) {
+                        $this->eval($ast->get($i), $env);
+                    }
+
+                    $ast = $ast->get($ast->count() - 1);
+                    continue; // tco
+                } elseif ($ast->get(0)->getName() == 'env') {
+                    if ($ast->count() >= 2) {
+                        if (!($ast->get(1) instanceof 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);
 
-                    for ($i = 0; $i < count($bindings); $i++) {
-                        $newEnv->set($bindings[$i]->getName(), $args[$i] ?? null);
+                    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);
+                        $newEnv->set($key->getName(), $val);
                     }
 
-                    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) {
-                    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");
+                    $ast = $ast->get(2);
+                    $env = $newEnv;
+                    continue; // tco
+                } elseif ($ast->get(0)->getName() == 'or') {
+                    if ($ast->count() == 1) {
+                        return false;
                     }
 
-                    $val = $this->eval($bindings[$i + 1], $newEnv);
-                    $newEnv->set($key->getName(), $val);
-                }
-
-                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;
+                    for ($i = 1; $i < $ast->count() - 1; $i++) {
+                        $value = $this->eval($ast->get($i), $env);
+                        if ($value == true) {
+                            return $value;
+                        }
                     }
-                }
 
-                return $value;
-            } elseif ($ast->get(0)->getName() == 'quote') {
-                if ($ast->count() != 2) {
-                    throw new MadLispException("quote requires exactly 1 argument");
-                }
+                    $ast = $ast->get($ast->count() - 1);
+                    continue; // tco
+                } elseif ($ast->get(0)->getName() == 'quote') {
+                    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)