GitLab

at 2024-05-29T08:13:52-07:00

Rename case-table.c to case-mapping.c

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.

Update make file to use case-mapping.c instead of case-table.c

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-`.

   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

   "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)."

                       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))

     (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)

     (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

     (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.))

 	 (= (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)

   '(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)

   '(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))))

 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))))

 /*

  * 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.

  */

 };

-const uint32_t (*case_table[1024])[64] = {

+const uint32_t (*case_mapping[1024])[64] = {

     &stage2_zeroes,

     &stage2_1,

     &stage2_zeroes,

 ;; 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.

 /*

  * 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

                             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

     (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)))

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

Commits:

5 changed files:

Changes: