;; 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 )