From 893dd75069ad851efd19e3d0fa5a4de9e84b4868 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Mon, 30 Jun 2003 04:24:13 +0000 Subject: [PATCH] 0.8.1.10: * Make condition-related functions be known (reported by Paul Dietz); * fix type declaration of CERROR. --- NEWS | 3 +++ package-data-list.lisp-expr | 5 ++++- src/code/deftypes-for-target.lisp | 6 ++++++ src/code/error.lisp | 5 ----- src/code/late-type.lisp | 5 +++++ src/compiler/fndb.lisp | 30 +++++++++++++++++++++++++----- tests/condition.pure.lisp | 12 ++++++++++++ version.lisp-expr | 2 +- 8 files changed, 56 insertions(+), 12 deletions(-) diff --git a/NEWS b/NEWS index 10ff16b..300e284 100644 --- a/NEWS +++ b/NEWS @@ -1898,6 +1898,9 @@ changes in sbcl-0.8.2 relative to sbcl-0.8.1: (with THE, so dependent on compiler policy) to involve objects of type FOO. Note that no such declaration is implied in (MAKE-ARRAY .. :ELEMENT-TYPE 'FOO). + * declared types of functions from the "Conditions" + chapter. (reported by Paul Dietz) + * bug fix: CERROR accepts a function as its first argument. planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 6bc5a2b..ce17c06 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1080,7 +1080,9 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "FIND-AND-INIT-OR-CHECK-LAYOUT" "FLOAT-EXPONENT" "FLOAT-FORMAT-DIGITS" "FLOAT-FORMAT-NAME" "FLOAT-FORMAT-MAX" "FLOATING-POINT-EXCEPTION" - "FORM" "*FREE-INTERRUPT-CONTEXT-INDEX*" "FUNCALLABLE-INSTANCE-P" + "FORM" + "FORMAT-CONTROL" + "*FREE-INTERRUPT-CONTEXT-INDEX*" "FUNCALLABLE-INSTANCE-P" "FUN-CODE-HEADER" "FUN-TYPE" "FUN-TYPE-ALLOWP" "FUN-TYPE-KEYP" "FUN-TYPE-KEYWORDS" @@ -1226,6 +1228,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." #!+x86 "*PSEUDO-ATOMIC-INTERRUPTED*" "PUNT-PRINT-IF-TOO-LONG" "READER-IMPOSSIBLE-NUMBER-ERROR" "READER-PACKAGE-ERROR" + "RESTART-DESIGNATOR" "SCALE-DOUBLE-FLOAT" #!+long-float "SCALE-LONG-FLOAT" "SCALE-SINGLE-FLOAT" diff --git a/src/code/deftypes-for-target.lisp b/src/code/deftypes-for-target.lisp index 232c61d..44438c0 100644 --- a/src/code/deftypes-for-target.lisp +++ b/src/code/deftypes-for-target.lisp @@ -104,6 +104,12 @@ ;;; semistandard types (sb!xc:deftype generalized-boolean () t) +(sb!xc:deftype format-control () + '(or string function)) + +(sb!xc:deftype restart-designator () + '(or (and symbol (not null)) restart)) + ;;; a type specifier ;;; ;;; FIXME: The SB!KERNEL:INSTANCE here really means CL:CLASS. diff --git a/src/code/error.lisp b/src/code/error.lisp index 9a0e47d..bb3b024 100644 --- a/src/code/error.lisp +++ b/src/code/error.lisp @@ -51,11 +51,6 @@ (define-condition simple-stream-error (simple-condition stream-error) ()) (define-condition simple-parse-error (simple-condition parse-error) ()) -;;; This condition is signalled whenever we make a UNKNOWN-TYPE so that -;;; compiler warnings can be emitted as appropriate. -(define-condition parse-unknown-type (condition) - ((specifier :reader parse-unknown-type-specifier :initarg :specifier))) - (define-condition control-stack-exhausted (storage-condition) () (:report diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 5e00418..9e66753 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -25,6 +25,11 @@ ;;; There are all sorts of nasty problems with open bounds on FLOAT ;;; types (and probably FLOAT types in general.) +;;; This condition is signalled whenever we make a UNKNOWN-TYPE so that +;;; compiler warnings can be emitted as appropriate. +(define-condition parse-unknown-type (condition) + ((specifier :reader parse-unknown-type-specifier :initarg :specifier))) + ;;; FIXME: This really should go away. Alas, it doesn't seem to be so ;;; simple to make it go away.. (See bug 123 in BUGS file.) (defvar *use-implementation-types* t ; actually initialized in cold init diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index e394ac4..e48440d 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1179,12 +1179,32 @@ (defknown directory (pathname-designator &key) list ()) -;;;; from the "Errors" chapter: - -(defknown error (t &rest t) nil) ; never returns -(defknown cerror (string t &rest t) null) +;;;; from the "Conditions" chapter: + +(defknown cell-error-name (cell-error) t) +(defknown error (t &rest t) nil) +(defknown cerror (format-control t &rest t) null) +(defknown invalid-method-error (t format-control &rest t) *) ; FIXME: first arg is METHOD +(defknown method-combination-error (format-control &rest t) *) +(defknown signal (t &rest t) null) +(defknown simple-condition-format-control (condition) + format-control) +(defknown simple-condition-format-arguments (condition) + list) (defknown warn (t &rest t) null) -(defknown break (&optional t &rest t) null) +(defknown invoke-debugger (condition) nil) +(defknown break (&optional format-control &rest t) null) +(defknown make-condition (type-specifier &rest t) condition) +(defknown compute-restarts (&optional (or condition null)) list) +(defknown find-restart (restart-designator &optional (or condition null)) + (or restart null)) +(defknown invoke-restart (restart-designator &rest t) *) +(defknown invoke-restart-interactively (restart-designator) *) +(defknown restart-name (restart) symbol) +(defknown (abort muffle-warning) (&optional (or condition null)) nil) +(defknown continue (&optional (or condition null)) null) +(defknown (store-value use-value) (t &optional (or condition null)) + null) ;;; and analogous SBCL extension: (defknown bug (t &rest t) nil) ; never returns diff --git a/tests/condition.pure.lisp b/tests/condition.pure.lisp index 96cdd0f..cf6bb96 100644 --- a/tests/condition.pure.lisp +++ b/tests/condition.pure.lisp @@ -89,3 +89,15 @@ (foo () :test (lambda (c) (declare (ignore c)) visible) 'in2)) (foo () 'ext))))))) + +;;; First argument of CERROR is a format control +(assert + (eq (block nil + (handler-bind + ((type-error (lambda (c) (return :failed))) + (simple-error (lambda (c) + (return (if (find-restart 'continue) + :passed + :failed))))) + (cerror (formatter "Continue from ~A") "bug ~A" :bug))) + :passed)) diff --git a/version.lisp-expr b/version.lisp-expr index 0c26546..a37bc1b 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.1.9" +"0.8.1.10" -- 1.7.10.4