/[cmucl]/src/compiler/array-tran.lisp
ViewVC logotype

Diff of /src/compiler/array-tran.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.44 by rtoy, Fri Mar 19 15:19:00 2010 UTC revision 1.45 by rtoy, Tue Apr 20 17:57:46 2010 UTC
# Line 293  Line 293 
293                            (integer &rest *))                            (integer &rest *))
294    (let* ((eltype (cond ((not element-type) t)    (let* ((eltype (cond ((not element-type) t)
295                         ((not (constant-continuation-p element-type))                         ((not (constant-continuation-p element-type))
296                          (give-up _"Element-Type is not constant."))                          (give-up (intl:gettext "Element-Type is not constant.")))
297                         (t                         (t
298                          (continuation-value element-type))))                          (continuation-value element-type))))
299           (len (if (constant-continuation-p length)           (len (if (constant-continuation-p length)
# Line 304  Line 304 
304      (multiple-value-bind      (multiple-value-bind
305          (default-initial-element element-size typecode)          (default-initial-element element-size typecode)
306          (dolist (info array-info          (dolist (info array-info
307                        (give-up _"Cannot open-code creation of ~S" spec))                        (give-up (intl:gettext "Cannot open-code creation of ~S") spec))
308            (when (csubtypep eltype-type (specifier-type (car info)))            (when (csubtypep eltype-type (specifier-type (car info)))
309              (return (values-list (cdr info)))))              (return (values-list (cdr info)))))
310        (let* ((nwords-form        (let* ((nwords-form
# Line 342  Line 342 
342  (deftransform make-array ((dims &key initial-element element-type)  (deftransform make-array ((dims &key initial-element element-type)
343                            (list &rest *))                            (list &rest *))
344    (unless (or (null element-type) (constant-continuation-p element-type))    (unless (or (null element-type) (constant-continuation-p element-type))
345      (give-up _"Element-type not constant; cannot open code array creation"))      (give-up (intl:gettext "Element-type not constant; cannot open code array creation")))
346    (unless (constant-continuation-p dims)    (unless (constant-continuation-p dims)
347      (give-up _"Dimension list not constant; cannot open code array creation"))      (give-up (intl:gettext "Dimension list not constant; cannot open code array creation")))
348    (let ((dims (continuation-value dims)))    (let ((dims (continuation-value dims)))
349      (unless (every #'integerp dims)      (unless (every #'integerp dims)
350        (give-up _"Dimension list contains something other than an integer: ~S"        (give-up (intl:gettext "Dimension list contains something other than an integer: ~S")
351                 dims))                 dims))
352      (if (= (length dims) 1)      (if (= (length dims) 1)
353          `(make-array ',(car dims)          `(make-array ',(car dims)
# Line 397  Line 397 
397        (give-up))        (give-up))
398      (let ((dims (array-type-dimensions array-type)))      (let ((dims (array-type-dimensions array-type)))
399        (if (not (listp dims))        (if (not (listp dims))
400            (give-up _"Array rank not known at compile time: ~S" dims)            (give-up (intl:gettext "Array rank not known at compile time: ~S") dims)
401            (length dims)))))            (length dims)))))
402    
403  ;;; ARRAY-DIMENSION  --  transform.  ;;; ARRAY-DIMENSION  --  transform.
# Line 410  Line 410 
410  (deftransform array-dimension ((array axis)  (deftransform array-dimension ((array axis)
411                                 (array index))                                 (array index))
412    (unless (constant-continuation-p axis)    (unless (constant-continuation-p axis)
413      (give-up _"Axis not constant."))      (give-up (intl:gettext "Axis not constant.")))
414    (let ((array-type (continuation-type array))    (let ((array-type (continuation-type array))
415          (axis (continuation-value axis)))          (axis (continuation-value axis)))
416      (unless (array-type-p array-type)      (unless (array-type-p array-type)
# Line 418  Line 418 
418      (let ((dims (array-type-dimensions array-type)))      (let ((dims (array-type-dimensions array-type)))
419        (unless (listp dims)        (unless (listp dims)
420          (give-up          (give-up
421           _"Array dimensions unknown, must call array-dimension at runtime."))           (intl:gettext "Array dimensions unknown, must call array-dimension at runtime.")))
422        (unless (> (length dims) axis)        (unless (> (length dims) axis)
423          (abort-transform _"Array has dimensions ~S, ~D is too large."          (abort-transform (intl:gettext "Array has dimensions ~S, ~D is too large.")
424                           dims axis))                           dims axis))
425        (let ((dim (nth axis dims)))        (let ((dim (nth axis dims)))
426          (cond ((integerp dim)          (cond ((integerp dim)
# Line 432  Line 432 
432                   ((nil)                   ((nil)
433                    '(length array))                    '(length array))
434                   ((:maybe *)                   ((:maybe *)
435                    (give-up _"Can't tell if array is simple."))))                    (give-up (intl:gettext "Can't tell if array is simple.")))))
436                (t                (t
437                 '(%array-dimension array axis)))))))                 '(%array-dimension array axis)))))))
438    
# Line 447  Line 447 
447        (give-up))        (give-up))
448      (let ((dims (array-type-dimensions type)))      (let ((dims (array-type-dimensions type)))
449        (unless (and (listp dims) (integerp (car dims)))        (unless (and (listp dims) (integerp (car dims)))
450          (give-up _"Vector length unknown, must call length at runtime."))          (give-up (intl:gettext "Vector length unknown, must call length at runtime.")))
451        (car dims))))        (car dims))))
452    
453  ;;; LENGTH  --  transform.  ;;; LENGTH  --  transform.
# Line 486  Line 486 
486        (give-up))        (give-up))
487      (let ((dims (array-type-dimensions array-type)))      (let ((dims (array-type-dimensions array-type)))
488        (unless (listp dims)        (unless (listp dims)
489          (give-up _"Can't tell the rank at compile time."))          (give-up (intl:gettext "Can't tell the rank at compile time.")))
490        (if (member '* dims)        (if (member '* dims)
491            (do ((form 1 `(truly-the index            (do ((form 1 `(truly-the index
492                                     (* (array-dimension array ,i) ,form)))                                     (* (array-dimension array ,i) ,form)))
# Line 511  Line 511 
511              ((nil)              ((nil)
512               nil)               nil)
513              (:maybe              (:maybe
514               (give-up _"Array type ambiguous; must call ~               (give-up (intl:gettext "Array type ambiguous; must call ~
515                        array-has-fill-pointer-p at runtime.")))))))                        array-has-fill-pointer-p at runtime."))))))))
516    
517  ;;; %CHECK-BOUND  --  transform.  ;;; %CHECK-BOUND  --  transform.
518  ;;;  ;;;

Legend:
Removed from v.1.44  
changed lines
  Added in v.1.45

  ViewVC Help
Powered by ViewVC 1.1.5