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