`((setf (symbol-function ',name)
(lambda (&rest rest)
(declare (ignore rest))
- (error "can't FUNCALL the SYMBOL-FUNCTION of ~
- special forms")))))))))
+ (error 'special-form-function
+ :name ',name)))))))))
;;; (This is similar to DEF-IR1-TRANSLATOR, except that we pass if the
;;; syntax is invalid.)
) ; EVAL-WHEN
;;; Define a new class of boolean attributes, with the attributes
-;;; having the specified Attribute-Names. Name is the name of the
+;;; having the specified ATTRIBUTE-NAMES. NAME is the name of the
;;; class, which is used to generate some macros to manipulate sets of
;;; the attributes:
;;;
;;; 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))
+ eval-name important)
&body body-decls-doc)
(when (and eval-name defun-only)
(error "can't specify both DEFUN-ONLY and EVAL-NAME"))
`'(function ,arg-types ,result-type))
(lambda ,@stuff)
,doc
- ,(if important t nil)
- ,when)))))))
+ ,(if important t nil))))))))
\f
;;;; DEFKNOWN and DEFOPTIMIZER
;;; 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.
+;;; of boolean attributes of the function. See their description in
+;;; (DEF-BOOLEAN-ATTRIBUTE IR1). 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)
(when (and (intersection attributes '(any call unwind))
(intersection attributes '(movable)))
(error "function cannot have both good and bad attributes: ~S" attributes))
+ (when (member 'any attributes)
+ (setf attributes (union '(call unsafe unwind) attributes)))
+ (when (member 'flushable attributes)
+ (pushnew 'unsafely-flushable attributes))
+
`(%defknown ',(if (and (consp name)
(not (eq (car name) 'setf)))
name
(list name))
'(function ,arg-types ,result-type)
- (ir1-attributes ,@(if (member 'any attributes)
- (union '(call unsafe unwind) attributes)
- attributes))
+ (ir1-attributes ,@attributes)
,@keys))
;;; Create a function which parses combination args according to WHAT
;;; Bind the hashtables used for keeping track of global variables,
;;; functions, etc. Also establish condition handlers.
(defmacro with-ir1-namespace (&body forms)
- `(let ((*free-variables* (make-hash-table :test 'eq))
+ `(let ((*free-vars* (make-hash-table :test 'eq))
(*free-funs* (make-hash-table :test 'equal))
(*constants* (make-hash-table :test 'equal))
(*source-paths* (make-hash-table :test 'eq)))
;;; :TEST keyword may be used to determine the name equality
;;; predicate.
(defmacro lexenv-find (name slot &key test)
- (once-only ((n-res `(assoc ,name (,(symbolicate "LEXENV-" slot) *lexenv*)
+ (once-only ((n-res `(assoc ,name (,(let ((*package* (symbol-package 'lexenv-funs)))
+ (symbolicate "LEXENV-" slot))
+ *lexenv*)
:test ,(or test '#'eq))))
`(if ,n-res
(values (cdr ,n-res) t)
(values nil nil))))
+
+;;;
+(defmacro with-continuation-type-assertion ((cont ctype context) &body body)
+ `(let ((*lexenv* (ir1ize-the-or-values ,ctype ,cont *lexenv* ,context)))
+ ,@body))
\f
;;;; the EVENT statistics/trace utility