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/early-defuns.lisp

    r8642 r8784  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: early-defuns.lisp,v 1.20 2005-02-26 17:41:38 piso Exp $
     4;;; $Id: early-defuns.lisp,v 1.21 2005-03-17 14:59:57 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    4242           (BASE-CHAR
    4343            (return-from normalize-type 'character))
    44            ((SHORT-FLOAT SINGLE-FLOAT DOUBLE-FLOAT LONG-FLOAT)
    45             (return-from normalize-type 'float))
     44           (SHORT-FLOAT
     45            (return-from normalize-type 'single-float))
     46           (LONG-FLOAT
     47            (return-from normalize-type 'double-float))
    4648           (COMPLEX
    4749            (return-from normalize-type '(complex *)))
     
    154156           (return-from normalize-type (list 'simple-array 'base-char (list (car i))))
    155157           (return-from normalize-type '(simple-array base-char (*)))))
    156       ((SHORT-FLOAT SINGLE-FLOAT DOUBLE-FLOAT LONG-FLOAT)
    157        (setf tp 'float))
     158      (SHORT-FLOAT
     159       (setf tp 'single-float))
     160      (LONG-FLOAT
     161       (setf tp 'double-float))
    158162      (COMPLEX
    159163        (cond ((null i)
    160164               (setf i '(*)))
    161               ((memq i '(short-float single-float double-float long-float))
    162                (setf i 'float)))))
     165              ((eq i 'short-float)
     166               (setf i 'single-float))
     167              ((eq i 'long-float)
     168               (setf i 'double-float)))))
    163169    (if i (cons tp i) tp)))
    164170
Note: See TracChangeset for help on using the changeset viewer.