once-only macro in Common Lisp

once-only.lisp

(defmacro once-only ((&rest names) &body body) 
  (let ((gensyms (loop for n in names collect (gensym)))) 
    `(let (,@(loop for g in gensyms collect `(,g (gensym)))) 
      `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n))) 
        ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g))) 
           ,@body)))))

(defmacro do-primes ((var start end) &body body) 
  (once-only (start end) 
    `(do ((,var (next-prime ,start) (next-prime (1+ ,var)))) 
         ((> ,var ,end)) 
       ,@body)))

(do-primes (i 1 (+ 100 1)) (format t "~d~%" i))

;; Let's see how it is expaned
(let ((gensyms '(#:G200 #:G201)))
  `(let (,@(loop for g in gensyms collect `(,g (gensym))))
     `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n)))
	,(let (,@(loop for n in names for g in gensyms collect `(,n ,g)))
	      ,@body))))

;; Well, CL has not (unquote ...) form, quasiquote is handled at reader level.
;; I borrowed the idea from Scheme to help me understand the expansion process.
(let ((#:G200 #:G300)) (#:G201 #:G301))
  `(let ((unquote `(,#:G200 ,start) `(,#:G201 ,end)))
     ,(let ((start #:G300) (end #:G301))
	   `(do ((,var (next-prime ,start) (next-prime (1+ ,var))))
		((> ,var ,end))
	      ,@body))))

;; This is the final result
(let ((#:G300 1) (#:G301 (+ 1 100)))
  (do ((i (next-prime #:G300) (next-prime (1+ i))))
      ((> i #:G301))
    (format t "~d~%" i)))