GitLab

at 2026-06-26T08:51:40-07:00

Remove defypte of standard-char from code/type.lisp

It's not needed now that we have a separate concrete standard-char
type.

Bootfile is not needed to build this change

Not sure why we had this originally, but I just did a normal build
without specifying a -B option, and everything built fine and the
standard-char test ran fine.

Address review comment

Reverse subtype args to verify that we're computing the correct
result.

Address review comment

Replace `subsetp` with `every` to determine subtype relationship
between standard-char and member types.  There were two places that
were updated.

Address review comment

Forgot to replace one `subsetp` with `every`.

 ENABLE3="yes"

 ENABLE4="yes"

-version=21f

+version=21e

 SRCDIR=src

 BINDIR=bin

 TOOLDIR=$BINDIR

-;; For #318.  Define new standard-char type.

-(in-package "KERNEL")

-(ext:without-package-locks

-(define-type-class standard-char)

-(defstruct (standard-char-type

-	    (:include ctype

-	     (class-info (type-class-or-lose 'standard-char))

-	     (:enumerable t))

-	    (:constructor %make-standard-char-type ())

-	    (:copier nil)))

-

-(defun make-standard-char-type ()

-  (%make-standard-char-type))

-)
 	 (values t t))

 	((member-type-p type2)

 	 ;; If TYPE2 is a member-type, check whether it contains all standard-chars

-	 (values (subsetp +standard-chars+ (member-type-members type2))

+	 (values (let ((members (member-type-members type2)))

+		   (every #'(lambda (c)

+			    (member c members))

+			+standard-chars+))

 		 t))

 	(t

 	 (values nil t))))

   (cond ((member-type-p type1)

 	 ;; If TYPE1 is a member-type, check whether it contains all

 	 ;; standard-chars.

-	 (values (subsetp (member-type-members type1) +standard-chars+)

+	 (values (every #'(lambda (c)

+			    (member c +standard-chars+))

+			(member-type-members type1))

 		 t))

 	(t

 	 (values nil t))))

       ((csubtypep (specifier-type 'character) other)

        other)

       ((and (member-type-p other)

-            (subsetp (member-type-members other)

-		     +standard-chars+))

+	    ;; Check to see every member of OTHER is a STANDARD-CHAR.

+	    (every #'(lambda (c)

+		       (member c +standard-chars+))

+		   (member-type-members other)))

        sc)

       (t nil))))

   "Type of characters that aren't base-char's.  None in CMU CL."

   '(and character (not base-char)))

-#+nil

-(deftype standard-char ()

-  "Type corresponding to the charaters required by the standard."

-  '(member #\NEWLINE #\SPACE #\! #\" #\# #\$ #\% #\& #\' #\( #\) #\* #\+ #\,

-	   #\- #\. #\/ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\: #\; #\< #\=

-	   #\> #\?  #\@ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M

-	   #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z #\[ #\\ #\]

-	   #\^ #\_ #\` #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m

-	   #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z #\{

-    #\| #\} #\~))

 (deftype keyword ()

   "Type for any keyword symbol."

   '(and symbol (satisfies keywordp)))

 ;; sure we test the intersection and union methods for standard-char.

 (define-test standard-char.typep

-    (:tag :issues)

+  (:tag :issues)

   (assert-true (typep #\a 'standard-char))

   (assert-false (typep #\tab 'standard-char))

   (assert-true (typep #\Z 'standard-char))

   (assert-equal (values t t)

 		(subtypep 'standard-char 'character))

+  (assert-equal (values nil t)

+		(subtypep 'character 'standard-char))

   (assert-equal (values t t)

-		(subtypep 'standard-char 'base-char)))

+		(subtypep 'standard-char 'base-char))

+  (assert-equal (values nil t)

+		(subtypep 'base-char 'standard-char)))

 (define-test standard-char.etypecase-15

     (:tag :issues)

Raymond Toy pushed to branch issue-318-add-concrete-standard-char-type at cmucl / cmucl

Commits:

4 changed files:

Changes: