Синтаксис цитирования в макросах схемы

Question

Я пытаюсь написать макрос схемы, который перебирает простые числа. Вот простой вариант макроса:

(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)) 

То, что я хочу сделать, это написать версию do-primes макроса, который использует локальную версию функции next-prime; Я хочу сделать это, потому что я могу сделать функцию 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 макроса будет использовать сегментированное сито для небольших простых чисел и перейти к Бейли-Вагстафф-псевдопримный тест для больших простых чисел.) Но это не работает; Я получаю сообщение об ошибке, сообщающее мне, что я пытаюсь «ссылаться на не-фазовый идентификатор next-prime». Я понимаю проблему. Но моего макронного волшебства недостаточно для его решения.

Может ли кто-нибудь показать мне, как написать макрос do-primes?

EDIT: Вот окончательный макрос:

(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-аргументные формы просто переписываются для использования формы с двумя аргументами).