From d7ebb3e607da6444d8215b1ee273c4247489f862 Mon Sep 17 00:00:00 2001
From: Andrey Orst <andreyorst@gmail.com>
Date: Mon, 2 Nov 2020 21:43:46 +0300
Subject: feature(macros): add def and defonce macros

---
 macros/core.fnl | 18 ++++++++++++++++++
 macros_test.fnl | 22 +++++++++++++++++++++-
 2 files changed, 39 insertions(+), 1 deletion(-)

diff --git a/macros/core.fnl b/macros/core.fnl
index de6a1b0..f300dbd 100644
--- a/macros/core.fnl
+++ b/macros/core.fnl
@@ -3,6 +3,11 @@
 (local unpack (or table.unpack _G.unpack))
 (local insert table.insert)
 
+(fn multisym->sym [s]
+  (if (multi-sym? s)
+      (values (sym (string.gsub (tostring s) ".*[.]" "")) true)
+      (values s false)))
+
 (fn check-bindings [bindings]
   (and (assert-compile (sequence? bindings) "expected binding table" [])
        (assert-compile (= (length bindings) 2) "expected exactly two forms in binding vector." bindings)))
@@ -178,4 +183,17 @@
            (fn ,(unpack fn-tail)))
      multifn#))
 
+(fn* core.def
+  [name expr]
+  (let [(s m) (multisym->sym name)]
+        (if m
+            `(local ,s (do (local ,s ,expr) (set ,name ,s) ,s))
+            `(local ,name ,expr))))
+
+(fn* core.defonce
+  [name expr]
+  (if (in-scope? name)
+      nil
+      (def name expr)))
+
 core
diff --git a/macros_test.fnl b/macros_test.fnl
index 8da9e7f..b8556e8 100644
--- a/macros_test.fnl
+++ b/macros_test.fnl
@@ -1,4 +1,4 @@
-(import-macros {: if-let : when-let : if-some : when-some : into : defmethod : defmulti} :macros.core)
+(import-macros {: if-let : when-let : if-some : when-some : into : defmethod : defmulti : defonce : def} :macros.core)
 (import-macros {: assert-eq : assert-ne : assert* : testing : deftest} :test)
 (local {: eq : identity} (require :core)) ;; required for testing
 
@@ -91,3 +91,23 @@
                "sending ваыв over HTTP")
     (assert-eq (send-message {:protocol :icap :message 42})
                "sending 42 over ICAP")))
+
+(deftest def-macros
+  (testing def
+    (def a 10)
+    (assert-eq a 10)
+    (def a {})
+    (assert-eq a {})
+    (def a.b 10)
+    (assert-eq a.b 10)
+    (assert-eq b 10))
+
+  (testing defonce
+    (defonce a 10)
+    (assert-eq a 10)
+    (defonce a {})
+    (assert-eq a 10)
+    (defonce b {})
+    (defonce b.a 10)
+    (assert-eq b.a 10)
+    (assert-eq a 10)))
-- 
cgit v1.2.3