(FILECREATED "11-Jun-86 21:08:47" {ERIS}<LISPCORE>LIBRARY>CMLDEFFER.;38
 13792  

      changes to:  (FUNCTIONS DEFUN DEFMACRO)

      previous date: "11-Jun-86 12:05:32" {ERIS}<LISPCORE>LIBRARY>CMLDEFFER.;37)


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

(PRETTYCOMPRINT CMLDEFFERCOMS)

(RPAQQ CMLDEFFERCOMS
 ((COMS (INITVARS (FILEPKGFLG))
                            (COMS (FNS PPRINT-DEFINER \DEFINE-TYPE-GETDEF)))
                      (PROP MACRO-FN DEFDEFINER WITHOUT-FILEPKG)
                      (FNS expand-DEFDEFINER expand-WITHOUT-FILEPKG)
                      (ADDVARS (FILEPKGTYPES DEFINE-TYPES FUNCTIONS))
                      (FUNCTIONS DEFDEFINER DEF-DEFINE-TYPE WITHOUT-FILEPKG)
                      (DEFINE-TYPES DEFINE-TYPES FUNCTIONS VARIABLES)
                      (FUNCTIONS DEFUN DEFMACRO CL:DEFMACRO DEFVAR DEFPARAMETER DEFCONSTANT)
                      (PROP FILEPKGCONTENTS FUNCTIONS)
                      (* don't note file package changes to MACRO-FN)
                      (PROP PROPTYPE MACRO-FN)
                      (PROP FILETYPE CMLDEFFER)
                      (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                                          (NLAML)
                                                                                          (LAMA)))))

(RPAQ? FILEPKGFLG
 )
(DEFINEQ

(PPRINT-DEFINER

  (LAMBDA (DEFINE-EXPRESSION)
                                (* lmm "24-May-86 15:10")

    (LET ((DEFINER (pop
 DEFINE-EXPRESSION))
          (DEFINED (pop
 DEFINE-EXPRESSION))
          (CURRENT (DSPXPOSITION))
          (#RPARS))
         (DECLARE
 (SPECVARS #RPARS))
         (PRINTOUT NIL "(" .P2 DEFINER %,)
         (if
 (LISTP DEFINED)
             then
 (PRINTOUT NIL "(" .FONT PRETTYCOMFONT .P2 (CAR DEFINED)
                         .FONT DEFAULTFONT %, # (PRINTDEF (CDR DEFINED)
                                                       T T T)
                         ")")
           else
 (PRINTOUT NIL .FONT PRETTYCOMFONT .P2 DEFINED .FONT DEFAULTFONT))
         (if
 (LISTP (CAR DEFINE-EXPRESSION))
             then
 (SPACES 1)
                  (PRINTDEF (pop
 DEFINE-EXPRESSION)
                         T NIL))
         (if
 (OR (STRINGP (CAR DEFINE-EXPRESSION))
                 (EQ (CAR (LISTP (CAR DEFINE-EXPRESSION)))
                     COMMENTFLG))
             then
 (SPACES 1)
                  (PRINTDEF (pop
 DEFINE-EXPRESSION)
                         T T))
         (if
 (NOT (FITP DEFINE-EXPRESSION T T))
             then
 (TERPRI)
                  (DSPXPOSITION CURRENT)
                  (SPACES 3)
           else
 (SPACES 1))
         (PROGN (PRINTDEF DEFINE-EXPRESSION T T T)
                (PRIN1 ")" NIL)
                (TERPRI NIL)))))

(\DEFINE-TYPE-GETDEF

  (LAMBDA (ITEM TYPE OPTIONS)
                                (* lmm " 5-Jun-86 03:22")

          
          (* GETDEF method for all definers. The EDIT is so that when you say EDITDEF you 

          get a copy & can know when you made edits)


    (AND (SYMBOLP ITEM)
         (COND
            ((EQMEMB (QUOTE EDIT)
                    OPTIONS)
             (COPY (GET ITEM TYPE)))
            (T (GET ITEM TYPE))))))
)

(PUTPROPS DEFDEFINER MACRO-FN
 expand-DEFDEFINER)

(PUTPROPS WITHOUT-FILEPKG MACRO-FN
 expand-WITHOUT-FILEPKG)
(DEFINEQ

(expand-DEFDEFINER

  (LAMBDA ($$MACRO-FORM $$MACRO-ENVIRONMENT)
                 (* lmm "30-May-86 16:51")

    (CL:DECLARE (IGNORE $$MACRO-ENVIRONMENT))
    (CL:BLOCK
     DEFDEFINER
     (LET*
      ((A0225 (CDR $$MACRO-FORM))
       (%%ORIGINAL-DEFINITION $$MACRO-FORM)
       (NAME (CAR A0225))
       (A0226 (CDR A0225))
       (TYPE (CAR A0226))
       (A0227 (CDR A0226))
       (ARGLIST (CAR A0227))
       (A0228 (CDR A0227))
       (BODY A0228))
      (BQUOTE
       (PROGN
        (WITHOUT-FILEPKG
         (\,
          (PROGN
           (BQUOTE
            (PROGN
             (DEFMACRO (\,
 NAME) (&WHOLE %%ORIGINAL-DEFINITION (\,@ ARGLIST))
                (BQUOTE (PROGN (WITHOUT-FILEPKG (\, (PROGN (\,@ BODY))))
                               (\,@ (AND FILEPKGFLG (BQUOTE
                                                     ((EVAL-WHEN (CL:EVAL)
                                                             (PUTPROPS (\, NAME)
                                                                    (\, (QUOTE (\, TYPE)))
                                                                    (\, %%ORIGINAL-DEFINITION)))))))
                               (QUOTE (\, NAME)))))

             (WITHOUT-FILEPKG (ADDTOVAR PRETTYPRINTMACROS ((\, NAME) . PPRINT-DEFINER)))
             (QUOTE (\, NAME)))))))
        (\,@ (AND FILEPKGFLG (BQUOTE ((EVAL-WHEN (CL:EVAL)
                                             (PUTPROPS (\, NAME)
                                                    (\, (QUOTE FUNCTIONS))
                                                    (\, %%ORIGINAL-DEFINITION)))))))
        (QUOTE (\, NAME))))))))

(expand-WITHOUT-FILEPKG

  (LAMBDA ($$MACRO-FORM $$MACRO-ENVIRONMENT)
    (DECLARE
 (IGNORE $$MACRO-ENVIRONMENT))
                   (* lmm "30-May-86 17:07")

    (CL:BLOCK WITHOUT-FILEPKG (LET* ((A3574 (CDR $$MACRO-FORM))
                                     (BODY A3574))
                                    (BQUOTE (PROGN (EVAL-WHEN (LOAD)
                                                          (\,@ BODY))
                                                   (EVAL-WHEN (CL:EVAL)
                                                          (AND (NEQ DFNFLG (QUOTE PROP))
                                                               (LET (FILEPKGFLG (DFNFLG T))
                                                                    (DECLARE
 (SPECIAL FILEPKGFLG 
                                                                                    DFNFLG))
                                                                    (\,@ BODY))))))))))
)

(ADDTOVAR FILEPKGTYPES
 DEFINE-TYPES FUNCTIONS)
(DEFDEFINER DEFDEFINER

   FUNCTIONS (NAME TYPE ARGLIST &BODY BODY)
         (BQUOTE (PROGN (DEFMACRO (\,
 NAME) (&WHOLE %%ORIGINAL-DEFINITION (\,@ ARGLIST))
                           (BQUOTE (PROGN (WITHOUT-FILEPKG (\, (PROGN (\,@ BODY))))
                                          (EVAL-WHEN (CL:EVAL)
                                                 (AND FILEPKGFLG (PUTPROPS (\, NAME)
                                                                        (\, (QUOTE (\, TYPE)))
                                                                        (\, %%ORIGINAL-DEFINITION))))
                                          (QUOTE (\, NAME)))))

                        (WITHOUT-FILEPKG (ADDTOVAR PRETTYPRINTMACROS ((\, NAME) . PPRINT-DEFINER)))
                        (QUOTE (\, NAME)))))

(DEFDEFINER DEF-DEFINE-TYPE

   DEFINE-TYPES (NAME DESCRIPTION)
         (BQUOTE (PROGN                                      (* This definition is a hokey way of 

                                                             defining a file package type that 

                                                             works even before the file package is 

                                                             loaded)

                        (ADDTOVAR PRETTYDEFMACROS
                               ((\, NAME)
                                X
                                (P *
 (MAPCAR (QUOTE X)
                                            (FUNCTION (LAMBDA (ITEM)
                                                        (CL:DO ((DEF (GET ITEM (QUOTE (\, NAME)))))
                                                               (DEF DEF)
                                                               (CERROR "Re-fetch the definition" 
                                                                      "No ~S definition for ~S"
                                                                      (QUOTE (\, NAME))
                                                                      ITEM))))))))
                        (ADDTOVAR PRETTYTYPELST ((\, (LET ((VAR (PACK* "CHANGED" NAME "LST")))
                                                          (OR (BOUNDP VAR)
                                                              (SET VAR))
                                                          VAR))
                                                 (\, NAME)
                                                 (\, DESCRIPTION)))
                        (ADDTOVAR FILEPKGTYPES (\, NAME))
                        (PUTPROPS (\, NAME)
                               GETDEF \DEFINE-TYPE-GETDEF)
                        (PUTPROPS (\, NAME)
                               FILEPKGCONTENTS NILL)
                        (PUTPROPS (\, NAME)
                               PROPTYPE
                               (\, NAME)))))

(DEFMACRO WITHOUT-FILEPKG
 (&BODY BODY) (BQUOTE (PROGN (EVAL-WHEN (CL:LOAD)
                                                             (\,@ BODY))
                                                      (EVAL-WHEN
                                                       (CL:EVAL)
                                                       (AND (NEQ DFNFLG (QUOTE PROP))
                                                            (LET (FILEPKGFLG (DFNFLG T))
                                                                 (DECLARE
 (SPECIAL FILEPKGFLG DFNFLG)
                                                                        )
                                                                 (\,@ BODY)))))))

(DEF-DEFINE-TYPE DEFINE-TYPES
 "Common Lisp definition type" )

(DEF-DEFINE-TYPE FUNCTIONS
 "Common Lisp functions" )

(DEF-DEFINE-TYPE VARIABLES
 "Common Lisp variables" )

(DEFDEFINER DEFUN
 FUNCTIONS (NAME ARGS &BODY (BODY DECLS DOCUMENTATION))
                        (BQUOTE (SETF (SYMBOL-FUNCTION (QUOTE (\, NAME)))
                                      (CL:FUNCTION (CL:LAMBDA (\, ARGS)
                                                          (\,@ DECLS)
                                                          (CL:BLOCK (\, NAME)
                                                                 (\,@ BODY)))))))

(DEFDEFINER DEFMACRO
 FUNCTIONS (NAME DEFMACRO-ARGS &BODY DEFMACRO-BODY)
                           (LET ((CMACRONAME (PACK* "expand-" NAME)))
                                (MULTIPLE-VALUE-BIND
                                 (PARSED-BODY PARSED-DECLARATIONS PARSED-DOCSTRING)
                                 (PARSE-DEFMACRO DEFMACRO-ARGS (QUOTE $$MACRO-FORM)
                                        DEFMACRO-BODY NAME NIL :ENVIRONMENT (QUOTE 
                                                                                  $$MACRO-ENVIRONMENT
                                                                                   ))
                                 (BQUOTE (EVAL-WHEN (CL:EVAL CL:COMPILE CL:LOAD)
                                                (SETF (SYMBOL-FUNCTION (QUOTE (\, CMACRONAME)))
                                                      (CL:FUNCTION (CL:LAMBDA ($$MACRO-FORM 
                                                                                  $$MACRO-ENVIRONMENT
                                                                                     )
                                                                          (\,@ PARSED-DECLARATIONS)
                                                                          (CL:BLOCK (\, NAME)
                                                                                 (\, PARSED-BODY)))))
                                                (SETF (MACRO-FUNCTION (QUOTE (\, NAME)))
                                                      (QUOTE (\, CMACRONAME))))))))

(DEFMACRO CL:DEFMACRO
 (&REST X) (CONS (QUOTE DEFMACRO)
                                      X))

(DEFDEFINER DEFVAR
 VARIABLES
                   (NAME &OPTIONAL (INITIAL-VALUE NIL IVP)
                         DOCUMENTATION)
                   (BQUOTE (PROGN (\,@ (if
 IVP
                                           then
 (BQUOTE ((OR (BOUNDP (QUOTE (\, NAME)))
                                                             (SETQ (\, NAME)
                                                              (\, INITIAL-VALUE)))))))
                                  (PROCLAIM (QUOTE (SPECIAL (\, NAME)))))))

(DEFDEFINER DEFPARAMETER
 VARIABLES (NAME INITIAL-VALUE &OPTIONAL DOCUMENTATION)
                               (BQUOTE (PROGN (SETQ (\, NAME)
                                               (\, INITIAL-VALUE))
                                              (PUT (QUOTE (\, NAME))
                                                   (QUOTE GLOBALVAR)
                                                   T))))

(DEFDEFINER DEFCONSTANT
 VARIABLES (NAME VALUE &OPTIONAL DOCUMENTATION)
                              (BQUOTE (PROGN (SETQ (\, NAME)
                                              (\, VALUE))
                                             (PUTHASH (QUOTE (\, NAME))
                                                    (QUOTE (CONSTANT (\, NAME)))
                                                    COMPVARMACROHASH))))


(PUTPROPS FUNCTIONS FILEPKGCONTENTS
 NILL)



(* don't note file package changes to MACRO-FN)



(PUTPROPS MACRO-FN PROPTYPE
 FUNCTIONS)

(PUTPROPS CMLDEFFER FILETYPE
 COMPILE-FILE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(PUTPROPS CMLDEFFER COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1437 3359 (PPRINT-DEFINER 1447 . 2897) (\DEFINE-TYPE-GETDEF 2899 . 3357)) (3478 6096 (
expand-DEFDEFINER 3488 . 5131) (expand-WITHOUT-FILEPKG 5133 . 6094)))))
STOP