Changeset 10616


Ignore:
Timestamp:
Sep 5, 2008, 9:27:30 AM (11 years ago)
Author:
gb
Message:

In OPTIMIZE-TYPEP of a type-specifier that's a class name, don't
expand into STD-INSTANCE-CLASS-CELL-TYPEP unless we're sure that
the class isnt a subtype of FUNCALLABLE-STANDARD-OBJECT (see
ticket:329), as well as checking the FOREIGN-STANDARD-OBJECT case.
We can't be sure of that unless the class exists (outside of
the lexical environment.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/optimizers.lisp

    r10442 r10616  
    15471547                                `(structure-typep ,thing ',(find-class-cell type t)))
    15481548                               ((find-class type nil env)
     1549                                ;; If we know for sure that the class
     1550                                ;; is one whose instances are all
     1551                                ;; STANDARD-INSTANCEs (not funcallable,
     1552                                ;; not foreign), we can use
     1553                                ;; STD-INSTANCE-CLASS-CELL-TYPEP, which
     1554                                ;; can be a little faster then the more
     1555                                ;; general CLASS-CELL-TYPEP.  We can
     1556                                ;; only be sure of that if the class
     1557                                ;; exists (as a non-COMPILE-TIME-CLASS)
    15491558                                (let* ((class (find-class type nil nil))
    15501559                                       (fname
    1551                                         (if (or (null class)
    1552                                                 (and (subtypep class 'standard-object)
    1553                                                      (not (subtypep class 'foreign-standard-object))))
     1560                                        (if (and class
     1561                                                 (subtypep class 'standard-object)
     1562                                                 (not (subtypep class 'foreign-standard-object))
     1563                                                 (not (subtypep class 'funcallable-standard-object)))
    15541564                                          'std-instance-class-cell-typep
    15551565                                          'class-cell-typep)))
Note: See TracChangeset for help on using the changeset viewer.