Changeset 8787


Ignore:
Timestamp:
03/18/05 18:39:37 (16 years ago)
Author:
piso
Message:

UPGRADED-ELEMENT-TYPE: call NORMALIZE-TYPE.

File:
1 edited

Legend:

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

    r7525 r8787  
    11;;; open.lisp
    22;;;
    3 ;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: open.lisp,v 1.17 2004-09-01 17:25:16 piso Exp $
     3;;; Copyright (C) 2003-2005 Peter Graves
     4;;; $Id: open.lisp,v 1.18 2005-03-18 18:39:37 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2020;;; Adapted from SBCL.
    2121
    22 (in-package "SYSTEM")
     22(in-package #:system)
    2323
    2424(defun upgraded-element-type-bits (bits)
     
    2828
    2929(defun upgraded-element-type (element-type)
     30  (setf element-type (normalize-type element-type))
    3031  (let ((ok nil))
    3132    (if (atom element-type)
     
    4041                 ok t))
    4142          (integer
    42            (setf element-type '(signed-byte 8))))
     43           (setf element-type '(signed-byte 8)
     44                 ok t)))
    4345        (cond ((eq (car element-type) 'or)
    4446               (let ((types (mapcar #'upgraded-element-type (cdr element-type)))
     
    7072                      (setf high (1- (car high))))
    7173                    (setf element-type
    72                           (if (minusp low)
    73                               (list 'signed-byte
    74                                     (upgraded-element-type-bits (max (1+ (integer-length low))
    75                                                                      (integer-length high))))
    76                               (list 'unsigned-byte
    77                                     (upgraded-element-type-bits (integer-length high))))
     74                          (cond ((eq high '*)
     75                                 (if (minusp low) '(signed-byte 8) '(unsigned-byte 8)))
     76                                ((minusp low)
     77                                 (list 'signed-byte
     78                                       (upgraded-element-type-bits (max (1+ (integer-length low))
     79                                                                        (integer-length high)))))
     80                                (t
     81                                 (list 'unsigned-byte
     82                                       (upgraded-element-type-bits (integer-length high)))))
    7883                          ok t)))))))
    7984    (if ok
Note: See TracChangeset for help on using the changeset viewer.