/[cmucl]/src/code/pred.lisp
ViewVC logotype

Diff of /src/code/pred.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.55 by toy, Wed Jan 29 02:16:30 2003 UTC revision 1.56 by gerd, Sat Mar 22 16:15:20 2003 UTC
# Line 133  Line 133 
133    (if (typep object '(or function array complex))    (if (typep object '(or function array complex))
134        (type-specifier (ctype-of object))        (type-specifier (ctype-of object))
135        (let* ((class (layout-class (layout-of object)))        (let* ((class (layout-class (layout-of object)))
136               (name (class-name class)))               (name (%class-name class)))
137          (if (%instancep object)          (if (%instancep object)
138              (case name              (case name
139                (alien-internals:alien-value                (alien-internals:alien-value
# Line 285  Line 285 
285                        (specifier-type (array-element-type object)))))))                        (specifier-type (array-element-type object)))))))
286      (member-type      (member-type
287       (if (member object (member-type-members type)) t))       (if (member object (member-type-members type)) t))
288      (class      (kernel::class
289       (class-typep (layout-of object) type object))       (class-typep (layout-of object) type object))
290      (union-type      (union-type
291       (dolist (type (union-type-types type))       (dolist (type (union-type-types type))
# Line 354  Line 354 
354  (defun class-typep (obj-layout class object)  (defun class-typep (obj-layout class object)
355    (declare (optimize speed))    (declare (optimize speed))
356    (when (layout-invalid obj-layout)    (when (layout-invalid obj-layout)
357      (if (and (typep (class-of object) 'standard-class) object)      (if (and (typep (kernel::class-of object) 'kernel::standard-class) object)
358          (setq obj-layout (pcl::check-wrapper-validity object))          (setq obj-layout (pcl::check-wrapper-validity object))
359          (error "TYPEP on obsolete object (was class ~S)."          (error "TYPEP on obsolete object (was class ~S)."
360                 (class-proper-name (layout-class obj-layout)))))                 (class-proper-name (layout-class obj-layout)))))
361    (let ((layout (class-layout class))    (let ((layout (%class-layout class))
362          (obj-inherits (layout-inherits obj-layout)))          (obj-inherits (layout-inherits obj-layout)))
363      (when (layout-invalid layout)      (when (layout-invalid layout)
364        (error "Class is currently invalid: ~S" class))        (error "Class is currently invalid: ~S" class))

Legend:
Removed from v.1.55  
changed lines
  Added in v.1.56

  ViewVC Help
Powered by ViewVC 1.1.5