Changeset 3728


Ignore:
Timestamp:
09/13/03 18:00:50 (19 years ago)
Author:
piso
Message:

Work in progess.

File:
1 edited

Legend:

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

    r3724 r3728  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: subtypep.lisp,v 1.1 2003-09-13 17:17:42 piso Exp $
     4;;; $Id: subtypep.lisp,v 1.2 2003-09-13 18:00:50 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    8181      (BASE-CHAR
    8282       (setq tp 'character))
     83      (FIXNUM
     84       (setq tp 'integer i '(#.most-negative-fixnum #.most-positive-fixnum)))
    8385      ((SHORT-FLOAT SINGLE-FLOAT DOUBLE-FLOAT LONG-FLOAT)
    8486       (setq tp 'float)))
     
    172174          (t
    173175           (cond ((eq t1 'float)
    174            (if (eq t2 'float)
    175                (values (sub-interval-p i1 i2) t)
    176                (values nil (known-type-p t2))))
    177           ((eq t1 'integer)
    178            (if (member t2 '(integer rational))
    179                (values (sub-interval-p i1 i2) t)
    180                (values nil (known-type-p t2))))
    181           ((eq t1 'rational)
    182            (if (member t2 '(rational real))
    183                (values (sub-interval-p i1 i2) t)
    184                (values nil (known-type-p t2))))
    185           ((memq t1 '(string simple-string base-string simple-base-string))
    186            (cond ((eq t2 'string)
    187                   (if (or (null i2) (eq (car i2) '*))
    188                       (values t t)
    189                       (values nil t)))
     176                  (if (eq t2 'float)
     177                      (values (sub-interval-p i1 i2) t)
     178                      (values nil (known-type-p t2))))
     179                 ((eq t1 'integer)
     180                  (if (member t2 '(integer rational real))
     181                      (values (sub-interval-p i1 i2) t)
     182                      (values nil (known-type-p t2))))
     183                 ((eq t1 'rational)
     184                  (if (member t2 '(rational real))
     185                      (values (sub-interval-p i1 i2) t)
     186                      (values nil (known-type-p t2))))
     187                 ((eq t1 'real)
     188                  (if (eq t2 'real)
     189                      (values (sub-interval-p i1 i2) t)
     190                      (values nil (known-type-p t2))))
     191                 ((memq t1 '(string simple-string base-string
     192                             simple-base-string))
     193                  (cond ((eq t2 'string)
     194                         (if (or (null i2) (eq (car i2) '*))
     195                             (values t t)
     196                             (values nil t)))
     197                        (t
     198                         (values nil (known-type-p t2)))))
    190199                 (t
    191                   (values nil (known-type-p t2)))))
    192           (t
    193            (values nil nil)))))))
     200                  (values nil nil)))))))
Note: See TracChangeset for help on using the changeset viewer.