Ignore:
Timestamp:
10/10/03 17:13:33 (19 years ago)
Author:
piso
Message:

SUBTYPEP: class support.

File:
1 edited

Legend:

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

    r4260 r4289  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: subtypep.lisp,v 1.19 2003-10-09 01:41:44 piso Exp $
     4;;; $Id: subtypep.lisp,v 1.20 2003-10-10 17:13:33 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    212212  (when (or (null type1) (eq type2 t))
    213213    (return-from subtypep (values t t)))
     214  (let* ((c1 (classp type1)) (c2 (classp type2))
     215         (t1 (if c1
     216                 type1
     217                 (and (symbolp type1) (find-class type1 nil))))
     218         (t2 (if c2
     219                 type2
     220                 (and (symbolp type2) (find-class type2 nil)))))
     221    (when (and t1 t2)
     222      (return-from subtypep
     223       (if (member t2 (class-precedence-list t1))
     224           (values t t) (values nil t))))
     225    (when (or c1 c2)
     226      (return-from subtypep (values nil t))))
    214227  (setq type1 (subtypep-normalize-type type1)
    215228        type2 (subtypep-normalize-type type2))
Note: See TracChangeset for help on using the changeset viewer.