Add keep-syntax and keep-syntax! functions

These functions are designed to make it easier to properly preserve the
sourcemap and tuple type in macros. This commit also modifies the threading
macros to make use of these functions.

src/boot/boot.janet

@@ -1232,6 +1232,29 @@
      (,eprintf (,dyn :pretty-format "%q") ,s)
      ,s))
 
+(defn keep-syntax
+  ``Creates a tuple with the tuple type and sourcemap of `before` but the
+  elements of `after`. If either one of its argements is not a tuple, returns
+  `after` unmodified. Useful to preserve syntactic information when transforming
+  an ast in macros.``
+  [before after]
+  (if (and (= :tuple (type before))
+           (= :tuple (type after)))
+    (do
+      (def res (if (= :parens (tuple/type before))
+                 (tuple/slice after)
+                 (tuple/brackets ;after)))
+      (tuple/setmap res ;(tuple/sourcemap before)))
+    after))
+
+(defn keep-syntax!
+  ``Like `keep-syntax`, but if `after` is an array, it is coerced into a tuple.
+  Useful to preserve syntactic information when transforming an ast in macros.``
+  [before after]
+  (keep-syntax before (if (= :array (type after))
+                        (tuple/slice after)
+                        after)))
+
 (defmacro ->
   ``Threading macro. Inserts x as the second value in the first form
   in `forms`, and inserts the modified first form into the second form
@@ -1242,7 +1265,7 @@
                  (tuple (in n 0) (array/slice n 1))
                  (tuple n @[])))
     (def parts (array/concat @[h last] t))
-    (tuple/slice parts 0))
+    (keep-syntax! n parts))
   (reduce fop x forms))
 
 (defmacro ->>
@@ -1255,7 +1278,7 @@
                  (tuple (in n 0) (array/slice n 1))
                  (tuple n @[])))
     (def parts (array/concat @[h] t @[last]))
-    (tuple/slice parts 0))
+    (keep-syntax! n parts))
   (reduce fop x forms))
 
 (defmacro -?>
@@ -1271,7 +1294,7 @@
                  (tuple n @[])))
     (def sym (gensym))
     (def parts (array/concat @[h sym] t))
-    ~(let [,sym ,last] (if ,sym ,(tuple/slice parts 0))))
+    ~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
   (reduce fop x forms))
 
 (defmacro -?>>
@@ -1287,7 +1310,7 @@
                  (tuple n @[])))
     (def sym (gensym))
     (def parts (array/concat @[h] t @[sym]))
-    ~(let [,sym ,last] (if ,sym ,(tuple/slice parts 0))))
+    ~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
   (reduce fop x forms))
 
 (defn- walk-ind [f form]
@@ -1311,10 +1334,7 @@
     :table (walk-dict f form)
     :struct (table/to-struct (walk-dict f form))
     :array (walk-ind f form)
-    :tuple (let [x (walk-ind f form)]
-             (if (= :parens (tuple/type form))
-               (tuple/slice x)
-               (tuple/brackets ;x)))
+    :tuple (keep-syntax! form (walk-ind f form))
     form))
 
 (defn postwalk

test/suite0010.janet

@@ -44,6 +44,43 @@
 (assert (= :brackets (tuple/type (1 (macex1 '~[1 2 3 4])))) "macex1 qq bracket tuple")
 (assert (deep= (macex1 '~@[1 2 3 4 ,blah]) '~@[1 2 3 4 ,blah]) "macex1 qq array")
 
+# Sourcemaps in threading macros
+(defn check-threading [macro expansion]
+  (def expanded (macex1 (tuple macro 0 '(x) '(y))))
+  (assert (= expanded expansion) (string macro " expansion value"))
+  (def smap-x (tuple/sourcemap (get expanded 1)))
+  (def smap-y (tuple/sourcemap expanded))
+  (def line first)
+  (defn column [t] (t 1))
+  (assert (not= smap-x [-1 -1]) (string macro " x sourcemap existence"))
+  (assert (not= smap-y [-1 -1]) (string macro " y sourcemap existence"))
+  (assert (or (< (line smap-x) (line smap-y))
+              (and (= (line smap-x) (line smap-y))
+                   (< (column smap-x) (column smap-y))))
+          (string macro " relation between x and y sourcemap")))
+
+(check-threading '-> '(y (x 0)))
+(check-threading '->> '(y (x 0)))
+
+# keep-syntax
+(let [brak '[1 2 3]
+      par '(1 2 3)]
+
+  (tuple/setmap brak 2 1)
+
+  (assert (deep= (keep-syntax brak @[1 2 3]) @[1 2 3]) "keep-syntax brackets ignore array")
+  (assert (= (keep-syntax! brak @[1 2 3]) '[1 2 3]) "keep-syntax! brackets replace array")
+
+  (assert (= (keep-syntax! par (map inc @[1 2 3])) '(2 3 4)) "keep-syntax! parens coerce array")
+  (assert (not= (keep-syntax! brak @[1 2 3]) '(1 2 3)) "keep-syntax! brackets not parens")
+  (assert (not= (keep-syntax! par @[1 2 3]) '[1 2 3]) "keep-syntax! parens not brackets")
+  (assert (= (tuple/sourcemap brak)
+             (tuple/sourcemap (keep-syntax! brak @[1 2 3]))) "keep-syntax! brackets source map")
+
+  (keep-syntax par brak)
+  (assert (not= (tuple/sourcemap brak) (tuple/sourcemap par)) "keep-syntax no mutate")
+  (assert (= (keep-syntax 1 brak) brak) "keep-syntax brackets ignore type"))
+
 # Cancel test
 (def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
 (assert (= 1 (resume f)) "cancel resume 1")