~ chicken-core (chicken-5) 1bfc0df86da217edb58c36f3155f6ac799d8a69c

commit 1bfc0df86da217edb58c36f3155f6ac799d8a69c
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sat Feb 13 19:21:33 2016 +0100
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Sun Feb 14 08:56:18 2016 +1300

    Preserve type of argument in car in assq/assv procedure results.
    
    If the result is a pair, the car will always be the same type as the
    first procedure argument.  The list may consist of pairs of union
    types or unknown types, so this allows us to recover some type info
    due to the first argument in most cases being more specific.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/types.db b/types.db
index aa386489..920e4295 100644
--- a/types.db
+++ b/types.db
@@ -195,13 +195,13 @@
 	((* (list-of (or symbol procedure immediate)))
 	 (##core#inline "C_u_i_memq" #(1) #(2))))
 
-(assq (forall (a b) (#(procedure #:clean) assq (* (list-of (pair a b)))
-		     (or false (pair a b))))
+(assq (forall (a b c) (#(procedure #:clean) assq (a (list-of (pair b c)))
+		       (or false (pair a c))))
       ((* null) (let ((#(tmp) #(1))) '#f))
       ((* (list-of pair)) (##core#inline "C_u_i_assq" #(1) #(2))))
 
-(assv (forall (a b) (#(procedure #:clean) assv (* (list-of (pair a b)))
-		     (or false (pair a b))))
+(assv (forall (a b c) (#(procedure #:clean) assv (a (list-of (pair b c)))
+		       (or false (pair a c))))
       ((* null) (let ((#(tmp) #(1))) '#f))
       (((or symbol immediate procedure) (list-of pair))
        (##core#inline "C_u_i_assq" #(1) #(2)))