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

Commits:

4 changed files:

Changes:

  • src/code/char.lisp
    ... ... @@ -63,15 +63,15 @@
    63 63
     (defconstant +ascii-limit+
    
    64 64
       127
    
    65 65
       "A character code strictly larger than this is handled using Unicode
    
    66
    -  rules.")
    
    66
    +c  rules.")
    
    67 67
     
    
    68 68
     ;; Table of mappings for upper case and lower case letters.  See
    
    69 69
     ;; src/lisp/case-mapping.c.
    
    70 70
     (alien:def-alien-variable "case_mapping" 
    
    71 71
         (alien:array (alien:* (alien:array c-call:unsigned-int 64)) 1024))
    
    72 72
     
    
    73
    -;; Each entry in the case table consists of the code for either an
    
    74
    -;; upper case or lower case character code.
    
    73
    +;; Each entry in the case mapping table consists of the code for
    
    74
    +;; either an upper case or lower case character code.
    
    75 75
     (defconstant +upper-case-entry+ (byte 16 0))
    
    76 76
     (defconstant +lower-case-entry+ (byte 16 16))
    
    77 77
     
    
    ... ... @@ -82,9 +82,9 @@
    82 82
     (declaim (inline case-mapping-entry))
    
    83 83
     
    
    84 84
     (defun case-mapping-entry (code)
    
    85
    -  "For the character code, CODE, return 0 or the 32-bit value from the
    
    86
    -  case table.  A value of 0 means there was no case mapping (neither
    
    87
    -  upper nor lower case)."
    
    85
    +  "For the character code, CODE, the 32-bit value from the
    
    86
    +  case mapping table that indicates the delta between CODE and the
    
    87
    +  corresponding upper or lower case character for CODE."
    
    88 88
       (declare (type (integer 0 (#.char-code-limit)) code)
    
    89 89
                (optimize (speed 3) (safety 0)))
    
    90 90
       (let* ((index1 (ldb (byte (- 16 +stage2-size+) +stage2-size+)
    

  • src/i18n/locale/cmucl.pot
    ... ... @@ -5446,7 +5446,7 @@ msgstr ""
    5446 5446
     #: src/code/char.lisp
    
    5447 5447
     msgid ""
    
    5448 5448
     "A character code strictly larger than this is handled using Unicode\n"
    
    5449
    -"  rules."
    
    5449
    +"c  rules."
    
    5450 5450
     msgstr ""
    
    5451 5451
     
    
    5452 5452
     #: src/code/char.lisp
    
    ... ... @@ -5457,9 +5457,9 @@ msgstr ""
    5457 5457
     
    
    5458 5458
     #: src/code/char.lisp
    
    5459 5459
     msgid ""
    
    5460
    -"For the character code, CODE, return 0 or the 32-bit value from the\n"
    
    5461
    -"  case table.  A value of 0 means there was no case mapping (neither\n"
    
    5462
    -"  upper nor lower case)."
    
    5460
    +"For the character code, CODE, the 32-bit value from the\n"
    
    5461
    +"  case mapping table that indicates the delta between CODE and the\n"
    
    5462
    +"  corresponding upper or lower case character for CODE."
    
    5463 5463
     msgstr ""
    
    5464 5464
     
    
    5465 5465
     #: src/code/char.lisp
    

  • src/lisp/case-mapping.c
    1 1
     /*
    
    2 2
      * DO NOT EDIT.
    
    3 3
      *
    
    4
    - * This was generated by (BUILD-CASE-TABLE :stage2-size 6) in
    
    5
    - * src/tools/create-case-table.c.
    
    4
    + * This was generated by (BUILD-CASE-MAPPING-TABLE :STAGE2-SIZE 6) in
    
    5
    + * src/tools/create-case-mapping.lisp.
    
    6 6
      */
    
    7 7
     
    
    8 8
     #include <stdint.h>
    

  • src/tools/create-case-table.lispsrc/tools/create-case-mapping.lisp
    ... ... @@ -18,7 +18,7 @@
    18 18
     ;; Each element of this table is 32-bits long.  The low 16 bits
    
    19 19
     ;; contains the mapping of C to the corresponding upper case letter.
    
    20 20
     ;; The high 16 bits maps C to the corresponding lower case letter.
    
    21
    -(defun compute-case-table (stage2-size)
    
    21
    +(defun compute-case-mapping-table (stage2-size)
    
    22 22
       (let ((table (make-array (ash 1 (- 16 stage2-size)))))
    
    23 23
         (dotimes (i (length table))
    
    24 24
           (setf (aref table i) (make-array (ash 1 stage2-size)
    
    ... ... @@ -93,7 +93,7 @@
    93 93
                (sort (loop for stage2-size from 1 to 15
    
    94 94
                            collect (list stage2-size
    
    95 95
                                          (print-table-stats
    
    96
    -                                      (compute-case-table stage2-size)
    
    96
    +                                      (compute-case-mapping-table stage2-size)
    
    97 97
                                           stage2-size)))
    
    98 98
                      #'<
    
    99 99
                      :key #'second))))
    
    ... ... @@ -119,15 +119,15 @@
    119 119
       (format stream "~%};~%"))
    
    120 120
     
    
    121 121
     ;; Print the case table TABLE to a file named by PATHNAME.
    
    122
    -(defun dump-case-table (pathname table stage2-size)
    
    122
    +(defun dump-case-mapping-table (pathname table stage2-size)
    
    123 123
       (with-open-file (stream pathname :direction :output :if-exists :supersede)
    
    124 124
         (format stream 
    
    125 125
                 "~
    
    126 126
     /*
    
    127 127
      * DO NOT EDIT.
    
    128 128
      *
    
    129
    - * This was generated by (BUILD-CASE-TABLE :STAGE2-SIZE ~D) in
    
    130
    - * src/tools/create-case-table.c.
    
    129
    + * This was generated by (BUILD-CASE-MAPPING-TABLE :STAGE2-SIZE ~D) in
    
    130
    + * src/tools/create-case-mapping.lisp.
    
    131 131
      */~2%"
    
    132 132
                 stage2-size)
    
    133 133
         (format stream "#include <stdint.h>~%")
    
    ... ... @@ -156,6 +156,6 @@
    156 156
         (format stream "};~%")
    
    157 157
         (format t "Wrote ~S~%" (namestring stream))))
    
    158 158
     
    
    159
    -(defun build-case-table (&key (stage2-size 6) (pathname "./src/lisp/case-mapping.c"))
    
    160
    -  (let ((table (compute-case-table stage2-size)))
    
    161
    -    (dump-case-table pathname table stage2-size)))
    159
    +(defun build-case-mapping-table (&key (stage2-size 6) (pathname "./src/lisp/case-mapping.c"))
    
    160
    +  (let ((table (compute-case-mapping-table stage2-size)))
    
    161
    +    (dump-case-mapping-table pathname table stage2-size)))