>From eb0aba3da937e792596043719a224843323e0e11 Mon Sep 17 00:00:00 2001
From: Evan Hanson <address@hidden>
Date: Mon, 30 Dec 2013 18:02:54 +1300
Subject: [PATCH] Add specializations for some nullary/unary comparators, fix
 list= argument type

---
 types.db |   22 +++++++++++++++++++---
 1 file changed, 19 insertions(+), 3 deletions(-)

diff --git a/types.db b/types.db
index 2a039ee..8e7fb93 100644
--- a/types.db
+++ b/types.db
@@ -324,6 +324,8 @@
     (##core#inline_allocate ("C_a_i_flonum_quotient_checked" 4) #(1) #(2))))
 
 (= (#(procedure #:clean #:enforce) = (#!rest number) boolean)
+   (() '#t)
+   ((number) '#t)
    ((fixnum fixnum) (eq? #(1) #(2)))
    ((float fixnum) (##core#inline
 		    "C_flonum_equalp"
@@ -336,6 +338,8 @@
    ((float float) (##core#inline "C_flonum_equalp" #(1) #(2))))
 
 (> (#(procedure #:clean #:enforce) > (#!rest number) boolean)
+   (() '#t)
+   ((number) '#t)
    ((fixnum fixnum) (fx> #(1) #(2)))
    ((float fixnum) (##core#inline
 		    "C_flonum_greaterp"
@@ -348,6 +352,8 @@
    ((float float) (##core#inline "C_flonum_greaterp" #(1) #(2))))
 
 (< (#(procedure #:clean #:enforce) < (#!rest number) boolean)
+   (() '#t)
+   ((number) '#t)
    ((fixnum fixnum) (fx< #(1) #(2)))
    ((float fixnum) (##core#inline
 		    "C_flonum_lessp"
@@ -360,6 +366,8 @@
    ((float float) (##core#inline "C_flonum_lessp" #(1) #(2))))
 
 (>= (#(procedure #:clean #:enforce) >= (#!rest number) boolean)
+    (() '#t)
+    ((number) '#t)
     ((fixnum fixnum) (fx>= #(1) #(2)))
     ((float fixnum) (##core#inline
 		     "C_flonum_greater_or_equal_p"
@@ -372,6 +380,8 @@
     ((float float) (##core#inline "C_flonum_greater_or_equal_p" #(1) #(2))))
 
 (<= (#(procedure #:clean #:enforce) <= (#!rest number) boolean)
+    (() '#t)
+    ((number) '#t)
     ((fixnum fixnum) (fx<= #(1) #(2)))
     ((float fixnum) (##core#inline
 		     "C_flonum_less_or_equal_p"
@@ -1916,7 +1926,9 @@
 (list-copy (forall (a) (#(procedure #:clean #:enforce) list-copy ((list-of a)) (list-of a))))
 (list-index (forall (a) (#(procedure #:enforce) list-index ((procedure (a #!rest) *) (list-of a) #!rest list) *)))
 (list-tabulate (forall (a) (#(procedure #:enforce) list-tabulate (fixnum (procedure (fixnum) a)) (list-of a))))
-(list= (#(procedure #:clean #:enforce) list= (#!rest list) boolean))
+(list= (#(procedure #:clean #:enforce) list= (#!rest (or list (procedure (list list) boolean))) boolean)
+       (() '#t)
+       (((or procedure list)) '#t))
 
 (lset-adjoin 
  (forall (a) (#(procedure #:enforce) lset-adjoin ((procedure (a a) *) (list-of a) #!rest a) (list-of a))))
@@ -2267,8 +2279,12 @@
 (char-set:title-case (struct char-set))
 (char-set:upper-case (struct char-set))
 (char-set:whitespace (struct char-set))
-(char-set<= (#(procedure #:clean #:enforce) char-set<= (#!rest (struct char-set)) boolean))
-(char-set= (#(procedure #:clean #:enforce) char-set= (#!rest (struct char-set)) boolean))
+(char-set<= (#(procedure #:clean #:enforce) char-set<= (#!rest (struct char-set)) boolean)
+	    (() '#t)
+	    (((struct char-set)) '#t))
+(char-set= (#(procedure #:clean #:enforce) char-set= (#!rest (struct char-set)) boolean)
+	   (() '#t)
+	   (((struct char-set)) '#t))
 
 (char-set? (#(procedure #:pure #:predicate (struct char-set)) char-set? (*) boolean))
 
-- 
1.7.10.4