~ chicken-core (chicken-5) 7ee034e3f2e6f8c9e433391dc4c02b6196052e7f

commit 7ee034e3f2e6f8c9e433391dc4c02b6196052e7f
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Jan 2 11:38:34 2011 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sun Jan 2 11:38:34 2011 +0100

    equal? and equal=? do not recurse into closures (CR #441)

diff --git a/library.scm b/library.scm
index c6874507..d5c99a88 100644
--- a/library.scm
+++ b/library.scm
@@ -124,6 +124,16 @@ fast_read_string_from_file(C_word dest, C_word port, C_word len, C_word pos)
 
   return C_fix (m);
 }
+
+static C_word
+shallow_equal(C_word x, C_word y)
+{
+  /* assumes x and y are non-immediate */
+  int i, len = C_header_size(x);
+
+  if(C_header_size(y) != len) return C_SCHEME_FALSE;      
+  else return C_mk_bool(!C_memcmp((void *)x, (void *)y, len * sizeof(C_word)));
+}
 EOF
 ) )
 
@@ -1095,8 +1105,9 @@ EOF
 	  ((not (##core#inline "C_sametypep" x y)) #f)
 	  ((##core#inline "C_specialp" x)
 	   (and (##core#inline "C_specialp" y)
-		(not (##core#inline "C_closurep" x))
-		(compare-slots x y 1)))
+		(if (##core#inline "C_closurep" x)
+		    (##core#inline "shallow_equal" x y)
+		    (compare-slots x y 1))))
 	  ((##core#inline "C_byteblockp" x)
 	   (and (##core#inline "C_byteblockp" y)
 		(let ((s1 (##sys#size x)))
diff --git a/manual/Deviations from the standard b/manual/Deviations from the standard
index 115ac941..ffda509e 100644
--- a/manual/Deviations from the standard	
+++ b/manual/Deviations from the standard	
@@ -90,10 +90,10 @@ lambda-expressions.
 
 === {{equal?}} compares all structured data recursively
 
-{{equal?}} compares all structured data recursively, while R5RS
-specifies that {{eqv?}} is used for data other than pairs, strings and
-vectors.  However, R5RS does not dictate the treatment of data types
-that are not specified by R5RS.
+{{equal?}} compares all structured data with the exception of
+procedures recursively, while R5RS specifies that {{eqv?}} is used for
+data other than pairs, strings and vectors.  However, R5RS does not
+dictate the treatment of data types that are not specified by R5RS
 
 
 === No built-in support for bignums
diff --git a/runtime.c b/runtime.c
index 409e7eff..e907c9a4 100644
--- a/runtime.c
+++ b/runtime.c
@@ -3891,7 +3891,10 @@ C_regparm C_word C_fcall C_equalp(C_word x, C_word y)
     n = header & C_HEADER_SIZE_MASK;
 
     if(bits & C_SPECIALBLOCK_BIT) {
-      if(C_u_i_car(x) != C_u_i_car(y)) return 0;
+      /* do not recurse into closures */
+      if((bits & C_CLOSURE_TYPE) != 0) 
+	return !C_memcmp(x, y, n * sizeof(C_word));
+      else if(C_block_item(x, 0) != C_block_item(y, 0)) return 0;
       else ++i;
 
       if(n == 1) return 1;