Changeset 8489


Ignore:
Timestamp:
02/06/05 13:25:39 (17 years ago)
Author:
piso
Message:

NORMALIZE-TYPE: work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/early-defuns.lisp

    r8173 r8489  
    11;;; early-defuns.lisp
    22;;;
    3 ;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: early-defuns.lisp,v 1.18 2004-11-21 04:34:58 piso Exp $
     3;;; Copyright (C) 2003-2005 Peter Graves
     4;;; $Id: early-defuns.lisp,v 1.19 2005-02-06 13:25:39 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    4444           ((SHORT-FLOAT SINGLE-FLOAT DOUBLE-FLOAT LONG-FLOAT)
    4545            (return-from normalize-type 'float))
     46           (COMPLEX
     47            (return-from normalize-type '(complex *)))
    4648           (ARRAY
    4749            (return-from normalize-type '(array * *)))
     
    9698         (return-from normalize-type (cons tp (list car-typespec cdr-typespec)))))
    9799      (SIGNED-BYTE
    98        (if (eq (car i) '*)
     100       (if (or (null i) (eq (car i) '*))
    99101           (return-from normalize-type 'integer)
    100102           (return-from normalize-type (list 'integer (expt -2 (1- (car i))) (1- (expt 2 (1- (car i))))))))
    101103      (UNSIGNED-BYTE
    102        (if (eq (car i) '*)
     104       (if (or (null i) (eq (car i) '*))
    103105           (return-from normalize-type '(integer 0 *)))
    104106           (return-from normalize-type (list 'integer 0 (1- (expt 2 (car i))))))
     
    153155      ((SHORT-FLOAT SINGLE-FLOAT DOUBLE-FLOAT LONG-FLOAT)
    154156       (setf tp 'float))
    155       ((COMPLEX
    156         (when (memq i '(short-float single-float double-float long-float))
    157           (setf i 'float)))))
     157      (COMPLEX
     158        (cond ((null i)
     159               (setf i '(*)))
     160              ((memq i '(short-float single-float double-float long-float))
     161               (setf i 'float)))))
    158162    (if i (cons tp i) tp)))
    159163
Note: See TracChangeset for help on using the changeset viewer.