Raymond Toy pushed to branch issue-318-add-concrete-standard-char-type at cmucl / cmucl Commits: 3dfca652 by Raymond Toy 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. - - - - - 7d0efaa6 by Raymond Toy at 2026-06-26T08:51:40-07:00 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. - - - - - 2302c6bc by Raymond Toy at 2026-06-26T08:51:40-07:00 Address review comment Reverse subtype args to verify that we're computing the correct result. - - - - - fecdd641 by Raymond Toy at 2026-06-26T08:51:40-07:00 Address review comment Replace `subsetp` with `every` to determine subtype relationship between standard-char and member types. There were two places that were updated. - - - - - a4842b2f by Raymond Toy at 2026-06-26T08:51:40-07:00 Address review comment Forgot to replace one `subsetp` with `every`. - - - - - 4 changed files: - bin/build.sh - − src/bootfiles/21f/boot-21f.lisp - src/code/type.lisp - tests/standard-char.lisp Changes: ===================================== bin/build.sh ===================================== @@ -38,7 +38,7 @@ ENABLE2="yes" ENABLE3="yes" ENABLE4="yes" -version=21f +version=21e SRCDIR=src BINDIR=bin TOOLDIR=$BINDIR ===================================== src/bootfiles/21f/boot-21f.lisp deleted ===================================== @@ -1,14 +0,0 @@ -;; 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)) -) ===================================== src/code/type.lisp ===================================== @@ -3347,7 +3347,10 @@ (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)))) @@ -3358,7 +3361,9 @@ (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)))) @@ -3374,8 +3379,10 @@ ((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)))) @@ -3640,16 +3647,6 @@ "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))) ===================================== tests/standard-char.lisp ===================================== @@ -10,7 +10,7 @@ ;; 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)) @@ -24,8 +24,12 @@ (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) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/95fb934cafa3ccd4a65de60... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/95fb934cafa3ccd4a65de60... You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications: https://gitlab.common-lisp.net/-/profile/notifications | Help: https://gitlab.common-lisp.net/help