Ignore:
Timestamp:
May 13, 2009, 5:52:49 PM (10 years ago)
Author:
gz
Message:

Extend the mechanism used to warn about undefined and duplicate functions in a
compilation unit to do the same for types, use it for types defined by
deftype/defstruct/defclass.

Also make proclaim-type err on invalid types and warn about undefined ones.

Tighten up assorted type/ftype declaration checking. This in turn unleashed
a bunch of test suite tests requiring errors on conflicts between DECLARATION
declarations and types, so I put in checks for those as well.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-typesys.lisp

    r12026 r12045  
    114114                  (let ((c (find-class name nil)))
    115115                    (and c (eq (class-name c) name)))))
    116          (error "Cannot redefine type ~S" name))
     116         (error "Cannot redefine type ~S because ~:[it is the name of a class~;it is a built-in type~]" name (built-in-type-p name)))
     117        ((memq name *nx-known-declarations*)
     118         (check-declaration-redefinition name 'deftype))
    117119        (t (setf (gethash name %deftype-expanders%) fn)
    118120           (record-source-file name 'type)))
     
    146148  (multiple-value-bind (lambda doc)
    147149      (parse-macro-internal name arglist body env '*)
    148       `(eval-when (:compile-toplevel :load-toplevel :execute)
    149          (,definer ',name
    150                    (nfunction ,name ,lambda)
    151                    ,doc))))
     150    `(progn
     151       (eval-when (:compile-toplevel)
     152         (note-type-info ',name 'macro ,env))
     153       (eval-when (:compile-toplevel :load-toplevel :execute)
     154         (,definer ',name
     155             (nfunction ,name ,lambda)
     156           ,doc)))))
    152157
    153158(defmacro deftype (name arglist &body body &environment env)
     
    904909;;;
    905910(defun values-type-types (type &optional (default-type *empty-type*))
    906   (declare (type values-type type))
     911  (declare (type values-ctype type))
    907912  (values (append (args-ctype-required type)
    908913                  (args-ctype-optional type))
     
    15411546  (handler-case
    15421547      (type-specifier (specifier-type spec env))
    1543     (invalid-type-specifier () spec)
     1548    (program-error () spec)
    15441549    (parse-unknown-type () spec)))
    15451550
     
    24702475  (coerce-bound bound type #'coerce))
    24712476
     2477#|
    24722478(def-type-translator real (&optional (low '*) (high '*))
    24732479  (specifier-type `(or (float ,(coerced-real-bound  low 'float)
     
    24822488        (double-float ,(coerced-float-bound  low 'double-float)
    24832489                      ,(coerced-float-bound high 'double-float)))))
     2490|#
    24842491
    24852492(def-bounded-type float float nil)
     
    25872594;;;
    25882595(define-type-method (number :simple-intersection) (type1 type2)
    2589   (declare (type numeric-type type1 type2))
     2596  (declare (type numeric-ctype type1 type2))
    25902597  (if (numeric-types-intersect type1 type2)
    25912598    (let* ((class1 (numeric-ctype-class type1))
     
    33633370           
    33643371(define-type-method (cons :simple-intersection) (type1 type2)
    3365   (declare (type cons-type type1 type2))
     3372  (declare (type cons-ctype type1 type2))
    33663373  (let ((car-int2 (type-intersection2 (cons-ctype-car-ctype type1)
    33673374                                      (cons-ctype-car-ctype type2)))
     
    43424349                    (unless (eq ctype *universal-type*)
    43434350                      (generate-predicate-for-ctype ctype)))
    4344                 (invalid-type-specifier ()
    4345                   (warn "Invalid type soecifier ~s in slot definition for ~s in class ~s." type (slot-definition-name spec) (slot-definition-class spec))
     4351                (program-error ()
     4352                  (warn "Invalid type specifier ~s in slot definition for ~s in class ~s." type (slot-definition-name spec) (slot-definition-class spec))
    43464353                  (lambda (v)
    43474354                    (cerror "Allow the assignment or initialization."
Note: See TracChangeset for help on using the changeset viewer.