b8efd58aca
* `list->array' now accepts an optional shape argument, and always returns an immutable array * `vector->array' now accepts an optional shape argument, and always returns a mutable array * Removed `make-mutable-array' because `vector->array' does its job now (I never liked the name anyway) * Renamed `unsafe-mutable-array' to `unsafe-vector->array' * Added optional type annotation to `array' macro to match `mutable-array' * Reworded error messages in array broadcasting functions * Made minor array doc fixes
65 lines
2.6 KiB
Racket
65 lines
2.6 KiB
Racket
#lang racket/base
|
|
|
|
(require (for-syntax racket/base
|
|
syntax/parse)
|
|
typed/racket/base
|
|
"mutable-array.rkt"
|
|
"utils.rkt")
|
|
|
|
(provide for/array:
|
|
for*/array:
|
|
for/array
|
|
for*/array)
|
|
|
|
(define-syntax (base-for/array: stx)
|
|
(syntax-parse stx #:literals (:)
|
|
[(_ name:id for/vector:id #:shape ds-expr:expr (~optional (~seq #:fill fill-expr:expr))
|
|
(clause ...) (~optional (~seq : A:expr)) body:expr ...+)
|
|
(with-syntax ([(maybe-fill ...) (if (attribute fill-expr) #'(#:fill fill-expr) #'())]
|
|
[(maybe-type ...) (if (attribute A) #'(: A) #'())])
|
|
(syntax/loc stx
|
|
(let*: ([ds : In-Indexes ds-expr]
|
|
[ds : Indexes (check-array-shape
|
|
ds (λ () (raise-argument-error 'name "Indexes" ds)))])
|
|
(define vs (for/vector #:length (array-shape-size ds) maybe-fill ...
|
|
(clause ...) maybe-type ... body ...))
|
|
(unsafe-vector->array ds vs))))]
|
|
[(_ name:id for/vector:id (clause ...) (~optional (~seq : A:expr)) body:expr ...+)
|
|
(with-syntax ([(maybe-type ...) (if (attribute A) #'(: A) #'())])
|
|
(syntax/loc stx
|
|
(let ()
|
|
(define vs (for/vector (clause ...) maybe-type ... body ...))
|
|
(define ds ((inst vector Index) (vector-length vs)))
|
|
(unsafe-vector->array ds vs))))]))
|
|
|
|
(define-syntax-rule (for/array: e ...)
|
|
(base-for/array: for/array: for/vector: e ...))
|
|
|
|
(define-syntax-rule (for*/array: e ...)
|
|
(base-for/array: for*/array: for*/vector: e ...))
|
|
|
|
(define-syntax (base-for/array stx)
|
|
(syntax-parse stx
|
|
[(_ name:id for/vector:id #:shape ds-expr:expr (~optional (~seq #:fill fill-expr:expr))
|
|
(clause ...) body:expr ...+)
|
|
(with-syntax ([(maybe-fill ...) (if (attribute fill-expr) #'(#:fill fill-expr) #'())])
|
|
(syntax/loc stx
|
|
(let* ([ds ds-expr]
|
|
[ds (check-array-shape
|
|
ds (λ () (raise-argument-error 'name "Indexes" ds)))])
|
|
(define vs (for/vector #:length (array-shape-size ds) maybe-fill ...
|
|
(clause ...) body ...))
|
|
(unsafe-vector->array ds vs))))]
|
|
[(_ name:id for/vector:id (clause ...) body:expr ...+)
|
|
(syntax/loc stx
|
|
(let ()
|
|
(define vs (for/vector (clause ...) body ...))
|
|
(define ds ((inst vector Index) (vector-length vs)))
|
|
(unsafe-vector->array ds vs)))]))
|
|
|
|
(define-syntax-rule (for/array e ...)
|
|
(base-for/array for/array for/vector e ...))
|
|
|
|
(define-syntax-rule (for*/array e ...)
|
|
(base-for/array for*/array for*/vector e ...))
|