;;;; additif au corrige 8 ;;; une version de exactly SANS #' et funcall (defmacro exactly-7 (n &body exprs) (let* ((delays (mapcar #'(lambda (e) (list (gensym) '() e)) exprs)) (calls (mapcar #'(lambda (d) (list (car d))) delays))) `(flet ,delays (exactly-3 ,n ,@calls)))) ;;;; question 1; (macroexpand-1 '(setf (car l) 90)) (macroexpand-1 '(setf (third l) 90)) (macroexpand-1 '(multiple-value-bind (x y) ((+ x y) (- x y)))) (macroexpand-1 '(defstruct point (x 0) (y 0))) ;;;; diff macroexpand-1 macroexpand (defmacro my-cond (&body body) `(cond ,@body)) (macroexpand-1 `(my-cond (A B) (C D) (T E))) (macroexpand `(my-cond (A B) (C D) (T E))) ;;;; (defun circ (l) (nconc l l)) (defmacro def-circular-iterator (function-name liste) "(def-circular-iterator name l) define name as a parameterless function which enumerates ad-infinitum the elements of l" (let ((list-name (gensym))) `(let ((,list-name (circ (copy-list ,liste)))) ; (defun ,function-name () (prog1 (car ,list-name) (setf ,list-name (cdr ,list-name))))))) (def-circular-iterator next-note '(do re mi fa sol la si)) (next-note) ; -> DO ; etc ... ;;; amelioration (defmacro with-circular-iterator (function-name liste &body body) "(with-circular-iterator name l &body body) evaluates body with name bound to a circular iterator of l" (let ((list-name (gensym))) `(let ((,list-name (circ (copy-list ,liste)))) (flet ((,function-name () (prog1 (car ,list-name) (setf ,list-name (cdr ,list-name))))) ,@body)))) (with-circular-iterator G '(do re mi fa) (defun une-note () (G))) (une-note) ; -> DO (une-note) ; -> RE (with-circular-iterator G '(do re mi fa) (let ((l '())) (dotimes (i 578 l) (push (G) l)))) ;;;; question on donne une version sans gensym : trouver la defaillance ! (defmacro buggy-with-circular-iterator (function-name liste &body body) "(with-circular-iterator name l &body body) evaluates body with name bound to a circular iterator of l" `(let ((l (circ (copy-list ,liste)))) (flet ((,function-name () (prog1 (car l) (setf l (cdr l)))))) ,@body)) (let ((l '(do re mi fa sol la si))) (with-circular-iterator it l (defun une-note () (it)) l)) ; bien ; (let ((l '(do re mi fa sol la si))) ; (buggy-with-circular-iterator it l ; (defun une-note () (it)) ; l)) ; pas bien (on peut interrrompre par Control-C ; (Control-Q control-C sous emacs)