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
65
66
67
68
69
70
71
72
|
#lang racket/base
(provide FCArray
unsafe-fcarray
(rename-out [fcarray/syntax fcarray])
array->fcarray
fcarray-real-data
fcarray-imag-data)
(module defs typed/racket/base
(require racket/flonum
"../flonum/flonum-functions.rkt"
"../flonum/flvector-syntax.rkt"
"../unsafe.rkt"
"array-struct.rkt"
"utils.rkt"
"for-each.rkt")
(provide (all-defined-out))
(struct: (A) fcarray Settable-Array ([real-data : FlVector] [imag-data : FlVector])
#:property prop:custom-write (λ (arr port mode) ((array-custom-printer) arr 'fcarray port mode)))
(define-type FCArray (fcarray Float-Complex))
(: unsafe-fcarray (Indexes FlVector FlVector -> FCArray))
(define (unsafe-fcarray ds xs ys)
(define proc
(make-unsafe-array-proc
ds (λ (j) (make-rectangular (unsafe-flvector-ref xs j) (unsafe-flvector-ref ys j)))))
(define set-proc
(make-unsafe-array-set-proc
Float-Complex ds (λ (j v)
(unsafe-flvector-set! xs j (real-part v))
(unsafe-flvector-set! ys j (imag-part v)))))
(fcarray ds (flvector-length xs) (box #t) void proc set-proc xs ys))
(: unsafe-vector->fcarray (Indexes (Vectorof Number) -> FCArray))
(define (unsafe-vector->fcarray ds zs)
(define size (vector-length zs))
(define xs (build-flvector size (λ: ([j : Index]) (fl (real-part (unsafe-vector-ref zs j))))))
(define ys (build-flvector size (λ: ([j : Index]) (fl (imag-part (unsafe-vector-ref zs j))))))
(unsafe-fcarray ds xs ys))
(: array->fcarray ((Array Number) -> FCArray))
(define (array->fcarray arr)
(define ds (array-shape arr))
(define size (array-size arr))
(define proc (unsafe-array-proc arr))
(define xs (make-flvector size))
(define ys (make-flvector size))
(for-each-array+data-index
ds (λ (js j)
(define z (proc js))
(unsafe-flvector-set! xs j (fl (real-part z)))
(unsafe-flvector-set! ys j (fl (imag-part z)))))
(unsafe-fcarray ds xs ys))
) ; module defs
(require 'defs
typed/racket/base
(for-syntax racket/base
syntax/parse)
"array-syntax.rkt")
(define-syntax (fcarray/syntax stx)
(syntax-parse stx
[(_ e:expr)
(syntax/loc stx (array/syntax fcarray (inst vector Number) unsafe-vector->fcarray e))]
[_:id (raise-syntax-error 'fcarray "not allowed as an expression" stx)]))
|
