#lang scheme

#|  gsl-rng.ss: Wraps gsl random number generators.
    Copyright (C) Will M. Farr <farr@mit.edu>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License along
    with this program; if not, write to the Free Software Foundation, Inc.,
    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|#


(require (lib "foreign.ss")
         "gsl-lib.ss")

(unsafe!)

(provide gsl-rng-type? gsl-rng? _gsl-rng-type-pointer _gsl-rng-pointer _gsl-rng-state-pointer
         gsl-rng-state? gsl-rng-state-set!)

(define *gsl-rng-state-tag* (gensym 'gsl-rng-state-tag))
(define _gsl-rng-state-pointer (_cpointer *gsl-rng-state-tag*))
(define (gsl-rng-state? obj)
  (and (cpointer? obj)
       (cpointer-has-tag? obj *gsl-rng-state-tag*)))

(define-cstruct _gsl-rng-type
  ((name _string*/utf-8)
   (max _ulong)
   (min _ulong)
   (size _ulong)
   (set _fpointer)
   (get _fpointer)
   (get-double _fpointer)))

(define-cstruct _gsl-rng
  ((type _gsl-rng-type-pointer)
   (struct-state _gsl-rng-state-pointer)))

(define-syntax define-gsl-rng
  (syntax-rules ()
    ((define-gsl-rng name type)
     (begin (provide name)
            (define name
              (get-ffi-obj (regexp-replaces 'name '((#rx"-" "_") (#rx"!" "")))
                           libgsl type))))))

(define-gsl-rng gsl-rng-borosh13 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-coveyou _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-cmrg _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-fishman18 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-fishman20 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-fishman2x _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-gfsr4 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-knuthran _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-knuthran2 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-knuthran2002 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-lecuyer21 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-minstd _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-mrg _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-mt19937 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-mt19937-1999 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-mt19937-1998 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-r250 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-ran0 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-ran1 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-ran2 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-ran3 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-rand _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-rand48 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random128-bsd _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random128-glibc2 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random128-libc5 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random256-bsd _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random256-glibc2 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random256-libc5 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random32-bsd _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random32-glibc2 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random32-libc5 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random64-bsd _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random64-glibc2 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random64-libc5 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random8-bsd _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random8-glibc2 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random8-libc5 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random-bsd _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random-glibc2 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-random-libc5 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-randu _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-ranf _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-ranlux _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-ranlux389 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-ranlxd1 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-ranlxd2 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-ranlxs0 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-ranlxs1 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-ranlxs2 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-ranmar _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-slatec _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-taus _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-taus2 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-taus113 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-transputer _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-tt800 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-uni _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-uni32 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-vax _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-waterman14 _gsl-rng-type-pointer)
(define-gsl-rng gsl-rng-zuf _gsl-rng-type-pointer)

; Defined specially so it won't be exported! 
; We don't want people fucking up the memory management.
(define gsl-rng-free
  (get-ffi-obj 'gsl_rng_free libgsl
               (_fun _gsl-rng-pointer -> _void)))

(define-gsl-rng gsl-rng-alloc (_fun _gsl-rng-type-pointer -> (rng : _gsl-rng-pointer)
                                    -> (begin (register-finalizer rng gsl-rng-free)
                                              rng)))
(define-gsl-rng gsl-rng-memcpy (_fun _gsl-rng-pointer _gsl-rng-pointer -> _int))
(define-gsl-rng gsl-rng-clone (_fun _gsl-rng-pointer -> (rng : _gsl-rng-pointer)
                                    -> (begin (register-finalizer rng gsl-rng-free)
                                              rng)))

(define-gsl-rng gsl-rng-set! (_fun _gsl-rng-pointer _ulong -> _void))
(define (gsl-rng-state-set! rng state)
  (set-gsl-rng-struct-state! rng state))
(define-gsl-rng gsl-rng-max (_fun _gsl-rng-pointer -> _ulong))
(define-gsl-rng gsl-rng-min (_fun _gsl-rng-pointer -> _ulong))
(define-gsl-rng gsl-rng-name (_fun _gsl-rng-pointer -> _string*/utf-8))

(define-gsl-rng gsl-rng-size (_fun _gsl-rng-pointer -> _ulong))
(define-gsl-rng gsl-rng-state (_fun _gsl-rng-pointer -> _gsl-rng-state-pointer))

(define-gsl-rng gsl-rng-get (_fun _gsl-rng-pointer -> _ulong))
(define-gsl-rng gsl-rng-uniform (_fun _gsl-rng-pointer -> _double))
(define-gsl-rng gsl-rng-uniform-pos (_fun _gsl-rng-pointer -> _double))
(define-gsl-rng gsl-rng-uniform-int (_fun _gsl-rng-pointer _ulong -> _ulong))