Reintroduce gensyms to unique renaming machinery

This fixes https://todo.sr.ht/~technomancy/fennel/54
in a different way than 6db6a2c that does not introduce
this bug: #355

Approach: decomplect registering a demangling from extracting
a gensym's base. This way, the first time a gensym is
declared, it is not further mangled.

Note that neither commit completely addresses
#355
e.g., consider (let [a 1 a 2] (lua "a"))
but this commit attempts to do an equivalent job
to 6db6a2c.

Author: frenchy64

src/fennel/compiler.fnl

@@ -22,6 +22,7 @@ implement nesting. "
      :manglings (setmetatable [] {:__index (and parent parent.manglings)})
      :specials (setmetatable [] {:__index (and parent parent.specials)})
      :symmeta (setmetatable [] {:__index (and parent parent.symmeta)})
+     :gensym-base (setmetatable [] {:__index (and parent parent.gensym-base)})
      :unmanglings (setmetatable [] {:__index (and parent parent.unmanglings)})
      :gensyms (setmetatable [] {:__index (and parent parent.gensyms)})
      :autogensyms (setmetatable [] {:__index (and parent parent.autogensyms)})
@@ -103,7 +104,7 @@ and compile-stream."
   (or (not allowed-globals) (utils.member? name allowed-globals)))
 
 (fn unique-mangling [original mangling scope append]
-  (if (and (. scope.unmanglings mangling) (not (. scope.gensyms mangling)))
+  (if (. scope.unmanglings mangling)
       (unique-mangling original (.. original append) scope (+ append 1))
       mangling))
 
@@ -120,7 +121,7 @@ symbol is unique if the input string is unique in the scope."
                      (string.gsub "-" "_")
                      (string.gsub "[^%w_]" #(string.format "_%02x" ($:byte))))
         unique (unique-mangling mangling mangling scope 0)]
-    (tset scope.unmanglings unique str)
+    (tset scope.unmanglings unique (or (. scope.gensym-base str) str))
     (let [manglings (or ?temp-manglings scope.manglings)]
       (tset manglings str unique))
     unique))
@@ -153,7 +154,8 @@ these new manglings instead of the current manglings."
   (var mangling (.. (or ?base "") (next-append) (or ?suffix "")))
   (while (. scope.unmanglings mangling)
     (set mangling (.. (or ?base "") (next-append) (or ?suffix ""))))
-  (tset scope.unmanglings mangling (or ?base true))
+  (when (and ?base (< 0 (length ?base)))
+    (tset scope.gensym-base mangling ?base))
   (tset scope.gensyms mangling true)
   mangling)
 

test/macro.fnl

@@ -77,7 +77,8 @@
   (== (do (import-macros {: unsandboxed} :test.macros) (unsandboxed))
       "[\"no\" \"sandbox\"]" {:compiler-env _G})
   (let [not-unqualified "(import-macros hi :test.macros) (print (inc 1))"]
-    (l.assertFalse (pcall fennel.eval not-unqualified))))
+    (l.assertFalse (pcall fennel.eval not-unqualified)))
+  (== 2 (do (import-macros {: gensym-shadow} :test.macros) (gensym-shadow))))
 
 (fn test-macro-path []
   (== (do (import-macros m :test.other-macros) (m.m)) "testing macro path"))

test/macros.fnl

@@ -21,4 +21,8 @@
                        y# {:one 1}]
                    (+ (x#:abc) y#.one)))
  :unsandboxed (fn [] (view [:no :sandbox]))
- :fail-one (fn [x] (when (= x 1) (abc)) true)}
+ :fail-one (fn [x] (when (= x 1) (abc)) true)
+ :gensym-shadow (fn []
+                  (let [g (gensym)]
+                    `(let [,g (let [,g 1] 2)]
+                       ,g)))}