Changeset 4802


Ignore:
Timestamp:
11/17/03 15:19:47 (18 years ago)
Author:
piso
Message:

SUBTYPEP: support EQL compound type specifier.

File:
1 edited

Legend:

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

    r4722 r4802  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: subtypep.lisp,v 1.29 2003-11-13 19:54:04 piso Exp $
     4;;; $Id: subtypep.lisp,v 1.30 2003-11-17 15:19:47 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    214214
    215215(defun subtypep (type1 type2)
    216   (when (or (equal type1 type2)
     216  (when (or (eq type1 type2)
    217217            (null type1)
    218218            (eq type2 t))
     
    236236  (setq type1 (subtypep-normalize-type type1)
    237237        type2 (subtypep-normalize-type type2))
    238   (when (equal type1 type2)
     238  (when (eq type1 type2)
    239239    (return-from subtypep (values t t)))
    240240  (let (t1 t2 i1 i2)
     
    253253             (unless (typep e type2) (return-from subtypep (values nil t))))
    254254           (return-from subtypep (values t t)))
     255          ((eq t1 'eql)
     256           (case t2
     257             (EQL
     258              (return-from subtypep (values (eql (car i1) (car i2)) t)))
     259             (SATISFIES
     260              (return-from subtypep (values (funcall (car i2) (car i1)) t)))
     261             (t
     262              (return-from subtypep (values (typep (car i1) type2) t)))))
    255263          ((eq t1 'or)
    256264           (dolist (tt i1)
Note: See TracChangeset for help on using the changeset viewer.