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: Clean up use of fx+, etc

Browse source 
* module/ice-9/psyntax.scm (fx+, fx-, fx=): Remove.  Replace uses with
1+, 1-, =.
* module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Andy Wingo 2024-11-14 16:10:40 +01:00
parent dd18780fb8
commit f376e6445d
2 changed files with 80 additions and 97 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -47,8 +47,6 @@
(set-lambda-meta! (lambda (x v) (struct-set! x 1 v))) (set-lambda-meta! (lambda (x v) (struct-set! x 1 v)))
(top-level-eval (lambda (x mod) (primitive-eval x))) (top-level-eval (lambda (x mod) (primitive-eval x)))
(local-eval (lambda (x mod) (primitive-eval x))) (local-eval (lambda (x mod) (primitive-eval x)))
(session-id
(let ((v (module-variable (current-module) 'syntax-session-id))) (lambda () ((variable-ref v)))))
(sourcev-filename (lambda (s) (vector-ref s 0))) (sourcev-filename (lambda (s) (vector-ref s 0)))
(sourcev-line (lambda (s) (vector-ref s 1))) (sourcev-line (lambda (s) (vector-ref s 1)))
(sourcev-column (lambda (s) (vector-ref s 2))) (sourcev-column (lambda (s) (vector-ref s 2)))
@ -210,7 +208,7 @@
(lambda (symname marks) (lambda (symname marks)
(vector-set! symnamevec i symname) (vector-set! symnamevec i symname)
(vector-set! marksvec i marks) (vector-set! marksvec i marks)
(f (cdr ids) (+ i 1)))))) (f (cdr ids) (#{1+}# i))))))
(make-ribcage symnamevec marksvec labelvec))) (make-ribcage symnamevec marksvec labelvec)))
(cdr w)))))) (cdr w))))))
(smart-append (lambda (m1 m2) (if (null? m2) m1 (append m1 m2)))) (smart-append (lambda (m1 m2) (if (null? m2) m1 (append m1 m2))))
@ -262,9 +260,9 @@
(same-marks? marks (vector-ref (ribcage-marks ribcage) i))) (same-marks? marks (vector-ref (ribcage-marks ribcage) i)))
(let ((n (vector-ref (ribcage-labels ribcage) i))) (let ((n (vector-ref (ribcage-labels ribcage) i)))
(if (pair? n) (if (pair? n)
(if (equal? mod (car n)) (values (cdr n) marks) (f (+ i 1))) (if (equal? mod (car n)) (values (cdr n) marks) (f (#{1+}# i)))
(values n marks)))) (values n marks))))
(else (f (+ i 1))))))))) (else (f (#{1+}# i)))))))))
(cond (cond
((symbol? id) (or (search id (cdr w) (car w) mod) id)) ((symbol? id) (or (search id (cdr w) (car w) mod) id))
((syntax? id) ((syntax? id)
@ -300,7 +298,7 @@
(let f ((i 0) (results results)) (let f ((i 0) (results results))
(if (= i n) (if (= i n)
(scan (cdr subst) results) (scan (cdr subst) results)
(f (+ i 1) (f (#{1+}# i)
(cons (wrap (vector-ref symnames i) (cons (wrap (vector-ref symnames i)
(anti-mark (cons (vector-ref marks i) subst)) (anti-mark (cons (vector-ref marks i) subst))
mod) mod)
@ -791,7 +789,7 @@
(begin (if #f #f) v) (begin (if #f #f) v)
(begin (begin
(vector-set! v i (rebuild-macro-output (vector-ref x i) m)) (vector-set! v i (rebuild-macro-output (vector-ref x i) m))
(loop (+ i 1))))) (loop (#{1+}# i)))))
(decorate-source v))) (decorate-source v)))
((symbol? x) ((symbol? x)
(syntax-violation (syntax-violation
@ -800,11 +798,11 @@
(source-wrap e w (cdr w) mod) (source-wrap e w (cdr w) mod)
x)) x))
(else (decorate-source x)))))) (else (decorate-source x))))))
(let* ((t-680b775fb37a463-df3 transformer-environment) (let* ((t-680b775fb37a463-dac transformer-environment)
(t-680b775fb37a463-df4 (lambda (k) (k e r w s rib mod)))) (t-680b775fb37a463-dad (lambda (k) (k e r w s rib mod))))
(with-fluid* (with-fluid*
t-680b775fb37a463-df3 t-680b775fb37a463-dac
t-680b775fb37a463-df4 t-680b775fb37a463-dad
(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)
@ -1334,11 +1332,11 @@
s s
mod mod
get-formals get-formals
(map (lambda (tmp-680b775fb37a463-1 (map (lambda (tmp-680b775fb37a463-2
tmp-680b775fb37a463 tmp-680b775fb37a463-1
tmp-680b775fb37a463-106f) tmp-680b775fb37a463)
(cons tmp-680b775fb37a463-106f (cons tmp-680b775fb37a463
(cons tmp-680b775fb37a463 tmp-680b775fb37a463-1))) (cons tmp-680b775fb37a463-1 tmp-680b775fb37a463-2)))
e2* e2*
e1* e1*
args*))) args*)))
@ -1500,7 +1498,7 @@
((= level 0) (values var maps)) ((= level 0) (values var maps))
((null? maps) (syntax-violation 'syntax "missing ellipsis" src)) ((null? maps) (syntax-violation 'syntax "missing ellipsis" src))
(else (call-with-values (else (call-with-values
(lambda () (gen-ref src var (- level 1) (cdr maps))) (lambda () (gen-ref src var (#{1-}# level) (cdr maps)))
(lambda (outer-var outer-maps) (lambda (outer-var outer-maps)
(let ((b (assq outer-var (car maps)))) (let ((b (assq outer-var (car maps))))
(if b (if b
@ -1606,8 +1604,8 @@
(apply (lambda (args e1 e2) (apply (lambda (args e1 e2)
(build-it (build-it
'() '()
(map (lambda (tmp-680b775fb37a463-6b4 tmp-680b775fb37a463-6b3 tmp-680b775fb37a463-6b2) (map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463)
(cons tmp-680b775fb37a463-6b2 (cons tmp-680b775fb37a463-6b3 tmp-680b775fb37a463-6b4))) (cons tmp-680b775fb37a463 (cons tmp-680b775fb37a463-1 tmp-680b775fb37a463-2)))
e2 e2
e1 e1
args))) args)))
@ -1617,9 +1615,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-6ca tmp-680b775fb37a463-6c9 tmp-680b775fb37a463-6c8) (map (lambda (tmp-680b775fb37a463-68d tmp-680b775fb37a463-68c tmp-680b775fb37a463-68b)
(cons tmp-680b775fb37a463-6c8 (cons tmp-680b775fb37a463-68b
(cons tmp-680b775fb37a463-6c9 tmp-680b775fb37a463-6ca))) (cons tmp-680b775fb37a463-68c tmp-680b775fb37a463-68d)))
e2 e2
e1 e1
args))) args)))
@ -1639,8 +1637,8 @@
(apply (lambda (args e1 e2) (apply (lambda (args e1 e2)
(build-it (build-it
'() '()
(map (lambda (tmp-680b775fb37a463-67e tmp-680b775fb37a463-67d tmp-680b775fb37a463-67c) (map (lambda (tmp-680b775fb37a463-1 tmp-680b775fb37a463 tmp-680b775fb37a463-63f)
(cons tmp-680b775fb37a463-67c (cons tmp-680b775fb37a463-67d tmp-680b775fb37a463-67e))) (cons tmp-680b775fb37a463-63f (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)))
e2 e2
e1 e1
args))) args)))
@ -1829,7 +1827,7 @@
(let loop ((i 0)) (let loop ((i 0))
(if (= i n) (if (= i n)
(begin (if #f #f) v) (begin (if #f #f) v)
(begin (vector-set! v i (remodulate (vector-ref x i) mod)) (loop (+ i 1))))))) (begin (vector-set! v i (remodulate (vector-ref x i) mod)) (loop (#{1+}# i)))))))
(else x))))) (else x)))))
(let* ((tmp e) (let* ((tmp e)
(tmp-1 ($sc-dispatch (tmp-1 ($sc-dispatch
@ -1914,7 +1912,7 @@
(if (and tmp-1 (apply (lambda (x dots) (ellipsis? dots)) tmp-1)) (if (and tmp-1 (apply (lambda (x dots) (ellipsis? dots)) tmp-1))
(apply (lambda (x dots) (apply (lambda (x dots)
(call-with-values (call-with-values
(lambda () (cvt x (+ n 1) ids)) (lambda () (cvt x (#{1+}# n) ids))
(lambda (p ids) (lambda (p ids)
(values (if (eq? p 'any) 'each-any (vector 'each p)) ids)))) (values (if (eq? p 'any) 'each-any (vector 'each p)) ids))))
tmp-1) tmp-1)
@ -2432,9 +2430,8 @@
#f #f
k k
'() '()
(map (lambda (tmp-680b775fb37a463-118d tmp-680b775fb37a463-118c tmp-680b775fb37a463-118b) (map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463)
(list (cons tmp-680b775fb37a463-118b tmp-680b775fb37a463-118c) (list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1) tmp-680b775fb37a463-2))
tmp-680b775fb37a463-118d))
template template
pattern pattern
keyword))) keyword)))
@ -2449,11 +2446,11 @@
#f #f
k k
(list docstring) (list docstring)
(map (lambda (tmp-680b775fb37a463-11a6 (map (lambda (tmp-680b775fb37a463-115d
tmp-680b775fb37a463-11a5 tmp-680b775fb37a463-115c
tmp-680b775fb37a463-11a4) tmp-680b775fb37a463-115b)
(list (cons tmp-680b775fb37a463-11a4 tmp-680b775fb37a463-11a5) (list (cons tmp-680b775fb37a463-115b tmp-680b775fb37a463-115c)
tmp-680b775fb37a463-11a6)) tmp-680b775fb37a463-115d))
template template
pattern pattern
keyword))) keyword)))
@ -2465,11 +2462,9 @@
dots dots
k k
'() '()
(map (lambda (tmp-680b775fb37a463-11bf (map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463)
tmp-680b775fb37a463-11be (list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)
tmp-680b775fb37a463-11bd) tmp-680b775fb37a463-2))
(list (cons tmp-680b775fb37a463-11bd tmp-680b775fb37a463-11be)
tmp-680b775fb37a463-11bf))
template template
pattern pattern
keyword))) keyword)))
@ -2485,11 +2480,11 @@
dots dots
k k
(list docstring) (list docstring)
(map (lambda (tmp-680b775fb37a463-11de (map (lambda (tmp-680b775fb37a463-2
tmp-680b775fb37a463-11dd tmp-680b775fb37a463-1
tmp-680b775fb37a463-11dc) tmp-680b775fb37a463)
(list (cons tmp-680b775fb37a463-11dc tmp-680b775fb37a463-11dd) (list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)
tmp-680b775fb37a463-11de)) tmp-680b775fb37a463-2))
template template
pattern pattern
keyword))) keyword)))
@ -2617,9 +2612,8 @@
(apply (lambda (p) (apply (lambda (p)
(if (= lev 0) (if (= lev 0)
(quasilist* (quasilist*
(map (lambda (tmp-680b775fb37a463-128b) (map (lambda (tmp-680b775fb37a463)
(list "value" (list "value" tmp-680b775fb37a463))
tmp-680b775fb37a463-128b))
p) p)
(quasi q lev)) (quasi q lev))
(quasicons (quasicons
@ -2683,8 +2677,8 @@
(apply (lambda (p) (apply (lambda (p)
(if (= lev 0) (if (= lev 0)
(quasilist* (quasilist*
(map (lambda (tmp-680b775fb37a463-12a6) (map (lambda (tmp-680b775fb37a463-125d)
(list "value" tmp-680b775fb37a463-12a6)) (list "value" tmp-680b775fb37a463-125d))
p) p)
(vquasi q lev)) (vquasi q lev))
(quasicons (quasicons
@ -2704,8 +2698,8 @@
(apply (lambda (p) (apply (lambda (p)
(if (= lev 0) (if (= lev 0)
(quasiappend (quasiappend
(map (lambda (tmp-680b775fb37a463-12ab) (map (lambda (tmp-680b775fb37a463)
(list "value" tmp-680b775fb37a463-12ab)) (list "value" tmp-680b775fb37a463))
p) p)
(vquasi q lev)) (vquasi q lev))
(quasicons (quasicons
@ -2787,8 +2781,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-12f4) (apply (lambda (t-680b775fb37a463-12ab)
(cons "vector" t-680b775fb37a463-12f4)) (cons "vector" t-680b775fb37a463-12ab))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f
@ -2798,7 +2792,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) (list "quote" tmp-680b775fb37a463)) (k (map (lambda (tmp-680b775fb37a463-12b7)
(list "quote" tmp-680b775fb37a463-12b7))
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))))
@ -2809,8 +2804,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-130f tmp)) (let ((t-680b775fb37a463-12c6 tmp))
(list "list->vector" t-680b775fb37a463-130f))))))))))))))))) (list "list->vector" t-680b775fb37a463-12c6)))))))))))))))))
(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))))
@ -2822,9 +2817,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-131e) (apply (lambda (t-680b775fb37a463-12d5)
(cons (make-syntax 'list '((top)) '(hygiene guile)) (cons (make-syntax 'list '((top)) '(hygiene guile))
t-680b775fb37a463-131e)) t-680b775fb37a463-12d5))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f
@ -2840,13 +2835,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-1 t-680b775fb37a463) (apply (lambda (t-680b775fb37a463-12e9
t-680b775fb37a463-12e8)
(list (make-syntax (list (make-syntax
'cons 'cons
'((top)) '((top))
'(hygiene guile)) '(hygiene guile))
t-680b775fb37a463-1 t-680b775fb37a463-12e9
t-680b775fb37a463)) t-680b775fb37a463-12e8))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f
@ -2859,12 +2855,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-133e) (apply (lambda (t-680b775fb37a463-12f5)
(cons (make-syntax (cons (make-syntax
'append 'append
'((top)) '((top))
'(hygiene guile)) '(hygiene guile))
t-680b775fb37a463-133e)) t-680b775fb37a463-12f5))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f
@ -2877,12 +2873,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-134a) (apply (lambda (t-680b775fb37a463)
(cons (make-syntax (cons (make-syntax
'vector 'vector
'((top)) '((top))
'(hygiene guile)) '(hygiene guile))
t-680b775fb37a463-134a)) t-680b775fb37a463))
tmp) tmp)
(syntax-violation (syntax-violation
#f #f
@ -2893,12 +2889,12 @@
(if tmp-1 (if tmp-1
(apply (lambda (x) (apply (lambda (x)
(let ((tmp (emit x))) (let ((tmp (emit x)))
(let ((t-680b775fb37a463 tmp)) (let ((t-680b775fb37a463-130d tmp))
(list (make-syntax (list (make-syntax
'list->vector 'list->vector
'((top)) '((top))
'(hygiene guile)) '(hygiene guile))
t-680b775fb37a463)))) t-680b775fb37a463-130d))))
tmp-1) tmp-1)
(let ((tmp-1 ($sc-dispatch tmp '(#(atom "value") any)))) (let ((tmp-1 ($sc-dispatch tmp '(#(atom "value") any))))
(if tmp-1 (if tmp-1

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

@ -179,24 +179,11 @@
(define-expansion-constructors) (define-expansion-constructors)
(define-expansion-accessors lambda meta) (define-expansion-accessors lambda meta)
;; hooks to nonportable run-time helpers (define (top-level-eval x mod)
(begin (primitive-eval x))
(define-syntax fx+ (identifier-syntax +))
(define-syntax fx- (identifier-syntax -))
(define-syntax fx= (identifier-syntax =))
(define-syntax fx< (identifier-syntax <))
(define (top-level-eval x mod) (define (local-eval x mod)
(primitive-eval x)) (primitive-eval x))
(define (local-eval x mod)
(primitive-eval x))
;; Capture syntax-session-id before we shove it off into a module.
(define session-id
(let ((v (module-variable (current-module) 'syntax-session-id)))
(lambda ()
((variable-ref v))))))
(define (sourcev-filename s) (vector-ref s 0)) (define (sourcev-filename s) (vector-ref s 0))
(define (sourcev-line s) (vector-ref s 1)) (define (sourcev-line s) (vector-ref s 1))
@ -618,7 +605,7 @@
(lambda (symname marks) (lambda (symname marks)
(vector-set! symnamevec i symname) (vector-set! symnamevec i symname)
(vector-set! marksvec i marks) (vector-set! marksvec i marks)
(f (cdr ids) (fx+ i 1)))))) (f (cdr ids) (1+ i))))))
(make-ribcage symnamevec marksvec labelvec)))) (make-ribcage symnamevec marksvec labelvec))))
(wrap-subst w)))))) (wrap-subst w))))))
@ -713,16 +700,16 @@
(let ((n (vector-length symnames))) (let ((n (vector-length symnames)))
(let f ((i 0)) (let f ((i 0))
(cond (cond
((fx= i n) (search sym (cdr subst) marks mod)) ((= i n) (search sym (cdr subst) marks mod))
((and (eq? (vector-ref symnames i) sym) ((and (eq? (vector-ref symnames i) sym)
(same-marks? marks (vector-ref (ribcage-marks ribcage) i))) (same-marks? marks (vector-ref (ribcage-marks ribcage) i)))
(let ((n (vector-ref (ribcage-labels ribcage) i))) (let ((n (vector-ref (ribcage-labels ribcage) i)))
(if (pair? n) (if (pair? n)
(if (equal? mod (car n)) (if (equal? mod (car n))
(values (cdr n) marks) (values (cdr n) marks)
(f (fx+ i 1))) (f (1+ i)))
(values n marks)))) (values n marks))))
(else (f (fx+ i 1)))))))) (else (f (1+ i))))))))
(cond (cond
((symbol? id) ((symbol? id)
(or (first (search id (wrap-subst w) (wrap-marks w) mod)) id)) (or (first (search id (wrap-subst w) (wrap-marks w) mod)) id))
@ -778,9 +765,9 @@
(lambda (subst symnames marks results) (lambda (subst symnames marks results)
(let ((n (vector-length symnames))) (let ((n (vector-length symnames)))
(let f ((i 0) (results results)) (let f ((i 0) (results results))
(if (fx= i n) (if (= i n)
(scan (cdr subst) results) (scan (cdr subst) results)
(f (fx+ i 1) (f (1+ i)
(cons (wrap (vector-ref symnames i) (cons (wrap (vector-ref symnames i)
(anti-mark (make-wrap (vector-ref marks i) subst)) (anti-mark (make-wrap (vector-ref marks i) subst))
mod) mod)
@ -1515,8 +1502,8 @@
((vector? x) ((vector? x)
(let* ((n (vector-length x)) (let* ((n (vector-length x))
(v (make-vector n))) (v (make-vector n)))
(do ((i 0 (fx+ i 1))) (do ((i 0 (1+ i)))
((fx= i n) v) ((= i n) v)
(vector-set! v i (vector-set! v i
(rebuild-macro-output (vector-ref x i) m))) (rebuild-macro-output (vector-ref x i) m)))
(decorate-source v))) (decorate-source v)))
@ -2138,12 +2125,12 @@
(define gen-ref (define gen-ref
(lambda (src var level maps) (lambda (src var level maps)
(if (fx= level 0) (if (= level 0)
(values var maps) (values var maps)
(if (null? maps) (if (null? maps)
(syntax-violation 'syntax "missing ellipsis" src) (syntax-violation 'syntax "missing ellipsis" src)
(call-with-values (call-with-values
(lambda () (gen-ref src var (fx- level 1) (cdr maps))) (lambda () (gen-ref src var (1- level) (cdr maps)))
(lambda (outer-var outer-maps) (lambda (outer-var outer-maps)
(let ((b (assq outer-var (car maps)))) (let ((b (assq outer-var (car maps))))
(if b (if b
@ -2467,8 +2454,8 @@
(syntax-sourcev x))) (syntax-sourcev x)))
((vector? x) ((vector? x)
(let* ((n (vector-length x)) (v (make-vector n))) (let* ((n (vector-length x)) (v (make-vector n)))
(do ((i 0 (fx+ i 1))) (do ((i 0 (1+ i)))
((fx= i n) v) ((= i n) v)
(vector-set! v i (remodulate (vector-ref x i) mod))))) (vector-set! v i (remodulate (vector-ref x i) mod)))))
(else x)))) (else x))))
(syntax-case e (@@ primitive) (syntax-case e (@@ primitive)
@ -2563,7 +2550,7 @@
((x dots) ((x dots)
(ellipsis? (syntax dots)) (ellipsis? (syntax dots))
(call-with-values (call-with-values
(lambda () (cvt (syntax x) (fx+ n 1) ids)) (lambda () (cvt (syntax x) (1+ n) ids))
(lambda (p ids) (lambda (p ids)
(values (if (eq? p 'any) 'each-any (vector 'each p)) (values (if (eq? p 'any) 'each-any (vector 'each p))
ids)))) ids))))