Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl
Commits:
-
6c1f62ca
by Raymond Toy at 2024-05-30T07:45:58-07:00
-
2b8d6de1
by Raymond Toy at 2024-05-30T07:47:22-07:00
-
38549cf2
by Raymond Toy at 2024-05-30T14:42:43-07:00
-
2f2f5ccb
by Raymond Toy at 2024-05-30T14:43:07-07:00
-
1b47d323
by Raymond Toy at 2024-05-30T14:43:26-07:00
4 changed files:
- src/code/char.lisp
- src/i18n/locale/cmucl.pot
- src/lisp/case-mapping.c
- src/tools/create-case-table.lisp → src/tools/create-case-mapping.lisp
Changes:
... | ... | @@ -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+)
|
... | ... | @@ -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
|
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>
|
... | ... | @@ -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))) |