1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
#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 ...))
|
