~ chicken-core (chicken-5) 8efd0784e189c0fe0434a5e1d16c25cff4c827e0

commit 8efd0784e189c0fe0434a5e1d16c25cff4c827e0
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Oct 4 20:34:08 2012 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Thu Oct 4 20:34:08 2012 +0200

    scrutinizer and types.db fixes by sjamaan
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/scrutinizer.scm b/scrutinizer.scm
index a08d2ea0..3ed4753d 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -1035,6 +1035,9 @@
 		    #t)
 		   (else #f))))
 	  ((eq? t1 '*))
+	  ((eq? t2 '*) (and (not exact) (not all)))
+	  ((eq? t1 'undefined) #f)
+	  ((eq? t2 'undefined) #f)
 	  ((and (pair? t1) (eq? 'not (car t1)))
 	   (fluid-let ((exact #f)
 		       (all #f))
@@ -1067,7 +1070,6 @@
 	   (match1 (third t1) t2)) ; assumes typeenv has already been extracted
 	  ((and (pair? t2) (eq? 'forall (car t2)))
 	   (match1 t1 (third t2))) ; assumes typeenv has already been extracted
-	  ((eq? t2 '*) (and (not exact) (not all)))
 	  ((eq? t1 'noreturn) (not exact))
 	  ((eq? t2 'noreturn) (not exact))
 	  ((eq? t1 'number) 
diff --git a/tests/specialization-test-1.scm b/tests/specialization-test-1.scm
index 01574204..37e8d6bb 100644
--- a/tests/specialization-test-1.scm
+++ b/tests/specialization-test-1.scm
@@ -41,4 +41,10 @@ return n;}
   (set-cdr! x x)
   (assert (not (list? x))))
 
+;(define (some-proc x y) (if (string->number y) (set-cdr! x x) x))
+;(assert (null? (some-proc (list) "invalid number syntax")))
+
+(assert (null? (the (or undefined *) (list))))
+
+
 )
diff --git a/types.db b/types.db
index 050af879..cda90f82 100644
--- a/types.db
+++ b/types.db
@@ -783,9 +783,10 @@
 (enable-warnings (#(procedure #:clean) enable-warnings (#!optional *) *))
 
 (equal=? (#(procedure #:clean) equal=? (* *) boolean)
-	 (((or fixnum symbol char eof null undefined) *) (eq? #(1) #(2)))
-	 ((* (or fixnum symbol char eof null undefined)) (eq? #(1) #(2)))
-	 (((or float number) (or float number)) (= #(1) #(2))))
+	 ((fixnum fixnum) (eq? #(1) #(2)))
+	 (((or symbol char eof null) *) (eq? #(1) #(2)))
+	 ((* (or symbol char eof null undefined)) (eq? #(1) #(2)))
+	 (((or float fixnum number) (or float fixnum number)) (= #(1) #(2))))
 
 (er-macro-transformer
  (#(procedure #:clean #:enforce)