diff --git a/README.md b/README.md index 4573811..5ac75bd 100644 --- a/README.md +++ b/README.md @@ -361,12 +361,14 @@ odd? | Return true if the argument is odd number (1, 3, 5, ...). The following constants are defined by default: -Name | PHP constant -------- | ------------ -DIRSEP | DIRECTORY_SEPARATOR -HOME | $_SERVER['HOME'] -EOL | PHP_EOL -PI | M_PI +Name | PHP constant +-------- | ------------ +DIRSEP | DIRECTORY_SEPARATOR +HOME | $_SERVER['HOME'] +EOL | PHP_EOL +PI | M_PI +__DIR__ | Directory of a file being evaluated using the special form `load`. Otherwise null. +__FILE__ | Filename of a file being evaluated using the special form `load`. Otherwise null. ## Extending diff --git a/src/Env.php b/src/Env.php index 7283c37..27ee6b4 100644 --- a/src/Env.php +++ b/src/Env.php @@ -37,13 +37,8 @@ class Env extends Hash return $this->parent; } - public function set(string $key, $value) + public function getRoot(): ?Env { - // Do not allow overwriting values in root env - if ($this->has($key) && $this->parent == null) { - throw new MadLispException("attempt to overwrite $key in root env"); - } - - return parent::set($key, $value); + return $this->parent ? $this->parent->getRoot() : $this; } } diff --git a/src/Evaller.php b/src/Evaller.php index bc10bfe..b7ec606 100644 --- a/src/Evaller.php +++ b/src/Evaller.php @@ -87,8 +87,16 @@ class Evaller throw new MadLispException("first argument to def is not symbol"); } + $name = $ast->get(1)->getName(); + + // Do not allow reserved symbols to be defined + $reservedSymbols = ['__FILE__', '__DIR__']; + if (in_array($name, $reservedSymbols)) { + throw new MadLispException("def reserved symbol $name"); + } + $value = $this->eval($ast->get(2), $env); - return $env->set($ast->get(1)->getName(), $value); + return $env->set($name, $value); } elseif ($ast->get(0)->getName() == 'do') { if ($ast->count() == 1) { return null; @@ -199,22 +207,42 @@ class Evaller throw new MadLispException("load requires exactly 1 argument"); } - $filename = $ast->get(1); + // We have to evaluate the argument, it could be a function + $filename = $this->eval($ast->get(1), $env); if (!is_string($filename)) { throw new MadLispException("first argument to load is not string"); - } elseif (!is_readable($filename)) { + } + + // Replace ~ with user home directory + // Expand relative path names into absolute + $targetFile = realpath(str_replace('~', $_SERVER['HOME'], $filename)); + + if (!$targetFile || !is_readable($targetFile)) { throw new MadLispException("unable to read file $filename"); } - $input = @file_get_contents($filename); + $input = @file_get_contents($targetFile); // Wrap input in a do to process multiple expressions $input = "(do $input)"; $expr = $this->reader->read($this->tokenizer->tokenize($input)); + // Handle special constants + $rootEnv = $env->getRoot(); + $prevFile = $rootEnv->get('__FILE__'); + $prevDir = $rootEnv->get('__DIR__'); + $rootEnv->set('__FILE__', $targetFile); + $rootEnv->set('__DIR__', dirname($targetFile) . \DIRECTORY_SEPARATOR); + + // Evaluate the contents $ast = $this->eval($expr, $env); + + // Restore the special constants to previous values + $rootEnv->set('__FILE__', $prevFile); + $rootEnv->set('__DIR__', $prevDir); + continue; // tco } elseif ($ast->get(0)->getName() == 'or') { if ($ast->count() == 1) { diff --git a/src/LispFactory.php b/src/LispFactory.php index 1848e84..fc71aeb 100644 --- a/src/LispFactory.php +++ b/src/LispFactory.php @@ -13,6 +13,10 @@ class LispFactory // Root environment $env = new Env('root'); + // Register special constants + $env->set('__FILE__', null); + $env->set('__DIR__', null); + // Register core functions $env->set('doc', new CoreFunc('doc', 'Get documentation for a function.', 1, 1, function ($a) {