03/05: gexp: Ignore nested gexps in macro expansion.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 607e1b51f4b473e69373b9887555d7f6abd4cf10
Author: Ludovic Courtès <address@hidden>
Date:   Sun Mar 22 23:09:43 2015 +0100

    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'.
---
 guix/gexp.scm |   18 ++++++++++++++++--
 1 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 218914c..3081ab0 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -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 ...))))