From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 3 May 2017 07:50:33 +0000 (-0700)
Subject: Add named character sets.
X-Git-Tag: mit-scheme-pucked-9.2.12~14^2~88
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=65a41a57c925870c101729095947476837f51525;p=mit-scheme.git

Add named character sets.
---

diff --git a/src/runtime/chrset.scm b/src/runtime/chrset.scm
index 49c55f918..dd33e8b95 100644
--- a/src/runtime/chrset.scm
+++ b/src/runtime/chrset.scm
@@ -278,6 +278,11 @@ USA.
 	   (loop (cdr cpl)
 		 ranges
 		 (cons (car cpl) char-sets)))
+	  ((name->char-set (car cpl))
+	   => (lambda (char-set)
+		(loop (cdr cpl)
+		      ranges
+		      (cons char-set char-sets))))
 	  (else
 	   (error:not-a cpl-element? (car cpl))))))
 
@@ -337,7 +342,20 @@ USA.
   (or (%range? object)
       (bitless-char? object)
       (string? object)
-      (char-set? object)))
+      (char-set? object)
+      (name->char-set object)))
+
+(define (name->char-set name)
+  (case name
+    ((alphabetic) char-set:alphabetic)
+    ((alphanumeric) char-set:alphanumeric)
+    ((cased) char-set:cased)
+    ((lower-case) char-set:lower-case)
+    ((numeric) char-set:numeric)
+    ((unicode) char-set:unicode)
+    ((upper-case) char-set:upper-case)
+    ((whitespace) char-set:whitespace)
+    (else #f)))
 
 (define (%range? object)
   (or (and (pair? object)