Changeset 9245


Ignore:
Timestamp:
Apr 24, 2008, 2:43:55 AM (11 years ago)
Author:
gz
Message:

Don't assume that specifier-type returns unknown-ctype for unknown
types - it doesn't. Catch parse-unknown-type conditions instead.

Don't cache unknown-ctype's (because that prevents parse-unknown-type
getting signalled).

Location:
branches/working-0711/ccl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/optimizers.lisp

    r9038 r9245  
    624624      `(progn ,@body))))
    625625
     626(defun specifier-type-if-known (typespec)
     627  (handler-case (specifier-type typespec)
     628    (parse-unknown-type () nil)
     629    (error () nil)))
     630
    626631
    627632(defun target-element-type-type-keyword (typespec)
    628   (let* ((ctype (ignore-errors (specifier-type `(array ,typespec)))))
    629     (if (or (null ctype) (typep ctype 'unknown-ctype))
     633  (let* ((ctype (specifier-type-if-known `(array ,typespec))))
     634    (if (null ctype)
    630635      (progn
    631636        (nx1-whine :unknown-type-declaration typespec)
     
    665670          (setf (array-ctype-dimensions ctype)
    666671                '*))))
    667     (let* ((element-type (specifier-type (if element-type-p (nx-unquote element-type) t))))
     672    (let* ((typespec (if element-type-p (nx-unquote element-type) t))
     673           (element-type (or (specifier-type-if-known typespec)
     674                             (make-unknown-ctype :specifier typespec))))
    668675      (setf (array-ctype-element-type ctype) element-type)
    669676      (if (typep element-type 'unknown-ctype)
     
    916923;;; optimizers... For now, at least try to get it to become (%car
    917924;;; (<typecheck> foo)).
    918 (define-compiler-macro require-type (&whole call &environment env arg type)
     925(define-compiler-macro require-type (&whole call &environment env arg type &aux ctype)
    919926  (cond ((and (or (eq type t)
    920927                  (and (quoted-form-p type)
    921928                       (setq type (%cadr type))))
    922               (not (typep (specifier-type type) 'unknown-ctype)))       
     929              (setq ctype (specifier-type-if-known type)))
    923930         (cond ((nx-form-typep arg type env) arg)
    924931               ((eq type 'simple-vector)
     
    940947               ((eq type 'symbol)
    941948                `(the symbol (require-symbol ,arg)))
    942                ((type= (specifier-type type)
     949               ((type= ctype
    943950                       (specifier-type '(signed-byte 8)))
    944951                `(the (signed-byte 8) (require-s8 ,arg)))               
    945                ((type= (specifier-type type)
     952               ((type= ctype
    946953                       (specifier-type '(unsigned-byte 8)))
    947954                `(the (unsigned-byte 8) (require-u8 ,arg)))
    948                ((type= (specifier-type type)
     955               ((type= ctype
    949956                       (specifier-type '(signed-byte 16)))
    950957                `(the (signed-byte 16) (require-s16 ,arg)))
    951                ((type= (specifier-type type)
     958               ((type= ctype
    952959                       (specifier-type '(unsigned-byte 16)))
    953960                `(the (unsigned-byte 16) (require-u16 ,arg)))               
    954                ((type= (specifier-type type)
     961               ((type= ctype
    955962                       (specifier-type '(signed-byte 32)))
    956963                `(the (signed-byte 32) (require-s32 ,arg)))
    957                ((type= (specifier-type type)
     964               ((type= ctype
    958965                       (specifier-type '(unsigned-byte 32)))
    959966                `(the (unsigned-byte 32) (require-u32 ,arg)))
    960                ((type= (specifier-type type)
     967               ((type= ctype
    961968                       (specifier-type '(signed-byte 64)))
    962969                `(the (signed-byte 64) (require-s64 ,arg)))
    963                ((type= (specifier-type type)
     970               ((type= ctype
    964971                       (specifier-type '(unsigned-byte 64)))
    965972                `(the (unsigned-byte 64) (require-u64 ,arg)))
     
    14831490(defun optimize-typep (thing type env)
    14841491  ;; returns a new form, or nil if it can't optimize
    1485   (let* ((ctype (ignore-errors (specifier-type type))))
    1486     (when (and ctype (not (typep ctype 'unknown-ctype)))
     1492  (let* ((ctype (specifier-type-if-known type)))
     1493    (when ctype
    14871494      (let* ((type (type-specifier ctype))
    14881495             (predicate (if (typep type 'symbol) (type-predicate type))))
     
    15321539  (declare (ignore e))
    15331540  (if (quoted-form-p type)
    1534     (if (constantp thing)
     1541    (if (and (constantp thing) (specifier-type-if-known type))
    15351542      (typep (if (quoted-form-p thing) (%cadr thing) thing) (%cadr type))
    15361543      (or (optimize-typep thing (%cadr type) env)
  • branches/working-0711/ccl/level-1/l1-typesys.lisp

    r9237 r9245  
    13991399     (and (cacheable-ctype-p (cons-ctype-car-ctype ctype))
    14001400          (cacheable-ctype-p (cons-ctype-cdr-ctype ctype))))
     1401    (unknown-ctype nil)
    14011402    ;; Anything else ?  Simple things (numbers, classes) can't lose.
    14021403    (t t)))
Note: See TracChangeset for help on using the changeset viewer.