File 0004-type-Compare-key-parameters-of-function-ty... of Package sbcl

Overview Repositories Revisions Requests Users Attributes Meta

File 0004-type-Compare-key-parameters-of-function-types.patch of Package sbcl (Revision 2adc159e25dbdbd0ae25f4cf3fd366fa)

Currently displaying revision 2adc159e25dbdbd0ae25f4cf3fd366fa , Show latest

From 0c0d240960138dbea32ff6e3e65e6f16b1f2f7da Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Sun, 31 Mar 2013 21:27:14 +0400
Subject: [PATCH 4/5] type=: Compare &key parameters of function types.

Compare key parameters in type=-args, mostly so that deftransforms
with key arguments could be redefined at runtime.
---
 src/code/late-type.lisp | 15 ++++++++++++++-
 1 file changed, 14 insertions(+), 1 deletion(-)

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 63431b9..697b775 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -654,6 +654,19 @@
                               :rest rest)
             exactp)))
 
+(defun compare-key-args (type1 type2)
+  (let ((keys1 (args-type-keywords type1))
+        (keys2 (args-type-keywords type2)))
+    (and (= (length keys1) (length keys2))
+         (eq (args-type-allowp type1)
+             (args-type-allowp type2))
+         (loop for key1 in keys1
+               for match = (find (key-info-name key1)
+                                 keys2 :key #'key-info-name)
+               always (and match
+                           (type= (key-info-type key1)
+                                  (key-info-type match)))))))
+
 (defun type=-args (type1 type2)
   (macrolet ((compare (comparator field)
                (let ((reader (symbolicate '#:args-type- field)))
@@ -668,7 +681,7 @@
      (and/type (and/type (compare type=-list required)
                          (compare type=-list optional))
                (if (or (args-type-keyp type1) (args-type-keyp type2))
-                   (values nil nil)
+                   (values (compare-key-args type1 type2) t)
                    (values t t))))))
 
 ;;; Do a union or intersection operation on types that might be values
-- 
1.8.2

Places

File 0004-type-Compare-key-parameters-of-function-types.patch of Package sbcl (Revision 2adc159e25dbdbd0ae25f4cf3fd366fa)

Places