0.6.11.10:
[sbcl.git] / src / compiler / macros.lisp
index 1717b27..1efe6b2 100644 (file)
 
 (declaim (special *wild-type* *universal-type* *compiler-error-context*))
 
-;;; An INLINEP value describes how a function is called. The values have these
-;;; meanings:
-;;;    NIL     No declaration seen: do whatever you feel like, but don't dump
-;;;            an inline expansion.
+;;; An INLINEP value describes how a function is called. The values
+;;; have these meanings:
+;;;    NIL     No declaration seen: do whatever you feel like, but don't 
+;;;            dump an inline expansion.
 ;;; :NOTINLINE  NOTINLINE declaration seen: always do full function call.
-;;;    :INLINE INLINE declaration seen: save expansion, expanding to it if
-;;;            policy favors.
+;;;    :INLINE INLINE declaration seen: save expansion, expanding to it 
+;;;            if policy favors.
 ;;; :MAYBE-INLINE
 ;;;            Retain expansion, but only use it opportunistically.
 (deftype inlinep () '(member :inline :maybe-inline :notinline nil))
 \f
-;;;; the POLICY macro
-
-(defparameter *policy-parameter-slots*
-  '((speed . cookie-speed) (space . cookie-space) (safety . cookie-safety)
-    (cspeed . cookie-cspeed) (brevity . cookie-brevity)
-    (debug . cookie-debug)))
-
-;;; Find all the policy parameters which are actually mentioned in Stuff,
-;;; returning the names in a list. We assume everything is evaluated.
-(eval-when (:compile-toplevel :load-toplevel :execute)
-(defun find-used-parameters (stuff)
-  (if (atom stuff)
-      (if (assoc stuff *policy-parameter-slots*) (list stuff) ())
-      (collect ((res () nunion))
-       (dolist (arg (cdr stuff) (res))
-         (res (find-used-parameters arg))))))
-) ; EVAL-WHEN
-
-;;; This macro provides some syntactic sugar for querying the settings of
-;;; the compiler policy parameters.
-(defmacro policy (node &rest conditions)
-  #!+sb-doc
-  "Policy Node Condition*
-  Test whether some conditions apply to the current compiler policy for Node.
-  Each condition is a predicate form which accesses the policy values by
-  referring to them as the variables SPEED, SPACE, SAFETY, CSPEED, BREVITY and
-  DEBUG. The results of all the conditions are combined with AND and returned
-  as the result.
-
-  Node is a form which is evaluated to obtain the node which the policy is for.
-  If Node is NIL, then we use the current policy as defined by *DEFAULT-COOKIE*
-  and *CURRENT-COOKIE*. This option is only well defined during IR1
-  conversion."
-  (let* ((form `(and ,@conditions))
-        (n-cookie (gensym))
-        (binds (mapcar
-                #'(lambda (name)
-                    (let ((slot (cdr (assoc name *policy-parameter-slots*))))
-                      `(,name (,slot ,n-cookie))))
-                (find-used-parameters form))))
-    `(let* ((,n-cookie (lexenv-cookie
-                       ,(if node
-                            `(node-lexenv ,node)
-                            '*lexenv*)))
-           ,@binds)
-       ,form)))
-\f
 ;;;; source-hacking defining forms
 
-;;; Passed to PARSE-DEFMACRO when we want compiler errors instead of real
-;;; errors.
+;;; to be passed to PARSE-DEFMACRO when we want compiler errors
+;;; instead of real errors
 #!-sb-fluid (declaim (inline convert-condition-into-compiler-error))
 (defun convert-condition-into-compiler-error (datum &rest stuff)
   (if (stringp datum)
                          (apply #'make-condition datum stuff)
                          datum))))
 
-;;; Parse DEFMACRO-style lambda-list, setting things up so that a
+;;; Parse a DEFMACRO-style lambda-list, setting things up so that a
 ;;; compiler error happens if the syntax is invalid.
+;;;
+;;; Define a function that converts a special form or other magical
+;;; thing into IR1. LAMBDA-LIST is a defmacro style lambda list.
+;;; START-VAR and CONT-VAR are bound to the start and result
+;;; continuations for the resulting IR1. KIND is the function kind to
+;;; associate with NAME.
 (defmacro def-ir1-translator (name (lambda-list start-var cont-var
                                                &key (kind :special-form))
                                   &body body)
-  #!+sb-doc
-  "Def-IR1-Translator Name (Lambda-List Start-Var Cont-Var {Key Value}*)
-                     [Doc-String] Form*
-  Define a function that converts a Special-Form or other magical thing into
-  IR1. Lambda-List is a defmacro style lambda list. Start-Var and Cont-Var
-  are bound to the start and result continuations for the resulting IR1.
-  This keyword is defined:
-      Kind
-         The function kind to associate with Name (default :special-form)."
   (let ((fn-name (symbolicate "IR1-CONVERT-" name))
        (n-form (gensym))
        (n-env (gensym)))
                       (error "can't FUNCALL the SYMBOL-FUNCTION of ~
                               special forms")))))))))
 
-;;; Similar to DEF-IR1-TRANSLATOR, except that we pass if the syntax is
-;;; invalid.
+;;; (This is similar to DEF-IR1-TRANSLATOR, except that we pass if the
+;;; syntax is invalid.)
+;;;
+;;; Define a macro-like source-to-source transformation for the
+;;; function NAME. A source transform may "pass" by returning a
+;;; non-nil second value. If the transform passes, then the form is
+;;; converted as a normal function call. If the supplied arguments are
+;;; not compatible with the specified LAMBDA-LIST, then the transform
+;;; automatically passes.
+;;;
+;;; Source transforms may only be defined for functions. Source
+;;; transformation is not attempted if the function is declared
+;;; NOTINLINE. Source transforms should not examine their arguments.
+;;; If it matters how the function is used, then DEFTRANSFORM should
+;;; be used to define an IR1 transformation.
+;;;
+;;; If the desirability of the transformation depends on the current
+;;; OPTIMIZE parameters, then the POLICY macro should be used to
+;;; determine when to pass.
 (defmacro def-source-transform (name lambda-list &body body)
-  #!+sb-doc
-  "Def-Source-Transform Name Lambda-List Form*
-  Define a macro-like source-to-source transformation for the function Name.
-  A source transform may \"pass\" by returning a non-nil second value. If the
-  transform passes, then the form is converted as a normal function call. If
-  the supplied arguments are not compatible with the specified lambda-list,
-  then the transform automatically passes.
-
-  Source-Transforms may only be defined for functions. Source transformation
-  is not attempted if the function is declared Notinline. Source transforms
-  should not examine their arguments. If it matters how the function is used,
-  then Deftransform should be used to define an IR1 transformation.
-
-  If the desirability of the transformation depends on the current Optimize
-  parameters, then the Policy macro should be used to determine when to pass."
   (let ((fn-name
         (if (listp name)
             (collect ((pieces))
             ,body))
         (setf (info :function :source-transform ',name) #',fn-name)))))
 
+;;; Define a function that converts a use of (%PRIMITIVE NAME ..)
+;;; into Lisp code. LAMBDA-LIST is a DEFMACRO-style lambda list.
 (defmacro def-primitive-translator (name lambda-list &body body)
-  #!+sb-doc
-  "DEF-PRIMITIVE-TRANSLATOR Name Lambda-List Form*
-  Define a function that converts a use of (%PRIMITIVE Name ...) into Lisp
-  code. Lambda-List is a DEFMACRO-style lambda list."
   (let ((fn-name (symbolicate "PRIMITIVE-TRANSLATE-" name))
        (n-form (gensym))
        (n-env (gensym)))
 \f
 ;;;; DEFTRANSFORM
 
-;;; Parse the lambda-list and generate code to test the policy and
-;;; automatically create the result lambda.
+;;; Define an IR1 transformation for NAME. An IR1 transformation
+;;; computes a lambda that replaces the function variable reference
+;;; for the call. A transform may pass (decide not to transform the
+;;; call) by calling the GIVE-UP-IR1-TRANSFORM function. LAMBDA-LIST
+;;; both determines how the current call is parsed and specifies the
+;;; LAMBDA-LIST for the resulting lambda.
+;;;
+;;; We parse the call and bind each of the lambda-list variables to
+;;; the continuation which represents the value of the argument. When
+;;; parsing the call, we ignore the defaults, and always bind the
+;;; variables for unsupplied arguments to NIL. If a required argument
+;;; is missing, an unknown keyword is supplied, or an argument keyword
+;;; is not a constant, then the transform automatically passes. The
+;;; DECLARATIONS apply to the bindings made by DEFTRANSFORM at
+;;; transformation time, rather than to the variables of the resulting
+;;; lambda. Bound-but-not-referenced warnings are suppressed for the
+;;; lambda-list variables. The DOC-STRING is used when printing
+;;; efficiency notes about the defined transform.
+;;;
+;;; Normally, the body evaluates to a form which becomes the body of
+;;; an automatically constructed lambda. We make LAMBDA-LIST the
+;;; lambda-list for the lambda, and automatically insert declarations
+;;; of the argument and result types. If the second value of the body
+;;; is non-null, then it is a list of declarations which are to be
+;;; inserted at the head of the lambda. Automatic lambda generation
+;;; may be inhibited by explicitly returning a lambda from the body.
+;;;
+;;; The ARG-TYPES and RESULT-TYPE are used to create a function type
+;;; which the call must satisfy before transformation is attempted.
+;;; The function type specifier is constructed by wrapping (FUNCTION
+;;; ...) around these values, so the lack of a restriction may be
+;;; specified by omitting the argument or supplying *. The argument
+;;; syntax specified in the ARG-TYPES need not be the same as that in
+;;; the LAMBDA-LIST, but the transform will never happen if the
+;;; syntaxes can't be satisfied simultaneously. If there is an
+;;; existing transform for the same function that has the same type,
+;;; then it is replaced with the new definition.
+;;;
+;;; These are the legal keyword options:
+;;;   :RESULT - A variable which is bound to the result continuation.
+;;;   :NODE   - A variable which is bound to the combination node for the call.
+;;;   :POLICY - A form which is supplied to the POLICY macro to determine
+;;;             whether this transformation is appropriate. If the result
+;;;             is false, then the transform automatically gives up.
+;;;   :EVAL-NAME
+;;;           - The name and argument/result types are actually forms to be
+;;;             evaluated. Useful for getting closures that transform similar
+;;;             functions.
+;;;   :DEFUN-ONLY
+;;;           - Don't actually instantiate a transform, instead just DEFUN
+;;;             Name with the specified transform definition function. This
+;;;             may be later instantiated with %DEFTRANSFORM.
+;;;   :IMPORTANT
+;;;           - If supplied and non-NIL, note this transform as ``important,''
+;;;             which means efficiency notes will be generated when this
+;;;             transform fails even if INHIBIT-WARNINGS=SPEED (but not if
+;;;             INHIBIT-WARNINGS>SPEED).
+;;;   :WHEN {:NATIVE | :BYTE | :BOTH}
+;;;           - Indicates whether this transform applies to native code,
+;;;             byte-code or both (default :native.)
 (defmacro deftransform (name (lambda-list &optional (arg-types '*)
                                          (result-type '*)
                                          &key result policy node defun-only
                                          eval-name important (when :native))
                             &body body-decls-doc)
-  #!+sb-doc
-  "Deftransform Name (Lambda-List [Arg-Types] [Result-Type] {Key Value}*)
-              Declaration* [Doc-String] Form*
-  Define an IR1 transformation for NAME. An IR1 transformation computes a
-  lambda that replaces the function variable reference for the call. A
-  transform may pass (decide not to transform the call) by calling the
-  GIVE-UP-IR1-TRANSFORM function. LAMBDA-LIST both determines how the
-  current call is parsed and specifies the LAMBDA-LIST for the resulting
-  lambda.
-
-  We parse the call and bind each of the lambda-list variables to the
-  continuation which represents the value of the argument. When parsing
-  the call, we ignore the defaults, and always bind the variables for
-  unsupplied arguments to NIL. If a required argument is missing, an
-  unknown keyword is supplied, or an argument keyword is not a constant,
-  then the transform automatically passes. The DECLARATIONS apply to the
-  bindings made by DEFTRANSFORM at transformation time, rather than to
-  the variables of the resulting lambda. Bound-but-not-referenced
-  warnings are suppressed for the lambda-list variables. The DOC-STRING
-  is used when printing efficiency notes about the defined transform.
-
-  Normally, the body evaluates to a form which becomes the body of an
-  automatically constructed lambda. We make LAMBDA-LIST the lambda-list
-  for the lambda, and automatically insert declarations of the argument
-  and result types. If the second value of the body is non-null, then it
-  is a list of declarations which are to be inserted at the head of the
-  lambda. Automatic lambda generation may be inhibited by explicitly
-  returning a lambda from the body.
-
-  The ARG-TYPES and RESULT-TYPE are used to create a function type
-  which the call must satisfy before transformation is attempted. The
-  function type specifier is constructed by wrapping (FUNCTION ...)
-  around these values, so the lack of a restriction may be specified by
-  omitting the argument or supplying *. The argument syntax specified in
-  the ARG-TYPES need not be the same as that in the LAMBDA-LIST, but the
-  transform will never happen if the syntaxes can't be satisfied
-  simultaneously. If there is an existing transform for the same
-  function that has the same type, then it is replaced with the new
-  definition.
-
-  These are the legal keyword options:
-    :Result - A variable which is bound to the result continuation.
-    :Node   - A variable which is bound to the combination node for the call.
-    :Policy - A form which is supplied to the POLICY macro to determine whether
-             this transformation is appropriate. If the result is false, then
-             the transform automatically passes.
-    :Eval-Name
-           - The name and argument/result types are actually forms to be
-             evaluated. Useful for getting closures that transform similar
-             functions.
-    :Defun-Only
-           - Don't actually instantiate a transform, instead just DEFUN
-             Name with the specified transform definition function. This may
-             be later instantiated with %DEFTRANSFORM.
-    :Important
-           - If supplied and non-NIL, note this transform as ``important,''
-             which means efficiency notes will be generated when this
-             transform fails even if brevity=speed (but not if brevity>speed)
-    :When {:Native | :Byte | :Both}
-           - Indicates whether this transform applies to native code,
-             byte-code or both (default :native.)"
-
   (when (and eval-name defun-only)
     (error "can't specify both DEFUN-ONLY and EVAL-NAME"))
   (multiple-value-bind (body decls doc) (parse-body body-decls-doc)
 ;;;
 ;;; FIXME: DEFKNOWN is needed only at build-the-system time. Figure
 ;;; out some way to keep it from appearing in the target system.
+;;;
+;;; Declare the function NAME to be a known function. We construct a
+;;; type specifier for the function by wrapping (FUNCTION ...) around
+;;; the ARG-TYPES and RESULT-TYPE. ATTRIBUTES is an unevaluated list
+;;; of boolean attributes of the function. These attributes are
+;;; meaningful here:
+;;;
+;;;     CALL
+;;;        May call functions that are passed as arguments. In order
+;;;        to determine what other effects are present, we must find
+;;;        the effects of all arguments that may be functions.
+;;;
+;;;     UNSAFE
+;;;        May incorporate arguments in the result or somehow pass
+;;;        them upward.
+;;;
+;;;     UNWIND
+;;;        May fail to return during correct execution. Errors
+;;;        are O.K.
+;;;
+;;;     ANY
+;;;        The (default) worst case. Includes all the other bad
+;;;        things, plus any other possible bad thing.
+;;;
+;;;     FOLDABLE
+;;;        May be constant-folded. The function has no side effects,
+;;;        but may be affected by side effects on the arguments. E.g.
+;;;        SVREF, MAPC.
+;;;
+;;;     FLUSHABLE
+;;;        May be eliminated if value is unused. The function has
+;;;        no side effects except possibly CONS. If a function is
+;;;        defined to signal errors, then it is not flushable even
+;;;        if it is movable or foldable.
+;;;
+;;;     MOVABLE
+;;;        May be moved with impunity. Has no side effects except
+;;;        possibly CONS, and is affected only by its arguments.
+;;;
+;;;     PREDICATE
+;;;         A true predicate likely to be open-coded. This is a
+;;;         hint to IR1 conversion that it should ensure calls always
+;;;         appear as an IF test. Not usually specified to DEFKNOWN,
+;;;         since this is implementation dependent, and is usually
+;;;         automatically set by the DEFINE-VOP :CONDITIONAL option.
+;;;
+;;; NAME may also be a list of names, in which case the same
+;;; information is given to all the names. The keywords specify the
+;;; initial values for various optimizers that the function might
+;;; have.
 (defmacro defknown (name arg-types result-type &optional (attributes '(any))
                         &rest keys)
-  #!+sb-doc
-  "Defknown Name Arg-Types Result-Type [Attributes] {Key Value}*
-  Declare the function Name to be a known function. We construct a type
-  specifier for the function by wrapping (FUNCTION ...) around the Arg-Types
-  and Result-Type. Attributes is an unevaluated list of boolean
-  attributes of the function. These attributes are meaningful here:
-      call
-        May call functions that are passed as arguments. In order
-        to determine what other effects are present, we must find
-        the effects of all arguments that may be functions.
-
-      unsafe
-        May incorporate arguments in the result or somehow pass
-        them upward.
-
-      unwind
-        May fail to return during correct execution. Errors
-        are O.K.
-
-      any
-        The (default) worst case. Includes all the other bad
-        things, plus any other possible bad thing.
-
-      foldable
-        May be constant-folded. The function has no side effects,
-        but may be affected by side effects on the arguments. E.g.
-        SVREF, MAPC.
-
-      flushable
-        May be eliminated if value is unused. The function has
-        no side effects except possibly CONS. If a function is
-        defined to signal errors, then it is not flushable even
-        if it is movable or foldable.
-
-      movable
-        May be moved with impunity. Has no side effects except
-        possibly CONS,and is affected only by its arguments.
-
-      predicate
-         A true predicate likely to be open-coded. This is a
-         hint to IR1 conversion that it should ensure calls always
-         appear as an IF test. Not usually specified to Defknown,
-         since this is implementation dependent, and is usually
-         automatically set by the Define-VOP :Conditional option.
-
-  Name may also be a list of names, in which case the same information
-  is given to all the names. The keywords specify the initial values
-  for various optimizers that the function might have."
   (when (and (intersection attributes '(any call unwind))
             (intersection attributes '(movable)))
     (error "function cannot have both good and bad attributes: ~S" attributes))
                                    attributes))
              ,@keys))
 
-;;; Create a function which parses combination args according to 
-;;; LAMBDA-LIST, optionally storing it in a FUNCTION-INFO slot.
+;;; Create a function which parses combination args according to WHAT
+;;; and LAMBDA-LIST, where WHAT is either a function name or a list
+;;; (FUNCTION-NAME KIND) and does some KIND of optimization.
+;;;
+;;; The FUNCTION-NAME must name a known function. LAMBDA-LIST is used
+;;; to parse the arguments to the combination as in DEFTRANSFORM. If
+;;; the argument syntax is invalid or there are non-constant keys,
+;;; then we simply return NIL.
+;;;
+;;; The function is DEFUN'ed as FUNCTION-KIND-OPTIMIZER. Possible
+;;; kinds are DERIVE-TYPE, OPTIMIZER, LTN-ANNOTATE and IR2-CONVERT. If
+;;; a symbol is specified instead of a (FUNCTION KIND) list, then we
+;;; just do a DEFUN with the symbol as its name, and don't do anything
+;;; with the definition. This is useful for creating optimizers to be
+;;; passed by name to DEFKNOWN.
+;;;
+;;; If supplied, NODE-VAR is bound to the combination node being
+;;; optimized. If additional VARS are supplied, then they are used as
+;;; the rest of the optimizer function's lambda-list. LTN-ANNOTATE
+;;; methods are passed an additional POLICY argument, and IR2-CONVERT
+;;; methods are passed an additional IR2-BLOCK argument.
 (defmacro defoptimizer (what (lambda-list &optional (n-node (gensym))
                                          &rest vars)
                             &body body)
-  #!+sb-doc
-  "Defoptimizer (Function Kind) (Lambda-List [Node-Var] Var*)
-               Declaration* Form*
-  Define some Kind of optimizer for the named Function. Function must be a
-  known function. Lambda-List is used to parse the arguments to the
-  combination as in Deftransform. If the argument syntax is invalid or there
-  are non-constant keys, then we simply return NIL.
-
-  The function is DEFUN'ed as Function-Kind-OPTIMIZER. Possible kinds are
-  DERIVE-TYPE, OPTIMIZER, LTN-ANNOTATE and IR2-CONVERT. If a symbol is
-  specified instead of a (Function Kind) list, then we just do a DEFUN with the
-  symbol as its name, and don't do anything with the definition. This is
-  useful for creating optimizers to be passed by name to DEFKNOWN.
-
-  If supplied, Node-Var is bound to the combination node being optimized. If
-  additional Vars are supplied, then they are used as the rest of the optimizer
-  function's lambda-list. LTN-ANNOTATE methods are passed an additional POLICY
-  argument, and IR2-CONVERT methods are passed an additional IR2-BLOCK
-  argument."
-
   (let ((name (if (symbolp what) what
                  (symbolicate (first what) "-" (second what) "-OPTIMIZER"))))
 
 \f
 ;;;; IR groveling macros
 
+;;; Iterate over the blocks in a component, binding BLOCK-VAR to each
+;;; block in turn. The value of ENDS determines whether to iterate
+;;; over dummy head and tail blocks:
+;;;    NIL  -- Skip Head and Tail (the default)
+;;;   :HEAD -- Do head but skip tail
+;;;   :TAIL -- Do tail but skip head
+;;;   :BOTH -- Do both head and tail
+;;;
+;;; If supplied, RESULT-FORM is the value to return.
 (defmacro do-blocks ((block-var component &optional ends result) &body body)
   #!+sb-doc
-  "Do-Blocks (Block-Var Component [Ends] [Result-Form]) {Declaration}* {Form}*
-  Iterate over the blocks in a component, binding Block-Var to each block in
-  turn. The value of Ends determines whether to iterate over dummy head and
-  tail blocks:
-    NIL   -- Skip Head and Tail (the default)
-    :Head -- Do head but skip tail
-    :Tail -- Do tail but skip head
-    :Both -- Do both head and tail
-
-  If supplied, Result-Form is the value to return."
   (unless (member ends '(nil :head :tail :both))
     (error "losing ENDS value: ~S" ends))
   (let ((n-component (gensym))
         (values (cdr ,n-res) t)
         (values nil nil))))
 \f
-;;; These functions are called by the expansion of the DEFPRINTER
-;;; macro to do the actual printing.
-(declaim (ftype (function (symbol t stream &optional t) (values))
-               defprinter-prin1 defprinter-princ))
-(defun defprinter-prin1 (name value stream &optional indent)
-  (declare (ignore indent))
-  (defprinter-prinx #'prin1 name value stream))
-(defun defprinter-princ (name value stream &optional indent)
-  (declare (ignore indent))
-  (defprinter-prinx #'princ name value stream))
-(defun defprinter-prinx (prinx name value stream)
-  (declare (type function prinx))
-  (write-char #\space stream)
-  (when *print-pretty*
-    (pprint-newline :linear stream))
-  (format stream ":~A " name)
-  (funcall prinx value stream)
-  (values))
-
-;; Define some kind of reasonable PRINT-OBJECT method for a STRUCTURE-OBJECT.
-;;
-;; NAME is the name of the structure class, and CONC-NAME is the same as in
-;; DEFSTRUCT.
-;;
-;; The SLOT-DESCS describe how each slot should be printed. Each SLOT-DESC can
-;; be a slot name, indicating that the slot should simply be printed. A
-;; SLOT-DESC may also be a list of a slot name and other stuff. The other stuff
-;; is composed of keywords followed by expressions. The expressions are
-;; evaluated with the variable which is the slot name bound to the value of the
-;; slot. These keywords are defined:
-;;
-;; :PRIN1    Print the value of the expression instead of the slot value.
-;; :PRINC    Like :PRIN1, only princ the value
-;; :TEST     Only print something if the test is true.
-;;
-;; If no printing thing is specified then the slot value is printed as PRIN1.
-;;
-;; The structure being printed is bound to STRUCTURE and the stream is bound to
-;; STREAM.
-(defmacro defprinter ((name &key (conc-name (concatenate 'simple-string
-                                                        (symbol-name name)
-                                                        "-")))
-                     &rest slot-descs)
-  (flet ((sref (slot-name)
-          `(,(symbolicate conc-name slot-name) structure)))
-    (collect ((prints))
-      (dolist (slot-desc slot-descs)
-       (if (atom slot-desc)
-         (prints `(defprinter-prin1 ',slot-desc ,(sref slot-desc) stream))
-         (let ((sname (first slot-desc))
-               (test t))
-           (collect ((stuff))
-             (do ((option (rest slot-desc) (cddr option)))
-                 ((null option)
-                  (prints
-                   `(let ((,sname ,(sref sname)))
-                      (when ,test
-                        ,@(or (stuff)
-                              `((defprinter-prin1 ',sname ,sname
-                                  stream)))))))
-               (case (first option)
-                 (:prin1
-                  (stuff `(defprinter-prin1 ',sname ,(second option)
-                            stream)))
-                 (:princ
-                  (stuff `(defprinter-princ ',sname ,(second option)
-                            stream)))
-                 (:test (setq test (second option)))
-                 (t
-                  (error "bad DEFPRINTER option: ~S" (first option)))))))))
-
-      `(def!method print-object ((structure ,name) stream)
-        (print-unreadable-object (structure stream :type t)
-          (pprint-logical-block (stream nil)
-            ;;(pprint-indent :current 2 stream)
-            ,@(prints)))))))
-\f
-;;;; the Event statistics/trace utility
+;;;; the EVENT statistics/trace utility
 
 ;;; FIXME: This seems to be useful for troubleshooting and
 ;;; experimentation, not for ordinary use, so it should probably
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 
-(defstruct event-info
+(defstruct (event-info (:copier nil))
   ;; The name of this event.
   (name (required-argument) :type symbol)
   ;; The string rescribing this event.
 
 (defmacro position-or-lose (&rest args)
   `(or (position ,@args)
-       (error "Shouldn't happen?")))
+       (error "shouldn't happen?")))