[cmucl-cvs] CMUCL commit: src (code/unidata.lisp tools/build-unidata.lisp)

Raymond Toy rtoy at common-lisp.net
Sat Sep 18 20:47:51 UTC 2010


    Date: Saturday, September 18, 2010 @ 16:47:51
  Author: rtoy
    Path: /project/cmucl/cvsroot/src

Modified: code/unidata.lisp tools/build-unidata.lisp

code/unidata.lisp:
o Just add some comments on why we don't put the dictionaries in
  unidata.bin.
o Print out some messages when building the hangul and cjk
  dictionaries so the user knows what's happening.

tools/build-unidata.lisp:
o Add some comments on the various parts of unidata.bin.


--------------------------+
 code/unidata.lisp        |   25 +++++++++++++++++++++----
 tools/build-unidata.lisp |   41 +++++++++++++++++++++++------------------
 2 files changed, 44 insertions(+), 22 deletions(-)


Index: src/code/unidata.lisp
diff -u src/code/unidata.lisp:1.14 src/code/unidata.lisp:1.15
--- src/code/unidata.lisp:1.14	Fri Sep 17 19:29:01 2010
+++ src/code/unidata.lisp	Sat Sep 18 16:47:51 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.14 2010-09-17 23:29:01 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.15 2010-09-18 20:47:51 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -18,7 +18,7 @@
 
 (defconstant +unidata-path+ #p"ext-formats:unidata.bin")
 
-(defvar *unidata-version* "$Revision: 1.14 $")
+(defvar *unidata-version* "$Revision: 1.15 $")
 
 (defstruct unidata
   range
@@ -1116,6 +1116,17 @@
 ;; Code written by Paul Foley, with some modifications by Raymond Toy.
 ;;
 
+;; These hold dictionaries for the Hangul syllables and the CJK
+;; unified ideographs.  Note that these could be stored in
+;; unidata.bin, but that adds almost a megabyte to the size of
+;; unidata.bin.  That seems way to much bloat for something that is
+;; probably not used that much.  However, this incurs a runtime cost
+;; the first time it needs to be accessed.  On a 450 MHz sparc, it
+;; takes 55 sec for the cjk dictionary and 9 sec for the Hangul
+;; dictionary.  A bit long but not too bad.  On a 2 GHz mac mini, it
+;; takes 5 sec and .8 sec, respectively.  This seems reasonable,
+;; especially since the intent is for character completion, which
+;; doesn't have to be too fast.
 (defvar *hangul-syllable-dictionary* nil
   "Dictionary of Hangul syllables")
 (defvar *cjk-unified-ideograph-dictionary* nil
@@ -1322,6 +1333,7 @@
 
 (defun build-hangul-syllable-dictionary ()
   "Build the dictionary for Hangul syllables"
+  (format t "~&Building Hangul Syllable dictionary.  Please wait...~%")
   (initialize-reverse-hangul-tables)
   (let ((hangul-codebook
 	 (map 'vector #'car
@@ -1344,10 +1356,13 @@
 			 names)
 		   (incf k))))
     (setf *hangul-syllable-dictionary*
-	  (build-dictionary hangul-codebook (nreverse names)))))
+	  (build-dictionary hangul-codebook (nreverse names)))
+    (format t "~&Done.~%")
+    (values)))
 
 (defun build-cjk-unified-ideograph-dictionary ()
   "Build the dictionary for CJK Unified Ideographs"
+  (format t "~&Building CJK Unified Ideographs dictionary.  Please wait...~%")
   (let ((codebook (coerce (loop for k from 0 to 15
 			     collect (format nil "~X" k))
 			  'vector))
@@ -1356,7 +1371,9 @@
 		  collect (cons (format nil "~X" codepoint)
 				codepoint))))
     (setf *cjk-unified-ideograph-dictionary*
-	  (build-dictionary codebook names))))
+	  (build-dictionary codebook names))
+    (format t "~&Done.~%")
+    (values)))
 
 ;; The definitions of BUILD-DICTIONARY, NAME-LOOKUP, and ENCODE-NAME
 ;; were taken from build-unidata.lisp.
Index: src/tools/build-unidata.lisp
diff -u src/tools/build-unidata.lisp:1.5 src/tools/build-unidata.lisp:1.6
--- src/tools/build-unidata.lisp:1.5	Wed Sep 15 17:06:39 2010
+++ src/tools/build-unidata.lisp	Sat Sep 18 16:47:51 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.5 2010-09-15 21:06:39 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/tools/build-unidata.lisp,v 1.6 2010-09-18 20:47:51 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -466,6 +466,8 @@
 		 (error "Index array too short for the data being written")))))
     (with-open-file (stm path :direction :io :if-exists :rename-and-delete
 			 :element-type '(unsigned-byte 8))
+      ;; The length of the index array is the number of sections to be
+      ;; written.  See below for each section.
       (let ((index (make-array 19 :fill-pointer 0)))
 	;; File header
 	(write32 +unicode-magic-number+ stm)	; identification "magic"
@@ -478,12 +480,12 @@
 	(dotimes (i (array-dimension index 0))
 	  (write32 0 stm))		; space for indices
 	(write32 0 stm)			; end marker
-	;; Range data
+	;; 0. Range data
 	(let ((data (unidata-range *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write32 (length (range-codes data)) stm)
 	  (write-vector (range-codes data) stm :endian-swap :network-order))
-	;; Character name data
+	;; 1. Character name data
 	(let ((data (unidata-name+ *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write-byte (1- (length (dictionary-cdbk data))) stm)
@@ -499,41 +501,41 @@
 	  (write-vector (dictionary-codev data) stm :endian-swap :network-order)
 	  (write-vector (dictionary-nextv data) stm :endian-swap :network-order)
 	  (write-vector (dictionary-namev data) stm :endian-swap :network-order))
-	;; Codepoint-to-name mapping
+	;; 2. Codepoint-to-name mapping
 	(let ((data (unidata-name *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write-ntrie32 data stm))
-	;; Codepoint-to-category table
+	;; 3. Codepoint-to-category table
 	(let ((data (unidata-category *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write-ntrie8 data stm))
-	;; Simple case mapping table
+	;; 4. Simple case mapping table
 	(let ((data (unidata-scase *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write-ntrie32 data stm)
 	  (write-byte (length (scase-svec data)) stm)
 	  (write-vector (scase-svec data) stm :endian-swap :network-order))
-	;; Numeric data
+	;; 5. Numeric data
 	(let ((data (unidata-numeric *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write-ntrie32 data stm))
-	;; Decomposition data
+	;; 6. Decomposition data
 	(let ((data (unidata-decomp *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write-ntrie32 data stm)
 	  (write16 (length (decomp-tabl data)) stm)
 	  (write-vector (decomp-tabl data) stm :endian-swap :network-order))
-	;; Combining classes
+	;; 7. Combining classes
 	(let ((data (unidata-combining *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write-ntrie8 data stm))
-	;; Bidi data
+	;; 8. Bidi data
 	(let ((data (unidata-bidi *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write-ntrie16 data stm)
 	  (write-byte (length (bidi-tabl data)) stm)
 	  (write-vector (bidi-tabl data) stm :endian-swap :network-order))
-	;; Unicode 1.0 names
+	;; 9. Unicode 1.0 names
 	(let ((data (unidata-name1+ *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write-byte (1- (length (dictionary-cdbk data))) stm)
@@ -549,10 +551,11 @@
 	  (write-vector (dictionary-codev data) stm :endian-swap :network-order)
 	  (write-vector (dictionary-nextv data) stm :endian-swap :network-order)
 	  (write-vector (dictionary-namev data) stm :endian-swap :network-order))
+	;; 10. Codepoint to unicode-1.0 name
 	(let ((data (unidata-name1 *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write-ntrie32 data stm))
-	;; Normalization quick-check data
+	;; 11. Normalization quick-check data
 	(update-index (file-position stm) index)
 	(let ((data (unidata-qc-nfd *unicode-data*)))
 	  (write-ntrie1 data stm))
@@ -562,35 +565,37 @@
 	  (write-ntrie2 data stm))
 	(let ((data (unidata-qc-nfkc *unicode-data*)))
 	  (write-ntrie2 data stm))
-	;; Write composition exclusion table
+	;; 12. Write composition exclusion table
 	(let ((data (unidata-comp-exclusions *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write16 (length data) stm)
 	  (write-vector data stm :endian-swap :network-order))
-	;; Write full-case lower data
 	(flet ((dump-full-case (data)
 		 (update-index (file-position stm) index)
 		 (write-ntrie32 data stm)
 		 (write16 (length (full-case-tabl data)) stm)
 		 (write-vector (full-case-tabl data) stm :endian-swap :network-order)))
+	  ;; 13. Write full-case lower data
 	  (dump-full-case (unidata-full-case-lower *unicode-data*))
+	  ;; 14. Write full-case title data
 	  (dump-full-case (unidata-full-case-title *unicode-data*))
+	  ;; 15. Write full-case upper data
 	  (dump-full-case (unidata-full-case-upper *unicode-data*)))
-	;; Write case folding data
+	;; 16. Write case-folding simple data
 	(let ((data (unidata-case-fold-simple *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write-ntrie32 data stm))
-	;; case-folding full
+	;; 17. Write case-folding full data
 	(let ((data (unidata-case-fold-full *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write-ntrie32 data stm)
 	  (write16 (length (case-folding-tabl data)) stm)
 	  (write-vector (case-folding-tabl data) stm :endian-swap :network-order))
-	;; Word-break
+	;; 18. Word-break
 	(let ((data (unidata-word-break *unicode-data*)))
 	  (update-index (file-position stm) index)
 	  (write-ntrie4 data stm))
-	;; Patch up index
+	;; All components saved. Patch up index table now.
 	(file-position stm 8)
 	(dotimes (i (length index))
 	  (write32 (aref index i) stm)))))




More information about the cmucl-cvs mailing list