Ignore:
Timestamp:
Aug 11, 2008, 3:49:48 AM (11 years ago)
Author:
gb
Message:

Merge a lot of the CLOS/type-system changes from working-0711 branch
into trunk. Todo: compiler-macros for those changes.

Have -not- yet merged source-tracking changes, new record-source file
from working-0711, but this stuff seems to bootstrap in one swell foop.

File:
1 edited

Legend:

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

    r10358 r10426  
    178178  `(specifier-type ',(type-specifier c)))
    179179
     180(defmethod make-load-form ((cell type-cell) &optional env)
     181  (declare (ignore env))
     182  `(register-type-cell `,(type-cell-type-specifier cell)))
     183
     184(defmethod print-object ((cell type-cell) stream)
     185  (print-unreadable-object (cell stream :type t :identity t)
     186    (format stream "for ~s" (type-cell-type-specifier cell))))
    180187
    181188(defun make-key-info (&key name type)
     
    11081115                             type1 type2
    11091116                             :complex-arg1 :complex-subtypep-arg1))))
     1117
     1118;;; Type1 is a type-epecifier; type2 is a TYPE-CELL which may cache
     1119;;; a mapping between a type-specifier and a CTYPE.
     1120(defun cell-csubtypep-2 (type-specifier type-cell)
     1121  (let* ((type1 (specifier-type type-specifier))
     1122         (type2 (or (type-cell-ctype type-cell)
     1123                    (let* ((ctype (specifier-type
     1124                                   (type-cell-type-specifier type-cell))))
     1125                      (when (cacheable-ctype-p ctype)
     1126                        (setf (type-cell-ctype type-cell) ctype))
     1127                      ctype))))
     1128    (cond ((or (eq type1 type2)
     1129               (eq type1 *empty-type*)
     1130               (eq type2 *wild-type*))
     1131           (values t t))
     1132          (t
     1133           (invoke-type-method :simple-subtypep :complex-subtypep-arg2
     1134                               type1 type2
     1135                               :complex-arg1 :complex-subtypep-arg1)))))
     1136                             
     1137
     1138
    11101139;;; Type=  --  Interface
    11111140;;;
     
    16481677
    16491678(defun hairy-ctype-p (x)
    1650   (istruct-typep x 'hairy-ctype))
     1679  (or (istruct-typep x 'hairy-ctype)
     1680      (istruct-typep x 'unknown-ctype)))
    16511681
    16521682(setf (type-predicate 'hairy-ctype) 'hairy-ctype-p)
     
    36063636            (let ((fun (second hairy-spec)))
    36073637              (cond ((and (symbolp fun) (fboundp fun))
    3608                      (values (not (null (ignore-errors (funcall fun obj)))) t))
     3638                     ;; Binding *BREAK-ON-SIGNALS* here is a modularity
     3639                     ;; violation intended to improve the signal-to-noise
     3640                     ;; ratio on a mailing list.
     3641                     (values (not (null (let* ((*break-on-signals* nil))
     3642                                          (ignore-errors (funcall fun obj))))) t))
    36093643                    (t
    36103644                     (values nil nil))))))))))
Note: See TracChangeset for help on using the changeset viewer.