0.7.7.11:
authorWilliam Harold Newman <william.newman@airmail.net>
Mon, 2 Sep 2002 22:35:17 +0000 (22:35 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Mon, 2 Sep 2002 22:35:17 +0000 (22:35 +0000)
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

BUGS
slam.sh
src/compiler/srctran.lisp
tests/arith.pure.lisp
version.lisp-expr

diff --git a/BUGS b/BUGS
index a2af047..729c8d2 100644 (file)
--- 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 (file)
--- a/slam.sh
+++ b/slam.sh
 #       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
index 4e6df73..d1c19d3 100644 (file)
 (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))))))
 \f
 ;;;; converting N-arg arithmetic functions
 ;;;;
index b46a12c..ad6abc2 100644 (file)
 (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))
index 90bbbd6..bdc8447 100644 (file)
@@ -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"