From c6193b6ea2c8f4cd74be85ce26f32f47742323ce Mon Sep 17 00:00:00 2001 From: Pekka Laiho Date: Sun, 6 Dec 2020 08:26:27 +0700 Subject: [PATCH] initial support for macros --- src/Env.php | 10 +++++--- src/Evaller.php | 53 +++++++++++++++++++++++++++++++++++------ src/Func.php | 9 ++++++- src/Lib/Collections.php | 3 +++ src/Lib/Core.php | 3 ++- src/Printer.php | 6 ++++- src/UserFunc.php | 4 ++-- 7 files changed, 73 insertions(+), 15 deletions(-) diff --git a/src/Env.php b/src/Env.php index 89a2621..60f39ef 100644 --- a/src/Env.php +++ b/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 diff --git a/src/Evaller.php b/src/Evaller.php index 96201dc..df168a4 100644 --- a/src/Evaller.php +++ b/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) { diff --git a/src/Func.php b/src/Func.php index 1049d1e..bff3688 100644 --- a/src/Func.php +++ b/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; diff --git a/src/Lib/Collections.php b/src/Lib/Collections.php index 2b4f584..4633233 100644 --- a/src/Lib/Collections.php +++ b/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)); } diff --git a/src/Lib/Core.php b/src/Lib/Core.php index 848ef7b..9bc04df 100644 --- a/src/Lib/Core.php +++ b/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'); } diff --git a/src/Printer.php b/src/Printer.php index 737e34d..36e2a8a 100644 --- a/src/Printer.php +++ b/src/Printer.php @@ -11,7 +11,11 @@ class Printer private function doPrint($a, bool $readable): string { if ($a instanceof Func) { - return ''; + if ($a->isMacro()) { + return ''; + } else { + return ''; + } } elseif ($a instanceof MList) { return '(' . implode(' ', array_map(fn ($b) => $this->doPrint($b, $readable), $a->getData())) . ')'; } elseif ($a instanceof Vector) { diff --git a/src/UserFunc.php b/src/UserFunc.php index fe89727..9c3bc9b 100644 --- a/src/UserFunc.php +++ b/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;