From 408c821f9160e1c421af1f3f826a32acc719994d Mon Sep 17 00:00:00 2001 From: Chris Hanson 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 - (%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