Ignore:
Timestamp:
10/08/03 19:12:00 (19 years ago)
Author:
piso
Message:

SIMPLE-SUBTYPEP

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/subtypep.lisp

    r4216 r4259  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: subtypep.lisp,v 1.17 2003-10-06 02:25:00 piso Exp $
     4;;; $Id: subtypep.lisp,v 1.18 2003-10-08 19:12:00 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    190190
    191191(defun simple-subtypep (type1 type2)
    192   (when (and (symbolp type1) (symbolp type2) (known-type-p type1))
    193     ;; type1 is a known type. type1 can only be a subtype of type2 if type2 is
    194     ;; also a known type.
    195     (return-from simple-subtypep (if (memq type2 (supertypes type1))
    196                                      t
    197                                      (dolist (supertype (supertypes type1))
    198                                        (when (simple-subtypep supertype type2)
    199                                          (return (values t)))))))
     192  (when (and (symbolp type1) (symbolp type2))
     193    (multiple-value-bind (type1-supertypes type1-known-p)
     194        (gethash type1 *known-types*)
     195      (when type1-known-p
     196        (return-from simple-subtypep (if (memq type2 type1-supertypes)
     197                                         t
     198                                         (dolist (supertype type1-supertypes)
     199                                           (when (simple-subtypep supertype type2)
     200                                             (return (values t)))))))))
    200201  (let ((c1 (if (classp type1) type1 (find-class type1 nil)))
    201202        (c2 (if (classp type2) type2 (find-class type2 nil))))
Note: See TracChangeset for help on using the changeset viewer.