ONCE-ONLY

Showing 1-7 of 7 messages
ONCE-ONLY Vladimir Zolotykh 4/29/05 6:05 AM
Hi,

Let me ask you a question about ONCE-ONLY macro, which I've read in
Practical Common Lisp by Peter Seibel, chapter 8. Macros: Defining
Your Own. Do you think there is a way to explain how it works? The
idea is understandable (I would appreciate if you corrected me): (1)
macro can't be used standalone , only inside another macro, (2) its
purpose is to evaluate each form passed as argument only once and in
the proper order, (3) bind each result to the local variable and
inside the BODY argument of this macro (4) use this variable instead
the original macro parameter of the surrounding macro. Even my
explanation is clumsy, not to mention my understanding of what's going
on. However, the implemetation of the macro is (IMO) quite obscure.

Here is the macro itself

   (defmacro once-only ((&rest names) &body body)
     (let ((gensyms (loop repeat (length 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)))))

and its simple usage

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

What I wanted to say in (4) is that: inside DO-PRIMES we have END as
parameter, END as argument to ONCE-ONLY, and END inside the BODY
argument to ONCE-ONLY. First two as far as I can judge is the same but
the third is quite different, the last idea proved to be the most
difficult to comprehend. Would you mind helpting me here?

Thanks in advnace


--
Vladimir Zolotykh

Re: ONCE-ONLY informatimago 4/29/05 8:27 AM
"Vladimir Zolotykh" <gsm...@eurocom.od.ua> writes:

> Hi,
>
> Let me ask you a question about ONCE-ONLY macro, which I've read in
> Practical Common Lisp by Peter Seibel, chapter 8. Macros: Defining
> Your Own. Do you think there is a way to explain how it works? The
> idea is understandable (I would appreciate if you corrected me): (1)
> macro can't be used standalone , only inside another macro, (2) its
> purpose is to evaluate each form passed as argument only once and in
> the proper order, (3) bind each result to the local variable and
> inside the BODY argument of this macro (4) use this variable instead
> the original macro parameter of the surrounding macro. Even my
> explanation is clumsy, not to mention my understanding of what's going
> on. However, the implemetation of the macro is (IMO) quite obscure.
>
> Here is the macro itself
>
>    (defmacro once-only ((&rest names) &body body)
>      (let ((gensyms (loop repeat (length 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)))))

Do understand a macro, a good way is to macroexpand-1 it:

[1]> (defmacro once-only ((&rest names) &body body)


     (let ((gensyms (loop repeat (length 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)))))
ONCE-ONLY
[37]> (macroexpand-1 '(once-only (a b)  (list 'list a b)))
(LET ((#:G4083 (GENSYM)) (#:G4084 (GENSYM)))
 (LIST 'LET (LIST (LIST #:G4083 A) (LIST #:G4084 B))
  (LET ((A #:G4083) (B #:G4084)) (LIST 'LIST A B)))) ;
T

Unfortunately the use of anonymous gensyms doesn't help reading this.
Let's correct it:

[246]> (defmacro once-only ((&rest names) &body body)
     (let ((gensyms (loop for n in names collect (gensym (string n)))))


       `(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)))))
ONCE-ONLY
[41]> (macroexpand-1 '(once-only (a b)  (list 'list a b)))
(LET ((#:A4103 (GENSYM)) (#:B4104 (GENSYM)))
 (LIST 'LET (LIST (LIST #:A4103 A) (LIST #:B4104 B))
  (LET ((A #:A4103) (B #:B4104)) (LIST 'LIST A B)))) ;
T

Now we see that this macro expands to code that return a s-expression.

If you evaluate this s-expression you get what macros using once-only
get.  To do that, we remove "#:", and we add templates for the
arguments A and B:

[47]> (let ((A :A-template) (b :b-template))
 (LET ((A4103 (GENSYM)) (B4104 (GENSYM)))
 (LIST 'LET (LIST (LIST A4103 A) (LIST B4104 B))
  (LET ((A A4103) (B B4104)) (LIST 'LIST A B)))))

(LET ((#:G4109 :A-TEMPLATE) (#:G4110 :B-TEMPLATE)) (LIST #:G4109 #:G4110))


If you need this s-expression, you can use it in a function too.

[38]> (let ((a '(+ 1 2)) (b '(* 3 4))) (once-only (a b)  (list 'list a b)))
(LET ((#:G4087 (+ 1 2)) (#:G4088 (* 3 4))) (LIST #:G4087 #:G4088))

Macros ARE NOT restricted to other macros.  (Your point (1) is false).
THIS macro is rather designed to be used by other macros, but you can still
use it stand alone.  It's nice to be able to write code that generate code.

[39]> (list '/ 'pi 2)
(/ PI 2)


Ok, note how the code generated by the code generated by once-only
don't contain the names of the variables given to once-only.  That's
because what we're interested here in is the values of these variables
whose names were given to once-only. These values are the expressions
bound to the local variables.

Once-only made a trick, because it masked these variable holding
forms, by binding them to the name of the anonymous variable that will
hold the values of these forms, so the body could use the values
instead of the forms.

(LET ((#:G4083 (GENSYM)) (#:G4084 (GENSYM)))         ; generate names

 (LIST 'LET (LIST (LIST #:G4083 A) (LIST #:G4084 B)) ; generate code to evaluate
                                                     ; the form and bind to
                                                     ; variables named above

  (LET ((A #:G4083) (B #:G4084)) (LIST 'LIST A B)))) ; and rebind the variables
                     ; holding the forms to the name of the variable generated.

> and its simple usage
>
>    (defmacro do-primes ((var start end) &body body)
>      (once-only (start end)
>                `(do ((,var (next-prime ,start)
>                            (next-prime (1+ ,var))))
>                     ((> ,var ,end))
>                   ,@body)))
>
> What I wanted to say in (4) is that: inside DO-PRIMES we have END as
> parameter, END as argument to ONCE-ONLY, and END inside the BODY
> argument to ONCE-ONLY. First two as far as I can judge is the same but
> the third is quite different, the last idea proved to be the most
> difficult to comprehend.

Well, yes.  The third is a new lexical binding. Same name, new
variables.  But there's also a difference between the first and the
second: the first END is a binding in the macro do-primes. Eg, it
names a variable (parameter) of do-primes.  But the second is just a
value in the NAMES list. NAMES is like the first END, for the
once-only. But now, in once-only END is data.

The non evaluation of macro arguments transforms program into data.


> Would you mind helpting me here?

Try this rather:

[27]> (let ((n 1e9))
        (let ((a '(ext:! n)) (b '(incf n)))
         (once-only (a b) (list 'list a b a b a b)))

The expression a will be long to evaluate.  And since we want to
repeat its value several time in the resulting list, we sure don't
want to evaluate it twice...  The expression b changes the value of n,
which is used in the expression a.  Since the programmer wrote the
expression b once, we don't want to evaluate it twice or more, only
once (otherwise it'd be a loop construct).  Moreover we want to
evaluate them in the order given by the programmer, otherwise we would
return (ext:! (1+ n)) instead of (ext:! n) as the programmer
wrote. Hence the introduction of the anonymous local variables
generated by the code generated by once-only:

(LET ((#:G4049 (EXT:! 1.0E9)) (#:G4050 (+ 1 1)))
 (LIST #:G4049 #:G4050 #:G4049 #:G4050 #:G4049 #:G4050))

So your point (2) is not correctly formulated.  The purpose is to
evaluate the forms stored in the variables whose names are given.

(3) and (4) are correct.

--
__Pascal Bourguignon__                     http://www.informatimago.com/
Wanna go outside.
Oh, no! Help! I got outside!
Let me back inside!

Re: ONCE-ONLY Peter Seibel 4/29/05 3:31 PM
"Vladimir Zolotykh" <gsm...@eurocom.od.ua> writes:

> Hi,
>
> Let me ask you a question about ONCE-ONLY macro, which I've read in
> Practical Common Lisp by Peter Seibel, chapter 8. Macros: Defining
> Your Own. Do you think there is a way to explain how it works? The
> idea is understandable (I would appreciate if you corrected me): (1)
> macro can't be used standalone , only inside another macro,

Well, technically it *can* be used anywhere, but not necesarily to any
good effect. It's intended purpose is to be used within other macros.

Pascal gave a good walk-through of how this macro works. Let me just
say--mostly to folks who haven't looked at the book--that I presented
this macro in a sidebar more as a puzzle for the curious; I don't
really try to explain how it works and said so. Maybe someday--after I
finish building a Windows Lispbox--I'll write up something about how
it works and put it on the web.

-Peter

--
Peter Seibel                                     pe...@gigamonkeys.com

         Lisp is the red pill. -- John Fraser, comp.lang.lisp

Re: ONCE-ONLY Vladimir Zolotykh 4/30/05 4:14 AM
On Fri, 29 Apr 2005 17:27:35 +0200, Pascal Bourguignon  
<p...@informatimago.com> wrote:

[SKIP]


> Unfortunately the use of anonymous gensyms doesn't help reading this.
> Let's correct it:
>
> [246]> (defmacro once-only ((&rest names) &body body)
>      (let ((gensyms (loop for n in names collect (gensym (string n)))))
>        `(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)))))
> ONCE-ONLY
> [41]> (macroexpand-1 '(once-only (a b)  (list 'list a b)))
> (LET ((#:A4103 (GENSYM)) (#:B4104 (GENSYM)))
>  (LIST 'LET (LIST (LIST #:A4103 A) (LIST #:B4104 B))
>   (LET ((A #:A4103) (B #:B4104)) (LIST 'LIST A B)))) ;
> T
>
> Now we see that this macro expands to code that return a s-expression.
>
> If you evaluate this s-expression you get what macros using once-only

This is probably the key of my misunderstanding. You say "If you
evaluate this s-expression". Isn't this the job of the evaluator?
This additional level of evaluation proved quite surprising for me.  A
macro produces output (a list), if this list's CAR isn't a macro the
macroexpansion is done, no further processing is performed during
macroexpansion time, right? ONCE-ONLY (from your example) expands to a
list which doesn't contain macro name as its CAR(s). So at that moment
macroexpansion stopped and so did I, unable to solve the puzzle.
Where does this additional evaluation come from?

> get.  To do that, we remove "#:", and we add templates for the
> arguments A and B:
>
> [47]> (let ((A :A-template) (b :b-template))
>  (LET ((A4103 (GENSYM)) (B4104 (GENSYM)))
>  (LIST 'LET (LIST (LIST A4103 A) (LIST B4104 B))
>   (LET ((A A4103) (B B4104)) (LIST 'LIST A B)))))
>
> (LET ((#:G4109 :A-TEMPLATE) (#:G4110 :B-TEMPLATE)) (LIST #:G4109  
> #:G4110))
[SKIP]
--
Vladimir Zolotykh

Re: ONCE-ONLY informatimago 4/30/05 7:59 AM
"Vladimir Zolotykh" <gsm...@eurocom.od.ua> writes:

Either it doesn't come:

[45]> (let ((a :a-template) (b :b-template)) (once-only (a b)  (list 'list a b)))
(LET ((#:G4022 :A-TEMPLATE) (#:G4023 :B-TEMPLATE)) (LIST #:G4022 #:G4023))

[46]> (caadr (let ((a :a-template) (b :b-template)) (once-only (a b)  (list 'list a b))))
(#:G4026 :A-TEMPLATE)

or it comes because you copy-and-paste the result back to the REPL
(removing the #:):

[47]> (LET ((G4022 :A-TEMPLATE) (G4023 :B-TEMPLATE)) (LIST G4022 G4023))
(:A-TEMPLATE :B-TEMPLATE)

or you use eval:

[49]> (let ((a :a-template) (b :b-template)) (once-only (a b)  (list 'list a b)))
(LET ((#:G4030 :A-TEMPLATE) (#:G4031 :B-TEMPLATE)) (LIST #:G4030 #:G4031))
[50]> (eval *)
(:A-TEMPLATE :B-TEMPLATE)

or you return the result of once-only in another macro, and let the
macro-expansion mechanism evaluate when it expands this other macro.

[51]> (defmacro m (a b)  (once-only (a b)  (list 'list a b)))
M
[52]> (m :template-1 :template-2)
(:TEMPLATE-1 :TEMPLATE-2)

Here once-only is expanded at its macro-expansion time returning the
(meta) s-expression, which evaluated returns: (LET ((G4022
:A-TEMPLATE) (G4023 :B-TEMPLATE)) (LIST G4022 G4023)) This
s-expression is used by the macro M, is returned as is, but is
evaluated itself for the macroexansion of M (or DO-PRIMES).


To see it in action read CLHS about *MACROEXPAND-HOOK*.

(defun hook (expander form env)
    (format t "Now expanding: ~S~%" form)
    (LET ((EXPANSION (MULTIPLE-VALUE-LIST (funcall expander form env))))
      (FORMAT T "~&--> ~{~s~%~^    ~}~%" EXPANSION) (VALUES-LIST EXPANSION)))

(LET ((*MACROEXPAND-HOOK* (FUNCTION HOOK)))
  (PRINT :DEFMACRO-ONCE-ONLY)(TERPRI)


  (defmacro once-only ((&rest names) &body body)
    (let ((gensyms (loop for n in names collect (gensym (string n)))))
      `(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)))))
  (PRINT :COMPILE-ONCE-ONLY)(TERPRI)
  (COMPILE 'ONCE-ONLY)
  (PRINT :DEFMACRO-M)(TERPRI)
  (defmacro m (a b) (once-only (a b) (list 'list a b)))
  (PRINT :COMPILE-M)(TERPRI)
  (COMPILE 'M)
  (PRINT :EXECUTE-M)(TERPRI)
  (m :template-1 :template-2))

;; (the details of the output depend obviously on the implementation).
;; Note that the macroexpansion time occurs here while compiling
;; (because I forced compilation with clisp, otherwise clisp would
;; have do the macroexpansion time at execution time).  But the
;; macroexpansion of DEFMACRO is done at the execution time of the
;; REPL.


:DEFMACRO-ONCE-ONLY
Now expanding:
(DEFMACRO ONCE-ONLY ((&REST NAMES) &BODY BODY)
 (LET ((GENSYMS (LOOP FOR N IN NAMES COLLECT (GENSYM (STRING N)))))
  `(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)))))
-->
(LET NIL
 (EVAL-WHEN (COMPILE LOAD EVAL) (SYSTEM::REMOVE-OLD-DEFINITIONS 'ONCE-ONLY)
  (SYSTEM::%PUTD 'ONCE-ONLY
   (SYSTEM::MAKE-MACRO
    (FUNCTION ONCE-ONLY
     (LAMBDA (SYSTEM::<MACRO-FORM> SYSTEM::<ENV-ARG>)
      (DECLARE (CONS SYSTEM::<MACRO-FORM>)) (DECLARE (IGNORE SYSTEM::<ENV-ARG>))
      (IF (< (EXT:LIST-LENGTH-DOTTED SYSTEM::<MACRO-FORM>) 2)
       (SYSTEM::MACRO-CALL-ERROR SYSTEM::<MACRO-FORM>)
       (LET*
        ((#:G4330 (CADR SYSTEM::<MACRO-FORM>)) (#:G4331 #:G4330) (NAMES #:G4331)
         (BODY (CDDR SYSTEM::<MACRO-FORM>)))
        (BLOCK ONCE-ONLY
         (LET ((GENSYMS (LOOP FOR N IN NAMES COLLECT (GENSYM (STRING N)))))
          `(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))))))))))))
 (EVAL-WHEN (EVAL)
  (SYSTEM::%PUT 'ONCE-ONLY 'SYSTEM::DEFINITION
   (CONS
    '(DEFMACRO ONCE-ONLY ((&REST NAMES) &BODY BODY)
      (LET ((GENSYMS (LOOP FOR N IN NAMES COLLECT (GENSYM (STRING N)))))
       `(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)))))
    (EXT:THE-ENVIRONMENT))))
 'ONCE-ONLY)

Now expanding: (EXT:THE-ENVIRONMENT)
-->
(PROGN (EVAL-WHEN ((NOT EVAL)) (SYSTEM::%UNCOMPILABLE 'EXT:THE-ENVIRONMENT))
 (LET ((CUSTOM:*EVALHOOK* #'SYSTEM::%THE-ENVIRONMENT)) 0))


:COMPILE-ONCE-ONLY
Now expanding: (LOOP FOR N IN NAMES COLLECT (GENSYM (STRING N)))
-->
(MACROLET ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-ERROR)))
 (BLOCK NIL
  (LET ((#:G4348 NAMES))
   (PROGN
    (LET ((N NIL))
     (LET ((#:ACCULIST-VAR-4349 NIL))
      (MACROLET ((LOOP-FINISH NIL '(GO SYSTEM::END-LOOP)))
       (TAGBODY SYSTEM::BEGIN-LOOP (WHEN (ENDP #:G4348) (LOOP-FINISH))
        (SETQ N (CAR #:G4348))
        (PROGN
         (SETQ #:ACCULIST-VAR-4349
          (CONS (GENSYM (STRING N)) #:ACCULIST-VAR-4349)))
        (PSETQ #:G4348 (CDR #:G4348)) (GO SYSTEM::BEGIN-LOOP) SYSTEM::END-LOOP
        (MACROLET
         ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-WARN) '(GO SYSTEM::END-LOOP)))
         (RETURN-FROM NIL (SYSTEM::LIST-NREVERSE #:ACCULIST-VAR-4349)))))))))))

Now expanding: (LOOP-FINISH)
--> (GO SYSTEM::END-LOOP)

Now expanding:
`(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)))
-->
(LIST 'LET (LOOP FOR G IN GENSYMS COLLECT `(,G (GENSYM)))
 `(LIST 'LET (LIST ,@(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)))

Now expanding: (LOOP FOR G IN GENSYMS COLLECT `(,G (GENSYM)))
-->
(MACROLET ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-ERROR)))
 (BLOCK NIL
  (LET ((#:G4356 GENSYMS))
   (PROGN
    (LET ((G NIL))
     (LET ((#:ACCULIST-VAR-4357 NIL))
      (MACROLET ((LOOP-FINISH NIL '(GO SYSTEM::END-LOOP)))
       (TAGBODY SYSTEM::BEGIN-LOOP (WHEN (ENDP #:G4356) (LOOP-FINISH))
        (SETQ G (CAR #:G4356))
        (PROGN
         (SETQ #:ACCULIST-VAR-4357 (CONS `(,G (GENSYM)) #:ACCULIST-VAR-4357)))
        (PSETQ #:G4356 (CDR #:G4356)) (GO SYSTEM::BEGIN-LOOP) SYSTEM::END-LOOP
        (MACROLET
         ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-WARN) '(GO SYSTEM::END-LOOP)))
         (RETURN-FROM NIL (SYSTEM::LIST-NREVERSE #:ACCULIST-VAR-4357)))))))))))

Now expanding: (LOOP-FINISH)
--> (GO SYSTEM::END-LOOP)

Now expanding: `(,G (GENSYM))
--> (CONS G '((GENSYM)))

Now expanding:
`(LIST 'LET (LIST ,@(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))
-->
(LIST 'LIST ''LET
 (CONS 'LIST (LOOP FOR G IN GENSYMS FOR N IN NAMES COLLECT ``(,,G ,,N)))
 (CONS 'LET
  (CONS (LOOP FOR N IN NAMES FOR G IN GENSYMS COLLECT `(,N ,G)) BODY)))

Now expanding: (LOOP FOR G IN GENSYMS FOR N IN NAMES COLLECT ``(,,G ,,N))
-->
(MACROLET ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-ERROR)))
 (BLOCK NIL
  (LET ((#:G4364 GENSYMS))
   (PROGN
    (LET ((G NIL))
     (LET ((#:G4365 NIL))
      (LET NIL
       (LET ((N NIL))
        (LET ((#:ACCULIST-VAR-4366 NIL))
         (MACROLET ((LOOP-FINISH NIL '(GO SYSTEM::END-LOOP)))
          (TAGBODY (SETQ #:G4365 NAMES) SYSTEM::BEGIN-LOOP
           (WHEN (ENDP #:G4364) (LOOP-FINISH)) (SETQ G (CAR #:G4364))
           (WHEN (ENDP #:G4365) (LOOP-FINISH)) (SETQ N (CAR #:G4365))
           (PROGN
            (SETQ #:ACCULIST-VAR-4366 (CONS ``(,,G ,,N) #:ACCULIST-VAR-4366)))
           (PSETQ #:G4364 (CDR #:G4364)) (PSETQ #:G4365 (CDR #:G4365))
           (GO SYSTEM::BEGIN-LOOP) SYSTEM::END-LOOP
           (MACROLET
            ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-WARN)
              '(GO SYSTEM::END-LOOP)))
            (RETURN-FROM NIL
             (SYSTEM::LIST-NREVERSE #:ACCULIST-VAR-4366))))))))))))))

Now expanding: (LOOP-FINISH)
--> (GO SYSTEM::END-LOOP)

Now expanding: (LOOP-FINISH)
--> (GO SYSTEM::END-LOOP)

Now expanding: ``(,,G ,,N)
--> `(LIST ,G ,N)

Now expanding: `(LIST ,G ,N)
--> (LIST 'LIST G N)

Now expanding: (LOOP FOR N IN NAMES FOR G IN GENSYMS COLLECT `(,N ,G))
-->
(MACROLET ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-ERROR)))
 (BLOCK NIL
  (LET ((#:G4374 NAMES))
   (PROGN
    (LET ((N NIL))
     (LET ((#:G4375 NIL))
      (LET NIL
       (LET ((G NIL))
        (LET ((#:ACCULIST-VAR-4376 NIL))
         (MACROLET ((LOOP-FINISH NIL '(GO SYSTEM::END-LOOP)))
          (TAGBODY (SETQ #:G4375 GENSYMS) SYSTEM::BEGIN-LOOP
           (WHEN (ENDP #:G4374) (LOOP-FINISH)) (SETQ N (CAR #:G4374))
           (WHEN (ENDP #:G4375) (LOOP-FINISH)) (SETQ G (CAR #:G4375))
           (PROGN
            (SETQ #:ACCULIST-VAR-4376 (CONS `(,N ,G) #:ACCULIST-VAR-4376)))
           (PSETQ #:G4374 (CDR #:G4374)) (PSETQ #:G4375 (CDR #:G4375))
           (GO SYSTEM::BEGIN-LOOP) SYSTEM::END-LOOP
           (MACROLET
            ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-WARN)
              '(GO SYSTEM::END-LOOP)))
            (RETURN-FROM NIL
             (SYSTEM::LIST-NREVERSE #:ACCULIST-VAR-4376))))))))))))))

Now expanding: (LOOP-FINISH)
--> (GO SYSTEM::END-LOOP)

Now expanding: (LOOP-FINISH)
--> (GO SYSTEM::END-LOOP)

Now expanding: `(,N ,G)
--> (LIST N G)


:DEFMACRO-M
Now expanding: (DEFMACRO M (A B) (ONCE-ONLY (A B) (LIST 'LIST A B)))
-->
(LET NIL
 (EVAL-WHEN (COMPILE LOAD EVAL) (SYSTEM::REMOVE-OLD-DEFINITIONS 'M)
  (SYSTEM::%PUTD 'M
   (SYSTEM::MAKE-MACRO
    (FUNCTION M
     (LAMBDA (SYSTEM::<MACRO-FORM> SYSTEM::<ENV-ARG>)
      (DECLARE (CONS SYSTEM::<MACRO-FORM>)) (DECLARE (IGNORE SYSTEM::<ENV-ARG>))
      (IF (/= (EXT:LIST-LENGTH-DOTTED SYSTEM::<MACRO-FORM>) 3)
       (SYSTEM::MACRO-CALL-ERROR SYSTEM::<MACRO-FORM>)
       (LET* ((A (CADR SYSTEM::<MACRO-FORM>)) (B (CADDR SYSTEM::<MACRO-FORM>)))
        (BLOCK M (ONCE-ONLY (A B) (LIST 'LIST A B))))))))))
 (EVAL-WHEN (EVAL)
  (SYSTEM::%PUT 'M 'SYSTEM::DEFINITION
   (CONS '(DEFMACRO M (A B) (ONCE-ONLY (A B) (LIST 'LIST A B)))
    (EXT:THE-ENVIRONMENT))))
 'M)

Now expanding: (EXT:THE-ENVIRONMENT)
-->
(PROGN (EVAL-WHEN ((NOT EVAL)) (SYSTEM::%UNCOMPILABLE 'EXT:THE-ENVIRONMENT))
 (LET ((CUSTOM:*EVALHOOK* #'SYSTEM::%THE-ENVIRONMENT)) 0))


:COMPILE-M
Now expanding: (ONCE-ONLY (A B) (LIST 'LIST A B))
-->
(LET ((#:A4400 (GENSYM)) (#:B4401 (GENSYM)))
 (LIST 'LET (LIST (LIST #:A4400 A) (LIST #:B4401 B))
  (LET ((A #:A4400) (B #:B4401)) (LIST 'LIST A B))))


:EXECUTE-M
Now expanding: (M :TEMPLATE-1 :TEMPLATE-2)
--> (LET ((#:G4404 :TEMPLATE-1) (#:G4405 :TEMPLATE-2)) (LIST #:G4404 #:G4405))

(:TEMPLATE-1 :TEMPLATE-2)
[73]>


--
__Pascal Bourguignon__                     http://www.informatimago.com/
You're always typing.
Well, let's see you ignore my
sitting on your hands.

Re: ONCE-ONLY Vladimir Zolotykh 5/1/05 2:39 AM
On Sat, 30 Apr 2005 16:59:00 +0200, Pascal Bourguignon  
<p...@informatimago.com> wrote:

> or you return the result of once-only in another macro, and let the
> macro-expansion mechanism evaluate when it expands this other macro.

Thank you, Pascal, for your elaborate explanation, now I venture to
say I got it. Although the macro still remains a bit tricky, there
isn't any mystery around it anymore. I found that I didn't understand
quite a vital point about macros, e.g. as I expressed it (wrongly)
"additional level of evaluation".  If someone before the ONCE-ONLY
study showed me two macros

   cl-user(1): (defmacro list1 (x) `(list ,x))
   list1
   cl-user(2): (defmacro list2 (x) (list1 x))
   list2

and asked what the expansion for (list1 10) and (list2 10) would be, I
would probably answer "both the same (list 10)". This of course would
have been a wrong answer because the second returns just (10). You
probably see now what I meant when I was talking about "additional
level". I don't actually know where does this delusion come from,
maybe because of my long usage of C, m4, etc. prior Lisp.


--
Vladimir Zolotykh

Re: ONCE-ONLY mac 5/1/05 1:48 PM
I found this blog entry from Bill Clementson quite helpful
http://home.comcast.net/~bc19191/blog/041205.html

Peter's example uses two set of gensyms. The values of the first set of
symbols contain the names of the second list of symbols.

The following example, however, only use one set of gensyms.
I found it easier to understand.

(defmacro once-only (variables &rest body)
  (let ((temps nil))
    (dotimes (i (length variables)) (push (gensym) temps))
    ``(let
          (,,@(mapcar #'(lambda (tmp var)
                          ``(,',tmp ,,var))
                      temps variables))
          ,(let ,(mapcar #'(lambda (var tmp) `(,var ',tmp))
                         variables temps)
             .,body))))

HTH
-nsr