From: William Harold Newman Date: Mon, 2 Sep 2002 22:35:17 +0000 (+0000) Subject: 0.7.7.11: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=9a2e730f74641e7de6ad4099111db92c5ad863bf;p=sbcl.git 0.7.7.11: Work around bug 194 in MIN/MAX type checking by using explicit UNLESS instead of THE. (This is loosely based on Matthew Danish's patch from sbcl-devel, which showed that the explicit type tests in CHECK-TYPE worked where THE did not. I also tried a few experiments based on APD's IDENTITY wrapper workaround for bug 194, but I wasn't immediately successful, and I'm not all that motivated to debug clever workarounds instead of just working to fix a real bug.) more tests of MIN and MAX tried to clarify slam.sh in response to emu question on IRC --- diff --git a/BUGS b/BUGS index a2af047..729c8d2 100644 --- a/BUGS +++ b/BUGS @@ -1357,6 +1357,37 @@ WORKAROUND: (IGNORE-ERRORS (MIN '(1 2 3))) from returning NIL as it should when the MIN source transform expanded to (THE REAL '(1 2 3)), because (IGNORE-ERRORS (THE REAL '(1 2 3))) returns (1 2 3). + Alexey Dejneka pointed out that + (IGNORE-ERRORS (IDENTITY (THE REAL '(1 2 3)))) works as it should. + (IGNORE-ERRORS (VALUES (THE REAL '(1 2 3)))) also works as it should. + Perhaps this is another case of VALUES type intersections behaving + in non-useful ways? + When I (WHN) tried to use the VALUES trick to work around this bug + in the MIN source transform, it didn't work for + (assert (null (ignore-errors (min 1 #(1 2 3))))) + Hand-expanding the source transform, I get + (assert (null (ignore-errors + (let ((arg1 1) + (arg2 (identity (the real #(1 2 3))))) + (if (< arg1 arg2) arg1 arg2))))) + which fails (i.e. the assertion fails, because the IGNORE-ERRORS + doesn't report MIN signalling a type error). At the REPL + (null (ignore-errors + (let ((arg1 1) + (arg2 (identity (the real #(1 2 3))))) + (if (< arg1 arg2) arg1 arg2)))) + => T + but when this expression is used as the body of (DEFUN FOO () ...) + then (FOO)=>NIL. + +195: "confusing reporting of not-a-REAL TYPE-ERRORs from THE REAL" + In sbcl-0.7.7.10, (THE REAL #(1 2 3)) signals a type error which + prints as "This is not a (OR SINGLE-FLOAT DOUBLE-FLOAT RATIONAL)". + The (OR SINGLE-FLOAT DOUBLE-FLOAT RATIONAL) representation of + REAL is unnecessarily confusing, especially since it relies on + internal implementation knowledge that even with SHORT-FLOAT + and LONG-FLOAT left out of the union, this type is equal to REAL. + So it'd be better just to say "This is not a REAL". DEFUNCT CATEGORIES OF BUGS IR1-#: diff --git a/slam.sh b/slam.sh index 366e0f6..8402cca 100644 --- a/slam.sh +++ b/slam.sh @@ -55,6 +55,12 @@ # file # Mostly it looks as though such limitations aren't fixable without # the aforementioned rearchitecting or solving the halting problem. +# +# To make this work, you need an after-xc.core file. To cause the +# system to generate an after-xc.core file, you need +# :SB-AFTER-XC-CORE in target features during an ordinary build. +# See the comments in base-target-features.lisp-expr for the +# recommended way to make that happen. ####################################################################### if [ "" != "$*" ]; then diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 4e6df73..d1c19d3 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -3083,23 +3083,44 @@ (define-source-transform char-not-equal (&rest args) (multi-not-equal 'char-equal args)) +;;; FIXME: can go away once bug 194 is fixed and we can use (THE REAL X) +;;; as God intended +(defun error-not-a-real (x) + (error 'simple-type-error + :datum x + :expected-type 'real + :format-control "not a REAL: ~S" + :format-arguments (list x))) + ;;; Expand MAX and MIN into the obvious comparisons. -(define-source-transform max (arg &rest more-args) - (if (null more-args) - `(the real ,arg) ; ANSI: should signal TYPE-ERROR if any arg not a REAL - (once-only ((arg1 arg) - (arg2 `(max ,@more-args))) - `(if (> ,arg1 ,arg2) - ,arg1 - ,arg2)))) -(define-source-transform min (arg &rest more-args) - (if (null more-args) - `(the real ,arg) ; ANSI: should signal TYPE-ERROR if any arg not a REAL - (once-only ((arg1 arg) - (arg2 `(min ,@more-args))) - `(if (< ,arg1 ,arg2) - ,arg1 - ,arg2)))) +(define-source-transform max (arg0 &rest rest) + (once-only ((arg0 arg0)) + ;; ANSI says MAX should signal TYPE-ERROR if any arg isn't a REAL. + ;; + ;; KLUDGE: This UNLESS hackery is a workaround for bug 194. + ;; Better, when that bug is fixed, would be (THE REAL ,ARG0). + ;; -- WHN 2002-09-02 + `(progn + (unless (realp ,arg0) + (error-not-a-real ,arg0)) + ,(if (null rest) + arg0 + `(let ((maxrest (max ,@rest))) + (if (> ,arg0 maxrest) ,arg0 maxrest)))))) +(define-source-transform min (arg0 &rest rest) + (once-only ((arg0 arg0)) + ;; ANSI says MIN should signal TYPE-ERROR if any arg isn't a REAL. + ;; + ;; KLUDGE: This UNLESS hackery is a workaround for bug 194. + ;; Better, when that bug is fixed, would be (THE REAL ,ARG0). + ;; -- WHN 2002-09-02 + `(progn + (unless (realp ,arg0) + (error-not-a-real ,arg0)) + ,(if (null rest) + arg0 + `(let ((minrest (min ,@rest))) + (if (< ,arg0 minrest) ,arg0 minrest)))))) ;;;; converting N-arg arithmetic functions ;;;; diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp index b46a12c..ad6abc2 100644 --- a/tests/arith.pure.lisp +++ b/tests/arith.pure.lisp @@ -48,11 +48,18 @@ (assert (= (coerce 1/2 '(complex float)) #c(0.5 0.0))) (assert (= (coerce 1.0d0 '(complex float)) #c(1.0d0 0.0d0))) -;;; ANSI: MIN and MAX should signal TYPE-ERROR if any argument -;;; isn't REAL. SBCL 0.7.7 didn't. (reported as a bug in CMU CL -;;; on IRC by lrasinen 2002-09-01) -;;; -;;; FIXME: Alas, even with the new fixed definition of MIN, no error -;;; is thrown, because of bug 194, so until bug 194 is fixed, we can't -;;; use this test. -#+nil (assert (null (ignore-errors (min '(1 2 3))))) \ No newline at end of file +;;; ANSI says MIN and MAX should signal TYPE-ERROR if any argument +;;; isn't REAL. SBCL 0.7.7 didn't in the 1-arg case. (reported as a +;;; bug in CMU CL on #lisp IRC by lrasinen 2002-09-01) +(assert (null (ignore-errors (min '(1 2 3))))) +(assert (= (min -1) -1)) +(assert (null (ignore-errors (min 1 #(1 2 3))))) +(assert (= (min 10 11) 10)) +(assert (null (ignore-errors (min (find-package "CL") -5.0)))) +(assert (= (min 5.0 -3) -3)) +(assert (null (ignore-errors (max #c(4 3))))) +(assert (= (max 0) 0)) +(assert (null (ignore-errors (max "MIX" 3)))) +(assert (= (max -1 10.0) 10.0)) +(assert (null (ignore-errors (max 3 #'max)))) +(assert (= (max -3 0) 0)) diff --git a/version.lisp-expr b/version.lisp-expr index 90bbbd6..bdc8447 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.7.10" +"0.7.7.11"