Add procedure-arity-intersection.

diff --git a/src/runtime/procedure.scm b/src/runtime/procedure.scm
index a4c59a1ff2841418140c77820cf948b2e9a48da2..9482fdbfd75f5eeeaa905572a1e6885ea91e55ae 100644 (file)
--- a/src/runtime/procedure.scm
+++ b/src/runtime/procedure.scm
@@ -220,6 +220,15 @@ USA.
                (fix:<= (procedure-arity-max arity1)
                        (procedure-arity-max arity2))))))
 
+(define (procedure-arity-intersection a1 a2)
+  (make-procedure-arity (fix:max (procedure-arity-min a1)
+                                (procedure-arity-min a2))
+                        (let ((m1 (procedure-arity-max a1))
+                              (m2 (procedure-arity-max a2)))
+                         (if m1
+                             (if m2 (fix:min m1 m2) m1)
+                             m2))))
+
 (define-integrable (simple-arity? object)
   (index-fixnum? object))
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index acb35ec2875236434fc211cd15d1f2bcae39f56a..714d247a5b8f24645ef931fcd89690508b38e55f 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1932,6 +1932,7 @@ USA.
          primitive-procedure-name
          primitive-procedure?
          procedure-arity
+         procedure-arity-intersection
          procedure-arity-max
          procedure-arity-min
          procedure-arity-valid?