(FILECREATED "25-May-86 00:21:28" {ERIS}<LISPCORE>EVAL>CMLDESTRUCT.;1
 2502   

      changes to:  (VARS CMLDESTRUCTCOMS)
                   (PROPS (CMLDESTRUCT FILETYPE))

      previous date: "17-May-86 01:14:25" {ERIS}<LISPCORE>LIBRARY>CMLDESTRUCT.;10)


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

(PRETTYCOMPRINT CMLDESTRUCTCOMS)

(RPAQQ CMLDESTRUCTCOMS
 ((MACROS DESTRUCTURING-BIND DESTRUCTURING-SETQ)
                        (FNS EXPAND-DESTRUCTURING-BIND)
                        (PROP FILETYPE CMLDESTRUCT)))
(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" "16-May-86 19:05")

          
          (* * 

          "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)
                       ENVIRONMENT :PATH WHOLE-VAR :DOC-STRING-ALLOWED NIL)
                (BQUOTE (LET (((\, WHOLE-VAR)
                               (\, FORM)))
                             (\,@ DECLARATIONS)
                             (\, CODE])
)

(PUTPROPS CMLDESTRUCT FILETYPE
 COMPILE-FILE)
(PUTPROPS CMLDESTRUCT COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1691 2370 (EXPAND-DESTRUCTURING-BIND 1701 . 2368)))))
STOP