Changeset 4813


Ignore:
Timestamp:
11/17/03 18:25:21 (18 years ago)
Author:
piso
Message:

(subtypep '(or (integer * (-2147483648)) (integer (2147483647) *)) 'bignum) => T

File:
1 edited

Legend:

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

    r4811 r4813  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: subtypep.lisp,v 1.31 2003-11-17 18:04:26 piso Exp $
     4;;; $Id: subtypep.lisp,v 1.32 2003-11-17 18:25:21 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    339339                   (values nil t))
    340340               (values nil (known-type-p t2))))
     341          ((eq t1 'float)
     342           (if (memq t2 '(float real number))
     343               (values (sub-interval-p i1 i2) t)
     344               (values nil (known-type-p t2))))
     345          ((eq t1 'integer)
     346           (cond ((memq t2 '(integer rational real number))
     347                  (values (sub-interval-p i1 i2) t))
     348                 ((eq t2 'bignum)
     349                  (values
     350                   (or (sub-interval-p i1 (list '* (list most-negative-fixnum)))
     351                       (sub-interval-p i1 (list (list most-positive-fixnum) '*)))
     352                   t))
     353                 (t
     354                   (values nil (known-type-p t2)))))
     355          ((eq t1 'rational)
     356           (if (memq t2 '(rational real number))
     357               (values (sub-interval-p i1 i2) t)
     358               (values nil (known-type-p t2))))
     359          ((eq t1 'real)
     360           (if (memq t2 '(real number))
     361               (values (sub-interval-p i1 i2) t)
     362               (values nil (known-type-p t2))))
     363          ((memq t1 '(string simple-string base-string
     364                      simple-base-string))
     365           (cond ((eq t2 'string)
     366                  (if (or (null i2) (eq (car i2) '*))
     367                      (values t t)
     368                      (values nil t)))
     369                 (t
     370                  (values nil (known-type-p t2)))))
    341371          (t
    342            (cond ((eq t1 'float)
    343                   (if (memq t2 '(float real number))
    344                       (values (sub-interval-p i1 i2) t)
    345                       (values nil (known-type-p t2))))
    346                  ((eq t1 'integer)
    347                   (if (memq t2 '(integer rational real number))
    348                       (values (sub-interval-p i1 i2) t)
    349                       (values nil (known-type-p t2))))
    350                  ((eq t1 'rational)
    351                   (if (memq t2 '(rational real number))
    352                       (values (sub-interval-p i1 i2) t)
    353                       (values nil (known-type-p t2))))
    354                  ((eq t1 'real)
    355                   (if (memq t2 '(real number))
    356                       (values (sub-interval-p i1 i2) t)
    357                       (values nil (known-type-p t2))))
    358                  ((memq t1 '(string simple-string base-string
    359                              simple-base-string))
    360                   (cond ((eq t2 'string)
    361                          (if (or (null i2) (eq (car i2) '*))
    362                              (values t t)
    363                              (values nil t)))
    364                         (t
    365                          (values nil (known-type-p t2)))))
    366                  (t
    367                   (values nil nil)))))))
     372           (values nil nil)))))
    368373
    369374(when (fboundp 'jvm::jvm-compile)
Note: See TracChangeset for help on using the changeset viewer.