New keyword argument for SB-C:DEFKNOWN: :overwrite-fndb-silently

 While not useful in the compiler itself, some libraries (not only
 contribs) define their own VOPs, transforms, etc., and the error
 when clobbering pre-existing defknowns made these libraries hard
 to reload.

 Use with :allow-other-keys for backward compatibility.

diff --git a/NEWS b/NEWS
index 5ff7f27..9e0fa13 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,10 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 changes relative to sbcl-1.1.5:
+  * enhancement: the continuable error when defknown-ing over extant 
+    fndb entries can be ignored by passing :overwrite-fndb-silently t
+    as a keyword argument to sb-c:defknown (after attributes). Useful
+    to allow defknown to be re-loaded. Use with :allow-other-keys t
+    for backward compatibility.
   * bug fix: Prevent a make-array transform from modifying source forms
     causing problems for inlined code. Thanks to Bart Botta.
    (regression since 1.0.42.11-bis)

diff --git a/contrib/sb-rotate-byte/compiler.lisp b/contrib/sb-rotate-byte/compiler.lisp
index 58937d6..38079fb 100644 (file)
--- a/contrib/sb-rotate-byte/compiler.lisp
+++ b/contrib/sb-rotate-byte/compiler.lisp
@@ -1,16 +1,20 @@
 (in-package "SB-ROTATE-BYTE")
 
 (defknown rotate-byte (integer byte-specifier integer) integer
-  (foldable flushable))
+  (foldable flushable)
+  :overwrite-fndb-silently t)
 (defknown %rotate-byte (integer bit-index bit-index integer) integer
-  (foldable flushable))
+  (foldable flushable)
+  :overwrite-fndb-silently t)
 (defknown %unsigned-32-rotate-byte ((integer -31 31) (unsigned-byte 32))
     (unsigned-byte 32)
-  (foldable flushable))
+  (foldable flushable)
+  :overwrite-fndb-silently t)
 #+x86-64
 (defknown %unsigned-64-rotate-byte ((integer -63 63) (unsigned-byte 64))
     (unsigned-byte 64)
-  (foldable flushable))
+  (foldable flushable)
+  :overwrite-fndb-silently t)
 
 (macrolet (;; see src/compiler/srctran.lisp
            (with-byte-specifier ((size-var pos-var spec) &body body)

diff --git a/contrib/sb-simple-streams/fndb.lisp b/contrib/sb-simple-streams/fndb.lisp
index 237cb93..2471f07 100644 (file)
--- a/contrib/sb-simple-streams/fndb.lisp
+++ b/contrib/sb-simple-streams/fndb.lisp
@@ -64,33 +64,35 @@ TODO (rudi 2003-05-19): make the above work, make (defknown open) use it.
 ||#
 
 
-(handler-bind ((error #'continue))
-  (sb-c:defknown open (t &rest t
-                         &key (:direction (member :input :output :io :probe))
-                         (:element-type sb-kernel:type-specifier)
-                         (:if-exists (member :error :new-version :rename
-                                             :rename-and-delete :overwrite
-                                             :append :supersede nil))
-                         (:if-does-not-exist (member :error :create nil))
-                         (:external-format keyword)
-                         (:class (or symbol class))
-                         (:mapped (member t nil))
-                         (:input-handle (or null fixnum stream))
-                         (:output-handle (or null fixnum stream))
-                         &allow-other-keys)
+(sb-c:defknown open (t &rest t
+                       &key (:direction (member :input :output :io :probe))
+                       (:element-type sb-kernel:type-specifier)
+                       (:if-exists (member :error :new-version :rename
+                                                  :rename-and-delete :overwrite
+                                                  :append :supersede nil))
+                       (:if-does-not-exist (member :error :create nil))
+                       (:external-format keyword)
+                       (:class (or symbol class))
+                       (:mapped (member t nil))
+                       (:input-handle (or null fixnum stream))
+                       (:output-handle (or null fixnum stream))
+                       &allow-other-keys)
     (or stream null)
     ()
-    ;; :derive-type #'result-type-open-class
-    )
-
-  (sb-c:defknown listen (&optional sb-kernel:stream-designator
-                                   (or null (integer 1 10) (member character)))
-    boolean (sb-c::unsafely-flushable sb-c::explicit-check))
-
-  (sb-c:defknown read-sequence (sequence stream &key (:start sb-int:index)
-                                         (:end sb-kernel:sequence-end)
-                                         (:partial-fill boolean))
-    (sb-int:index) ())
-
-  (sb-c:defknown clear-input (&optional stream boolean) null
-                 (sb-c::explicit-check)))
+  ;; :derive-type #'result-type-open-class
+  :overwrite-fndb-silently t)
+
+(sb-c:defknown listen (&optional sb-kernel:stream-designator
+                                 (or null (integer 1 10) (member character)))
+    boolean (sb-c::unsafely-flushable sb-c::explicit-check)
+  :overwrite-fndb-silently t)
+
+(sb-c:defknown read-sequence (sequence stream &key (:start sb-int:index)
+                                       (:end sb-kernel:sequence-end)
+                                       (:partial-fill boolean))
+    (sb-int:index) ()
+  :overwrite-fndb-silently t)
+
+(sb-c:defknown clear-input (&optional stream boolean) null
+    (sb-c::explicit-check)
+  :overwrite-fndb-silently t)

diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp
index c9ec933..100f3ee 100644 (file)
--- a/src/compiler/knownfun.lisp
+++ b/src/compiler/knownfun.lisp
@@ -206,10 +206,13 @@
                                 (:derive-type (or function null))
                                 (:optimizer (or function null))
                                 (:destroyed-constant-args (or function null))
-                                (:result-arg (or index null)))
+                                (:result-arg (or index null))
+                                (:overwrite-fndb-silently boolean))
                           *)
                 %defknown))
-(defun %defknown (names type attributes &key derive-type optimizer destroyed-constant-args result-arg)
+(defun %defknown (names type attributes
+                  &key derive-type optimizer destroyed-constant-args result-arg
+                    overwrite-fndb-silently)
   (let ((ctype (specifier-type type))
         (info (make-fun-info :attributes attributes
                              :derive-type derive-type
@@ -217,20 +220,21 @@
                              :destroyed-constant-args destroyed-constant-args
                              :result-arg result-arg)))
     (dolist (name names)
-      (let ((old-fun-info (info :function :info name)))
-        (when old-fun-info
-          ;; This is handled as an error because it's generally a bad
-          ;; thing to blow away all the old optimization stuff. It's
-          ;; also a potential source of sneaky bugs:
-          ;;    DEFKNOWN FOO
-          ;;    DEFTRANSFORM FOO
-          ;;    DEFKNOWN FOO ; possibly hidden inside some macroexpansion
-          ;;    ; Now the DEFTRANSFORM doesn't exist in the target Lisp.
-          ;; However, it's continuable because it might be useful to do
-          ;; it when testing new optimization stuff interactively.
-          (cerror "Go ahead, overwrite it."
-                  "~@<overwriting old FUN-INFO ~2I~_~S ~I~_for ~S~:>"
-                  old-fun-info name)))
+      (unless overwrite-fndb-silently
+        (let ((old-fun-info (info :function :info name)))
+          (when old-fun-info
+            ;; This is handled as an error because it's generally a bad
+            ;; thing to blow away all the old optimization stuff. It's
+            ;; also a potential source of sneaky bugs:
+            ;;    DEFKNOWN FOO
+            ;;    DEFTRANSFORM FOO
+            ;;    DEFKNOWN FOO ; possibly hidden inside some macroexpansion
+            ;;    ; Now the DEFTRANSFORM doesn't exist in the target Lisp.
+            ;; However, it's continuable because it might be useful to do
+            ;; it when testing new optimization stuff interactively.
+            (cerror "Go ahead, overwrite it."
+                    "~@<overwriting old FUN-INFO ~2I~_~S ~I~_for ~S~:>"
+                    old-fun-info name))))
       (setf (info :function :type name) ctype)
       (setf (info :function :where-from name) :declared)
       (setf (info :function :kind name) :function)