Skip to content
Snippets Groups Projects
Commit 2d9f16ca authored by wlott's avatar wlott
Browse files

Fixed the make-array derive type optimizer to only spec the dimensions

if the created array is known to be simple.  Otherwise, someone might
adjust it, which would cause the type to be wrong.
parent 85f79adc
No related branches found
No related tags found
No related merge requests found
...@@ -7,11 +7,11 @@ ...@@ -7,11 +7,11 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.10 1991/04/24 23:51:00 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.11 1991/06/05 10:58:50 wlott Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.10 1991/04/24 23:51:00 ram Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.11 1991/06/05 10:58:50 wlott Exp $
;;; ;;;
;;; This file contains array specific optimizers and transforms. ;;; This file contains array specific optimizers and transforms.
;;; ;;;
...@@ -130,25 +130,26 @@ ...@@ -130,25 +130,26 @@
(defoptimizer (make-array derive-type) (defoptimizer (make-array derive-type)
((dims &key initial-element element-type initial-contents ((dims &key initial-element element-type initial-contents
adjustable fill-pointer displaced-index-offset displaced-to)) adjustable fill-pointer displaced-index-offset displaced-to))
(specifier-type (let ((simple (and (unsupplied-or-nil adjustable)
`(,(if (and (unsupplied-or-nil adjustable) (unsupplied-or-nil displaced-to)
(unsupplied-or-nil displaced-to) (unsupplied-or-nil fill-pointer))))
(unsupplied-or-nil fill-pointer)) (specifier-type
'simple-array `(,(if simple 'simple-array 'array)
'array) ,(cond ((not element-type) 't)
,(cond ((not element-type) 't) ((constant-continuation-p element-type)
((constant-continuation-p element-type) (continuation-value element-type))
(continuation-value element-type)) (t
(t '*))
'*)) ,(cond ((not simple)
,(cond ((constant-continuation-p dims) '*)
(let ((val (continuation-value dims))) ((constant-continuation-p dims)
(if (listp val) val (list val)))) (let ((val (continuation-value dims)))
((csubtypep (continuation-type dims) (if (listp val) val (list val))))
(specifier-type 'integer)) ((csubtypep (continuation-type dims)
'(*)) (specifier-type 'integer))
(t '(*))
'*))))) (t
'*))))))
;;;; Constructors. ;;;; Constructors.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment