blob: c1719064c22c2836638c4bfc87e626bee61f3253 (
about) (
plain)
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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
;; openblas+gsl example (WIP)
(define %vec-a (vector-unfold (lambda (i)
(* i i))
5))
;; take vec-a's length at compile-time
(define %len-a (vector-length %vec-a))
(define foox
(external "computefoox" (=> (integer integer) integer)
(lambda (x y)
(display (+ x y)))))
(define (handle-error message)
(define out (current-error-port))
(error message))
(define-wrapper-type gsl-vector)
(define (gsl-create-vector size) ; gsl_vector_alloc (3);
((external "gsl_vector_alloc" (=> (integer) gsl-vector))
size))
(define (gsl-destroy-vector vector)
((external "gsl_vector_free" (=> (gsl-vector) unit ) )
vector))
(define (with-vector vector proc)
(if (null-pointer? vector)
(handle-error "Could not create vector")
(let ((result (proc vector)))
(gsl-destroy-vector vector)
result)))
;; void gsl_vector_set(gsl_vector *v, const size_t i, double x)
(define (gsl-vector-set! v i x)
((external "gsl_vector_set" (=> (gsl-vector integer float) unit ) )
v i x))
;; double gsl_vector_get(const gsl_vector *v, const size_t i)
(define (gsl-vector-get v i)
((external "gsl_vector_get" (=> (gsl-vector integer) float ) )
v i))
;; gcvt (float value, int ndigits, char * buf);
(define (gcvt v ndigits buf)
((external "gcvt" (=> (float integer (^ char)) unit ) )
v ndigits buf))
;;(define-c-generator make-string #t
;; (lambda (call port indent)
;; ; calloc is used as a hack to get a zero at the end
;; (format port "(char *)calloc( 1, 1 + ")
;; (c-value (call-arg call 0) port)
;; (format port ")")))
(define (main)
(define out (current-output-port))
(write-string "Prescheme vector: print vec-a with vector-for-each:\n" out)
; (make-pointer gsl-vector)
(vector-for-each (lambda (i val)
(write-string " vec-a[" out)
(write-integer i out)
(write-string "] = " out)
(write-integer val out)
(write-string ", " out)
)
%vec-a %len-a)
(newline out)
(write-string "OpenBLAS: print vec-a with vector-for-each:\n" out)
(with-vector
(gsl-create-vector 5)
(lambda (one-vec)
;; (gsl-vector-for-each (lambda (i val)
;; gsl-set-vector(one-vec,i,val);
;; )
;; one-vec)
(let ((x 1.1))
(gsl-vector-set! one-vec 0 (fl* x 0.0))
(gsl-vector-set! one-vec 1 (fl* x x))
(gsl-vector-set! one-vec 2 (fl* x 2.1))
(gsl-vector-set! one-vec 3 4.0)
(gsl-vector-set! one-vec 4 5.0)
;; (gsl-vector-set one-vec 5 6.0)
)
(vector-for-each (lambda (i val)
(write-string " vec-b[" out)
(write-integer i out)
(write-string "] = " out)
;; (write-number (gsl-vector-get one-vec i) out)
(let ((target (make-string 20)))
;; (write-integer (gsl-vector-get one-vec i) out)
;; (gcvt (gsl-vector-get one-vec i) target)
(gcvt (gsl-vector-get one-vec i) 4 target)
(write-string target out)
)
(write-string ", " out)
)
%vec-a %len-a)
))
(newline out)
0
)
|
