Commit 6d283811 authored by rtoy's avatar rtoy
Browse files

Update deftransforms for unicode.

Be sure to cross-compile using boot-2009-03-cross-unicode-foo.  Then
do a normal build using boot-2009-03-unicode-char as the bootstrap
file for a normal build.

bootfiles/19e/boot-2008-05-cross-unicode-common.lisp:
o Initialize *UNICODE-DATA* to be an EQL hash table instead of EQUAL.
  The key is a character, so EQL works as well.  This also means we
  don't need to do any hashing of the character, which is problematic
  in building and bootstrapping with unicode support.

code/char/lisp:
o Make UNICODE-DATA be inline, since it's so simple.
o Clean up unicode implementation of ALPHANUMERICP to use the fast
  ASCII tests before trying unicode.
o Update REBUILD-UNICODE-DATA to take an optional arg for the
  path to the UnicodeData.txt file, and remove the test for the size
  of the hash table; we always want to rebuild.

compiler/srctran.lisp:
o Update deftransforms for CHAR-EQUAL, CHAR-UPCASE, and CHAR-DOWNCASE
  to handle unicode.  However, for speed (I hope), we keep a fast test
  for ASCII characters.
parent 6ac77d96
Loading
Loading
Loading
Loading
+1 −1
Original line number Diff line number Diff line
@@ -405,7 +405,7 @@

(in-package "LISP")

(defvar *unicode-data* (make-hash-table :test 'equal :size 26674))
(defvar *unicode-data* (make-hash-table :test 'eql :size 30000))
(defvar *assigned-codepoints-bitmap* (make-array 65536 :element-type 'bit))
(when (< (hash-table-count *unicode-data*) 20000)
  (dolist (range '((#x0000 . #x001F) (#x007F . #x009F) (#x3400 . #x4DB5)
+45 −42
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/char.lisp,v 1.15.18.5 2009/03/25 19:32:53 rtoy Exp $")
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/char.lisp,v 1.15.18.6 2009/03/27 03:02:15 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -102,13 +102,15 @@
(defstruct (unicode (:type vector))
  character name category num1 num2 num3 upper lower title)

;; Note: *unicode-data* is initializes with itself.  So how does it
;; Note: *unicode-data* is initialized with itself.  So how does it
;; get initialized to begin with?  A bootstrap files needs to be run
;; and rebuild-unicode-data will fill *unicode-data* with appropriate
;; values.  Likewise for *assigned-codepoints-bitmap*.
#+unicode
(defvar *unicode-data* #.*unicode-data*)

#+unicoode
(declaim (inline unicode-data))
#+unicode
(defun unicode-data (thing)
  (gethash thing *unicode-data*))
@@ -311,14 +313,13 @@
  "Given a character-object argument, alphanumericp returns T if the
   argument is either numeric or alphabetic."
  (declare (character char))
  #-(and unicode (not unicode-bootstrap))
  (let ((m (char-code char)))
    (or (< 47 m 58) (< 64 m 91) (< 96 m 123)))
    ;; Shortcut for ASCII digits and upper and lower case letters
    (or (< 47 m 58) (< 64 m 91) (< 96 m 123)
	#+(and unicode (not unicode-bootstrap))
  (or (< 47 (char-code char) 58)
	(let ((data (unicode-data char)))
	  (and data (or (= (unicode-category data) #x16)
		      (= (unicode-category data) #x1D))))))
			(= (unicode-category data) #x1D)))))))


(defun char= (character &rest more-characters)
@@ -506,14 +507,16 @@

;; Rebuild *unicode-data* and *assigned-codepoints-bitmap*
#+unicode
(defun rebuild-unicode-data ()
  (when (< (hash-table-count *unicode-data*) 20000)
(defun rebuild-unicode-data (&optional (unicode-data-file "target:i18n/UnicodeData.txt"))
  (dolist (range '((#x0000 . #x001F) (#x007F . #x009F) (#x3400 . #x4DB5)
		   (#x4E00 . #x9FBB) (#xAC00 . #xD7A3) (#xE000 . #xF8FF)
		   (#xDB80 . #xDBFF)))
    (loop for i from (car range) to (cdr range) do
	 (setf (aref *assigned-codepoints-bitmap* i) 1)))
    (with-open-file (s "target:i18n/UnicodeData.txt")
  ;; Make the sure the hash table is an eql hash table.  This helps
  ;; during build because we don't need to do equal on characters.
  (setf *unicode-data* (make-hash-table :test 'eql :size 30000))
  (with-open-file (s unicode-data-file)
    (flet ((cat (x) (dpb (position (char x 0) "CLMNPSZ") (byte 3 4)
			 (position (char x 1) "cdefiklmnopstu")))
	   (num (x) (if (string= x "") nil x))
@@ -538,4 +541,4 @@
				(chr (nth 13 split))
				(chr (nth 14 split)))))
		 (setf (gethash (code-char code) *unicode-data*) x)
		    (setf (gethash (second split) *unicode-data*) x)))))))))
		 (setf (gethash (second split) *unicode-data*) x))))))))
+42 −10
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.163.4.2 2008/12/18 21:50:18 rtoy Exp $")
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.163.4.3 2009/03/27 03:02:15 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -3259,29 +3259,61 @@

(deftransform char-equal ((a b) (base-char base-char))
  "open code"
  #-(and unicode (not unicode-bootstrap))
  '(let* ((ac (char-code a))
	  (bc (char-code b))
	  (sum (logxor ac bc)))
     (or (zerop sum)
	 (when (eql sum #x20)
	   (let ((sum (+ ac bc)))
	     (and (> sum 161) (< sum 213)))))))
	     (and (> sum 161) (< sum 213))))))
  #+(and unicode (not unicode-bootstrap))
  '(let* ((ac (char-code a))
	  (bc (char-code b)))
     (if (and (<= ac #x7f)
	      (<= bc #x7f))
	 ;; ASCII
	 (let ((sum (logxor ac bc)))
	   (or (zerop sum)
	       (when (eql sum #x20)
		 (let ((sum (+ ac bc)))
		   (and (> sum 161) (< sum 213))))))
	 ;; Unicode
	 (= (lisp::equal-char-code a)
	    (lisp::equal-char-code b)))))

(deftransform char-upcase ((x) (base-char))
  "open code"
  '(let ((n-code (char-code x)))
     (if (<= n-code #x7f)
	 ;; ASCII
	 (if (and (> n-code #o140)	; Octal 141 is #\a.
		  (< n-code #o173))	; Octal 172 is #\z.
	     (code-char (logxor #x20 n-code))
	 x)))
	     x)
	 ;; Unicode
	 #-(and unicode (not unicode-bootstrap))
	 x
	 #+(and unicode (not unicode-bootstrap))
	 (let ((data (lisp::unicode-data x)))
	   (if data
	       (or (lisp::unicode-upper data) x)
	       x)))))

(deftransform char-downcase ((x) (base-char))
  "open code"
  '(let ((n-code (char-code x)))
     (if (<= n-code #x7f)
	 ;; ASCII
	 (if (and (> n-code 64)		; 65 is #\A.
		  (< n-code 91))	; 90 is #\Z.
	     (code-char (logxor #x20 n-code))
	 x)))
	     x)
	 ;; Unicode
	 (let ((data (lisp::unicode-data x)))
	   (if data
	       (or (lisp::unicode-lower data) x)
	       x)))))


;;;; Equality predicate transforms: