initial support for macros

src/Env.php

@@ -21,15 +21,19 @@ class Env extends Hash
         return $this->name;
     }
 
-    public function get(string $key)
+    public function get(string $key, bool $throw = true)
     {
         if (array_key_exists($key, $this->data)) {
             return $this->data[$key];
         } elseif ($this->parent) {
-            return $this->parent->get($key);
+            return $this->parent->get($key, $throw);
         }
 
-        throw new MadLispException("symbol $key not defined in env");
+        if ($throw) {
+            throw new MadLispException("symbol $key not defined in env");
+        } else {
+            return null;
+        }
     }
 
     public function getParent(): ?Env

src/Evaller.php

@@ -37,7 +37,15 @@ class Evaller
                 }
             }
 
-            // Not list
+            // Return fast for optimization if not list
+            if (!($ast instanceof MList)) {
+                return $this->evalAst($ast, $env);
+            }
+
+            // Perform macro expansion
+            $ast = $this->macroexpand($ast, $env);
+
+            // After macro expansion we have to check for not-a-list again
             if (!($ast instanceof MList)) {
                 return $this->evalAst($ast, $env);
             }
@@ -135,23 +143,23 @@ class Evaller
 
                     $ast = $this->eval($astData[1], $env);
                     continue; // tco
-                } elseif ($symbolName == 'fn') {
+                } elseif ($symbolName == 'fn' || $symbolName == 'macro') {
                     if ($astLength != 3) {
-                        throw new MadLispException("fn requires exactly 2 arguments");
+                        throw new MadLispException("$symbolName requires exactly 2 arguments");
                     }
 
                     if (!($astData[1] instanceof Seq)) {
-                        throw new MadLispException("first argument to fn is not seq");
+                        throw new MadLispException("first argument to $symbolName is not seq");
                     }
 
                     $bindings = $astData[1]->getData();
                     foreach ($bindings as $bind) {
                         if (!($bind instanceof Symbol)) {
-                            throw new MadLispException("binding key for fn is not symbol");
+                            throw new MadLispException("binding key for $symbolName is not symbol");
                         }
                     }
 
-                    $closure = function (...$args) use ($bindings, $ast, $env, $astData) {
+                    $closure = function (...$args) use ($bindings, $env, $astData) {
                         $newEnv = new Env('closure', $env);
 
                         for ($i = 0; $i < count($bindings); $i++) {
@@ -161,7 +169,7 @@ class Evaller
                         return $this->eval($astData[2], $newEnv);
                     };
 
-                    return new UserFunc($closure, $astData[2], $env, $astData[1]);
+                    return new UserFunc($closure, $astData[2], $env, $astData[1], $symbolName == 'macro');
                 } elseif ($symbolName == 'if') {
                     if ($astLength < 3 || $astLength > 4) {
                         throw new MadLispException("if requires 2 or 3 arguments");
@@ -257,6 +265,12 @@ class Evaller
                     $rootEnv->set('__DIR__', $prevDir);
 
                     continue; // tco
+                } elseif ($symbolName == 'macroexpand') {
+                    if ($astLength != 2) {
+                        throw new MadLispException("macroexpand requires exactly 1 argument");
+                    }
+
+                    return $this->macroexpand($astData[1], $env);
                 } elseif ($symbolName == 'or') {
                     if ($astLength == 1) {
                         return false;
@@ -344,6 +358,31 @@ class Evaller
         return $ast;
     }
 
+    private function getMacroFn($ast, Env $env): ?Func
+    {
+        if ($ast instanceof MList) {
+            $data = $ast->getData();
+            if (count($data) > 0 && $data[0] instanceof Symbol) {
+                $fn = $env->get($data[0]->getName(), false);
+                if ($fn && $fn instanceof Func && $fn->isMacro()) {
+                    return $fn;
+                }
+            }
+        }
+
+        return null;
+    }
+
+    private function macroexpand($ast, Env $env)
+    {
+        while (($fn = $this->getMacroFn($ast, $env))) {
+            // We know ast is a list
+            $ast = $fn->call(array_slice($ast->getData(), 1));
+        }
+
+        return $ast;
+    }
+
     private function quasiquote($ast)
     {
         if ($ast instanceof MList) {

src/Func.php

@@ -7,11 +7,13 @@ abstract class Func
 {
     protected Closure $closure;
     protected ?string $doc;
+    protected bool $macro;
 
-    public function __construct(Closure $closure, ?string $doc = null)
+    public function __construct(Closure $closure, ?string $doc = null, bool $macro = false)
     {
         $this->closure = $closure;
         $this->doc = $doc;
+        $this->macro = $macro;
     }
 
     public function getClosure(): Closure
@@ -24,6 +26,11 @@ abstract class Func
         return $this->doc;
     }
 
+    public function isMacro(): bool
+    {
+        return $this->macro;
+    }
+
     public function setDoc(?string $val): void
     {
         $this->doc = $val;

src/Lib/Collections.php

@@ -156,6 +156,9 @@ class Collections implements ILib
 
         $env->set('concat', new CoreFunc('concat', 'Concatenate multiple sequences together.', 1, -1,
             function (Seq ...$args) {
+                // This is used by quasiquote, so we need to always return
+                // a list for it to work properly.
+
                 $data = array_map(fn ($a) => $a->getData(), $args);
                 return new MList(array_merge(...$data));
             }

src/Lib/Core.php

@@ -102,7 +102,8 @@ class Core implements ILib
                         } elseif ($attribute == 'body') {
                             return $obj->getAst();
                         } elseif ($attribute == 'code') {
-                            return new MList([new Symbol('fn'), $obj->getBindings(), $obj->getAst()]);
+                            $name = $obj->isMacro() ? 'macro' : 'fn';
+                            return new MList([new Symbol($name), $obj->getBindings(), $obj->getAst()]);
                         } else {
                             throw new MadLispException('unknown attribute for meta');
                         }

src/Printer.php

@@ -11,7 +11,11 @@ class Printer
     private function doPrint($a, bool $readable): string
     {
         if ($a instanceof Func) {
-            return '<function>';
+            if ($a->isMacro()) {
+                return '<macro>';
+            } else {
+                return '<function>';
+            }
         } elseif ($a instanceof MList) {
             return '(' . implode(' ', array_map(fn ($b) => $this->doPrint($b, $readable), $a->getData())) . ')';
         } elseif ($a instanceof Vector) {

src/UserFunc.php

@@ -9,9 +9,9 @@ class UserFunc extends Func
     protected Env $tempEnv;
     protected Seq $bindings;
 
-    public function __construct(Closure $closure, $ast, Env $tempEnv, Seq $bindings)
+    public function __construct(Closure $closure, $ast, Env $tempEnv, Seq $bindings, bool $macro = false)
     {
-        parent::__construct($closure, null);
+        parent::__construct($closure, null, $macro);
 
         $this->ast = $ast;
         $this->tempEnv = $tempEnv;