(deftype attributes () 'fixnum)
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
;;; Given a list of attribute names and an alist that translates them
;;; to masks, return the OR of the masks.
;;;; to parse the IR1 representation of a function call using a
;;;; standard function lambda-list.
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
;;; Given a DEFTRANSFORM-style lambda-list, generate code that parses
;;; the arguments of a combination with respect to that lambda-list.
(pushnew 'unsafely-flushable attributes))
`(%defknown ',(if (and (consp name)
- (not (eq (car name) 'setf)))
+ (not (legal-fun-name-p name)))
name
(list name))
'(function ,arg-types ,result-type)
(defmacro with-continuation-type-assertion ((cont ctype context) &body body)
`(let ((*lexenv* (ir1ize-the-or-values ,ctype ,cont *lexenv* ,context)))
,@body))
+
+(defmacro with-component-last-block ((component block) &body body)
+ (with-unique-names (old-last-block)
+ (once-only ((component component)
+ (block block))
+ `(let ((,old-last-block (component-last-block ,component)))
+ (unwind-protect
+ (progn (setf (component-last-block ,component)
+ ,block)
+ ,@body)
+ (setf (component-last-block ,component)
+ ,old-last-block))))))
+
\f
;;;; the EVENT statistics/trace utility
;;; experimentation, not for ordinary use, so it should probably
;;; become conditional on SB-SHOW.
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
(defstruct (event-info (:copier nil))
;; The name of this event.
new-value))
(defsetf event-level %set-event-level)
-;;; Define a new kind of event. Name is a symbol which names the event
-;;; and Description is a string which describes the event. Level
+;;; Define a new kind of event. NAME is a symbol which names the event
+;;; and DESCRIPTION is a string which describes the event. Level
;;; (default 0) is the level of significance associated with this
;;; event; it is used to determine whether to print a Note when the
;;; event happens.
(declaim (type unsigned-byte *event-note-threshold*))
(defvar *event-note-threshold* 1)
-;;; Note that the event with the specified Name has happened. Node is
+;;; Note that the event with the specified NAME has happened. NODE is
;;; evaluated to determine the node to which the event happened.
(defmacro event (name &optional node)
;; Increment the counter and do any action. Mumble about the event if
;;;; functions on directly-linked lists (linked through specialized
;;;; NEXT operations)
-#!-sb-fluid (declaim (inline find-in position-in map-in))
+#!-sb-fluid (declaim (inline find-in position-in))
-;;; Find Element in a null-terminated List linked by the accessor
-;;; function Next. Key, Test and Test-Not are the same as for generic
+;;; Find ELEMENT in a null-terminated LIST linked by the accessor
+;;; function NEXT. KEY, TEST and TEST-NOT are the same as for generic
;;; sequence functions.
(defun find-in (next
element
&key
(key #'identity)
(test #'eql test-p)
- (test-not nil not-p))
+ (test-not #'eql not-p))
+ (declare (type function next key test test-not))
(when (and test-p not-p)
(error "It's silly to supply both :TEST and :TEST-NOT arguments."))
(if not-p
(when (funcall test (funcall key current) element)
(return current)))))
-;;; Return the position of Element (or NIL if absent) in a
-;;; null-terminated List linked by the accessor function Next. Key,
-;;; Test and Test-Not are the same as for generic sequence functions.
+;;; Return the position of ELEMENT (or NIL if absent) in a
+;;; null-terminated LIST linked by the accessor function NEXT. KEY,
+;;; TEST and TEST-NOT are the same as for generic sequence functions.
(defun position-in (next
element
list
&key
(key #'identity)
(test #'eql test-p)
- (test-not nil not-p))
+ (test-not #'eql not-p))
+ (declare (type function next key test test-not))
(when (and test-p not-p)
(error "It's silly to supply both :TEST and :TEST-NOT arguments."))
(if not-p
(when (funcall test (funcall key current) element)
(return i)))))
-;;; Map FUNCTION over the elements in a null-terminated LIST linked by the
-;;; accessor function NEXT, returning an ordinary list of the results.
-(defun map-in (next function list)
- (collect ((res))
- (do ((current list (funcall next current)))
- ((null current))
- (res (funcall function current)))
- (res)))
;;; KLUDGE: This is expanded out twice, by cut-and-paste, in a
;;; (DEF!MACRO FOO (..) .. CL:GET-SETF-EXPANSION ..)