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 stale analyze-variable case

Browse source 
* module/ice-9/psyntax.scm (analyze-variable): Remove "bare" case, long
gone.
* module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Andy Wingo 2024-11-19 09:59:15 +01:00
parent cdf8473b19
commit 5ddb366375
2 changed files with 61 additions and 70 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -76,7 +76,6 @@
(lambda (mod var modref-cont bare-cont) (lambda (mod var modref-cont bare-cont)
(let* ((v mod) (let* ((v mod)
(fk (lambda () (fk (lambda ()
(let ((fk (lambda ()
(let ((fk (lambda () (let ((fk (lambda ()
(let ((fk (lambda () (let ((fk (lambda ()
(let ((fk (lambda () (error "value failed to match" v)))) (let ((fk (lambda () (error "value failed to match" v))))
@ -89,10 +88,6 @@
var) var)
(fk))) (fk)))
(fk)))))) (fk))))))
(if (pair? v)
(let ((vx (car v)) (vy (cdr v)))
(if (eq? vx 'bare) (bare-cont var) (fk)))
(fk))))))
(if (pair? v) (if (pair? v)
(let ((vx (car v)) (vy (cdr v))) (let ((vx (car v)) (vy (cdr v)))
(let ((tk (lambda () (let ((tk (lambda ()
@ -1151,11 +1146,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-c51 transformer-environment) (let* ((t-680b775fb37a463-c47 transformer-environment)
(t-680b775fb37a463-c52 (lambda (k) (k e r w s rib mod)))) (t-680b775fb37a463-c48 (lambda (k) (k e r w s rib mod))))
(with-fluid* (with-fluid*
t-680b775fb37a463-c51 t-680b775fb37a463-c47
t-680b775fb37a463-c52 t-680b775fb37a463-c48
(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)
@ -1686,11 +1681,11 @@
s s
mod mod
get-formals get-formals
(map (lambda (tmp-680b775fb37a463-eda (map (lambda (tmp-680b775fb37a463-ed0
tmp-680b775fb37a463-ed9 tmp-680b775fb37a463-ecf
tmp-680b775fb37a463-ed8) tmp-680b775fb37a463-ece)
(cons tmp-680b775fb37a463-ed8 (cons tmp-680b775fb37a463-ece
(cons tmp-680b775fb37a463-ed9 tmp-680b775fb37a463-eda))) (cons tmp-680b775fb37a463-ecf tmp-680b775fb37a463-ed0)))
e2* e2*
e1* e1*
args*))) args*)))
@ -1963,11 +1958,8 @@
(apply (lambda (args e1 e2) (apply (lambda (args e1 e2)
(build-it (build-it
'() '()
(map (lambda (tmp-680b775fb37a463-113f (map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463)
tmp-680b775fb37a463-113e (cons tmp-680b775fb37a463 (cons tmp-680b775fb37a463-1 tmp-680b775fb37a463-2)))
tmp-680b775fb37a463-113d)
(cons tmp-680b775fb37a463-113d
(cons tmp-680b775fb37a463-113e tmp-680b775fb37a463-113f)))
e2 e2
e1 e1
args))) args)))
@ -1977,9 +1969,11 @@
(apply (lambda (docstring args e1 e2) (apply (lambda (docstring args e1 e2)
(build-it (build-it
(list (cons 'documentation (syntax->datum docstring))) (list (cons 'documentation (syntax->datum docstring)))
(map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463) (map (lambda (tmp-680b775fb37a463-114b
tmp-680b775fb37a463-114a
tmp-680b775fb37a463)
(cons tmp-680b775fb37a463 (cons tmp-680b775fb37a463
(cons tmp-680b775fb37a463-1 tmp-680b775fb37a463-2))) (cons tmp-680b775fb37a463-114a tmp-680b775fb37a463-114b)))
e2 e2
e1 e1
args))) args)))
@ -1997,8 +1991,9 @@
(apply (lambda (args e1 e2) (apply (lambda (args e1 e2)
(build-it (build-it
'() '()
(map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463) (map (lambda (tmp-680b775fb37a463-116b tmp-680b775fb37a463-116a tmp-680b775fb37a463)
(cons tmp-680b775fb37a463 (cons tmp-680b775fb37a463-1 tmp-680b775fb37a463-2))) (cons tmp-680b775fb37a463
(cons tmp-680b775fb37a463-116a tmp-680b775fb37a463-116b)))
e2 e2
e1 e1
args))) args)))
@ -2008,11 +2003,9 @@
(apply (lambda (docstring args e1 e2) (apply (lambda (docstring args e1 e2)
(build-it (build-it
(list (cons 'documentation (syntax->datum docstring))) (list (cons 'documentation (syntax->datum docstring)))
(map (lambda (tmp-680b775fb37a463-118b (map (lambda (tmp-680b775fb37a463-1 tmp-680b775fb37a463 tmp-680b775fb37a463-117f)
tmp-680b775fb37a463-118a (cons tmp-680b775fb37a463-117f
tmp-680b775fb37a463) (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)))
(cons tmp-680b775fb37a463
(cons tmp-680b775fb37a463-118a tmp-680b775fb37a463-118b)))
e2 e2
e1 e1
args))) args)))
@ -2822,8 +2815,9 @@
#f #f
k k
'() '()
(map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463) (map (lambda (tmp-680b775fb37a463-145f tmp-680b775fb37a463-145e tmp-680b775fb37a463-145d)
(list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1) tmp-680b775fb37a463-2)) (list (cons tmp-680b775fb37a463-145d tmp-680b775fb37a463-145e)
tmp-680b775fb37a463-145f))
template template
pattern pattern
keyword))) keyword)))
@ -2851,11 +2845,9 @@
dots dots
k k
'() '()
(map (lambda (tmp-680b775fb37a463-149b (map (lambda (tmp-680b775fb37a463-1 tmp-680b775fb37a463 tmp-680b775fb37a463-148f)
tmp-680b775fb37a463-149a (list (cons tmp-680b775fb37a463-148f tmp-680b775fb37a463)
tmp-680b775fb37a463) tmp-680b775fb37a463-1))
(list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-149a)
tmp-680b775fb37a463-149b))
template template
pattern pattern
keyword))) keyword)))
@ -2871,11 +2863,11 @@
dots dots
k k
(list docstring) (list docstring)
(map (lambda (tmp-680b775fb37a463-14ba (map (lambda (tmp-680b775fb37a463-14b0
tmp-680b775fb37a463-14b9 tmp-680b775fb37a463-14af
tmp-680b775fb37a463-14b8) tmp-680b775fb37a463-14ae)
(list (cons tmp-680b775fb37a463-14b8 tmp-680b775fb37a463-14b9) (list (cons tmp-680b775fb37a463-14ae tmp-680b775fb37a463-14af)
tmp-680b775fb37a463-14ba)) tmp-680b775fb37a463-14b0))
template template
pattern pattern
keyword))) keyword)))
@ -3003,8 +2995,9 @@
(apply (lambda (p) (apply (lambda (p)
(if (= lev 0) (if (= lev 0)
(quasilist* (quasilist*
(map (lambda (tmp-680b775fb37a463) (map (lambda (tmp-680b775fb37a463-155d)
(list "value" tmp-680b775fb37a463)) (list "value"
tmp-680b775fb37a463-155d))
p) p)
(quasi q lev)) (quasi q lev))
(quasicons (quasicons
@ -3030,9 +3023,9 @@
(apply (lambda (p) (apply (lambda (p)
(if (= lev 0) (if (= lev 0)
(quasiappend (quasiappend
(map (lambda (tmp-680b775fb37a463-156c) (map (lambda (tmp-680b775fb37a463)
(list "value" (list "value"
tmp-680b775fb37a463-156c)) tmp-680b775fb37a463))
p) p)
(quasi q lev)) (quasi q lev))
(quasicons (quasicons
@ -3089,8 +3082,8 @@
(apply (lambda (p) (apply (lambda (p)
(if (= lev 0) (if (= lev 0)
(quasiappend (quasiappend
(map (lambda (tmp-680b775fb37a463) (map (lambda (tmp-680b775fb37a463-157d)
(list "value" tmp-680b775fb37a463)) (list "value" tmp-680b775fb37a463-157d))
p) p)
(vquasi q lev)) (vquasi q lev))
(quasicons (quasicons
@ -3172,8 +3165,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-15d0) (apply (lambda (t-680b775fb37a463-15c6)
(cons "vector" t-680b775fb37a463-15d0)) (cons "vector" t-680b775fb37a463-15c6))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f
@ -3183,8 +3176,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-15dc) (k (map (lambda (tmp-680b775fb37a463-15d2)
(list "quote" tmp-680b775fb37a463-15dc)) (list "quote" tmp-680b775fb37a463-15d2))
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))))
@ -3195,8 +3188,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-15eb tmp)) (let ((t-680b775fb37a463-15e1 tmp))
(list "list->vector" t-680b775fb37a463-15eb))))))))))))))))) (list "list->vector" t-680b775fb37a463-15e1)))))))))))))))))
(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))))
@ -3208,9 +3201,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-15fa) (apply (lambda (t-680b775fb37a463-15f0)
(cons (make-syntax 'list '((top)) '(hygiene guile)) (cons (make-syntax 'list '((top)) '(hygiene guile))
t-680b775fb37a463-15fa)) t-680b775fb37a463-15f0))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f
@ -3226,14 +3219,13 @@
(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-160e (apply (lambda (t-680b775fb37a463-1 t-680b775fb37a463)
t-680b775fb37a463-160d)
(list (make-syntax (list (make-syntax
'cons 'cons
'((top)) '((top))
'(hygiene guile)) '(hygiene guile))
t-680b775fb37a463-160e t-680b775fb37a463-1
t-680b775fb37a463-160d)) t-680b775fb37a463))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f
@ -3246,12 +3238,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-161a) (apply (lambda (t-680b775fb37a463)
(cons (make-syntax (cons (make-syntax
'append 'append
'((top)) '((top))
'(hygiene guile)) '(hygiene guile))
t-680b775fb37a463-161a)) t-680b775fb37a463))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f
@ -3264,12 +3256,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) (apply (lambda (t-680b775fb37a463-161c)
(cons (make-syntax (cons (make-syntax
'vector 'vector
'((top)) '((top))
'(hygiene guile)) '(hygiene guile))
t-680b775fb37a463)) t-680b775fb37a463-161c))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f

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

@ -228,7 +228,6 @@
(if (equal? mod (module-name (current-module))) (if (equal? mod (module-name (current-module)))
(bare-cont mod var) (bare-cont mod var)
(modref-cont mod var #f))) (modref-cont mod var #f)))
(('bare . _) (bare-cont var))
(('primitive . _) (('primitive . _)
(syntax-violation #f "primitive not in operator position" var)))) (syntax-violation #f "primitive not in operator position" var))))