From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 22 Sep 2009 13:58:30 +0000 (-0700)
Subject: Tweak EQUALITY-PREDICATE to do what it's called.
X-Git-Tag: 20100708-Gtk~316^2~5
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ff03ebca1a3bce35a2f10c5994166eaf77d080a1;p=mit-scheme.git

Tweak EQUALITY-PREDICATE to do what it's called.
---

diff --git a/src/runtime/structure-parser.scm b/src/runtime/structure-parser.scm
index 0a12c2ab8..a49d27e6f 100644
--- a/src/runtime/structure-parser.scm
+++ b/src/runtime/structure-parser.scm
@@ -220,7 +220,7 @@ USA.
     env
     (make-object-parser
      (lambda (item win lose)
-       `(IF ,(equality-predicate item (cadr pattern))
+       `(IF (,(equality-predicate (cadr pattern)) ,item ',(cadr pattern))
 	    (,win ,(single-val item) ,lose)
 	    (,lose))))))
 
@@ -229,20 +229,18 @@ USA.
     env
     (make-object-parser
      (lambda (item win lose)
-       `(IF ,(equality-predicate item (cadr pattern))
+       `(IF (,(equality-predicate (cadr pattern)) ,item ',(cadr pattern))
 	    (,win ,(null-vals) ,lose)
 	    (,lose))))))
 
-(define (equality-predicate item datum)
-  `(,(cond ((or (symbol? datum)
-		(char? datum)
-		(boolean? datum)
-		(null? datum))
-	    'EQ?)
-	   ((number? datum) 'EQV?)
-	   (else 'EQUAL?))
-    ,item
-    ',datum))
+(define (equality-predicate datum)
+  (cond ((or (symbol? datum)
+	     (char? datum)
+	     (boolean? datum)
+	     (null? datum))
+	 'EQ?)
+	((number? datum) 'EQV?)
+	(else 'EQUAL?)))
 
 (define-context-method 'VALUES 'OBJECT
   (lambda (vals)