Changeset 12500 for trunk/source/level-1


Ignore:
Timestamp:
Aug 1, 2009, 3:36:45 AM (10 years ago)
Author:
gz
Message:

Be aware of FTYPE declarations in more places

Location:
trunk/source/level-1
Files:
3 edited

Legend:

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

    r12463 r12500  
    25332533)
    25342534
    2535 ;; Stub to prevent errors when the user doesn't define types
    2536 (defun type-intersect (type1 type2)
    2537   (cond ((and (null type1) (null type2))
    2538          nil)
    2539         ((equal type1 type2)
    2540          type1)
    2541         ((subtypep type1 type2)
    2542          type1)
    2543         ((subtypep type2 type1)
    2544          type2)
    2545         (t `(and ,type1 ,type2))
    2546         ;(t (error "type-intersect not implemented yet."))
    2547         ))
    2548 
    25492535(defun %add-direct-methods (method)
    25502536  (dolist (spec (%method-specializers method))
  • trunk/source/level-1/l1-utils.lisp

    r12371 r12500  
    571571  ;; Do not signal anything about unknown types though -- it should be ok to have forward
    572572  ;; references here, before anybody needs the info.
    573   (specifier-type ftype)
     573  (let* ((ctype (specifier-type ftype)))
     574    ;; If know enough to complain now, do so.
     575    (when (types-disjoint-p ctype (specifier-type 'function))
     576      (bad-proclaim-spec `(ftype ,ftype ,@names))))
    574577  (dolist (name names)
    575578    (setf (gethash (maybe-setf-function-name name) *nx-proclaimed-ftypes*) ftype)))
  • trunk/source/level-1/sysutils.lisp

    r12463 r12500  
    345345  (csubtypep (specifier-type type1 env) (specifier-type type2 env)))
    346346
     347(defun types-disjoint-p (type1 type2 &optional env)
     348  ;; Return true if types are guaranteed to be disjoint, nil if not disjoint or unknown.
     349  (let ((ctype1 (if (typep type1 'ctype) type1 (specifier-type type1 env)))
     350        (ctype2 (if (typep type2 'ctype) type2 (specifier-type type2 env))))
     351    (eq *empty-type* (type-intersection ctype1 ctype2))))
    347352
    348353
Note: See TracChangeset for help on using the changeset viewer.