Change UCD converter to ignore derived properties.

diff --git a/src/etc/ucd-converter.scm b/src/etc/ucd-converter.scm
index d0eefd11c1c4d0cccb39ccee47961b3152fa2285..576b3d47d5ccd90457b0f64e072ce3b58db2ec62 100644 (file)
--- a/src/etc/ucd-converter.scm
+++ b/src/etc/ucd-converter.scm
@@ -48,7 +48,7 @@ USA.
 
 (define (well-formed-metadata-spec? object)
   (and (list? object)
-       (= 3 (length object))
+       (memv (length object) '(3 4))
        (string? (car object))
        (symbol? (cadr object))
        (property-type? (caddr object))))
@@ -123,15 +123,19 @@ USA.
               (error "Ill-formed property metadata record:" metadata))
           (make-metadata (car metadata)
                          (cadr metadata)
-                         (caddr metadata)))
+                         (caddr metadata)
+                         (if (pair? (cdddr metadata))
+                             (cadddr metadata)
+                             #f)))
         properties)))
 
 (define-record-type <metadata>
-    (make-metadata name full-name type-spec)
+    (make-metadata name full-name type-spec note)
     metadata?
   (name metadata-name)
   (full-name metadata-full-name)
-  (type-spec metadata-type-spec))
+  (type-spec metadata-type-spec)
+  (note metadata-note))
 
 (define ucd-property-metadata
   (read-ucd-property-metadata))
@@ -158,12 +162,13 @@ USA.
       (lambda (port)
        (write-line ucd-version port)))
     (for-each (lambda (metadata)
-               (let ((prop-name (metadata-name metadata)))
-                 (write-prop-file
-                  prop-name
-                  ucd-version
-                  (single-repertoire-property (string->symbol prop-name)
-                                              document))))
+               (if (not (eq? 'derived (metadata-note metadata)))
+                   (let ((prop-name (metadata-name metadata)))
+                     (write-prop-file
+                      prop-name
+                      ucd-version
+                      (single-repertoire-property (string->symbol prop-name)
+                                                  document)))))
               ucd-property-metadata)))
 
 (define (write-prop-file prop-name ucd-version prop-alist)
@@ -596,8 +601,7 @@ USA.
               (symbol "ucd-" (string-downcase prop-name) "-value"))))
 
 (define (metadata->code-generator metadata)
-  (let ((name (metadata-name metadata))
-       (type-spec (metadata-type-spec metadata)))
+  (let ((type-spec (metadata-type-spec metadata)))
     (cond ((eq? type-spec 'boolean) code-generator:boolean)
          ((eq? type-spec 'ccc) code-generator:ccc)
          ((eq? type-spec 'code-point) code-generator:code-point)
@@ -873,7 +877,7 @@ USA.
        `((define (,proc-name char)
             ,(let ((accesses
                     `(let ((sv (char->integer char)))
-                       ,(generate-accesses prop-name 'sv tables)))
+                       ,(generate-accesses 'sv tables)))
                    (default (runtime-default 'char)))
                (if default
                    `(or ,accesses ,default)
@@ -891,7 +895,7 @@ USA.
          #f
           (value-converter value)))))
 
-(define (generate-accesses prop-name sv-expr tables)
+(define (generate-accesses sv-expr tables)
   (define (generate-access table index)
     ((trie-table-accessor table)
      (trie-table-name table)
@@ -1122,12 +1126,12 @@ USA.
     (lambda ()
       (if (pair? alist)
          (let ((end (fix:+ start step)))
-           (receive (head tail) (slice-prop-alist-at alist start end)
+           (receive (head tail) (slice-prop-alist-at alist end)
              (cons head
                    (loop tail end))))
          '()))))
 
-(define (slice-prop-alist-at alist start end)
+(define (slice-prop-alist-at alist end)
   (let loop ((tail alist) (head '()))
     (if (pair? tail)
        (let ((entry (car tail)))

diff --git a/src/etc/ucd-raw-props/names.scm b/src/etc/ucd-raw-props/names.scm
index 22e6505363eb79ce643ff4804480611f155566ee..a62088a519b6031847046c6c5a53b3e90b4d0238 100644 (file)
--- a/src/etc/ucd-raw-props/names.scm
+++ b/src/etc/ucd-raw-props/names.scm
@@ -460,8 +460,8 @@ USA.
 ("bmg" mirror-image code-point?)
 ("bpb" bidi-paired-bracket code-point)
 ("bpt" bidi-paired-bracket-type (enum "o" "c" "n"))
-("canonical-cm" canonical-composition-mapping u16)
-("canonical-dm" canonical-decomposition-mapping code-point*)
+("canonical-cm" canonical-composition-mapping u16 derived)
+("canonical-dm" canonical-decomposition-mapping code-point* derived)
 ("ccc" combining-class ccc)
 ("cf" case-folding code-point+)
 ("dm" decomposition-mapping code-point*)