- (dolist (optimization '(((speed 3) (space 0))
- ((speed 2) (space 2))
- ((speed 1) (space 2))
- ((speed 0) (space 1))))
- (let* ((seq (if (eq seq-type 'list)
- (coerce base-seq 'list)
- (destructuring-bind (type-first &rest type-rest)
- seq-type
- (ecase type-first
- (simple-array
- (destructuring-bind (eltype one) type-rest
- (assert (= one 1))
- (if (entirely eltype)
- (coerce base-seq seq-type)
- (return))))
- (vector
- (destructuring-bind (eltype) type-rest
- (if (entirely eltype)
- (let ((initial-element
- (cond ((subtypep eltype 'character)
- #\!)
- ((subtypep eltype 'number)
- 0)
- (t #'error))))
- (replace (make-array
- (+ (length base-seq)
- (random 3))
- :element-type eltype
- :fill-pointer
- (length base-seq)
- :initial-element
- initial-element)
- base-seq))
- (return))))))))
- (lambda-expr `(lambda (seq)
- ,@(when declaredness
- `((declare (type ,seq-type seq))))
- (declare (optimize ,@optimization))
- ,snippet)))
- (format t "~&~S~%" lambda-expr)
- (multiple-value-bind (fun warnings-p failure-p)
- (compile nil lambda-expr)
- (when (or warnings-p failure-p)
- (error "~@<failed compilation:~2I ~_LAMBDA-EXPR=~S ~_WARNINGS-P=~S ~_FAILURE-P=~S~:@>"
- lambda-expr warnings-p failure-p))
- (format t "~&~S ~S~%~S~%~S ~S~%"
- base-seq snippet seq-type declaredness optimization)
- (format t "~&(TYPEP SEQ 'SIMPLE-ARRAY)=~S~%"
- (typep seq 'simple-array))
- (unless (funcall fun seq)
- (error "~@<failed test:~2I ~_BASE-SEQ=~S ~_SNIPPET=~S ~_SEQ-TYPE=~S ~_DECLAREDNESS=~S ~_OPTIMIZATION=~S~:@>"
- base-seq
- snippet
- seq-type
- declaredness
- optimization)))))))))
+ (dolist (optimization '(((speed 3) (space 0))
+ ((speed 2) (space 2))
+ ((speed 1) (space 2))
+ ((speed 0) (space 1))))
+ (let* ((seq (if (eq seq-type 'list)
+ (coerce base-seq 'list)
+ (destructuring-bind (type-first &rest type-rest)
+ seq-type
+ (ecase type-first
+ (simple-array
+ (destructuring-bind (eltype one) type-rest
+ (assert (= one 1))
+ (if (entirely eltype)
+ (coerce base-seq seq-type)
+ (return))))
+ (vector
+ (destructuring-bind (eltype) type-rest
+ (if (entirely eltype)
+ (let ((initial-element
+ (cond ((subtypep eltype 'character)
+ #\!)
+ ((subtypep eltype 'number)
+ 0)
+ (t #'error))))
+ (replace (make-array
+ (+ (length base-seq)
+ (random 3))
+ :element-type eltype
+ :fill-pointer
+ (length base-seq)
+ :initial-element
+ initial-element)
+ base-seq))
+ (return))))))))
+ (lambda-expr `(lambda (seq)
+ ,@(when declaredness
+ `((declare (type ,seq-type seq))))
+ (declare (optimize ,@optimization))
+ ,snippet)))
+ (format t "~&~S~%" lambda-expr)
+ (multiple-value-bind (fun warnings-p failure-p)
+ (compile nil lambda-expr)
+ (when (or warnings-p failure-p)
+ (error "~@<failed compilation:~2I ~_LAMBDA-EXPR=~S ~_WARNINGS-P=~S ~_FAILURE-P=~S~:@>"
+ lambda-expr warnings-p failure-p))
+ (format t "~&~S ~S~%~S~%~S ~S~%"
+ base-seq snippet seq-type declaredness optimization)
+ (format t "~&(TYPEP SEQ 'SIMPLE-ARRAY)=~S~%"
+ (typep seq 'simple-array))
+ (unless (funcall fun seq)
+ (error "~@<failed test:~2I ~_BASE-SEQ=~S ~_SNIPPET=~S ~_SEQ-TYPE=~S ~_DECLAREDNESS=~S ~_OPTIMIZATION=~S~:@>"
+ base-seq
+ snippet
+ seq-type
+ declaredness
+ optimization)))))))))