From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 25 Feb 2017 05:07:22 +0000 (-0800)
Subject: Implement support for "unmapped" enum types.
X-Git-Tag: mit-scheme-pucked-9.2.12~198^2~24
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c48f0d718c986c58c5bf1702a95e27e213245d21;p=mit-scheme.git

Implement support for "unmapped" enum types.

This maps them to index integers in the same order they appear in the enum.
Also change GCB to be unmapped.
---

diff --git a/src/etc/ucd-converter.scm b/src/etc/ucd-converter.scm
index 29d9b69e2..a66247884 100644
--- a/src/etc/ucd-converter.scm
+++ b/src/etc/ucd-converter.scm
@@ -71,6 +71,9 @@ USA.
        (eq? 'enum (car object))
        (every string? (cdr object))))
 
+(define (unmapped-enum-type-names enum-type)
+  (cdr enum-type))
+
 (define (mapped-enum-type? object)
   (and (list? object)
        (>= (length object) 2)
@@ -503,7 +506,7 @@ USA.
    prop-name metadata prop-alist proc-name))
 
 (define (code-generator:gcb prop-name metadata prop-alist proc-name)
-  ((trie-code-generator (mapped-enum-value-manager #f metadata) '(5 8 8))
+  ((trie-code-generator (unmapped-enum-value-manager #f metadata) '(5 8 8))
    prop-name metadata prop-alist proc-name))
 
 (define (code-generator:nfc-qc prop-name metadata prop-alist proc-name)
@@ -585,10 +588,24 @@ USA.
 			     (error "Illegal rational value:" string))
 			 n)))))
 
-(define (converter:mapped-enum metadata)
-  (let ((name (symbol->string (metadata-full-name metadata)))
-	(translations
-	 (mapped-enum-type-translations (metadata-type-spec metadata))))
+(define (unmapped-enum-value-manager default-string metadata)
+  (value-manager default-string
+		 (enum-converter metadata
+				 (let ((names
+					(unmapped-enum-type-names
+					 (metadata-type-spec metadata))))
+				   (map cons
+					names
+					(iota (length names)))))))
+
+(define (mapped-enum-value-manager default-string metadata)
+  (value-manager default-string
+		 (enum-converter metadata
+				 (mapped-enum-type-translations
+				  (metadata-type-spec metadata)))))
+
+(define (enum-converter metadata translations)
+  (let ((name (symbol->string (metadata-full-name metadata))))
     (lambda (value)
       (if value
 	  (let ((p
@@ -599,9 +616,6 @@ USA.
 		(error (string-append "Illegal " name " value:") value))
 	    (cdr p))
 	  (default-object)))))
-
-(define (mapped-enum-value-manager default-string metadata)
-  (value-manager default-string (converter:mapped-enum metadata)))
 
 (define (hashed-code-generator value-manager)
   (let ((default-string (value-manager-default-string value-manager))
diff --git a/src/etc/ucd-raw-props/names.scm b/src/etc/ucd-raw-props/names.scm
index 5c15cc8f9..914582e8f 100644
--- a/src/etc/ucd-raw-props/names.scm
+++ b/src/etc/ucd-raw-props/names.scm
@@ -53,24 +53,8 @@ USA.
 ("Ext" extender boolean)
 ("FC_NFKC" fc-nfkc-closure code-point+)
 ("GCB" grapheme-cluster-break
- (enum ("CN" . control)
-       ("CR" . carriage-return)
-       ("EB" . emoji-base)
-       ("EBG" . emoji-base-gaz)
-       ("EM" . emoji-modifier)
-       ("EX" . extend)
-       ("GAZ" . glue-after-zero-width-joiner)
-       ("L" . hangul-syllable-type=l)
-       ("LF" . linefeed)
-       ("LV" . hangul-syllable-type=lv)
-       ("LVT" . hangul-syllable-type=lvt)
-       ("PP" . prepend)
-       ("RI" . regional-indicator)
-       ("SM" . spacing-mark)
-       ("T" . hangul-syllable-type=t)
-       ("V" . hangul-syllable-type=v)
-       ("XX" . other)
-       ("ZWJ" . zero-width-joiner)))
+ (enum "CN" "CR" "EB" "EBG" "EM" "EX" "GAZ" "L" "LF"
+       "LV" "LVT" "PP" "RI" "SM" "T" "V" "XX" "ZWJ"))
 ("Gr_Base" grapheme-base boolean)
 ("Gr_Ext" grapheme-extend boolean)
 ("Gr_Link" grapheme-link boolean)