Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl

Commits:

2 changed files:

Changes:

  • src/code/char.lisp
    ... ... @@ -60,9 +60,7 @@
    60 60
     (deftype codepoint ()
    
    61 61
       `(integer 0 (,codepoint-limit)))
    
    62 62
     
    
    63
    -;; This MUST be greater than or equal to 127!  Be very careful about
    
    64
    -;; changing this.  It affects all kinds of casing issues.
    
    65
    -(defconstant +unicode-lower-limit+
    
    63
    +(defconstant +ascii-limit+
    
    66 64
       127
    
    67 65
       "A character code strictly larger than this is handled using Unicode
    
    68 66
       rules.")
    
    ... ... @@ -261,7 +259,7 @@
    261 259
            (let ((m (char-code (the base-char char))))
    
    262 260
     	 (or (< 31 m 127)
    
    263 261
     	     #+(and unicode (not unicode-bootstrap))
    
    264
    -	     (and (> m +unicode-lower-limit+)
    
    262
    +	     (and (> m +ascii-limit+)
    
    265 263
     		  (>= (unicode-category m) +unicode-category-graphic+))))))
    
    266 264
     
    
    267 265
     
    
    ... ... @@ -272,7 +270,7 @@
    272 270
       (let ((m (char-code char)))
    
    273 271
         (or (< 64 m 91) (< 96 m 123)
    
    274 272
     	#+(and unicode (not unicode-bootstrap))
    
    275
    -	(and (> m +unicode-lower-limit+)
    
    273
    +	(and (> m +ascii-limit+)
    
    276 274
     	     (<= +unicode-category-letter+ (unicode-category m)
    
    277 275
     		 (+ +unicode-category-letter+ #x0F))))))
    
    278 276
     
    
    ... ... @@ -284,7 +282,7 @@
    284 282
       (let ((m (char-code char)))
    
    285 283
         (or (< 64 m 91)
    
    286 284
     	#+(and unicode (not unicode-bootstrap))
    
    287
    -	(and (> m +unicode-lower-limit+)
    
    285
    +	(and (> m +ascii-limit+)
    
    288 286
                  (not (zerop (ldb +lower-case-entry+ (case-mapping-entry m))))))))
    
    289 287
     
    
    290 288
     
    
    ... ... @@ -295,7 +293,7 @@
    295 293
       (let ((m (char-code char)))
    
    296 294
         (or (< 96 m 123)
    
    297 295
     	#+(and unicode (not unicode-bootstrap))
    
    298
    -	(and (> m +unicode-lower-limit+)
    
    296
    +	(and (> m +ascii-limit+)
    
    299 297
                  (not (zerop (ldb +upper-case-entry+ (case-mapping-entry m))))))))
    
    300 298
     
    
    301 299
     (defun title-case-p (char)
    
    ... ... @@ -305,7 +303,7 @@
    305 303
       (let ((m (char-code char)))
    
    306 304
         (or (< 64 m 91)
    
    307 305
     	#+(and unicode (not unicode-bootstrap))
    
    308
    -	(and (> m +unicode-lower-limit+)
    
    306
    +	(and (> m +ascii-limit+)
    
    309 307
     	     (= (unicode-category m) +unicode-category-title+)))))
    
    310 308
     
    
    311 309
     
    
    ... ... @@ -317,7 +315,7 @@
    317 315
       (let ((m (char-code char)))
    
    318 316
         (or (< 64 m 91) (< 96 m 123)
    
    319 317
     	#+(and unicode (not unicode-bootstrap))
    
    320
    -	(and (> m +unicode-lower-limit+)
    
    318
    +	(and (> m +ascii-limit+)
    
    321 319
                  (not (zerop (case-mapping-entry m)))))))
    
    322 320
     
    
    323 321
     
    
    ... ... @@ -349,7 +347,7 @@
    349 347
         ;; Shortcut for ASCII digits and upper and lower case ASCII letters
    
    350 348
         (or (< 47 m 58) (< 64 m 91) (< 96 m 123)
    
    351 349
     	#+(and unicode (not unicode-bootstrap))
    
    352
    -	(and (> m +unicode-lower-limit+)
    
    350
    +	(and (> m +ascii-limit+)
    
    353 351
     	     (<= +unicode-category-letter+ (unicode-category m)
    
    354 352
     		 (+ +unicode-category-letter+ #x0F))))))
    
    355 353
     
    
    ... ... @@ -424,7 +422,7 @@
    424 422
     	 #-(and unicode (not unicode-bootstrap))
    
    425 423
     	 ch
    
    426 424
     	 #+(and unicode (not unicode-bootstrap))
    
    427
    -	 (if (> ch +unicode-lower-limit+) (unicode-lower ch) ch))))
    
    425
    +	 (if (> ch +ascii-limit+) (unicode-lower ch) ch))))
    
    428 426
     
    
    429 427
     
    
    430 428
     (defun char-equal (character &rest more-characters)
    
    ... ... @@ -513,7 +511,7 @@
    513 511
           char)
    
    514 512
       #+(and unicode (not unicode-bootstrap))
    
    515 513
       (let ((m (char-code char)))
    
    516
    -    (cond ((> m +unicode-lower-limit+) (code-char (unicode-title m)))
    
    514
    +    (cond ((> m +ascii-limit+) (code-char (unicode-title m)))
    
    517 515
     	  ((< 96 m 123) (code-char (- m 32)))
    
    518 516
     	  (t char))))
    
    519 517
     
    

  • src/compiler/srctran.lisp
    ... ... @@ -3344,7 +3344,7 @@
    3344 3344
       #+(and unicode (not unicode-bootstrap))
    
    3345 3345
       '(let ((m (char-code x)))
    
    3346 3346
         (cond ((< 96 m 123) (code-char (- m 32)))
    
    3347
    -          ((> m lisp::+unicode-lower-limit+)
    
    3347
    +          ((> m lisp::+ascii-limit+)
    
    3348 3348
                (code-char (lisp::case-mapping-upper-case m)))
    
    3349 3349
     	   (t x))))
    
    3350 3350
     
    
    ... ... @@ -3357,7 +3357,7 @@
    3357 3357
       #+(and unicode (not unicode-bootstrap))
    
    3358 3358
       '(let ((m (char-code x)))
    
    3359 3359
         (cond ((< 64 m 91) (code-char (+ m 32)))
    
    3360
    -          ((> m lisp::+unicode-lower-limit+)
    
    3360
    +          ((> m lisp::+ascii-limit+)
    
    3361 3361
                (code-char (lisp::case-mapping-lower-case m)))
    
    3362 3362
     	  (t x))))
    
    3363 3363