Ignore:
Timestamp:
03/17/05 15:05:09 (16 years ago)
Author:
piso
Message:

SINGLE-FLOAT support.

File:
1 edited

Legend:

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

    r8762 r8784  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: subtypep.lisp,v 1.60 2005-03-13 01:50:18 piso Exp $
     4;;; $Id: subtypep.lisp,v 1.61 2005-03-17 15:04:50 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2222(in-package #:system)
    2323
    24 (defparameter *known-types* (make-hash-table))
     24(defparameter *known-types* (make-hash-table :test 'eq))
    2525
    2626(dolist (i '((ARITHMETIC-ERROR ERROR)
     
    4141             (CONTROL-ERROR ERROR)
    4242             (DIVISION-BY-ZERO ARITHMETIC-ERROR)
     43             (DOUBLE-FLOAT FLOAT)
    4344             (END-OF-FILE STREAM-ERROR)
    4445             (ERROR SERIOUS-CONDITION)
     
    5758             (KEYWORD SYMBOL)
    5859             (LIST SEQUENCE)
     60             (LONG-FLOAT FLOAT)
    5961             (NIL-VECTOR SIMPLE-STRING)
    6062             (NULL BOOLEAN LIST)
     
    7476             (RESTART)
    7577             (SERIOUS-CONDITION CONDITION)
     78             (SHORT-FLOAT FLOAT)
    7679             (SIMPLE-ARRAY ARRAY)
    7780             (SIMPLE-BASE-STRING SIMPLE-STRING BASE-STRING)
     
    8386             (SIMPLE-VECTOR VECTOR SIMPLE-ARRAY)
    8487             (SIMPLE-WARNING SIMPLE-CONDITION WARNING)
     88             (SINGLE-FLOAT FLOAT)
    8589             (STANDARD-CHAR CHARACTER)
    8690             (STANDARD-CLASS CLASS)
     
    570574               (values (sub-interval-p i1 i2) t)
    571575               (values nil (known-type-p t2))))
     576          ((memq t1 '(single-float short-float))
     577           (if (memq t2 '(single-float short-float float real number))
     578               (values (sub-interval-p i1 i2) t)
     579               (values nil (known-type-p t2))))
     580          ((memq t1 '(double-float long-float))
     581           (if (memq t2 '(double-float long-float float real number))
     582               (values (sub-interval-p i1 i2) t)
     583               (values nil (known-type-p t2))))
    572584          ((eq t1 'integer)
    573585           (cond ((memq t2 '(integer rational real number))
Note: See TracChangeset for help on using the changeset viewer.