From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 7 May 2017 20:37:50 +0000 (-0700)
Subject: Revert earlier change and try a new approach for char-set predicates.
X-Git-Tag: mit-scheme-pucked-9.2.12~14^2~69
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=408c821f9160e1c421af1f3f826a32acc719994d;p=mit-scheme.git

Revert earlier change and try a new approach for char-set predicates.
---

diff --git a/src/runtime/char.scm b/src/runtime/char.scm
index 96381169b..3d52e11ac 100644
--- a/src/runtime/char.scm
+++ b/src/runtime/char.scm
@@ -91,21 +91,15 @@ USA.
 
 (define (char=-predicate char)
   (guarantee char? char 'char=-predicate)
-  (let ((predicate
-	 (lambda (char*)
-	   (and (char? char*)
-		(char=? char* char)))))
-    (register-predicate! predicate `(char=-predicate ,char) '<= char?)
-    predicate))
+  (lambda (char*)
+    (and (char? char*)
+	 (char=? char* char))))
 
 (define (char-ci=-predicate char)
   (guarantee char? char 'char-ci=-predicate)
-  (let ((predicate
-	 (lambda (char*)
-	   (and (char? char*)
-		(char-ci=? char* char)))))
-    (register-predicate! predicate `(char-ci=-predicate ,char) '<= char?)
-    predicate))
+  (lambda (char*)
+    (and (char? char*)
+	 (char-ci=? char* char))))
 
 (define-integrable (%char=? x y)
   (fix:= (char->integer x) (char->integer y)))
diff --git a/src/runtime/chrset.scm b/src/runtime/chrset.scm
index 96f43acf3..5a1a9242d 100644
--- a/src/runtime/chrset.scm
+++ b/src/runtime/chrset.scm
@@ -39,10 +39,24 @@ USA.
 ;;; The HIGH range sequence is a u24 bytevector implementing an inversion list.
 
 (define-record-type <char-set>
-    (%make-char-set low high)
+    (%make-char-set low high predicate)
     char-set?
   (low %char-set-low)
-  (high %char-set-high))
+  (high %char-set-high)
+  (predicate %char-set-predicate))
+
+(define (make-char-set low high)
+  (letrec
+      ((char-set
+	(%make-char-set low high
+	  (delay
+	    (let ((predicate
+		   (lambda (char)
+		     (and (bitless-char? char)
+			  (char-in-set? char char-set)))))
+	      (register-predicate! predicate 'char-set-predicate '<= char?)
+	      predicate)))))
+    char-set))
 
 (define-integrable %low-cps-per-byte 8)
 
@@ -93,8 +107,8 @@ USA.
 ;;; All char-sets are constructed by %INVERSION-LIST->CHAR-SET.
 (define (%inversion-list->char-set ilist)
   (let ((low-limit (%choose-low-limit ilist)))
-    (%make-char-set (%inversion-list->low ilist low-limit)
-		    (%inversion-list->high ilist low-limit))))
+    (make-char-set (%inversion-list->low ilist low-limit)
+		   (%inversion-list->high ilist low-limit))))
 
 (define (%choose-low-limit ilist)
   (let ((max-low-bytes (fix:quotient #x110000 %high-bytes-per-cp)))
@@ -423,13 +437,7 @@ USA.
 	      #f)))))
 
 (define (char-set-predicate char-set)
-  (guarantee char-set? char-set 'char-set-predicate)
-  (let ((predicate
-	 (lambda (char)
-	   (and (bitless-char? char)
-		(char-in-set? char char-set)))))
-    (register-predicate! predicate 'char-set-predicate '<= char?)
-    predicate))
+  (force (%char-set-predicate char-set)))
 
 (define (char-set=? char-set . char-sets)
   (every (lambda (char-set*)