Scheme宏中的语法引用

Question

我正在尝试编写一个在素数上循环的Scheme宏。这里是宏的一个简单的版本：

(define-syntax do-primes 
    (syntax-rules() 
    ((do-primes (p lo hi) (binding ...) (test res ...) exp ...) 
     (do ((p (next-prime (- lo 1)) (next-prime p)) binding ...) 
      ((or test (< hi p)) res ...) exp ...)) 
    ((do-primes (p lo) (binding ...) (test res ...) exp ...) 
     (do ((p (next-prime (- lo 1)) (next-prime p)) binding ...) 
      (test res ...) exp ...)) 
    ((do-primes (p) (binding ...) (test res ...) exp ...) 
     (do ((p 2 (next-prime p)) binding ...) (test res ...) exp ...)))) 

的do-primes宏展开为一个do有三种语法：如果第一个参数do-primes是(p lo hi)那么do遍历从lo素数到hi除非迭代如果do-primes的第一个参数是(p lo)，那么do将从lo开始的素数循环并继续，直到终止子句停止迭代，并且如果do-primes的第一个参数是(p)，则do从2开始循环素数，直到终止子句停止迭代。下面是do-primes宏观的一些样品用途：

; these lines display the primes less than 25 
(do-primes (p 2 25)() (#f) (display p) (newline)) 
(do-primes (p 2)() ((< 25 p)) (display p) (newline)) 
(do-primes (p)() ((< 25 p)) (display p) (newline)) 

; these lines return a list of the primes less than 25 
(do-primes (p 2 25) ((ps (list) (cons p ps))) (#f (reverse ps))) 
(do-primes (p 2) ((ps (list) (cons p ps))) ((< 25 p) (reverse ps))) 
(do-primes (p) ((ps (list) (cons p ps))) ((< 25 p) (reverse ps))) 

; these lines return the sum of the primes less than 25 
(do-primes (p 2 25) ((s 0 (+ s p))) (#f s)) 
(do-primes (p 2) ((s 0 (+ s p))) ((< 25 p) s)) 
(do-primes (p) ((s 0 (+ s p))) ((< 25 p) s)) 

我想要做的是写一个版本，使用next-prime功能的本地版本的do-primes宏;我想这样做，因为我可以使next-prime函数运行得比我的通用函数next-prime更快，因为我知道它将被调用的环境。我试图写这样的宏：

(define-syntax do-primes 
    (let() 
    (define (prime? n) 
     (if (< n 2) #f 
     (let loop ((f 2)) 
      (if (< n (* f f)) #t 
      (if (zero? (modulo n f)) #f 
       (loop (+ f 1))))))) 
    (define (next-prime n) 
     (let loop ((n (+ n 1))) 
     (if (prime? n) n (loop (+ n 1))))) 
    (lambda (x) (syntax-case x() 
    ((do-primes (p lo hi) (binding ...) (test res ...) exp ...) 
     (syntax 
     (do ((p (next-prime (- lo 1)) (next-prime p)) binding ...) 
      ((or test (< hi p)) res ...) exp ...))) 
    ((do-primes (p lo) (binding ...) (test res ...) exp ...) 
     (syntax 
     (do ((p (next-prime (- lo 1)) (next-prime p)) binding ...) 
      (test res ...) exp ...))) 
    ((do-primes (p) (binding ...) (test res ...) exp ...) 
     (syntax 
     (do ((p 2 (next-prime p)) binding ...) (test res ...) exp ...)))))))) 

（忽略prime?和next-prime函数，它们是有仅用于说明的do-primes宏的实际版本将使用分段筛小的素数，并切换到一个Baillie-Wagstaff为更大素数伪指数测试。）但这并不奏效;我收到一条错误消息，告诉我，我正在尝试“引用不同阶段的标识符next-prime。”我理解这个问题。但是我的宏观魔法不足以解决它。

有人可以告诉我如何编写do-primes宏吗？

编辑：下面是最终宏：

(define-syntax do-primes (syntax-rules() ; syntax for iterating over primes 

    ; (do-primes (p lo hi) ((var init next) ...) (pred? result ...) expr ...) 

    ; Macro do-primes provides syntax for iterating over primes. It expands to 
    ; a do-loop with variable p bound in the same scope as the rest of the (var 
    ; init next) variables, as if it were defined as (do ((p (primes lo hi) (cdr 
    ; p)) (var init next) ...) (pred result ...) expr ...). Variables lo and hi 
    ; are inclusive; for instance, given (p 2 11), p will take on the values 2, 
    ; 3, 5, 7 and 11. If hi is omitted the iteration continues until stopped by 
    ; pred?. If lo is also omitted iteration starts from 2. Some examples: 

    ; three ways to display the primes less than 25 
    ; (do-primes (p 2 25)() (#f) (display p) (newline)) 
    ; (do-primes (p 2)() ((< 25 p)) (display p) (newline)) 
    ; (do-primes (p)() ((< 25 p)) (display p) (newline)) 

    ; three ways to return a list of the primes less than 25 
    ; (do-primes (p 2 25) ((ps (list) (cons p ps))) (#f (reverse ps))) 
    ; (do-primes (p 2) ((ps (list) (cons p ps))) ((< 25 p) (reverse ps))) 
    ; (do-primes (p) ((ps (list) (cons p ps))) ((< 25 p) (reverse ps))) 

    ; three ways to return the sum of the primes less than 25 
    ; (do-primes (p 2 25) ((s 0 (+ s p))) (#f s)) 
    ; (do-primes (p 2) ((s 0 (+ s p))) ((< 25 p) s)) 
    ; (do-primes (p) ((s 0 (+ s p))) ((< 25 p) s)) 

    ; functions to count primes and return the nth prime (from P[1] = 2) 
    ; (define (prime-pi n) (do-primes (p) ((k 0 (+ k 1))) ((< n p) k))) 
    ; (define (nth-prime n) (do-primes (p) ((n n (- n 1))) ((= n 1) p))) 

    ; The algorithm used to generate primes is a segmented Sieve of Eratosthenes 
    ; up to 2^32. For larger primes, a segmented sieve runs over the sieving 
    ; primes up to 2^16 to produce prime candidates, then a Baillie-Wagstaff 
    ; pseudoprimality test is performed to confirm the number is prime. 

    ; If functions primes, expm, jacobi, strong-pseudoprime?, lucas, selfridge 
    ; and lucas-pseudoprime? exist in the outer environment, they can be removed 
    ; from the macro. 

    ((do-primes (p lo hi) (binding ...) (test result ...) expr ...) 
    (do-primes (p lo) (binding ...) ((or test (< hi p)) result ...) expr ...)) 

    ((do-primes (pp low) (binding ...) (test result ...) expr ...) 

    (let* ((limit (expt 2 16)) (delta 50000) (limit2 (* limit limit)) 
      (sieve (make-vector delta #t)) (ps #f) (qs #f) (bottom 0) (pos 0)) 

     (define (primes n) ; sieve of eratosthenes 
     (let ((sieve (make-vector n #t))) 
      (let loop ((p 2) (ps (list))) 
      (cond ((= n p) (reverse ps)) 
        ((vector-ref sieve p) 
        (do ((i (* p p) (+ i p))) ((<= n i)) 
         (vector-set! sieve i #f)) 
        (loop (+ p 1) (cons p ps))) 
        (else (loop (+ p 1) ps)))))) 

     (define (expm b e m) ; modular exponentiation 
     (let loop ((b b) (e e) (x 1)) 
      (if (zero? e) x 
      (loop (modulo (* b b) m) (quotient e 2) 
        (if (odd? e) (modulo (* b x) m) x))))) 

     (define (jacobi a m) ; jacobi symbol 
     (let loop1 ((a (modulo a m)) (m m) (t 1)) 
      (if (zero? a) (if (= m 1) t 0) 
      (let ((z (if (member (modulo m 8) (list 3 5)) -1 1))) 
       (let loop2 ((a a) (t t)) 
       (if (even? a) (loop2 (/ a 2) (* t z)) 
        (loop1 (modulo m a) a 
         (if (and (= (modulo a 4) 3) 
            (= (modulo m 4) 3)) 
          (- t) t)))))))) 

     (define (strong-pseudoprime? n a) ; strong pseudoprime base a 
     (let loop ((r 0) (s (- n 1))) 
      (if (even? s) (loop (+ r 1) (/ s 2)) 
      (if (= (expm a s n) 1) #t 
       (let loop ((r r) (s s)) 
       (cond ((zero? r) #f) 
         ((= (expm a s n) (- n 1)) #t) 
         (else (loop (- r 1) (* s 2))))))))) 

     (define (lucas p q m n) ; lucas sequences u[n] and v[n] and q^n (mod m) 
     (define (even e o) (if (even? n) e o)) 
     (define (mod n) (if (zero? m) n (modulo n m))) 
     (let ((d (- (* p p) (* 4 q)))) 
      (let loop ((un 1) (vn p) (qn q) (n (quotient n 2)) 
        (u (even 0 1)) (v (even 2 p)) (k (even 1 q))) 
      (if (zero? n) (values u v k) 
       (let ((u2 (mod (* un vn))) (v2 (mod (- (* vn vn) (* 2 qn)))) 
        (q2 (mod (* qn qn))) (n2 (quotient n 2))) 
       (if (even? n) (loop u2 v2 q2 n2 u v k) 
        (let* ((uu (+ (* u v2) (* u2 v))) 
         (vv (+ (* v v2) (* d u u2))) 
         (uu (if (and (positive? m) (odd? uu)) (+ uu m) uu)) 
         (vv (if (and (positive? m) (odd? vv)) (+ vv m) vv)) 
         (uu (mod (/ uu 2))) (vv (mod (/ vv 2)))) 
        (loop u2 v2 q2 n2 uu vv (* k q2))))))))) 

     (define (selfridge n) ; initialize lucas sequence 
     (let loop ((d-abs 5) (sign 1)) 
      (let ((d (* d-abs sign))) 
      (cond ((< 1 (gcd d n)) (values d 0 0)) 
        ((= (jacobi d n) -1) (values d 1 (/ (- 1 d) 4))) 
        (else (loop (+ d-abs 2) (- sign))))))) 

     (define (lucas-pseudoprime? n) ; standard lucas pseudoprime 
     (call-with-values 
      (lambda() (selfridge n)) 
      (lambda (d p q) 
      (if (zero? p) (= n d) 
       (call-with-values 
       (lambda() (lucas p q n (+ n 1))) 
       (lambda (u v qkd) (zero? u))))))) 

     (define (init lo) ; initialize sieve, return first prime 
     (set! bottom (if (< lo 3) 2 (if (odd? lo) (- lo 1) lo))) 
     (set! ps (cdr (primes limit))) (set! pos 0) 
     (set! qs (map (lambda (p) (modulo (/ (+ bottom p 1) -2) p)) ps)) 
     (do ((p ps (cdr p)) (q qs (cdr q))) ((null? p)) 
      (do ((i (+ (car p) (car q)) (+ i (car p)))) ((<= delta i)) 
      (vector-set! sieve i #f))) 
     (if (< lo 3) 2 (next))) 

     (define (advance) ; advance to next segment 
     (set! bottom (+ bottom delta delta)) (set! pos 0) 
     (do ((i 0 (+ i 1))) ((= i delta)) (vector-set! sieve i #t)) 
     (set! qs (map (lambda (p q) (modulo (- q delta) p)) ps qs)) 
     (do ((p ps (cdr p)) (q qs (cdr q))) ((null? p)) 
      (do ((i (car q) (+ i (car p)))) ((<= delta i)) 
      (vector-set! sieve i #f)))) 

     (define (next) ; next prime after current prime 
     (when (= pos delta) (advance)) 
     (let ((p (+ bottom pos pos 1))) 
      (if (and (vector-ref sieve pos) (or (< p limit2) 
       (and (strong-pseudoprime? p 2) (lucas-pseudoprime? p)))) 
       (begin (set! pos (+ pos 1)) p) 
       (begin (set! pos (+ pos 1)) (next))))) 

     (do ((pp (init low) (next)) binding ...) (test result ...) expr ...))) 

    ((do-primes (p) (binding ...) (test result ...) expr ...) 
    (do-primes (p 2) (binding ...) (test result ...) expr ...)))) 

Answer 1

为了得到正确的相位，你next-prime需要宏观输出中定义。这里是去了解的一种方式（用球拍测试）：

(define-syntax do-primes 
    (syntax-rules() 
    ((do-primes (p lo hi) (binding ...) (test res ...) exp ...) 
    (do-primes (p lo) (binding ...) ((or test (< hi p)) res ...) exp ...)) 
    ((do-primes (p lo) (binding ...) (test res ...) exp ...) 
    (let() 
     (define (prime? n) 
     ...) 
     (define (next-prime n) 
     ...) 
     (do ((p (next-prime (- lo 1)) (next-prime p)) binding ...) 
      (test res ...) 
     exp ...))) 
    ((do-primes (p) (binding ...) (test res ...) exp ...) 
    (do-primes (p 2) (binding ...) (test res ...) exp ...)))) 

这样一来，这个定义最局部范围内尽可能prime?和next-prime，而不是在你的宏定义吨重复的代码（因为1和3参数形式简单地重写为使用2参数形式）。