From 61ef22e5381fedcac04b1bfd736ba7d88f09f23e Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 6 May 2017 14:53:35 -0700
Subject: [PATCH] Register char and char-set predicates.

---
 src/runtime/char.scm   | 16 ++++++++++++----
 src/runtime/chrset.scm | 11 +++++++----
 2 files changed, 19 insertions(+), 8 deletions(-)

diff --git a/src/runtime/char.scm b/src/runtime/char.scm
index 78371080e..96381169b 100644
--- a/src/runtime/char.scm
+++ b/src/runtime/char.scm
@@ -91,13 +91,21 @@ USA.
 
 (define (char=-predicate char)
   (guarantee char? char 'char=-predicate)
-  (lambda (char*)
-    (char=? char* char)))
+  (let ((predicate
+	 (lambda (char*)
+	   (and (char? char*)
+		(char=? char* char)))))
+    (register-predicate! predicate `(char=-predicate ,char) '<= char?)
+    predicate))
 
 (define (char-ci=-predicate char)
   (guarantee char? char 'char-ci=-predicate)
-  (lambda (char*)
-    (char-ci=? char* char)))
+  (let ((predicate
+	 (lambda (char*)
+	   (and (char? char*)
+		(char-ci=? char* char)))))
+    (register-predicate! predicate `(char-ci=-predicate ,char) '<= char?)
+    predicate))
 
 (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 dd33e8b95..96f43acf3 100644
--- a/src/runtime/chrset.scm
+++ b/src/runtime/chrset.scm
@@ -423,10 +423,13 @@ USA.
 	      #f)))))
 
 (define (char-set-predicate char-set)
-  (guarantee char-set? char-set 'CHAR-SET-PREDICATE)
-  (lambda (char)
-    (and (bitless-char? char)
-	 (char-in-set? char 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))
 
 (define (char-set=? char-set . char-sets)
   (every (lambda (char-set*)
-- 
2.25.1