From 408c821f9160e1c421af1f3f826a32acc719994d Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 7 May 2017 13:37:50 -0700
Subject: [PATCH] Revert earlier change and try a new approach for char-set
predicates.
---
src/runtime/char.scm | 18 ++++++------------
src/runtime/chrset.scm | 30 +++++++++++++++++++-----------
2 files changed, 25 insertions(+), 23 deletions(-)
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*)
--
2.25.1