(FILECREATED "11-Jun-86 12:05:32" {ERIS}<DANIELS>CML>CMLDEFFER.;1 15019
changes to: (FUNCTIONS DEF-DEFINE-TYPE)
previous date: " 6-Jun-86 01:51:04" {ERIS}<LISPCORE>LIBRARY>CMLDEFFER.;34)
(* 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 expand-WITHOUT-FILEPKG expand-DEFDEFINER)))))
(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)))
(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 LOAD)
(SETF (SYMBOL-FUNCTION (QUOTE (\, CMACRONAME)))
(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 expand-WITHOUT-FILEPKG expand-DEFDEFINER)
)
(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)))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS CMLDEFFER COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1394 3316 (PPRINT-DEFINER 1404 . 2854) (\DEFINE-TYPE-GETDEF 2856 . 3314)) (3435 6053 (
expand-DEFDEFINER 3445 . 5088) (expand-WITHOUT-FILEPKG 5090 . 6051)))))
STOP