From 076ba784f75d6c9bb8ed2ed14b70ccf3ebe5bf2a Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 16 Apr 2005 04:22:35 +0000
Subject: [PATCH] MAKE-PROCEDURE-ARITY must not simplify the result by default.

---
 v7/src/runtime/uproc.scm | 26 ++++++++++++++++----------
 1 file changed, 16 insertions(+), 10 deletions(-)

diff --git a/v7/src/runtime/uproc.scm b/v7/src/runtime/uproc.scm
index 61a30a371..a70fa8608 100644
--- a/v7/src/runtime/uproc.scm
+++ b/v7/src/runtime/uproc.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: uproc.scm,v 1.17 2005/04/16 03:39:35 cph Exp $
+$Id: uproc.scm,v 1.18 2005/04/16 04:22:35 cph Exp $
 
 Copyright 1990,1991,1992,1995,1996,2003 Massachusetts Institute of Technology
 Copyright 2005 Massachusetts Institute of Technology
@@ -153,16 +153,22 @@ USA.
   (if (not (procedure-arity-valid? object arity))
       (error:bad-range-argument object caller)))
 
-(define (make-procedure-arity min #!optional max)
+(define (make-procedure-arity min #!optional max simple-ok?)
   (guarantee-index-fixnum min 'MAKE-PROCEDURE-ARITY)
-  (if (or (default-object? max) (eqv? max min))
-      min
-      (begin
-	(if max
-	    (begin
-	      (guarantee-index-fixnum max 'MAKE-PROCEDURE-ARITY)
-	      (if (not (fix:> max min))
-		  (error:bad-range-argument max 'MAKE-PROCEDURE-ARITY))))
+  (let ((max
+	 (if (default-object? max)
+	     min
+	     (begin
+	       (if max
+		   (begin
+		     (guarantee-index-fixnum max 'MAKE-PROCEDURE-ARITY)
+		     (if (not (fix:>= max min))
+			 (error:bad-range-argument max
+						   'MAKE-PROCEDURE-ARITY))))
+	       max))))
+    (if (and (eqv? min max)
+	     (if (default-object? simple-ok?) #f simple-ok?))
+	min
 	(cons min max))))
 
 (define (procedure-arity? object)
-- 
2.25.1