[alexandria-devel] Adding ignorability to once-only

[John Fremlin]

Dear Alexandrians,

Thanks for your great library. However, consider this (on SBCL)

CL-USER>  (macrolet ((m (x) (alexandria:once-only (x) (declare (ignore x)) t))) (m t))
		
; in: LAMBDA NIL
;     (LET ((#:X871 T))
;       T)
; 
; caught STYLE-WARNING:
;   The variable #:X871 is defined but never used.
; 
; compilation unit finished
;   caught 1 STYLE-WARNING condition
T
CL-USER>  (macrolet ((m (x) (alexandria:once-only (x) `(locally (declare (ignorable ,x)) t)))) (m t))
		
; in: LAMBDA NIL
;     (LOCALLY (DECLARE (IGNORABLE #:X830)) T)
; 
; caught STYLE-WARNING:
;   declaring unknown variable #:X830 to be ignored

;     (LET ((#:X830 T))
;       (LOCALLY (DECLARE (IGNORABLE #:X830)) T))
; 
; caught STYLE-WARNING:
;   The variable #:X830 is defined but never used.


In complex macros sometimes it's nice to be able to declare a once-only
variable ignorable.

I've been using this version in my fast Lisp webserver. 
http://github.com/vii/teepeedee2/tree/master

(defun force-first (x) (if (listp x) (first x) x))
(defun force-rest (x) (when (listp x) (rest x)))

(defmacro once-only ((&rest names-and-decls) &body body)
  ;; Each name is already lexically bound to something in the macro M using once-only
  ;; For each NAME:
  ;; - Generate a unique symbol SYM with value a unique symbol SYM-VAL
  ;; - In the macro-expansion of M, bind SYM-VAL to the value of NAME
  ;; - For BODY, bind NAME to SYM

  ;; It is necessary to use the indirection SYM -> SYM-VAL so that a
  ;; new symbol will be created for each invocation of M, not just
  ;; for each invocation of once-only

    (let* ((names (mapcar 'force-first names-and-decls))
	 (declarations (mapcar 'force-rest names-and-decls))
	 (symbols (loop for name in names collect (gensym (string name)))))
    `(let ,(loop for symbol in symbols 
	      for name in names
	      collect `(,symbol (gensym ,(string name))))
       `(let ,(list ,@(loop for name in names
			 for symbol in symbols
			 collect `(list ,symbol ,name)))
	  ,@(list
	     ,@(loop for symbol in symbols for decl in declarations
		  append 
		    (loop for d in decl
		       collect ``(declare (,@,(if (listp d) d `(list `,',d)) ,,symbol)))))
	  ,(let ,(loop for symbol in symbols
		    for name in names
		    collect `(,name ,symbol))
		, at body)))))

I wrote this macro when I was quite unfamiliar with Lisp. I'm sure you
can think a better syntax and can improve it.

The result is syntax like this

CL-USER>  (macrolet ((m (x) (once-only ((x ignorable)) (declare (ignore x)) t))) (m t))
		
T