Changeset 7917


Ignore:
Timestamp:
Dec 17, 2007, 10:03:43 PM (13 years ago)
Author:
gb
Message:

Provide type-predicate for NAMED-CTYPE; the type system otherwise
wanders around the CLOS class hierarchy trying to determine whether
or not CTYPE objects are NAMED-CTYPEs.

Unparse ARRAY-CTYPEs into STRINGs when possible.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-typesys.lisp

    r5602 r7917  
    15291529(defvar *empty-type* (define-named-ctype nil))
    15301530(defvar *universal-type* (define-named-ctype t))
     1531
     1532(defun named-ctype-p (x)
     1533  (istruct-typep x 'named-ctype))
     1534
     1535(setf (type-predicate 'named-ctype) 'named-ctype-p)
    15311536
    15321537(define-type-method (named :simple-=) (type1 type2)
     
    26712676                   (case eltype
    26722677                     (bit 'bit-vector)
    2673                      (base-char 'base-string)
     2678                     ((character base-char) 'base-string)
    26742679                     (* 'vector)
    26752680                     (t `(vector ,eltype)))
    26762681                   (case eltype
    26772682                     (bit `(bit-vector ,(car dims)))
    2678                      (base-char `(base-string ,(car dims)))
     2683                     ((character base-char) `(base-string ,(car dims)))
    26792684                     (t `(vector ,eltype ,(car dims)))))
    26802685               (if (eq (car dims) '*)
    26812686                   (case eltype
    26822687                     (bit 'simple-bit-vector)
    2683                      (base-char 'simple-base-string)
     2688                     ((base-char character) 'simple-base-string)
    26842689                     ((t) 'simple-vector)
    26852690                     (t `(simple-array ,eltype (*))))
    26862691                   (case eltype
    26872692                     (bit `(simple-bit-vector ,(car dims)))
    2688                      (base-char `(simple-base-string ,(car dims)))
     2693                     ((base-char character) `(simple-base-string ,(car dims)))
    26892694                     ((t) `(simple-vector ,(car dims)))
    26902695                     (t `(simple-array ,eltype ,dims))))))
Note: See TracChangeset for help on using the changeset viewer.