GitLab

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

Commits:

65083eba

by Raymond Toy at 2026-05-04T11:26:25-07:00

Cleanups

In code/type.lisp
* Add docstring for `+standard-chars+`
* Remove old version standard-char :complex-union

In tests/standard-char.lisp
* Remove individual tests (asserts)
* Remove tests that are duplicated elsewhere

5df4f946

by Raymond Toy at 2026-05-04T11:38:52-07:00

Fix silly typo

Put the docstring in the wrong place for `+standard-chars+`

c3f6a944
by Raymond Toy at 2026-05-04T11:40:58-07:00
```
Update cmucl.pot for new docstring
```

Changes:

src/code/type.lisp

@@ -3321,14 +3321,15 @@
    (declare (ignore type1 type2))
    (values t t))
 -(defconstant +standard-chars+
 +(defconstant +standard-chars+
    '(#\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 #\{
 -    #\| #\} #\~))
 +    #\| #\} #\~)
 +  "The set of characters in the STANDARD-CHAR type")
  (define-type-method (standard-char :simple-union) (type1 type2)
    (declare (ignore type2))
@@ -3362,33 +3363,19 @@
  	(t
  	 (values nil t))))
 -#+nil
 -(define-type-method (standard-char :complex-union) (type1 type2)
 -   (cond ((csubtypep (specifier-type 'character) type2)
 -	  ;; STANDARD-CHAR union any super-type of CHARACTER is that
 -	  ;; super-type. Hence, it's TYPE2.
 -	  type2)
 -	 ((and (member-type-p type2)
 -	       (every #'characterp (member-type-members type2)))
 -	  ;; STANDARD-CHAR union MEMBER-TYPE whose members are all
 -	  ;; standard-characters is a STANDARD-CHAR.
 -	  type1)
 -	 ((eq (type-intersection (specifier-type 'standard-char)
 -				 type2)
 -	      *empty-type*)
 -	  ;; STANDARD-CHAR union with disjoint type2 has no simplification.
 -	  nil)
 -	 (t
 -	  ;; No simplification
 -	  nil)))
+-
  (define-type-method (standard-char :complex-union) (type1 type2)
 -  (let* ((sc (if (standard-char-type-p type1) type1 type2))
 -         (other (if (eq sc type1) type2 type1)))
 +  ;; The standard-char type could be in type1 or type2.  Figure out
 +  ;; which one is a standard-char.
 +  (multiple-value-bind (sc other)
 +      (if (standard-char-type-p type1)
 +	  (values type1 type2)
 +	  (values type2 type1))
      (cond
 -      ((csubtypep (specifier-type 'character) other) other)
 +      ((csubtypep (specifier-type 'character) other)
 +       other)
        ((and (member-type-p other)
 -            (subsetp (member-type-members other) kernel::+standard-chars+))
 +            (subsetp (member-type-members other)
 +		     +standard-chars+))
         sc)
        (t nil))))
@@ -3420,7 +3407,7 @@
             (cond ((null (members))
  		  c::*empty-type*)
                   ((= (length (members))
 -		     (length kernel::+standard-chars+))
 +		     (length +standard-chars+))
  		  sc)
                   (t
  		  (make-member-type :members (members))))))))))

src/i18n/locale/cmucl.pot

No preview for this file type

tests/standard-char.lisp

@@ -13,11 +13,9 @@
      (:tag :issues)
    (assert-true (typep #\a 'standard-char))
    (assert-false (typep #\tab 'standard-char))
 -  (assert-true (typep #\a 'standard-char))
    (assert-true (typep #\Z 'standard-char))
    (assert-true (typep #\Space 'standard-char))
    (assert-true (typep #\Newline 'standard-char))
 -  (assert-false (typep #\Tab 'standard-char))
    (assert-false (typep #\Rubout 'standard-char))
    (assert-false (typep 5 'standard-char))
    (assert-false (typep "hello" 'standard-char))
@@ -165,10 +163,7 @@
                                 (c::specifier-type '(member #\Tab)))))
      ;; Should not collapse into a 97-element MEMBER.
      (assert-false (c::member-type-p result))
 -    (assert-true (c::union-type-p result))
 -    #+nil
 -    (not (and (c::member-type-p result)
 -              (>= (length (c::member-type-members result)) 90)))))
 +    (assert-true (c::union-type-p result))))
  (define-test standard-char.complex-intersection
      (:tag :issues)
@@ -246,17 +241,6 @@
  		       :error))))
        (assert-eql expected actual ch))))
 -(define-test standard-char.caching
 -    (:tag :issues)
 -  ;; Multiple specifier-type calls on `standard-char` return EQ.
 -  (assert-eq (c::specifier-type 'standard-char)
 -	     (c::specifier-type 'standard-char))
+-
 -  ;; And via the deftype expansion.
 -  (assert-eq (c::specifier-type 'standard-char)
 -	     (c::specifier-type 'standard-char)))
 -					;
+-
  (define-test standard-char.intersection-character-both-orderings
      (:tag :issues)
    ;; Standard-char intersect character = standard-char, regardless of argument order.
@@ -333,17 +317,6 @@
                           (some (complement #'characterp)
                                 (kernel::member-type-members m)))))))
 -(define-test standard-char.subtypep-bidirectional
 -    (:tag :issues)
 -  ;; arg1 path: standard-char subset of X?
 -  (assert-equal (values t t) (subtypep 'standard-char 'character))
 -  (assert-equal (values nil t) (subtypep 'standard-char 'integer))
 -  ;; arg2 path: X subset of standard-char?
 -  (assert-equal (values nil t) (subtypep 'character 'standard-char))
 -  (assert-equal (values nil t) (subtypep 'integer 'standard-char))
 -  ;; Both reflexively
 -  (assert-equal (values t t) (subtypep 'standard-char 'standard-char)))
+-
  (defun assert-commutative-union (type-a-spec type-b-spec)
    "Assert that union(A, B) and union(B, A) produce type= results."
    (assert-equality #'kernel::type=