Changeset 4813 for trunk/j/src/org/armedbear/lisp/subtypep.lisp
 Timestamp:
 11/17/03 18:25:21 (18 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/j/src/org/armedbear/lisp/subtypep.lisp
r4811 r4813 2 2 ;;; 3 3 ;;; Copyright (C) 2003 Peter Graves 4 ;;; $Id: subtypep.lisp,v 1.3 1 20031117 18:04:26piso Exp $4 ;;; $Id: subtypep.lisp,v 1.32 20031117 18:25:21 piso Exp $ 5 5 ;;; 6 6 ;;; This program is free software; you can redistribute it and/or … … 339 339 (values nil t)) 340 340 (values nil (knowntypep t2)))) 341 ((eq t1 'float) 342 (if (memq t2 '(float real number)) 343 (values (subintervalp i1 i2) t) 344 (values nil (knowntypep t2)))) 345 ((eq t1 'integer) 346 (cond ((memq t2 '(integer rational real number)) 347 (values (subintervalp i1 i2) t)) 348 ((eq t2 'bignum) 349 (values 350 (or (subintervalp i1 (list '* (list mostnegativefixnum))) 351 (subintervalp i1 (list (list mostpositivefixnum) '*))) 352 t)) 353 (t 354 (values nil (knowntypep t2))))) 355 ((eq t1 'rational) 356 (if (memq t2 '(rational real number)) 357 (values (subintervalp i1 i2) t) 358 (values nil (knowntypep t2)))) 359 ((eq t1 'real) 360 (if (memq t2 '(real number)) 361 (values (subintervalp i1 i2) t) 362 (values nil (knowntypep t2)))) 363 ((memq t1 '(string simplestring basestring 364 simplebasestring)) 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 (knowntypep t2))))) 341 371 (t 342 (cond ((eq t1 'float) 343 (if (memq t2 '(float real number)) 344 (values (subintervalp i1 i2) t) 345 (values nil (knowntypep t2)))) 346 ((eq t1 'integer) 347 (if (memq t2 '(integer rational real number)) 348 (values (subintervalp i1 i2) t) 349 (values nil (knowntypep t2)))) 350 ((eq t1 'rational) 351 (if (memq t2 '(rational real number)) 352 (values (subintervalp i1 i2) t) 353 (values nil (knowntypep t2)))) 354 ((eq t1 'real) 355 (if (memq t2 '(real number)) 356 (values (subintervalp i1 i2) t) 357 (values nil (knowntypep t2)))) 358 ((memq t1 '(string simplestring basestring 359 simplebasestring)) 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 (knowntypep t2))))) 366 (t 367 (values nil nil))))))) 372 (values nil nil))))) 368 373 369 374 (when (fboundp 'jvm::jvmcompile)
Note: See TracChangeset
for help on using the changeset viewer.