diff --git a/pcl/defs.lisp b/pcl/defs.lisp index 348c1f9dc3d3934557beb04b4605ffa9970723b3..99a18934c04930cfbb37e710a5a59c70ae4007b9 100644 --- a/pcl/defs.lisp +++ b/pcl/defs.lisp @@ -361,22 +361,33 @@ (t (typep object (convert-to-system-type type))))) +;Writing the missing NOT and AND clauses will improve +;the quality of code generated by generate-discrimination-net, but +;calling subtypep in place of just returning (values nil nil) can be +;very slow. *subtypep is used by PCL itself, and must be fast. (defun *subtypep (type1 type2) (if (equal type1 type2) (values t t) (if (eq *boot-state* 'early) (values (eq type1 type2) t) - (let ((*in-precompute-effective-methods-p* t)) ; not a descriptive name + (let ((*in-precompute-effective-methods-p* t)) (declare (special *in-precompute-effective-methods-p*)) - ;; This changes the way class-applicable-using-class-p works. + ;; *in-precompute-effective-methods-p* is not a good name. + ;; It changes the way class-applicable-using-class-p works. (setq type1 (*normalize-type type1)) (setq type2 (*normalize-type type2)) - (if (member (car type2) '(eql wrapper-eq class-eq class)) - (multiple-value-bind (app-p maybe-app-p) - (specializer-applicable-using-type-p type2 type1) - (values app-p (or app-p (not maybe-app-p)))) - (subtypep (convert-to-system-type type1) - (convert-to-system-type type2))))))) + (case (car type2) + (not + (values nil nil)) ; Should improve this. + (and + (values nil nil)) ; Should improve this. + ((eql wrapper-eq class-eq class) + (multiple-value-bind (app-p maybe-app-p) + (specializer-applicable-using-type-p type2 type1) + (values app-p (or app-p (not maybe-app-p))))) + (t + (subtypep (convert-to-system-type type1) + (convert-to-system-type type2)))))))) (defun do-satisfies-deftype (name predicate) #+(or :Genera (and :Lucid (not :Prime)) ExCL :coral)