X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tools-for-build%2Fucd.lisp;h=b1cae492216d061b327bb402bbbae9dfbeaf1ab0;hb=1f03c7f326823245708a84af86b31ac72bdb1742;hp=599fda87849f4efa97de5307ee52314da2929f6f;hpb=ba1d157b8797b9c0e66b457221d4c2fbbd0261fb;p=sbcl.git

diff --git a/tools-for-build/ucd.lisp b/tools-for-build/ucd.lisp
index 599fda8..b1cae49 100644
--- a/tools-for-build/ucd.lisp
+++ b/tools-for-build/ucd.lisp
@@ -114,8 +114,44 @@
           do (slurp-ucd-line line)))
   (second-pass)
   (build-misc-table)
+  (fixup-hangul-syllables)
   *decompositions*)
 
+(defun fixup-hangul-syllables ()
+  ;; "Hangul Syllable Composition, Unicode 5.1 section 3-12"
+  (let* ((sbase #xac00)
+         (lbase #x1100)
+         (vbase #x1161)
+         (tbase #x11a7)
+         (scount 11172)
+         (lcount 19)
+         (vcount 21)
+         (tcount 28)
+         (ncount (* vcount tcount))
+         (table (make-hash-table)))
+    (with-open-file (*standard-input*
+                     (make-pathname :name "Jamo" :type "txt"
+                                    :defaults *unicode-character-database*))
+      (loop for line = (read-line nil nil)
+            while line
+            if (position #\; line)
+            do (add-jamo-information line table)))
+    (dotimes (sindex scount)
+      (let* ((l (+ lbase (floor sindex ncount)))
+             (v (+ vbase (floor (mod sindex ncount) tcount)))
+             (tee (+ tbase (mod sindex tcount)))
+             (name (format nil "HANGUL_SYLLABLE_~A~A~:[~A~;~]"
+                           (gethash l table) (gethash v table)
+                           (= tee tbase) (gethash tee table))))
+        (setf (gethash (+ sbase sindex) *unicode-names*) name)))))
+
+(defun add-jamo-information (line table)
+  (let* ((split (split-string line #\;))
+         (code (parse-integer (first split) :radix 16))
+         (syllable (string-trim '(#\Space)
+                                (subseq (second split) 0 (position #\# (second split))))))
+    (setf (gethash code table) syllable)))
+
 (defun split-string (line character)
   (loop for prev-position = 0 then (1+ position)
         for position = (position character line :start prev-position)
@@ -420,17 +456,17 @@
   (values))
 
 ;;; The stuff below is dependent on misc.lisp-expr being
-;;; (:LENGTH 206 :UPPERCASE (0 2) :LOWERCASE (1 3) :TITLECASE (4)).
+;;; (:LENGTH 215 :UPPERCASE (0 2) :LOWERCASE (1 3) :TITLECASE (4)).
 ;;;
 ;;; There are two entries for UPPERCASE and LOWERCASE because some
 ;;; characters have case (by Unicode standards) but are not
-;;; transformable character-by-character in a locale-independet way
+;;; transformable character-by-character in a locale-independent way
 ;;; (as CL requires for its standard operators).
 ;;;
 ;;; for more details on these debugging functions, see the description
 ;;; of the character database format in src/code/target-char.lisp
 
-(defparameter *length* 206)
+(defparameter *length* 215)
 
 (defun cp-index (cp)
   (let* ((cp-high (cp-high cp))