Date: Thursday, September 16, 2010 @ 22:11:10 Author: rtoy Path: /project/cmucl/cvsroot/src/code
Modified: unidata.lisp
o Fix typo in UNICODE-DECOMP. (It's hangul-syllable-p, not hangule-syllable-p.) o Move the computation of *reverse-hangule-choseong*, *reverse-hangul-jungseong*, and *reverse-hangul-jongseong* to its own routine. Call it in UNICODE-NAME-TO-CODEPOINT.
--------------+ unidata.lisp | 47 +++++++++++++++++++++++++---------------------- 1 file changed, 25 insertions(+), 22 deletions(-)
Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.10 src/code/unidata.lisp:1.11 --- src/code/unidata.lisp:1.10 Wed Sep 15 19:32:06 2010 +++ src/code/unidata.lisp Thu Sep 16 22:11:09 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.10 2010-09-15 23:32:06 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.11 2010-09-17 02:11:09 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -15,7 +15,7 @@
(defconstant +unidata-path+ #p"ext-formats:unidata.bin")
-(defvar *unidata-version* "$Revision: 1.10 $") +(defvar *unidata-version* "$Revision: 1.11 $")
(defstruct unidata range @@ -649,6 +649,27 @@ ;; the values here. (<= #xAC00 code #xD7A3))
+(defun initialize-reverse-hangul-tables () + (unless (boundp '*reverse-hangul-choseong*) + (setq *reverse-hangul-choseong* + (sort (coerce (loop for x across +hangul-choseong+ + as i upfrom 0 by 588 + collect (cons x i)) + 'vector) + #'> :key (lambda (x) (length (car x))))) + (setq *reverse-hangul-jungseong* + (sort (coerce (loop for x across +hangul-jungseong+ + as i upfrom 0 by 28 + collect (cons x i)) + 'vector) + #'> :key (lambda (x) (length (car x))))) + (setq *reverse-hangul-jongseong* + (sort (coerce (loop for x across +hangul-jongseong+ + as i upfrom 1 + collect (cons x i)) + 'vector) + #'> :key (lambda (x) (length (car x))))))) + (defun unicode-name-to-codepoint (name) (declare (type string name)) (cond ((and (> (length name) 22) @@ -669,25 +690,7 @@ :start (+ x 8))) (ll nil) (vv nil) (tt 0)) (unless n (return-from unicode-name-to-codepoint nil)) - (unless (boundp '*reverse-hangul-choseong*) - (setq *reverse-hangul-choseong* - (sort (coerce (loop for x across +hangul-choseong+ - as i upfrom 0 by 588 - collect (cons x i)) - 'vector) - #'> :key (lambda (x) (length (car x))))) - (setq *reverse-hangul-jungseong* - (sort (coerce (loop for x across +hangul-jungseong+ - as i upfrom 0 by 28 - collect (cons x i)) - 'vector) - #'> :key (lambda (x) (length (car x))))) - (setq *reverse-hangul-jongseong* - (sort (coerce (loop for x across +hangul-jongseong+ - as i upfrom 1 - collect (cons x i)) - 'vector) - #'> :key (lambda (x) (length (car x)))))) + (initialize-reverse-hangul-tables) (loop for (x . y) across *reverse-hangul-choseong* when (and (<= (+ n (length x)) (length name)) (string= name x :start1 n :end1 (+ n (length x)))) @@ -863,7 +866,7 @@ (defun unicode-decomp (code &optional (compatibility t)) (declare (optimize (speed 3) (space 0) (safety 0)) (type codepoint code)) - (if (hangule-syllable-p code) + (if (hangul-syllable-p code) ;; Hangul syllables. (See ;; http://www.unicode.org/reports/tr15/#Hangul for the ;; algorithm.)