Changeset 9517


Ignore:
Timestamp:
May 16, 2008, 1:24:57 AM (11 years ago)
Author:
gb
Message:

Remove some type-predicates, use istruct-type-name (etc.) rather than %SVREF.

File:
1 edited

Legend:

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

    r9446 r9517  
    495495(defun ctype-p (x)
    496496  (and (eql (typecode x) target::subtag-istruct)
    497        (memq (%svref x 0)
     497       (memq (istruct-type-name x)
    498498             '#.(cons 'ctype
    499499                      (cons 'unknown-ctype                             
     
    541541
    542542(defun values-ctype-p (x) (istruct-typep x 'values-ctype))
    543 (setf (type-predicate 'values-ctype) 'values-ctype-p)
    544543
    545544
     
    626625
    627626(defun function-ctype-p (x) (istruct-typep x 'function-ctype))
    628 (setf (type-predicate 'function-ctype) 'function-ctype-p)
    629627
    630628;;; A flag that we can bind to cause complex function types to be unparsed as
     
    745743
    746744(defun constant-ctype-p (x) (istruct-typep x 'constant-ctype))
    747 (setf (type-predicate 'constant-ctype) 'constant-ctype-p)
    748745
    749746(define-type-method (constant :unparse) (type)
     
    14121409;;; be stack-allocated or might be EQUAL without being EQL.
    14131410(defun cacheable-ctype-p (ctype)
    1414   (case (%svref ctype 0)
     1411  (case (istruct-cell-name (%svref ctype 0))
    14151412    (member-ctype
    14161413     (dolist (m (member-ctype-members ctype) t)
     
    14321429                     (cacheable-ctype-p (key-info-type info)))
    14331430                 (values-ctype-keywords ctype))
    1434           (or (not (eq (%svref ctype 0) 'function-ctype))
     1431          (or (not (eq (istruct-cell-name (%svref ctype 0)) 'function-ctype))
    14351432              (let* ((result (function-ctype-returns ctype)))
    14361433                (or (null result)
     
    15851582  (istruct-typep x 'named-ctype))
    15861583
    1587 (setf (type-predicate 'named-ctype) 'named-ctype-p)
    15881584
    15891585(define-type-method (named :simple-=) (type1 type2)
     
    16771673
    16781674(defun hairy-ctype-p (x)
    1679   (istruct-typep x 'hairy-ctype))
     1675  (or (istruct-typep x 'hairy-ctype)
     1676      (istruct-typep x 'unknown-ctype)))
    16801677
    16811678(setf (type-predicate 'hairy-ctype) 'hairy-ctype-p)
     
    17491746  (istruct-typep x 'negation-ctype))
    17501747
    1751 (setf (type-predicate 'negation-ctype) 'negation-ctype-p)
    17521748
    17531749
     
    20912087  (istruct-typep x 'numeric-ctype))
    20922088
    2093 (setf (type-predicate 'numeric-ctype) 'numeric-ctype-p)
    20942089
    20952090(define-type-method (number :simple-=) (type1 type2)
     
    26872682
    26882683(defun array-ctype-p (x) (istruct-typep x 'array-ctype))
    2689 (setf (type-predicate 'array-ctype) 'array-ctype-p)
    26902684
    26912685;;; Specialized-Element-Type-Maybe  --  Internal
     
    29402934
    29412935(defun member-ctype-p (x) (istruct-typep x 'member-ctype))
    2942 (setf (type-predicate 'member-ctype) 'member-ctype-p)
    29432936
    29442937(define-type-method (member :unparse) (type)
     
    30583051
    30593052(defun union-ctype-p (x) (istruct-typep x 'union-ctype))
    3060 (setf (type-predicate 'union-ctype) 'union-ctype-p)
    30613053
    30623054
     
    31653157(defun intersection-ctype-p (x)
    31663158  (istruct-typep x 'intersection-ctype))
    3167 (setf (type-predicate 'intersection-ctype) 'intersection-ctype-p)
    31683159
    31693160(define-type-method (intersection :unparse) (type)
     
    32773268  (istruct-typep x 'cons-ctype))
    32783269
    3279 (setf (type-predicate 'cons-ctype) 'cons-ctype-p)
    32803270 
    32813271(def-type-translator cons (&optional (car-type-spec '*) (cdr-type-spec '*) &environment env)
     
    33813371  (istruct-typep x 'unknown-ctype))
    33823372
    3383 (setf (type-predicate 'unknown-ctype) 'unknown-ctype-p)
    33843373
    33853374
     
    33973386
    33983387(defun foreign-ctype-p (x) (istruct-typep x 'foreign-ctype))
    3399 (setf (type-predicate 'foreign-ctype) 'foreign-ctype-p)
    34003388
    34013389(define-type-method (foreign :unparse) (type)
     
    34393427
    34403428(defun class-ctype-p (x) (istruct-typep x 'class-ctype))
    3441 (setf (type-predicate 'class-ctype) 'class-ctype-p)
    34423429
    34433430(defun args-ctype-p (x) (and (eql (typecode x) target::subtag-istruct)
    3444                              (member (%svref x 0)
     3431                             (member (istruct-type-name x)
    34453432                                     '(args-ctype values-ctype function-ctype))))
    34463433
     
    34483435(defun valuec-ctype-p (x) (istruct-typep x 'values-ctype))
    34493436
    3450 (setf (type-predicate 'args-ctype) 'args-ctype-p
    3451       (type-predicate 'function-ctype) 'function-ctype-p
    3452       (type-predicate 'values-ctype) 'values-ctype-p)
     3437(setf (type-predicate 'args-ctype) 'args-ctype-p)
    34533438
    34543439
Note: See TracChangeset for help on using the changeset viewer.