From 2f487549025a3d4dd60422b891079a025546c503 Mon Sep 17 00:00:00 2001
From: Pekka Laiho <pekka.i.laiho@gmail.com>
Date: Sat, 24 Oct 2020 12:27:28 +0700
Subject: [PATCH] add special constants __FILE__ and __DIR__

---
 README.md           | 14 ++++++++------
 src/Env.php         |  9 ++-------
 src/Evaller.php     | 36 ++++++++++++++++++++++++++++++++----
 src/LispFactory.php |  4 ++++
 4 files changed, 46 insertions(+), 17 deletions(-)

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) {