~ruther/guix-local: gexp: Ignore nested gexps in macro expansion.

607e1b51f4b473e69373b9887555d7f6abd4cf10 — Ludovic Courtès 11 years ago accb682

gexp: Ignore nested gexps in macro expansion.

Before that, the 'references' and 'natives' or the outer gexp in an
expression like #~#+#~#$coreutils would include those of the inner
gexp.

* guix/gexp.scm (gexp)[collect-escapes]: Ignore everything below
  'ungexp-native' or 'ungexp-native-splicing'.
  [collect-native-escapes]: Ignore everything below 'ungexp' or
  'ungexp-splicing'.

patch browse .tar.gz

1 files changed, 16 insertions(+), 2 deletions(-)

M guix/gexp.scm

M guix/gexp.scm => guix/gexp.scm +16 -2

@@ 474,13 474,20 @@ and in the current monad setting (system type, etc.)"
       ;; Return all the 'ungexp' present in EXP.
       (let loop ((exp    exp)
                  (result '()))
-        (syntax-case exp (ungexp ungexp-splicing)
+        (syntax-case exp (ungexp
+                          ungexp-splicing
+                          ungexp-native
+                          ungexp-native-splicing)
           ((ungexp _)
            (cons exp result))
           ((ungexp _ _)
            (cons exp result))
           ((ungexp-splicing _ ...)
            (cons exp result))
+          ((ungexp-native _ ...)
+           result)
+          ((ungexp-native-splicing _ ...)
+           result)
           ((exp0 exp ...)
            (let ((result (loop #'exp0 result)))
              (fold loop result #'(exp ...))))


@@ 491,13 498,20 @@ and in the current monad setting (system type, etc.)"
       ;; Return all the 'ungexp-native' forms present in EXP.
       (let loop ((exp    exp)
                  (result '()))
-        (syntax-case exp (ungexp-native ungexp-native-splicing)
+        (syntax-case exp (ungexp
+                          ungexp-splicing
+                          ungexp-native
+                          ungexp-native-splicing)
           ((ungexp-native _)
            (cons exp result))
           ((ungexp-native _ _)
            (cons exp result))
           ((ungexp-native-splicing _ ...)
            (cons exp result))
+          ((ungexp _ ...)
+           result)
+          ((ungexp-splicing _ ...)
+           result)
           ((exp0 exp ...)
            (let ((result (loop #'exp0 result)))
              (fold loop result #'(exp ...))))