ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-14 19:05:10 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gexp: Ignore nested gexps in macro expansion.

Browse source 
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'.
This commit is contained in:
Ludovic Courtès 2015-03-22 23:09:43 +01:00
parent accb682c50
commit 607e1b51f4
1 changed files with 16 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
guix/gexp.scm
View file

@ -474,13 +474,20 @@ (define (collect-escapes exp)
;; Return all the 'ungexp' present in EXP. ;; Return all the 'ungexp' present in EXP.
(let loop ((exp exp) (let loop ((exp exp)
(result '())) (result '()))
(syntax-case exp (ungexp ungexp-splicing) (syntax-case exp (ungexp
ungexp-splicing
ungexp-native
ungexp-native-splicing)
((ungexp _) ((ungexp _)
(cons exp result)) (cons exp result))
((ungexp _ _) ((ungexp _ _)
(cons exp result)) (cons exp result))
((ungexp-splicing _ ...) ((ungexp-splicing _ ...)
(cons exp result)) (cons exp result))
((ungexp-native _ ...)
result)
((ungexp-native-splicing _ ...)
result)
((exp0 exp ...) ((exp0 exp ...)
(let ((result (loop #'exp0 result))) (let ((result (loop #'exp0 result)))
(fold loop result #'(exp ...)))) (fold loop result #'(exp ...))))
@ -491,13 +498,20 @@ (define (collect-native-escapes exp)
;; Return all the 'ungexp-native' forms present in EXP. ;; Return all the 'ungexp-native' forms present in EXP.
(let loop ((exp exp) (let loop ((exp exp)
(result '())) (result '()))
(syntax-case exp (ungexp-native ungexp-native-splicing) (syntax-case exp (ungexp
ungexp-splicing
ungexp-native
ungexp-native-splicing)
((ungexp-native _) ((ungexp-native _)
(cons exp result)) (cons exp result))
((ungexp-native _ _) ((ungexp-native _ _)
(cons exp result)) (cons exp result))
((ungexp-native-splicing _ ...) ((ungexp-native-splicing _ ...)
(cons exp result)) (cons exp result))
((ungexp _ ...)
result)
((ungexp-splicing _ ...)
result)
((exp0 exp ...) ((exp0 exp ...)
(let ((result (loop #'exp0 result))) (let ((result (loop #'exp0 result)))
(fold loop result #'(exp ...)))) (fold loop result #'(exp ...))))