From 6761f6d489f02bdb4acb604c705dff8e5df204ff Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 11 Feb 2017 17:20:17 -0800 Subject: [PATCH] Change code generator for boolean sets to use standard names. --- src/etc/ucd-converter.scm | 6 ++++-- src/runtime/runtime.pkg | 10 +++++----- src/runtime/ucd-glue.scm | 18 +++--------------- src/runtime/ucd-table-alpha.scm | 2 +- src/runtime/ucd-table-lower.scm | 2 +- src/runtime/ucd-table-upper.scm | 2 +- src/runtime/ucd-table-wspace.scm | 2 +- 7 files changed, 16 insertions(+), 26 deletions(-) diff --git a/src/etc/ucd-converter.scm b/src/etc/ucd-converter.scm index 32c9cf5c4..e8f890ca9 100644 --- a/src/etc/ucd-converter.scm +++ b/src/etc/ucd-converter.scm @@ -459,8 +459,10 @@ USA. (else (error "Unsupported metadata:" metadata))))) (define (code-generator:boolean prop-name metadata prop-alist proc-name) - (let ((char-set-name (symbol "char-set:" (metadata-full-name metadata)))) - `((define (,proc-name char) + (declare (ignore proc-name)) + (let* ((full-name (metadata-full-name metadata)) + (char-set-name (symbol "char-set:" full-name))) + `((define (,(symbol "char-" full-name "?") char) (char-in-set? char ,char-set-name)) (define-deferred ,char-set-name (char-set* diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index e0ba2d268..c96e3fb89 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -1422,6 +1422,10 @@ USA. "ucd-table-wspace") (parent (runtime)) (export () + char-alphabetic? + char-lower-case? + char-upper-case? + char-whitespace? char-set:alphabetic char-set:lower-case char-set:upper-case @@ -1443,9 +1447,7 @@ USA. (files "ucd-glue") (parent (runtime)) (export () - char-alphabetic? char-alphanumeric? - char-lower-case? char-numeric? char-set:alphanumeric char-set:not-alphabetic @@ -1456,9 +1458,7 @@ USA. char-set:not-whitespace char-set:numeric char-set:symbol-constituent - char-set:symbol-initial - char-upper-case? - char-whitespace?)) + char-set:symbol-initial)) (define-package (runtime character-set) (files "chrset") diff --git a/src/runtime/ucd-glue.scm b/src/runtime/ucd-glue.scm index bb73db067..767717077 100644 --- a/src/runtime/ucd-glue.scm +++ b/src/runtime/ucd-glue.scm @@ -34,27 +34,15 @@ USA. (lambda (sv) (eq? 'decimal (ucd-nt-value (integer->char sv)))))) +(define-deferred char-numeric? + (char-set-predicate char-set:numeric)) + (define-deferred char-set:alphanumeric (char-set-union char-set:alphabetic char-set:numeric)) -(define-deferred char-alphabetic? - (char-set-predicate char-set:alphabetic)) - (define-deferred char-alphanumeric? (char-set-predicate char-set:alphanumeric)) -(define-deferred char-lower-case? - (char-set-predicate char-set:lower-case)) - -(define-deferred char-numeric? - (char-set-predicate char-set:numeric)) - -(define-deferred char-upper-case? - (char-set-predicate char-set:upper-case)) - -(define-deferred char-whitespace? - (char-set-predicate char-set:whitespace)) - (define-deferred char-set:not-alphabetic (char-set-invert char-set:alphabetic)) diff --git a/src/runtime/ucd-table-alpha.scm b/src/runtime/ucd-table-alpha.scm index fac5f3729..331e75f24 100644 --- a/src/runtime/ucd-table-alpha.scm +++ b/src/runtime/ucd-table-alpha.scm @@ -30,7 +30,7 @@ USA. (declare (usual-integrations)) -(define (ucd-alpha-value char) +(define (char-alphabetic? char) (char-in-set? char char-set:alphabetic)) (define-deferred char-set:alphabetic diff --git a/src/runtime/ucd-table-lower.scm b/src/runtime/ucd-table-lower.scm index 68d745bff..fe0f710ac 100644 --- a/src/runtime/ucd-table-lower.scm +++ b/src/runtime/ucd-table-lower.scm @@ -30,7 +30,7 @@ USA. (declare (usual-integrations)) -(define (ucd-lower-value char) +(define (char-lower-case? char) (char-in-set? char char-set:lower-case)) (define-deferred char-set:lower-case diff --git a/src/runtime/ucd-table-upper.scm b/src/runtime/ucd-table-upper.scm index 17afbeb46..722170fd5 100644 --- a/src/runtime/ucd-table-upper.scm +++ b/src/runtime/ucd-table-upper.scm @@ -30,7 +30,7 @@ USA. (declare (usual-integrations)) -(define (ucd-upper-value char) +(define (char-upper-case? char) (char-in-set? char char-set:upper-case)) (define-deferred char-set:upper-case diff --git a/src/runtime/ucd-table-wspace.scm b/src/runtime/ucd-table-wspace.scm index 3a586a513..e83e9e709 100644 --- a/src/runtime/ucd-table-wspace.scm +++ b/src/runtime/ucd-table-wspace.scm @@ -30,7 +30,7 @@ USA. (declare (usual-integrations)) -(define (ucd-wspace-value char) +(define (char-whitespace? char) (char-in-set? char char-set:whitespace)) (define-deferred char-set:whitespace -- 2.25.1