Implement char-set-size and update char-set:newline.

diff --git a/src/runtime/char-set.scm b/src/runtime/char-set.scm
index a91e0317026de94c1cc9340ee9334bdf1d6a0602..efba94f882c115a1ddfbe30fc33410a60272b79a 100644 (file)
--- a/src/runtime/char-set.scm
+++ b/src/runtime/char-set.scm
@@ -224,6 +224,39 @@ USA.
 
 (define-integrable (rcons start end ilist)
   (cons end (cons start ilist)))
+
+(define (char-set-size char-set)
+  (fix:+ (%low-size (%char-set-low char-set))
+        (%high-size (%char-set-high char-set))))
+
+(define (%low-size low)
+  (let ((low-limit (%low-limit low)))
+
+    (define (find-start i size)
+      (if (fix:< i low-limit)
+         (if (%low-ref low i)
+             (let ((end (find-end (fix:+ i 1))))
+               (find-start end (fix:+ size (fix:- end i))))
+             (find-start (fix:+ i 1) size))
+         size))
+
+    (define (find-end i)
+      (if (fix:< i low-limit)
+         (if (%low-ref low i)
+             (find-end (fix:+ i 1))
+             i)
+         low-limit))
+
+    (find-start 0 0)))
+
+(define (%high-size high)
+  (let ((end (%high-length high)))
+    (do ((index 0 (fix:+ index 2))
+        (size 0
+               (fix:+ size
+                      (fix:- (%high-ref high (fix:+ index 1))
+                             (%high-ref high index)))))
+       ((not (fix:< index end)) size))))
 \f
 (define (make-inversion-list-combiner combine)
 
@@ -378,6 +411,7 @@ USA.
     ((graphic graph) char-set:graphic)
     ((hex-digit xdigit) char-set:hex-digit)
     ((lower-case lower) char-set:lower-case)
+    ((newline nl) char-set:newline)
     ((no-newline nonl) char-set:no-newline)
     ((numeric num) char-set:numeric)
     ((printing print) char-set:printing)
@@ -587,13 +621,10 @@ USA.
 (define char-set:ascii)
 (define char-set:ctls)
 (define char-set:hex-digit)
-(define char-set:newline)
 (define char-set:wsp)
 (define char-wsp?)
 (add-boot-init!
  (lambda ()
-
-   (set! char-set:newline (char-set #\newline))
    (set! char-set:hex-digit (char-set "0123456789abcdefABCDEF"))
 
    ;; Used in RFCs:

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index f3336c19d989720b404251995e1b381ee2c32739..3fd354e6fe8fb2613d7ce1233d96ef398d6cd75c 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1571,10 +1571,12 @@ USA.
   (export ()
          char-alphanumeric?
          char-graphic?
+         char-newline?
          char-printing?
          char-set:alphanumeric
          char-set:control
          char-set:graphic
+         char-set:newline
          char-set:no-newline
          char-set:not-alphabetic
          char-set:not-alphanumeric
@@ -1624,12 +1626,12 @@ USA.
          char-set-invert
          char-set-members
          char-set-predicate
+         char-set-size
          char-set-union
          char-set-union*
          char-set:ascii
          char-set:ctls
          char-set:hex-digit
-         char-set:newline
          char-set:wsp
          char-set=?
          char-set?

diff --git a/src/runtime/ucd-glue.scm b/src/runtime/ucd-glue.scm
index d9e591479f82307b3ae13871c58243e7aa7a9d23..940054b0487bd63555046107f4c52cd880ab4c37 100644 (file)
--- a/src/runtime/ucd-glue.scm
+++ b/src/runtime/ucd-glue.scm
@@ -90,8 +90,10 @@ USA.
 (define-deferred char-set:not-graphic (char-set-invert char-set:graphic))
 (define-deferred char-graphic? (char-set-predicate char-set:graphic))
 
+(define-deferred char-set:newline (char-set #\newline #\return))
 (define-deferred char-set:no-newline
-  (char-set-difference char-set:unicode (char-set #\newline #\return)))
+  (char-set-difference char-set:unicode char-set:newline))
+(define-deferred char-newline? (char-set-predicate char-set:newline))
 
 (define-deferred char-set:printing
   (char-set-union char-set:graphic