From c97f013651a262a62e094b69655bc0adb504dfcc Mon Sep 17 00:00:00 2001
From: Andrey Listopadov <andreyorst@gmail.com>
Date: Wed, 7 Sep 2022 22:50:35 +0300
Subject: support automatic relative require in the ns macro

---
 init-macros.fnl | 58 ++++++++++++++++++++++++++++++++++++---------------------
 init.fnl        |  4 ++--
 2 files changed, 39 insertions(+), 23 deletions(-)

diff --git a/init-macros.fnl b/init-macros.fnl
index a8d3e70..569bee7 100644
--- a/init-macros.fnl
+++ b/init-macros.fnl
@@ -33,7 +33,25 @@ SOFTWARE.")
 
 (var current-ns nil)
 
+(fn has? [tbl sym]
+  ;; searches for the given symbol in a table.
+  (var has false)
+  (each [_ elt (ipairs tbl) :until has]
+    (set has (= sym elt)))
+  has)
+
+(fn make-require [module relative?]
+  (let [module (tostring module)]
+    (if relative?
+        `(if (: (or ... "") :match "(.+%.)[^.]+")
+             (require (.. (: (or ... "") :match "(.+%.)[^.]+") ,module))
+             (= ... "init")
+             (require ,module)
+             (require (.. ... "." ,module)))
+        `(require ,module))))
+
 (fn ns [name commentary requirements]
+  "Namespace declaration macro."
   (set current-ns name)
   (let [bind-table [name]
         require-table [{}]
@@ -43,20 +61,21 @@ SOFTWARE.")
     (match requirements
       [:require & requires]
       (each [_ spec (ipairs requires)]
-        (match spec
-          (where (or [module :as alias :refer names]
-                     [module :refer names :as alias]))
-          (do (table.insert bind-table (collect [_ name (ipairs names) :into {'&as alias}]
-                                         (values (tostring name) name)))
-              (table.insert require-table `(require ,(tostring module))))
-          [module :as alias]
-          (do (table.insert bind-table alias)
-              (table.insert require-table `(require ,(tostring module))))
-          [module :refer names]
-          (do (table.insert bind-table (collect [_ name (ipairs names)]
-                                         (values (tostring name) name)))
-              (table.insert require-table `(require ,(tostring module))))
-          _ (assert-compile false "wrong require syntax" name)))
+        (let [relative? (has? spec :relative)]
+          (match spec
+            (where (or [module :as alias :refer names]
+                       [module :refer names :as alias]))
+            (do (table.insert bind-table (collect [_ name (ipairs names) :into {'&as alias}]
+                                           (values (tostring name) name)))
+                (table.insert require-table (make-require module relative?)))
+            [module :as alias]
+            (do (table.insert bind-table alias)
+                (table.insert require-table (make-require module relative?)))
+            [module :refer names]
+            (do (table.insert bind-table (collect [_ name (ipairs names)]
+                                           (values (tostring name) name)))
+                (table.insert require-table (make-require module relative?)))
+            _ (assert-compile false "wrong require syntax" name))))
       nil nil
       _ (assert-compile false "wrong require syntax" name))
     (if (string? commentary)
@@ -70,6 +89,10 @@ SOFTWARE.")
 ;;; def
 
 (fn def [...]
+  {:fnl/docstring "Name binding macro similar to `local` but acts in terms of current
+namespace set with the `ns` macro, unless `:private` was passed before
+the binding name."
+   :fnl/arglist [([name initializer]) ([meta name initializer])]}
   (match [...]
     (where (or [:private name val]
                [{:private true} name val]))
@@ -98,13 +121,6 @@ SOFTWARE.")
 (fn vfirst [x] x)
 (fn vrest [_ ...] ...)
 
-(fn has? [arglist sym]
-  ;; searches for the given symbol in a table.
-  (var has false)
-  (each [_ arg (ipairs arglist) :until has]
-    (set has (= sym arg)))
-  has)
-
 (fn length* [arglist]
   ;; Gets "length" of variadic arglist, stopping at first & plus 1 arg.
   ;; Additionally checks whether there are more than one arg after &.
diff --git a/init.fnl b/init.fnl
index 1e87284..ccb705f 100644
--- a/init.fnl
+++ b/init.fnl
@@ -31,8 +31,8 @@ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM‚ DAMAGES OR OTHER
 LIABILITY‚ WHETHER IN AN ACTION OF CONTRACT‚ TORT OR OTHERWISE‚ ARISING FROM‚
 OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
 SOFTWARE."
-  (:require [lazy-seq :as lazy]
-            [itable :as itable]))
+  (:require [lazy-seq :as lazy :relative]
+            [itable :as itable :relative]))
 
 ;;; Utility functions
 
-- 
cgit v1.2.3