(FILECREATED "15-May-86 23:27:06" {ERIS}<LISPCORE>LIBRARY>CMLDESTRUCT.;8
 2381   

      changes to:  (VARS CMLDESTRUCTCOMS)
                   (FNS EXPAND-DESTRUCTURING-BIND)

      previous date: "22-Apr-86 12:56:30" {ERIS}<LISPCORE>LIBRARY>CMLDESTRUCT.;4)


(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT CMLDESTRUCTCOMS)

(RPAQQ CMLDESTRUCTCOMS
 ((MACROS DESTRUCTURING-BIND DESTRUCTURING-SETQ)
                        (FNS EXPAND-DESTRUCTURING-BIND)))
(DECLARE: EVAL@COMPILE 

(DEFMACRO DESTRUCTURING-BIND
 (PATTERN FORM &BODY BODY &ENVIRONMENT ENV)
   (EXPAND-DESTRUCTURING-BIND PATTERN FORM BODY ENV))


(DEFMACRO DESTRUCTURING-SETQ
 (VARS VALUE)
   [if
 (NULL VARS)
       then
 VALUE
     elseif
 (NLISTP VARS)
       then
 (BQUOTE (SETQ (\, VARS)
                     (\, VALUE)))
     elseif
 (NULL (CDR VARS))
       then
 [BQUOTE (DESTRUCTURING-SETQ (\, (CAR VARS))
                           (CAR (\, VALUE]
     elseif
 (LISTP VALUE)
       then
 [LET ((DV (GENSYM)))
                 (BQUOTE (LET (((\, DV)
                                (\, VALUE)))
                              (DESTRUCTURING-SETQ (\, (CAR VARS))
                                     (CAR (\, DV)))
                              (DESTRUCTURING-SETQ (\, (CDR VARS))
                                     (CDR (\, DV]
     else
 (BQUOTE (PROGN (DESTRUCTURING-SETQ (\, (CAR VARS))
                                (CAR (\, VALUE)))
                         (DESTRUCTURING-SETQ (\, (CDR VARS))
                                (CDR (\, VALUE])

)
(DEFINEQ

(EXPAND-DESTRUCTURING-BIND

  [LAMBDA (PATTERN FORM BODY ENVIRONMENT)
                    (* "Pavel" "15-May-86 23:26")

          
          (* * 

          "A compiled function so that circularity of MULTIPLE-VALUE-BIND isn't caught")


    (LET ((WHOLE-VAR (GENSYM)))
         (MULTIPLE-VALUE-BIND (CODE DECLARATIONS)
                (PARSE-DEFMACRO PATTERN WHOLE-VAR BODY (QUOTE DESTRUCTURING-BIND)
                       :PATH WHOLE-VAR :CURRENT-ENV ENVIRONMENT :DOC-STRING-ALLOWED NIL)
                (BQUOTE (LET (((\, WHOLE-VAR)
                               (\, FORM)))
                             (\,@ DECLARATIONS)
                             (\, CODE])
)
(PUTPROPS CMLDESTRUCT COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1603 2299 (EXPAND-DESTRUCTURING-BIND 1613 . 2297)))))
STOP