\f
;;;; simplifying HAIRY-DATA-VECTOR-REF and HAIRY-DATA-VECTOR-SET
+(deftransform hairy-data-vector-ref ((string index) (simple-string t))
+ (let ((ctype (continuation-type string)))
+ (if (array-type-p ctype)
+ ;; the other transform will kick in, so that's OK
+ (give-up-ir1-transform)
+ `(typecase string
+ ((simple-array character (*)) (data-vector-ref string index))
+ ((simple-array nil (*)) (data-vector-ref string index))))))
+
(deftransform hairy-data-vector-ref ((array index) (array t) * :important t)
"avoid runtime dispatch on array element type"
(let ((element-ctype (extract-upgraded-element-type array)))
index
new-value)))))
+(deftransform hairy-data-vector-set ((string index new-value)
+ (simple-string t t))
+ (let ((ctype (continuation-type string)))
+ (if (array-type-p ctype)
+ ;; the other transform will kick in, so that's OK
+ (give-up-ir1-transform)
+ `(typecase string
+ ((simple-array character (*))
+ (data-vector-set string index new-value))
+ ((simple-array nil (*))
+ (data-vector-set string index new-value))))))
+
(deftransform data-vector-set ((array index new-value)
(simple-array t t))
(let ((array-type (continuation-type array)))
(*))
index)))))
-(deftransform %data-vector-and-index ((array index)
- (simple-array t)
- *
- :important t)
+(deftransform %data-vector-and-index ((%array %index)
+ (simple-array t)
+ *
+ :important t)
+ ;; KLUDGE: why the percent signs? Well, ARRAY and INDEX are
+ ;; respectively exported from the CL and SB!INT packages, which
+ ;; means that they're visible to all sorts of things. If the
+ ;; compiler can prove that the call to ARRAY-HEADER-P, below, either
+ ;; returns T or NIL, it will delete the irrelevant branch. However,
+ ;; user code might have got here with a variable named CL:ARRAY, and
+ ;; quite often compiler code with a variable named SB!INT:INDEX, so
+ ;; this can generate code deletion notes for innocuous user code:
+ ;; (DEFUN F (ARRAY I) (DECLARE (SIMPLE-VECTOR ARRAY)) (AREF ARRAY I))
+ ;; -- CSR, 2003-04-01
;; We do this solely for the -OR-GIVE-UP side effect, since we want
;; to know that the type can be figured out in the end before we
;; proceed, but we don't care yet what the type will turn out to be.
- (upgraded-element-type-specifier-or-give-up array)
+ (upgraded-element-type-specifier-or-give-up %array)
- '(if (array-header-p array)
- (values (%array-data-vector array) index)
- (values array index)))
+ '(if (array-header-p %array)
+ (values (%array-data-vector %array) %index)
+ (values %array %index)))
;;; transforms for getting at simple arrays of (UNSIGNED-BYTE N) when (< N 8)
;;;
(memmove (sap+ (sapify dst) dst-start)
(sap+ (sapify src) src-start)
(- dst-end dst-start)))
- nil))
+ (values)))
\f
;;;; transforms for EQL of floating point values