I wrote this program that uses the macros nota and ping, nota to allow me to define a note easier and ping to compress in only one line of code(the ones starting with ping) what I would do in three lines in the commented section(to send it through the loudspeaker).
The problem is that the two macros appear to not work together and I get the arity mismatch error:
stream-time: arity mismatch;
the expected number of arguments does not match the given number
expected: 0
given: 2
arguments.:
#
#
I tried with define and define-syntax and it doesn't work.
#lang racket
(provide (all-defined-out))
(require rsound)
(define-syntax-rule (nota x y)
(define x
(network ()
[sunet <= sine-wave y]
[out = (+ sunet)])))
(define-syntax-rule (ping y)
(
(signal-play y)
(sleep 0.25)
(stop)))
(nota E2 82)
(nota F#2 92)
(nota G2 98)
(nota A2 110)
(ping E2)
(ping F#2)
(ping E2)
(ping G2)
(ping E2)
(ping A2)
;(signal-play E2)
;(sleep 0.25)
;(stop)
;(signal-play F#2)
;(sleep 0.25)
;(stop)
;(signal-play G2)
;(sleep 0.25)
;(stop)
;(signal-play A2)
;(sleep 0.25)
;(stop)
ping is missing a begin to group the 3 forms:
(define-syntax-rule (ping y)
(begin
(signal-play y)
(sleep 0.25)
(stop)))
then the macro stepper shows that your code is expanded to
(define E2 (network () [sunet <= sine-wave 82] [out = (+ sunet)]))
(define F#2 (network () [sunet <= sine-wave 92] [out = (+ sunet)]))
(define G2 (network () [sunet <= sine-wave 98] [out = (+ sunet)]))
(define A2 (network () [sunet <= sine-wave 110] [out = (+ sunet)]))
(begin (signal-play E2) (sleep 0.25) (stop))
(begin (signal-play F#2) (sleep 0.25) (stop))
(begin (signal-play E2) (sleep 0.25) (stop))
(begin (signal-play G2) (sleep 0.25) (stop))
(begin (signal-play E2) (sleep 0.25) (stop))
(begin (signal-play A2) (sleep 0.25) (stop))))
Related
I'm trying to make macros for defining various object similar to defparameter and defvar. The defregion1 macro works: upon executing it defines a variable with object region. However, defregion2 only returns an expression that must be executed manually. Here is the code:
(defclass location ()
((x
:initarg :x
:accessor x)
(y
:initarg :y
:accessor y)))
(defclass region ()
((x :initarg :x
:accessor x)
(y :initarg :y
:accessor y)
(w :initarg :w
:accessor w)
(h :initarg :h
:accessor h)))
(defmacro deflocation (var x y)
`(defparameter ,var `(make-instance 'location :x ,x :y ,y)))
(defmacro defregion1 (var x y w h)
`(defparameter ,(intern (symbol-name var))
(make-instance 'region :x ,x :y ,y :w ,w :h ,h)))
(defmacro defregion2 (var l1 l2)
`(with-slots ((x1 x) (y1 y))
,l1
(with-slots ((x2 x) (y2 y))
,l2
`(defparameter ,(intern (symbol-name ,var))
(make-instance 'region
:x ,x1 :y ,y1 :w (- ,x2 ,x1) :h (- ,y2 ,y1))))))
The output of defregion1:
(defregion1 *test-reg1* 1 2 3 4)
=> *test-reg1*
The output of deferegion2:
(deflocation *l1* 20 30)
(deflocation *l2* 50 60)
(defregion2 '*test-reg2* *l1* *l2*)
=> (DEFPARAMETER *TEST-REG2*
(MAKE-INSTANCE 'REGION :X 20 :Y 30 :W (- 50 20) :H (- 60 30)))
I want *test-reg2* to also become a variable. What is wrong here?
You have two nested backquotes.
But your macro is also inside-out: you really want defparameter at the top-level, so something like this would be better:
(defmacro defregion2 (var l1 l2)
`(defparameter ,(intern (symbol-name ,var))
(with-slots ((x1 x) (y1 y))
,l1
(with-slots ((x2 x) (y2 y))
,l2
(make-instance 'region :x x1 :y y1 :w (- x2 x1) :h (- y2 y1))))))
Also are you sure you want this slightly odd internery? What that's going to do is take the name of the symbol you give as an argument and intern it in the current package. So for instance
(defregion2 x:*foo* ...)
will result in a symbol *foo* in the current package, instead of giving a value to x:*foo*. (Of course this all collapses into the same thing if the current package is x).
I suspect you possibly want
(defmacro defregion2 (var l1 l2)
`(defparameter ,var
(with-slots ((x1 x) (y1 y))
,l1
(with-slots ((x2 x) (y2 y))
,l2
(make-instance 'region :x x1 :y y1 :w (- x2 x1) :h (- y2 y1))))))
Your code is also potentially unhygenic as it binds variables (really symbol macros) with names which are visible to whatever l2 is: it would be safer as
(defmacro defregion2 (var l1 l2)
`(defparameter ,var
(let ((l1 ,l1) (l2 ,l2))
(with-slots ((x1 x) (y1 y))
l1
(with-slots ((x2 x) (y2 y))
l2
(make-instance 'region :x x1 :y y1 :w (- x2 x1) :h (- y2 y1)))))))
This is now safe as you can see from the expansion:
(defregion2 *thing*
(expression-involving x1 x2)
(another-expression-involving x1 x2))
expands to
(defparameter *thing*
(let ((l1 (expression-involving x1 x2))
(l2 (another-expression-involving x1 x2)))
(with-slots ((x1 x) (x2 y)) l1
(with-slots ((x2 x) (y2 y)) l2
(make-instance 'region :x x1 :y y1 :w (- x2 x1) :h (- y2 y1))))))
You can see that the x1 in (another-expression-involving x1 ...) is not the one that is bound by with-slots.
In the Little Typer chapter 2 frame 100 gives the following definition:
(claim pearwise+
(→ Pear Pear
Pear))
(define pearwise+
(λ (anjou bosc)
(elim-Pear anjou
(λ (a1 d1)
(elim-Pear bosc
(λ (a2 d2)
(cons
(+ a1 a2)
(+ d1 d2))))))))
When I run it I get the following error:
Unknown variable +
What is wrong?
Pie does not ship out of the box with an addition function but chapter 3 frames 24, 26, and 27 of the Little Typer give the following definition for +:
; 3.26
(claim step-+
(→ Nat
Nat))
(define step-+
(λ (+n-1)
(add1 +n-1)))
; 3.24
(claim +
(→ Nat Nat
Nat))
; 3.27
(define +
(λ (n j)
(iter-Nat n
j
step-+)))
Put these before the definition of pairwise+ to use + in the definition.
The complete solution would look like this:
#lang pie
; 2.80
(claim Pear U)
(define Pear
(Pair Nat Nat))
; 2.82
(check-same Pear (cons 3 5) (cons 3 (add1 4)))
; 2.93
(claim Pear-maker U)
(define Pear-maker
(→ Nat Nat
Pear))
(claim elim-Pear
(→ Pear Pear-maker
Pear))
(define elim-Pear
(λ (pear maker)
(maker (car pear) (cdr pear))))
; 2.95
(check-same (Pair Nat Nat)
(cons 17 3)
(elim-Pear
(cons 3 17)
(λ (a d)
(cons d a))))
;----------------------
; need to add + define
; taken from chapter 3
;----------------------
; 3.26
(claim step-+
(→ Nat
Nat))
(define step-+
(λ (+n-1)
(add1 +n-1)))
; 3.24
(claim +
(→ Nat Nat
Nat))
; 3.27
(define +
(λ (n j)
(iter-Nat n
j
step-+)))
; 2.100
(claim pearwise+
(→ Pear Pear
Pear))
(define pearwise+
(λ (anjou bosc)
(elim-Pear anjou
(λ (a1 d1)
(elim-Pear bosc
(λ (a2 d2)
(cons
(+ a1 a2)
(+ d1 d2))))))))
(check-same Pear
(cons 3 4)
(pearwise+
(cons 1 2)
(cons 2 2)))
I found a general memoization from here, which makes fib much faster by
(define (memoize fn)
(let ((cache (make-hash)))
(λ arg (hash-ref! cache arg (thunk (apply fn arg))))))
(define fib
(memoize
(lambda (n)
(if (< n 2) n (+ (fib (sub1 n)) (fib (- n 2)))))))
I tried to implement the interleaving string question in Racket in natural recursion as
(define (is-interleave-rec s1 s2 s3)
(if (eq? (+ (string-length s1) (string-length s2))
(string-length s3))
(aux-rec s1 0 s2 0 s3 0)
#f))
(define (aux-rec s1 p1 s2 p2 s3 p3)
(cond
[(eq? p3 (string-length s3)) #t]
[(eq? p1 (string-length s1))
(equal? (substring s2 p2) (substring s3 p3))]
[(eq? p2 (string-length s2))
(equal? (substring s1 p1) (substring s3 p3))]
[(and (eq? (string-ref s1 p1) (string-ref s3 p3))
(eq? (string-ref s2 p2) (string-ref s3 p3)))
(or (aux-rec s1 (add1 p1) s2 p2 s3 (add1 p3))
(aux-rec s1 p1 s2 (add1 p2) s3 (add1 p3)))]
[(eq? (string-ref s1 p1) (string-ref s3 p3))
(aux-rec s1 (add1 p1) s2 p2 s3 (add1 p3))]
[(eq? (string-ref s2 p2) (string-ref s3 p3))
(aux-rec s1 p1 s2 (add1 p2) s3 (add1 p3))]
[else #f]))
And then a memoization version
(define (is-interleave-mem s1 s2 s3)
(if (eq? (+ (string-length s1) (string-length s2))
(string-length s3))
(aux-mem s1 0 s2 0 s3 0)
#f))
(define aux-mem
(memoize
(λ (s1 p1 s2 p2 s3 p3)
(cond
[(eq? p3 (string-length s3)) #t]
[(eq? p1 (string-length s1))
(equal? (substring s2 p2) (substring s3 p3))]
[(eq? p2 (string-length s2))
(equal? (substring s1 p1) (substring s3 p3))]
[(and (eq? (string-ref s1 p1) (string-ref s3 p3))
(eq? (string-ref s2 p2) (string-ref s3 p3)))
(or (aux-mem s1 (add1 p1) s2 p2 s3 (add1 p3))
(aux-mem s1 p1 s2 (add1 p2) s3 (add1 p3)))]
[(eq? (string-ref s1 p1) (string-ref s3 p3))
(aux-mem s1 (add1 p1) s2 p2 s3 (add1 p3))]
[(eq? (string-ref s2 p2) (string-ref s3 p3))
(aux-mem s1 p1 s2 (add1 p2) s3 (add1 p3))]
[else #f]))))
To my surprise, the memoization version is slower, testing case was
(define as (make-string 10000 #\a))
(define zs (make-string 10000 #\z))
(define bs (make-string 10000 #\b))
(define az (string-append as zs))
(define abz (string-append as bs zs))
(time (is-interleave-rec az bs abz))
(time (is-interleave-mem az bs abz))
The result would be
cpu time: 4 real time: 4 gc time: 0
#t
cpu time: 5333 real time: 5348 gc time: 67
#t
I thought the reason would be there're so many parameters for the hash table, I was wondering if maybe we could improve it?
I changed the code as follows:
(define allcalls 0)
(define memcalls 0)
(define (memoize fn)
(let ((cache (make-hash)))
(λ arg
(set! allcalls (add1 allcalls))
(hash-ref! cache arg
(thunk
(set! memcalls (add1 memcalls))
(apply fn arg))))))
to track how many times aux-mem is called, and how many times it has to call the underlying procedure.
Adding a
(displayln allcalls)
(displayln memcalls)
at the end I get
cpu time: 2 real time: 2 gc time: 0
#t
cpu time: 7046 real time: 7040 gc time: 30
#t
20001
20001
meaning that aux-mem is never called twice with the same arguments.
So your memoïzation is totally ineffective (after all, the point of memoïzing is to return a result that has already been asked for and therefore computed earlier) and all it does here is adding overhead.
I am trying to write a Scheme function that takes in a list of letters, hashes them with another function, multiplies each one iteratively by 5^i, and sums them together. I am new to Scheme and this is what I have written:
(define (key w)
keyhelper w 0)
(define (keyhelper w i)
(cond ((null? w) '())
(else (+ (* (hashchar(car w) (expt 5 i)) (keyhelper(cdr w) (+ i 1)))))))
So for example, doing (key '(h e l l o)) should do hashchar(h)*5^0 + hashchar(e)*5^1 + hashchar(l)^5^2 ... etc. The function is only returning 0 for any list that is sent in. Could anyone please tell me where I am going wrong?
My implementation of hashchar is:
(define hashchar
(lambda (x)
(cond
((eq? x 'a) 1)
((eq? x 'b) 2)
((eq? x 'c) 3)
((eq? x 'd) 4)
((eq? x 'e) 5)
((eq? x 'f) 6)
((eq? x 'g) 7)
((eq? x 'h) 8)
((eq? x 'i) 9)
((eq? x 'j) 10)
((eq? x 'k) 11)
((eq? x 'l) 12)
((eq? x 'm) 13)
((eq? x 'n) 14)
((eq? x 'o) 15)
((eq? x 'p) 16)
((eq? x 'q) 17)
((eq? x 'r) 18)
((eq? x 's) 19)
((eq? x 't) 20)
((eq? x 'u) 21)
((eq? x 'v) 22)
((eq? x 'w) 23)
((eq? x 'x) 24)
((eq? x 'y) 25)
((eq? x 'z) 26))))
key returns zero all the time because you defined it that way. You had:
(define (key w)
keyhelper
w
0)
thus, it evaluates keyhelper (discarding its value), then w (discarding its value), then 0 (returning its value). So the answer is always 0.
You should instead define it this way:
(define (key w)
(keyhelper w 0))
Notice the extra parentheses.
Also, the base-case value for keyhelper is wrong. It shouldn't be '(), it should be i.
If your definition of hashchar is similar to this one:
(define (hash:hash-char-ci char n)
(modulo (char->integer (char-downcase char)) n))
(define hash:hash-char hash:hash-char-ci)
Then hashchar will return 0 when i = 0 is passed to (expt 5 i) because (expt 5 i) is one, and the one-modulo of any integer is zero.
Once you multiply zero into your hash function, then you'll always get zero out...since + isn't doing anything but returning identity because it is only passed one argument:
(* (hashchar(car w) (expt 5 i)) (keyhelper(cdr w) (+ i 1)))
Maybe string-hash is a better choice of library function?
I am trying to write a Scheme macro that loops over the prime numbers. Here is a simple version of the macro:
(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 ...))))
The do-primes macro expands to a do with three possible syntaxes: if the first argument to do-primes is (p lo hi) then the do loops over the primes from lo to hi unless iteration is stopped early by the termination clause, if the first argument to do-primes is (p lo) then the do loops over the primes starting from lo and continuing until the termination clause stops the iteration, and if the first argument to do-primes is (p) then the do loops over the primes starting from 2 and continuing until the termination clause stops the iteration. Here are some sample uses of the do-primes macro:
; 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))
What I want to do is write a version of the do-primes macro that uses a local version of the next-prime function; I want to do that because I can make the next-prime function run faster than my general-purpose next-prime function because I know the environment in which it will be called. I tried to write the macro like this:
(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 ...))))))))
(Ignore the prime? and next-prime functions, which are there only for illustration. The real version of the do-primes macro will use a segmented sieve for small primes and switch to a Baillie-Wagstaff pseudoprime test for larger primes.) But that doesn't work; I get an error message telling me that that I am trying "to reference out-of-phase identifier next-prime." I understand the problem. But my macrology wizardry is insufficient to solve it.
Can someone show me how to write the do-primes macro?
EDIT: Here is the final macro:
(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 ...))))
To get correct phasing, your next-prime needs to defined within the macro output. Here's one way to go about it (tested with Racket):
(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 ...))))
This way, this defines the prime? and next-prime in the most local scope possible, while not having tons of duplicate code in your macro definition (since the 1- and 3-argument forms are simply rewritten to use the 2-argument form).