mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

psyntax: Remove pre-3.0 hack about syntax transformer bindings.

Browse source 
* module/ice-9/psyntax.scm (resolve-identifier): Remove "transformer is
a pair" case.
* module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Andy Wingo 2024-11-18 15:59:14 +01:00
parent 527b4498a8
commit 6c4f9a58c9
2 changed files with 35 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

72
module/ice-9/psyntax-pp.scm
View file

@ -583,10 +583,7 @@
(let ((v (and (not (equal? mod '(primitive))) (let ((v (and (not (equal? mod '(primitive)))
(module-variable (if mod (resolve-module (cdr mod)) (current-module)) var)))) (module-variable (if mod (resolve-module (cdr mod)) (current-module)) var))))
(if (and v (variable-bound? v) (macro? (variable-ref v))) (if (and v (variable-bound? v) (macro? (variable-ref v)))
(let* ((m (variable-ref v)) (let* ((m (variable-ref v)) (type (macro-type m)) (trans (macro-binding m)))
(type (macro-type m))
(trans (macro-binding m))
(trans (if (pair? trans) (car trans) trans)))
(if (eq? type 'syntax-parameter) (if (eq? type 'syntax-parameter)
(if resolve-syntax-parameters? (if resolve-syntax-parameters?
(let ((lexical (assq-ref r v))) (let ((lexical (assq-ref r v)))
@ -1154,11 +1151,11 @@
(source-wrap e w (wrap-subst w) mod) (source-wrap e w (wrap-subst w) mod)
x)) x))
(else (decorate-source x)))))) (else (decorate-source x))))))
(let* ((t-680b775fb37a463-10a5 transformer-environment) (let* ((t-680b775fb37a463-10a3 transformer-environment)
(t-680b775fb37a463-10a6 (lambda (k) (k e r w s rib mod)))) (t-680b775fb37a463-10a4 (lambda (k) (k e r w s rib mod))))
(with-fluid* (with-fluid*
t-680b775fb37a463-10a5 t-680b775fb37a463-10a3
t-680b775fb37a463-10a6 t-680b775fb37a463-10a4
(lambda () (rebuild-macro-output (p (source-wrap e (anti-mark w) s mod)) (new-mark)))))))) (lambda () (rebuild-macro-output (p (source-wrap e (anti-mark w) s mod)) (new-mark))))))))
(expand-body (expand-body
(lambda (body outer-form r w mod) (lambda (body outer-form r w mod)
@ -1689,11 +1686,11 @@
s s
mod mod
get-formals get-formals
(map (lambda (tmp-680b775fb37a463-132e (map (lambda (tmp-680b775fb37a463-132c
tmp-680b775fb37a463-132d tmp-680b775fb37a463-132b
tmp-680b775fb37a463-132c) tmp-680b775fb37a463-132a)
(cons tmp-680b775fb37a463-132c (cons tmp-680b775fb37a463-132a
(cons tmp-680b775fb37a463-132d tmp-680b775fb37a463-132e))) (cons tmp-680b775fb37a463-132b tmp-680b775fb37a463-132c)))
e2* e2*
e1* e1*
args*))) args*)))
@ -2805,8 +2802,9 @@
#f #f
k k
(list docstring) (list docstring)
(map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463) (map (lambda (tmp-680b775fb37a463 tmp-680b775fb37a463-145f tmp-680b775fb37a463-145e)
(list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1) tmp-680b775fb37a463-2)) (list (cons tmp-680b775fb37a463-145e tmp-680b775fb37a463-145f)
tmp-680b775fb37a463))
template template
pattern pattern
keyword))) keyword)))
@ -2818,11 +2816,9 @@
dots dots
k k
'() '()
(map (lambda (tmp-680b775fb37a463-147b (map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463)
tmp-680b775fb37a463-147a (list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)
tmp-680b775fb37a463) tmp-680b775fb37a463-2))
(list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-147a)
tmp-680b775fb37a463-147b))
template template
pattern pattern
keyword))) keyword)))
@ -2838,11 +2834,11 @@
dots dots
k k
(list docstring) (list docstring)
(map (lambda (tmp-680b775fb37a463-149a (map (lambda (tmp-680b775fb37a463-2
tmp-680b775fb37a463-1 tmp-680b775fb37a463-1
tmp-680b775fb37a463) tmp-680b775fb37a463)
(list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1) (list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)
tmp-680b775fb37a463-149a)) tmp-680b775fb37a463-2))
template template
pattern pattern
keyword))) keyword)))
@ -2997,9 +2993,9 @@
(apply (lambda (p) (apply (lambda (p)
(if (= lev 0) (if (= lev 0)
(quasiappend (quasiappend
(map (lambda (tmp-680b775fb37a463-154c) (map (lambda (tmp-680b775fb37a463-154a)
(list "value" (list "value"
tmp-680b775fb37a463-154c)) tmp-680b775fb37a463-154a))
p) p)
(quasi q lev)) (quasi q lev))
(quasicons (quasicons
@ -3139,8 +3135,8 @@
(let ((tmp-1 ls)) (let ((tmp-1 ls))
(let ((tmp ($sc-dispatch tmp-1 'each-any))) (let ((tmp ($sc-dispatch tmp-1 'each-any)))
(if tmp (if tmp
(apply (lambda (t-680b775fb37a463-15b0) (apply (lambda (t-680b775fb37a463-15ae)
(cons "vector" t-680b775fb37a463-15b0)) (cons "vector" t-680b775fb37a463-15ae))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f
@ -3150,8 +3146,8 @@
(let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") each-any)))) (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") each-any))))
(if tmp-1 (if tmp-1
(apply (lambda (y) (apply (lambda (y)
(k (map (lambda (tmp-680b775fb37a463-15bc) (k (map (lambda (tmp-680b775fb37a463-15ba)
(list "quote" tmp-680b775fb37a463-15bc)) (list "quote" tmp-680b775fb37a463-15ba))
y))) y)))
tmp-1) tmp-1)
(let ((tmp-1 ($sc-dispatch tmp '(#(atom "list") . each-any)))) (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list") . each-any))))
@ -3162,8 +3158,8 @@
(apply (lambda (y z) (f z (lambda (ls) (k (append y ls))))) tmp-1) (apply (lambda (y z) (f z (lambda (ls) (k (append y ls))))) tmp-1)
(let ((else tmp)) (let ((else tmp))
(let ((tmp x)) (let ((tmp x))
(let ((t-680b775fb37a463-15cb tmp)) (let ((t-680b775fb37a463-15c9 tmp))
(list "list->vector" t-680b775fb37a463-15cb))))))))))))))))) (list "list->vector" t-680b775fb37a463-15c9)))))))))))))))))
(emit (lambda (x) (emit (lambda (x)
(let ((tmp x)) (let ((tmp x))
(let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") any)))) (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") any))))
@ -3175,9 +3171,9 @@
(let ((tmp-1 (map emit x))) (let ((tmp-1 (map emit x)))
(let ((tmp ($sc-dispatch tmp-1 'each-any))) (let ((tmp ($sc-dispatch tmp-1 'each-any)))
(if tmp (if tmp
(apply (lambda (t-680b775fb37a463-15da) (apply (lambda (t-680b775fb37a463-15d8)
(cons (make-syntax 'list '((top)) '(hygiene guile)) (cons (make-syntax 'list '((top)) '(hygiene guile))
t-680b775fb37a463-15da)) t-680b775fb37a463-15d8))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f
@ -3193,14 +3189,14 @@
(let ((tmp-1 (list (emit (car x*)) (f (cdr x*))))) (let ((tmp-1 (list (emit (car x*)) (f (cdr x*)))))
(let ((tmp ($sc-dispatch tmp-1 '(any any)))) (let ((tmp ($sc-dispatch tmp-1 '(any any))))
(if tmp (if tmp
(apply (lambda (t-680b775fb37a463-15ee (apply (lambda (t-680b775fb37a463-15ec
t-680b775fb37a463-15ed) t-680b775fb37a463-15eb)
(list (make-syntax (list (make-syntax
'cons 'cons
'((top)) '((top))
'(hygiene guile)) '(hygiene guile))
t-680b775fb37a463-15ee t-680b775fb37a463-15ec
t-680b775fb37a463-15ed)) t-680b775fb37a463-15eb))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f
@ -3213,12 +3209,12 @@
(let ((tmp-1 (map emit x))) (let ((tmp-1 (map emit x)))
(let ((tmp ($sc-dispatch tmp-1 'each-any))) (let ((tmp ($sc-dispatch tmp-1 'each-any)))
(if tmp (if tmp
(apply (lambda (t-680b775fb37a463-15fa) (apply (lambda (t-680b775fb37a463-15f8)
(cons (make-syntax (cons (make-syntax
'append 'append
'((top)) '((top))
'(hygiene guile)) '(hygiene guile))
t-680b775fb37a463-15fa)) t-680b775fb37a463-15f8))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f

3
module/ice-9/psyntax.scm
View file

@ -777,8 +777,7 @@
(if (and v (variable-bound? v) (macro? (variable-ref v))) (if (and v (variable-bound? v) (macro? (variable-ref v)))
(let* ((m (variable-ref v)) (let* ((m (variable-ref v))
(type (macro-type m)) (type (macro-type m))
(trans (macro-binding m)) (trans (macro-binding m)))
(trans (if (pair? trans) (car trans) trans)))
(if (eq? type 'syntax-parameter) (if (eq? type 'syntax-parameter)
(if resolve-syntax-parameters? (if resolve-syntax-parameters?
(let ((lexical (assq-ref r v))) (let ((lexical (assq-ref r v)))