CMUCL commit: src/tools (build-unidata.lisp)

[Raymond Toy]

    Date: Saturday, September 18, 2010 @ 16:58:28
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/tools

Modified: build-unidata.lisp

Simple refactoring:  Add function to write out a dictionary and use it
to write out the unicode name dictionaries. 


--------------------+
 build-unidata.lisp |   50 +++++++++++++++++++-------------------------------
 1 file changed, 19 insertions(+), 31 deletions(-)


Index: src/tools/build-unidata.lisp
diff -u src/tools/build-unidata.lisp:1.6 src/tools/build-unidata.lisp:1.7
--- src/tools/build-unidata.lisp:1.6	Sat Sep 18 16:47:51 2010
+++ src/tools/build-unidata.lisp	Sat Sep 18 16:58:28 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.6 2010-09-18 20:47:51 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/tools/build-unidata.lisp,v 1.7 2010-09-18 20:58:28 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -460,6 +460,20 @@
 			  (ntrie1-mvec data)
 			  (ntrie1-lvec data)
 			  stm))
+	   (write-dict (data stm)
+	     (write-byte (1- (length (dictionary-cdbk data))) stm)
+	     (write16 (length (dictionary-keyv data)) stm)
+	     (write32 (length (dictionary-codev data)) stm)
+	     (let ((codebook (dictionary-cdbk data)))
+	       (dotimes (i (length codebook))
+		 (write-byte (length (aref codebook i)) stm)
+		 (dotimes (j (length (aref codebook i)))
+		   (write-byte (char-code (char (aref codebook i) j)) stm))))
+	     (write-vector (dictionary-keyv data) stm :endian-swap :network-order)
+	     (write-vector (dictionary-keyl data) stm :endian-swap :network-order)
+	     (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))
 	   (update-index (val array)
 	     (let ((result (vector-push val array)))
 	       (unless result
@@ -486,21 +500,8 @@
 	  (write32 (length (range-codes data)) stm)
 	  (write-vector (range-codes data) stm :endian-swap :network-order))
 	;; 1. Character name data
-	(let ((data (unidata-name+ *unicode-data*)))
-	  (update-index (file-position stm) index)
-	  (write-byte (1- (length (dictionary-cdbk data))) stm)
-	  (write16 (length (dictionary-keyv data)) stm)
-	  (write32 (length (dictionary-codev data)) stm)
-	  (let ((codebook (dictionary-cdbk data)))
-	    (dotimes (i (length codebook))
-	      (write-byte (length (aref codebook i)) stm)
-	      (dotimes (j (length (aref codebook i)))
-		(write-byte (char-code (char (aref codebook i) j)) stm))))
-	  (write-vector (dictionary-keyv data) stm :endian-swap :network-order)
-	  (write-vector (dictionary-keyl data) stm :endian-swap :network-order)
-	  (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))
+	(update-index (file-position stm) index)
+	(write-dict (unidata-name+ *unicode-data*) stm)
 	;; 2. Codepoint-to-name mapping
 	(let ((data (unidata-name *unicode-data*)))
 	  (update-index (file-position stm) index)
@@ -536,21 +537,8 @@
 	  (write-byte (length (bidi-tabl data)) stm)
 	  (write-vector (bidi-tabl data) stm :endian-swap :network-order))
 	;; 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)
-	  (write16 (length (dictionary-keyv data)) stm)
-	  (write32 (length (dictionary-codev data)) stm)
-	  (let ((codebook (dictionary-cdbk data)))
-	    (dotimes (i (length codebook))
-	      (write-byte (length (aref codebook i)) stm)
-	      (dotimes (j (length (aref codebook i)))
-		(write-byte (char-code (char (aref codebook i) j)) stm))))
-	  (write-vector (dictionary-keyv data) stm :endian-swap :network-order)
-	  (write-vector (dictionary-keyl data) stm :endian-swap :network-order)
-	  (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))
+	(update-index (file-position stm) index)
+	(write-dict (unidata-name1+ *unicode-data*) stm)
 	;; 10. Codepoint to unicode-1.0 name
 	(let ((data (unidata-name1 *unicode-data*)))
 	  (update-index (file-position stm) index)