X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmacros.lisp;h=f6e4fb0b5f511f48ad4ad191da2b348e4a83ba0a;hb=5930ee54090c03d242c70716683b12b95d74a089;hp=f8fb006eae00945379f0cb24dcdfd9b56eea99c8;hpb=cf607a404d7518e8a18c9e362913f370eb9a5e38;p=sbcl.git

diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp
index f8fb006..f6e4fb0 100644
--- a/src/compiler/macros.lisp
+++ b/src/compiler/macros.lisp
@@ -473,7 +473,7 @@
     (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)
@@ -687,6 +687,19 @@
 (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)
+  (let ((old-last-block (gensym "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))))))
+
 
 ;;;; the EVENT statistics/trace utility
 
@@ -756,8 +769,8 @@
 	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.
@@ -776,7 +789,7 @@
 (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
@@ -811,10 +824,10 @@
 ;;;; 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
@@ -822,7 +835,8 @@
 		&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
@@ -835,16 +849,17 @@
 	(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
@@ -859,14 +874,6 @@
 	(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 ..)