- cmucl-cvs - mailman3.common-lisp.net

[cmucl-cvs] CMUCL commit: src/code (unidata.lisp)
by Raymond Toy 20 Sep '10

20 Sep '10

Date: Sunday, September 19, 2010 @ 20:59:22 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: unidata.lisp Improve completion of Hangul syllables and CJK unified ideographs some more and fix some bugs in previous change. --------------+ unidata.lisp | 87 ++++++++++++++++++++++----------------------------------- 1 file changed, 35 insertions(+), 52 deletions(-) Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.19 src/code/unidata.lisp:1.20 --- src/code/unidata.lisp:1.19 Sun Sep 19 19:07:46 2010 +++ src/code/unidata.lisp Sun Sep 19 20:59:22 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.19 2010-09-19 23:07:46 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.20 2010-09-20 00:59:22 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,7 @@ (defconstant +unidata-path+ #p"ext-formats:unidata.bin") -(defvar *unidata-version* "$Revision: 1.19 $") +(defvar *unidata-version* "$Revision: 1.20 $") (defstruct unidata range @@ -1274,62 +1274,45 @@ completions starting with Prefix. If there is no match, NIL is returned." (let (names) - (cond ((search "Hangul_Syllable_" prefix) - (initialize-reverse-hangul-tables) - (unless *hangul-syllable-dictionary* - (build-hangul-syllable-dictionary)) - (multiple-value-bind (prefix-match next completep) - (unicode-complete-name (subseq prefix 16) - *hangul-syllable-dictionary*) - (loop for x in next - do (push (concatenate 'string "Hangul_Syllable_" prefix-match x) - names)) - (when completep - (push (concatenate 'string "Hangul_Syllable_" prefix-match) - names)))) - ((search "Cjk_Unified_Ideograph-" prefix) - (unless *cjk-unified-ideograph-dictionary* - (build-cjk-unified-ideograph-dictionary)) - (multiple-value-bind (prefix-match next completep) - (unicode-complete-name (subseq prefix 22) - *cjk-unified-ideograph-dictionary*) - (loop for x in next - do (push (concatenate 'string "Cjk_Unified_Ideograph-" prefix-match x) - names)) - (when completep - (push (concatenate 'string "Cjk_Unified_Ideograph-" prefix-match) - names))))) (multiple-value-bind (prefix-match next completep) (unicode-complete-name prefix dict) (loop for x in next do (push (concatenate 'string prefix-match x) names)) (when completep (push prefix-match names)) - ;; Match prefix against Hangul and/or Hangul_syllable - (cond ((search "Hangul_S" prefix-match - :end1 (min 8 (length prefix-match))) - ;; Add syllable as possible completion, and then try to - ;; complete some more so that we don't end up with slime - ;; saying "Hangul_Syllable_" is the only completion. - (multiple-value-bind (m suffixes) - (unicode-complete-name (subseq prefix-match (min 16 (length prefix-match))) - *hangul-syllable-dictionary*) - (declare (ignore m)) - (if suffixes - (loop for n in suffixes - do (push (concatenate 'string "Hangul_Syllable_" n) names)) - (push "Hangul_Syllable_" names)))) - ((or ;;(string= prefix-match "Cjk_") - (search "Cjk_Unified_Ideograph-" prefix-match - :end1 (min 22 (length prefix-match)))) - ;; Try to complete the first part so we don't get - ;; "Cjk_Unified_Ideograph-" as the only completion. - (multiple-value-bind (m suffixes) - (unicode-complete-name (subseq prefix-match (min 22 (length prefix-match))) - *cjk-unified-ideograph-dictionary*) - (declare (ignore m)) - (loop for n in suffixes - do (push (concatenate 'string "Cjk_Unified_Ideograph-" n) names))))) + (flet ((han-or-cjk-completion (prefix-match prefix dictionary) + (let* ((prefix-tail (subseq prefix-match + (min (length prefix) + (length prefix-match)))) + (full-prefix (concatenate 'string prefix prefix-tail))) + (multiple-value-bind (m suffixes) + (unicode-complete-name prefix-tail dictionary) + (declare (ignore m)) + (if suffixes + (loop for n in suffixes + do (push (concatenate 'string full-prefix n) names)) + (push full-prefix names)))))) + ;; Match prefix for Hangul syllables or CJK unified ideographs. + (cond ((char= (char prefix-match 0) #\H) + ;; Add "Hangul_Syllable_" as possible completion for + ;; anything beginning with "H". + (push "Hangul_Syllable_" names) + (when (<= (length names) 1) + ;; Hangul_Syllable is the only match, so let's extend it. + (unless *hangul-syllable-dictionary* + (initialize-reverse-hangul-tables) + (build-hangul-syllable-dictionary)) + (han-or-cjk-completion prefix-match "Hangul_Syllable_" + *hangul-syllable-dictionary*))) + ((char= (char prefix-match 0) #\C) + ;; Add "Cjk_Unified_Ideograph-" as possible completion + ;; for anything beginning with "C". + (push "Cjk_Unified_Ideograph-" names) + (when (<= (length names) 1) + (unless *cjk-unified-ideograph-dictionary* + (build-cjk-unified-ideograph-dictionary)) + (han-or-cjk-completion prefix-match "Cjk_Unified_Ideograph-" + *cjk-unified-ideograph-dictionary*))))) (setf names (mapcar #'string-capitalize names)) ;;(format t "Final names = ~S~%" names) names)))

1 0

[cmucl-cvs] CMUCL commit: src/code (unidata.lisp)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Sunday, September 19, 2010 @ 19:07:46 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: unidata.lisp o Move %STR, %STRX and %MATCH around so that we can inline them (because they're so simple). o Add some comments for %STR. o Change implementation of %MATCH to be simpler and add comments on why we do what we do and explain what happens if we don't. o Handle completion of Hangul syllables better: - Match "Hangul_S" instead of "Hangul_Syllable" because there's #\Hangul_Single_Dot_Tone_Mark. - If we match "Hangul_S", try to complete some Hangul syllables so we don't fool slime into thinking "Hangul_Syllable_" is the only completion. There are obviously more. o Handle completion of CJK Unified Ideographs better by trying to complete more so slime isn't fooled into thinking "CJK_Unified_Ideograph-" is the only possible completion. --------------+ unidata.lisp | 91 +++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 63 insertions(+), 28 deletions(-) Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.18 src/code/unidata.lisp:1.19 --- src/code/unidata.lisp:1.18 Sat Sep 18 22:37:10 2010 +++ src/code/unidata.lisp Sun Sep 19 19:07:46 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.18 2010-09-19 02:37:10 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.19 2010-09-19 23:07:46 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,7 @@ (defconstant +unidata-path+ #p"ext-formats:unidata.bin") -(defvar *unidata-version* "$Revision: 1.18 $") +(defvar *unidata-version* "$Revision: 1.19 $") (defstruct unidata range @@ -1132,7 +1132,43 @@ (defvar *cjk-unified-ideograph-dictionary* nil "Dictionary of CJK Unified ideographs") -;; +;; Convert the string into the form we want for character names. +;; Basically the Unicode name has spaces replaced by underscores, and +;; the result is capitalized. +(declaim (inline %str %strx)) +(defun %str (x) + (nsubstitute #\_ #\Space (string-capitalize x))) + +(defun %strx (x) + (%str (car x))) + +(declaim (inline %match)) +#+(or) +(defun %match (part prefix posn) + (and (>= (length part) (- (length prefix) posn)) + (string= part prefix :start2 posn :end1 (- (length prefix) posn)))) + +#+(or) +(defun %match (part prefix posn) + (let ((s1 (search part prefix :start2 posn)) + (s2 (search prefix part :start1 posn))) + (or (and s1 (= s1 posn)) + (and s2 (zerop s2))))) + +;; Test if the string PART matches the string PREFIX starting from +;; position POSN. Basically test that the initial parts of the +;; strings match each other exactly. For if the prefix is "BO", then +;; both "B" and "BOX" should match. (This is needed to get the +;; completion of "cjk_radical_bo" to match "cjk_radical_box" as well +;; as "cjk_radical_bone" and others because at one point in the +;; algorithm the part is "B", which we do want to match "BO" so that +;; we can get the possible completions BONE" and "BOLT OF CLOTH". +(defun %match (part prefix posn) + (let ((len (min (length part) + (- (length prefix) posn)))) + (string= part prefix :end1 len :start2 posn :end2 (+ posn len)))) + + (defun unicode-complete-name (prefix &optional (dict (unidata-name+ *unicode-data*))) @@ -1270,36 +1306,35 @@ (when completep (push prefix-match names)) ;; Match prefix against Hangul and/or Hangul_syllable - (cond ((or (string= prefix-match "Hangul_") - (search "Hangul_Syllable_" prefix-match :end1 (min 16 (length prefix-match)))) - ;; Add syllable as possible completion - (push "Hangul_Syllable_" names)) + (cond ((search "Hangul_S" prefix-match + :end1 (min 8 (length prefix-match))) + ;; Add syllable as possible completion, and then try to + ;; complete some more so that we don't end up with slime + ;; saying "Hangul_Syllable_" is the only completion. + (multiple-value-bind (m suffixes) + (unicode-complete-name (subseq prefix-match (min 16 (length prefix-match))) + *hangul-syllable-dictionary*) + (declare (ignore m)) + (if suffixes + (loop for n in suffixes + do (push (concatenate 'string "Hangul_Syllable_" n) names)) + (push "Hangul_Syllable_" names)))) ((or ;;(string= prefix-match "Cjk_") - (search "Cjk_Unified_Ideograph-" prefix-match :end1 (min 22 (length prefix-match)))) - ;; Add Unified - (push "Cjk_Unified_Ideograph-" names))) + (search "Cjk_Unified_Ideograph-" prefix-match + :end1 (min 22 (length prefix-match)))) + ;; Try to complete the first part so we don't get + ;; "Cjk_Unified_Ideograph-" as the only completion. + (multiple-value-bind (m suffixes) + (unicode-complete-name (subseq prefix-match (min 22 (length prefix-match))) + *cjk-unified-ideograph-dictionary*) + (declare (ignore m)) + (loop for n in suffixes + do (push (concatenate 'string "Cjk_Unified_Ideograph-" n) names))))) (setf names (mapcar #'string-capitalize names)) ;;(format t "Final names = ~S~%" names) names))) -;; Convert the string into the form we want for character names. -(defun %str (x) - (nsubstitute #\_ #\Space (string-capitalize x))) - -(defun %strx (x) - (%str (car x))) - -#+(or) -(defun %match (part prefix posn) - (and (>= (length part) (- (length prefix) posn)) - (string= part prefix :start2 posn :end1 (- (length prefix) posn)))) - -(defun %match (part prefix posn) - (let ((s1 (search part prefix :start2 posn)) - (s2 (search prefix part :start1 posn))) - (or (and s1 (= s1 posn)) - (and s2 (zerop s2))))) - +;; Find the longest initial substring of the STRINGS. (defun %mip (strings) (let* ((first (first strings)) (posn (length first)))

1 0

[cmucl-cvs] CMUCL commit: src/general-info (release-20b.txt)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Sunday, September 19, 2010 @ 00:10:52 Author: rtoy Path: /project/cmucl/cvsroot/src/general-info Modified: release-20b.txt Merge from 20b-branch for bug fix for Unicode 1.0 names. -----------------+ release-20b.txt | 3 +++ 1 file changed, 3 insertions(+) Index: src/general-info/release-20b.txt diff -u src/general-info/release-20b.txt:1.48 src/general-info/release-20b.txt:1.49 --- src/general-info/release-20b.txt:1.48 Wed Sep 8 20:22:03 2010 +++ src/general-info/release-20b.txt Sun Sep 19 00:10:52 2010 @@ -205,6 +205,9 @@ - For SSE2 builds, SIGCONTEXT-FLOAT-REGISTER returned the wrong value for single-floats. Easily noticead when tracing a function with single-float arguments. + - The table for Unicode 1.0 names was constructed incorrectly. + Thus, UNICODE-1.0-NAME would return the wrong names for many + (all?) codepoints. * Trac Tickets: #33: get-dispatch-macro-character doesn't signal errors in

1 0

[cmucl-cvs] CMUCL commit: src/i18n (unidata.bin)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Sunday, September 19, 2010 @ 00:10:16 Author: rtoy Path: /project/cmucl/cvsroot/src/i18n Modified: unidata.bin Regenerated with correct table for Unicode 1.0 names. -------------+ unidata.bin | <<Binary file>> 1 file changed, 1 insertion(+) Index: src/i18n/unidata.bin <<Binary file>>

1 0

[cmucl-cvs] CMUCL commit: RELEASE-20B-BRANCH src (general-info/release-20b.txt i18n/unidata.bin)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Saturday, September 18, 2010 @ 23:46:03 Author: rtoy Path: /project/cmucl/cvsroot/src Tag: RELEASE-20B-BRANCH Modified: general-info/release-20b.txt i18n/unidata.bin release-20b.txt: o Note bug fix for Unicode 1.0 names unidata.bin: o Regenerated with correct table for Unicode 1.0 names. ------------------------------+ general-info/release-20b.txt | 3 +++ i18n/unidata.bin | <<Binary file>> 2 files changed, 4 insertions(+) Index: src/general-info/release-20b.txt diff -u src/general-info/release-20b.txt:1.41.2.6 src/general-info/release-20b.txt:1.41.2.7 --- src/general-info/release-20b.txt:1.41.2.6 Wed Sep 8 20:23:56 2010 +++ src/general-info/release-20b.txt Sat Sep 18 23:46:02 2010 @@ -200,6 +200,9 @@ - For SSE2 builds, SIGCONTEXT-FLOAT-REGISTER returned the wrong value for single-floats. Easily noticead when tracing a function with single-float arguments. + - The table for Unicode 1.0 names was constructed incorrectly. + Thus, UNICODE-1.0-NAME would return the wrong names for many + (all?) codepoints. * Trac Tickets: #33: get-dispatch-macro-character doesn't signal errors in Index: src/i18n/unidata.bin <<Binary file>>

1 0

[cmucl-cvs] CMUCL commit: RELEASE-20B-BRANCH src/tools (build-unidata.lisp)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Saturday, September 18, 2010 @ 23:31:40 Author: rtoy Path: /project/cmucl/cvsroot/src/tools Tag: RELEASE-20B-BRANCH Modified: build-unidata.lisp Merge fix for long standing bug where the trie for Unicode 1.0 names was given the wrong split value. --------------------+ build-unidata.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) Index: src/tools/build-unidata.lisp diff -u src/tools/build-unidata.lisp:1.4 src/tools/build-unidata.lisp:1.4.14.1 --- src/tools/build-unidata.lisp:1.4 Fri Sep 11 12:22:35 2009 +++ src/tools/build-unidata.lisp Sat Sep 18 23:31:40 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/tools/build-unidata.lisp,v 1.4 2009-09-11 16:22:35 rtoy Rel $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/tools/build-unidata.lisp,v 1.4.14.1 2010-09-19 03:31:40 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -980,7 +980,7 @@ (multiple-value-bind (hvec mvec lvec) (pack ucd range (lambda (x) (pack-name x t dict)) 0 32 #x54) (setf (unidata-name1 *unicode-data*) - (make-ntrie32 :split #x72 :hvec hvec :mvec mvec :lvec lvec)))) + (make-ntrie32 :split #x54 :hvec hvec :mvec mvec :lvec lvec)))) (format t "~&Building general category table~%") (multiple-value-bind (hvec mvec lvec)

1 0

[cmucl-cvs] CMUCL commit: src/tools (build-unidata.lisp)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Saturday, September 18, 2010 @ 23:31:12 Author: rtoy Path: /project/cmucl/cvsroot/src/tools Modified: build-unidata.lisp Oops. Fix long standing bug where the trie for Unicode 1.0 names was given the wrong split value. --------------------+ build-unidata.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) Index: src/tools/build-unidata.lisp diff -u src/tools/build-unidata.lisp:1.7 src/tools/build-unidata.lisp:1.8 --- src/tools/build-unidata.lisp:1.7 Sat Sep 18 16:58:28 2010 +++ src/tools/build-unidata.lisp Sat Sep 18 23:31:12 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/tools/build-unidata.lisp,v 1.7 2010-09-18 20:58:28 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/tools/build-unidata.lisp,v 1.8 2010-09-19 03:31:12 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -973,7 +973,7 @@ (multiple-value-bind (hvec mvec lvec) (pack ucd range (lambda (x) (pack-name x t dict)) 0 32 #x54) (setf (unidata-name1 *unicode-data*) - (make-ntrie32 :split #x72 :hvec hvec :mvec mvec :lvec lvec)))) + (make-ntrie32 :split #x54 :hvec hvec :mvec mvec :lvec lvec)))) (format t "~&Building general category table~%") (multiple-value-bind (hvec mvec lvec)

1 0

[cmucl-cvs] CMUCL commit: src/code (unidata.lisp)
by Raymond Toy 19 Sep '10

19 Sep '10

Date: Saturday, September 18, 2010 @ 22:37:11 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: unidata.lisp o Construction of the Hangul syllable codebook was wrong. To satisfy the constraints on the codebook, we just sort them in descreasing order of length. o In %MIP, it might happen that MISMATCH returns NIL, which means a match. In this case, don't change the position. --------------+ unidata.lisp | 33 ++++++++++++++++++++++----------- 1 file changed, 22 insertions(+), 11 deletions(-) Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.17 src/code/unidata.lisp:1.18 --- src/code/unidata.lisp:1.17 Sat Sep 18 17:38:10 2010 +++ src/code/unidata.lisp Sat Sep 18 22:37:10 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.17 2010-09-18 21:38:10 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.18 2010-09-19 02:37:10 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,7 @@ (defconstant +unidata-path+ #p"ext-formats:unidata.bin") -(defvar *unidata-version* "$Revision: 1.17 $") +(defvar *unidata-version* "$Revision: 1.18 $") (defstruct unidata range @@ -1304,7 +1304,7 @@ (let* ((first (first strings)) (posn (length first))) (dolist (string (rest strings)) - (setq posn (mismatch first string :end1 posn))) + (setq posn (or (mismatch first string :end1 posn) posn))) (subseq first 0 posn))) (defun node-next (i &optional (dict (unidata-name+ *unicode-data*))) @@ -1334,15 +1334,23 @@ (defun build-hangul-syllable-dictionary () "Build the dictionary for Hangul syllables" (format t "~&Building Hangul Syllable dictionary. Please wait...~%") + (force-output) (initialize-reverse-hangul-tables) (let ((hangul-codebook - (map 'vector #'car - (delete "" - (concatenate 'vector - *reverse-hangul-choseong* - *reverse-hangul-jungseong* - *reverse-hangul-jongseong*) - :test #'string= :key #'car))) + ;; For our codebook, combine all the choseong, jungseong, and + ;; jonseong syllables, but removing empty strings (there's at + ;; least one). Then sort these according to length. This + ;; ensures that if A is an initial substring of B, then B + ;; must come before A (or A will never be used). (See + ;; tools/build-unidata.lisp, *codebook*.) + (sort (map 'vector #'car + (delete "" + (concatenate 'vector + *reverse-hangul-choseong* + *reverse-hangul-jungseong* + *reverse-hangul-jongseong*) + :test #'string= :key #'car)) + #'> :key #'length)) (names (loop for codepoint from 0 below codepoint-limit when (hangul-syllable-p codepoint) @@ -1352,13 +1360,15 @@ codepoint)))) (setf *hangul-syllable-dictionary* - (build-dictionary hangul-codebook (nreverse names))) + (build-dictionary hangul-codebook names)) (format t "~&Done.~%") + (force-output) (values))) (defun build-cjk-unified-ideograph-dictionary () "Build the dictionary for CJK Unified Ideographs" (format t "~&Building CJK Unified Ideographs dictionary. Please wait...~%") + (force-output) (let ((codebook (coerce (loop for k from 0 to 15 collect (format nil "~X" k)) 'vector)) @@ -1369,6 +1379,7 @@ (setf *cjk-unified-ideograph-dictionary* (build-dictionary codebook names)) (format t "~&Done.~%") + (force-output) (values))) ;; The definitions of BUILD-DICTIONARY, NAME-LOOKUP, and ENCODE-NAME

1 0

[cmucl-cvs] CMUCL commit: src/code (unidata.lisp)
by Raymond Toy 18 Sep '10

18 Sep '10

Date: Saturday, September 18, 2010 @ 17:38:11 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: unidata.lisp Some Hangul syllables were left out of the Hangul syllable dictionary. Redo this by looping over all codepoints and selecting the codepoints that are Hangul syllables. --------------+ unidata.lisp | 24 ++++++++++-------------- 1 file changed, 10 insertions(+), 14 deletions(-) Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.16 src/code/unidata.lisp:1.17 --- src/code/unidata.lisp:1.16 Sat Sep 18 17:10:42 2010 +++ src/code/unidata.lisp Sat Sep 18 17:38:10 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.16 2010-09-18 21:10:42 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.17 2010-09-18 21:38:10 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,7 @@ (defconstant +unidata-path+ #p"ext-formats:unidata.bin") -(defvar *unidata-version* "$Revision: 1.16 $") +(defvar *unidata-version* "$Revision: 1.17 $") (defstruct unidata range @@ -1343,18 +1343,14 @@ *reverse-hangul-jungseong* *reverse-hangul-jongseong*) :test #'string= :key #'car))) - (k 0) - names) - (loop for choseong across *reverse-hangul-choseong* do - (loop for junseong across *reverse-hangul-jungseong* do - (loop for jongseong across *reverse-hangul-jongseong* do - (push (cons (format nil "~A~A~A" - (car choseong) - (car junseong) - (car jongseong)) - k) - names) - (incf k)))) + (names + (loop for codepoint from 0 below codepoint-limit + when (hangul-syllable-p codepoint) + collect (cons (subseq (format nil "~A" + (string-upcase (char-name (code-char codepoint)))) + 16) + codepoint)))) + (setf *hangul-syllable-dictionary* (build-dictionary hangul-codebook (nreverse names))) (format t "~&Done.~%")

1 0

[cmucl-cvs] CMUCL commit: src (code/unidata.lisp i18n/unidata.bin)
by Raymond Toy 18 Sep '10

18 Sep '10

Date: Saturday, September 18, 2010 @ 17:10:42 Author: rtoy Path: /project/cmucl/cvsroot/src Modified: code/unidata.lisp i18n/unidata.bin code/unidata.lisp: o Update constants to Unicode version 5.2.0. i18n/unidata.bin: o Regenerated using Unicode version 5.2.0. -------------------+ code/unidata.lisp | 6 +++--- i18n/unidata.bin | <<Binary file>> 2 files changed, 4 insertions(+), 3 deletions(-) Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.15 src/code/unidata.lisp:1.16 --- src/code/unidata.lisp:1.15 Sat Sep 18 16:47:51 2010 +++ src/code/unidata.lisp Sat Sep 18 17:10:42 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.15 2010-09-18 20:47:51 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.16 2010-09-18 21:10:42 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,7 @@ (defconstant +unidata-path+ #p"ext-formats:unidata.bin") -(defvar *unidata-version* "$Revision: 1.15 $") +(defvar *unidata-version* "$Revision: 1.16 $") (defstruct unidata range @@ -57,7 +57,7 @@ ;; The expected Unicode version. This needs to be synced with ;; build-unidata.lisp. (defconstant +unicode-major-version+ 5) -(defconstant +unicode-minor-version+ 1) +(defconstant +unicode-minor-version+ 2) (defconstant +unicode-update-version+ 0) ;;; These need to be synched with tools/build-unidata.lisp Index: src/i18n/unidata.bin <<Binary file>>

1 0