diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 5ab4bc87..ae8477f0 100644 --- a/src/boot/boot.janet +++ b/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 diff --git a/test/suite0010.janet b/test/suite0010.janet index e3db6818..5ac0cd16 100644 --- a/test/suite0010.janet +++ b/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")