Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl Commits: 2764c097 by Raymond Toy at 2024-05-29T08:13:52-07:00 Rename case-table.c to case-mapping.c - - - - - 0f411c4b by Raymond Toy at 2024-05-29T08:16:03-07:00 Rename case_table to case_mapping. Update the code to name the table from case_table to case_mapping. Also correct the generated comment to use the correct form used to generate the C file. Change the default name from case-table.c to case-mapping.c. Regenerate case-mapping.c as well. - - - - - 5fb9f515 by Raymond Toy at 2024-05-29T08:17:56-07:00 Update make file to use case-mapping.c instead of case-table.c - - - - - 2e4de525 by Raymond Toy at 2024-05-29T08:18:15-07:00 Update naming to use case-mapping instead of case-table. The alien variable name is now `case_mapping`. Update function names from `case-table-` to `case-mapping-`. - - - - - 5 changed files: - src/code/char.lisp - src/compiler/srctran.lisp - src/lisp/GNUmakefile - src/lisp/case-table.c → src/lisp/case-mapping.c - src/tools/create-case-table.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -68,8 +68,8 @@ rules.") ;; Table of mappings for upper case and lower case letters. See -;; src/lisp/case-table.c. -(alien:def-alien-variable "case_table" +;; src/lisp/case-mapping.c. +(alien:def-alien-variable "case_mapping" (alien:array (alien:* (alien:array c-call:unsigned-int 64)) 1024)) ;; Each entry in the case table consists of the code for either an @@ -81,9 +81,9 @@ "Number of bits used for the index of the second stage table of the case mapping table.") -(declaim (inline case-table-entry)) +(declaim (inline case-mapping-entry)) -(defun case-table-entry (code) +(defun case-mapping-entry (code) "For the character code, CODE, return 0 or the 32-bit value from the case table. A value of 0 means there was no case mapping (neither upper nor lower case)." @@ -93,24 +93,24 @@ code)) (index2 (ldb (byte +stage2-size+ 0) code)) - (stage2-sap (alien:alien-sap (alien:deref case-table index1)))) + (stage2-sap (alien:alien-sap (alien:deref case-mapping index1)))) (sys:sap-ref-32 stage2-sap (* 4 index2)))) -(declaim (inline case-table-lower-case)) -(defun case-table-lower-case (code) +(declaim (inline case-mapping-lower-case)) +(defun case-mapping-lower-case (code) "Compute the lower-case character code for the given character CODE. If no lower-case code exists, just return CODE." (declare (type (integer 0 (#.char-code-limit)) code) (optimize (speed 3))) - (ldb (byte 16 0) (- code (ldb +lower-case-entry+ (case-table-entry code))))) + (ldb (byte 16 0) (- code (ldb +lower-case-entry+ (case-mapping-entry code))))) -(declaim (inline case-table-upper-case)) -(defun case-table-upper-case (code) +(declaim (inline case-mapping-upper-case)) +(defun case-mapping-upper-case (code) "Compute the upper-case character code for the given character CODE. If no upper-case code exists, just return CODE." (declare (type (integer 0 (#.char-code-limit)) code) (optimize (speed 3))) - (ldb (byte 16 0) (- code (ldb +upper-case-entry+ (case-table-entry code))))) + (ldb (byte 16 0) (- code (ldb +upper-case-entry+ (case-mapping-entry code))))) (macrolet ((frob (char-names-list) (collect ((results)) @@ -285,7 +285,7 @@ (or (< 64 m 91) #+(and unicode (not unicode-bootstrap)) (and (> m +unicode-lower-limit+) - (not (zerop (ldb +lower-case-entry+ (case-table-entry m)))))))) + (not (zerop (ldb +lower-case-entry+ (case-mapping-entry m)))))))) (defun lower-case-p (char) @@ -296,7 +296,7 @@ (or (< 96 m 123) #+(and unicode (not unicode-bootstrap)) (and (> m +unicode-lower-limit+) - (not (zerop (ldb +upper-case-entry+ (case-table-entry m)))))))) + (not (zerop (ldb +upper-case-entry+ (case-mapping-entry m)))))))) (defun title-case-p (char) "The argument must be a character object; title-case-p returns T if the @@ -318,7 +318,7 @@ (or (< 64 m 91) (< 96 m 123) #+(and unicode (not unicode-bootstrap)) (and (> m +unicode-lower-limit+) - (not (zerop (case-table-entry m))))))) + (not (zerop (case-mapping-entry m))))))) (defun digit-char-p (char &optional (radix 10.)) ===================================== src/compiler/srctran.lisp ===================================== @@ -3335,7 +3335,7 @@ (= (lisp::equal-char-code a) (lisp::equal-char-code b))))) -(deftransform char-upcase ((x) (character)) +(deftransform char-upcase ((x) (base-char)) "open code" #-(and unicode (not unicode-bootstrap)) '(if (lower-case-p x) @@ -3345,10 +3345,10 @@ '(let ((m (char-code x))) (cond ((< 96 m 123) (code-char (- m 32))) ((> m lisp::+unicode-lower-limit+) - (code-char (lisp::case-table-upper-case m))) + (code-char (lisp::case-mapping-upper-case m))) (t x)))) -(deftransform char-downcase ((x) (character)) +(deftransform char-downcase ((x) (base-char)) "open code" #-(and unicode (not unicode-bootstrap)) '(if (upper-case-p x) @@ -3358,7 +3358,7 @@ '(let ((m (char-code x))) (cond ((< 64 m 91) (code-char (+ m 32))) ((> m lisp::+unicode-lower-limit+) - (code-char (lisp::case-table-lower-case m))) + (code-char (lisp::case-mapping-lower-case m))) (t x))))  ===================================== src/lisp/GNUmakefile ===================================== @@ -33,7 +33,7 @@ FDLIBM = k_sin.c k_cos.c k_tan.c s_sin.c s_cos.c s_tan.c sincos.c \ SRCS = lisp.c coreparse.c alloc.c monitor.c print.c interr.c \ vars.c parse.c interrupt.c search.c validate.c globals.c \ dynbind.c breakpoint.c regnames.c backtrace.c save.c purify.c \ - runprog.c time.c case-table.c exec-init.c \ + runprog.c time.c case-mapping.c exec-init.c \ ${FDLIBM} ${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC} ${GC_SRC} OBJS = $(patsubst %.c,%.o,$(patsubst %.S,%.o,$(patsubst %.s,%.o,$(SRCS)))) ===================================== src/lisp/case-table.c → src/lisp/case-mapping.c ===================================== @@ -1,7 +1,7 @@ /* * DO NOT EDIT. * - * This was generated by (BUILD-CASE-TABLE 6) in + * This was generated by (BUILD-CASE-TABLE :stage2-size 6) in * src/tools/create-case-table.c. */ @@ -681,7 +681,7 @@ const uint32_t stage2_1021[64] = { }; -const uint32_t (*case_table[1024])[64] = { +const uint32_t (*case_mapping[1024])[64] = { &stage2_zeroes, &stage2_1, &stage2_zeroes, ===================================== src/tools/create-case-table.lisp ===================================== @@ -1,7 +1,7 @@ ;; Creates a table of tables that maps a lower case letter to an upper ;; case letter or an upper case letter to a lower case letter. This ;; mapping only works if the roundtrip casing returns the original -;; character, as required by CLHS. +;; character, as required by the standard. ;; ;; STAGE2-SIZE is the number of bits to used for the index of the ;; second stage table. @@ -126,10 +126,10 @@ /* * DO NOT EDIT. * - * This was generated by (BUILD-CASE-TABLE ~D) in + * This was generated by (BUILD-CASE-TABLE :STAGE2-SIZE ~D) in * src/tools/create-case-table.c. */~2%" -stage2-size) + stage2-size) (format stream "#include <stdint.h>~%") (format stream "#include <stddef.h>~%") ;; First, dump the all-zeroes table @@ -144,7 +144,7 @@ stage2-size) s2 stream)) ;; Now dump the stage1 table - (format stream "~2%const uint32_t (*case_table[~D])[~D] = {~%" + (format stream "~2%const uint32_t (*case_mapping[~D])[~D] = {~%" (length table) (length (aref table (position-if-not #'null table)))) (loop for s2 across table @@ -156,6 +156,6 @@ stage2-size) (format stream "};~%") (format t "Wrote ~S~%" (namestring stream)))) -(defun build-case-table (&key (stage2-size 6) (pathname "./src/lisp/case-table.c")) +(defun build-case-table (&key (stage2-size 6) (pathname "./src/lisp/case-mapping.c")) (let ((table (compute-case-table stage2-size))) (dump-case-table pathname table stage2-size))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/fce0c4ec7a9cd3261c04904... -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/fce0c4ec7a9cd3261c04904... You're receiving this email because of your account on gitlab.common-lisp.net.