Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Added high level wrapper. Used ForeignPtr. Added finalizer.

  • Loading branch information...
commit a8742cfb8dddf9fb5dd8981cb1fcbe64934ec7d4 1 parent a28da82
@bjpop authored
View
6 haskell-sprng.cabal
@@ -20,9 +20,10 @@ source-repository head
location: git://github.com/bjpop/haskell-sprng.git
Library
- extra-libraries: sprng
+ extra-libraries: sprng stdc++
build-tools:
- ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-orphans -pgml g++
+ -- ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-orphans -pgml g++
+ ghc-options: -Wall -fno-warn-name-shadowing
c-sources:
src/cbits/sprng_wrapper.cpp
include-dirs:
@@ -33,5 +34,6 @@ Library
base > 3 && <= 5,
haskell98
exposed-modules:
+ Sprng
Sprng.Internal
other-modules:
View
50 src/Sprng.hs
@@ -0,0 +1,50 @@
+module Sprng
+ ( RNG {- abstract -}
+ , SprngGen (..)
+ , LFG, LCG, LCG64, CMRG, MLFG, PMLCG
+ ) where
+
+import qualified Sprng.Internal as Internal
+
+data RNG a = RNG Internal.Sprng
+
+data LFG
+data LCG
+data LCG64
+data CMRG
+data MLFG
+data PMLCG
+
+class SprngGen a where
+ newRng :: IO (RNG a)
+ initRng :: RNG a -> Int -> Int -> Int -> Int -> IO ()
+ randomInt :: RNG a -> IO Int
+ randomFloat :: RNG a -> IO Float
+ randomDouble :: RNG a -> IO Double
+ spawnRng :: RNG a -> Int -> IO [RNG a]
+ printRng :: RNG a -> IO ()
+ printRng (RNG rng) = Internal.printRng rng
+
+ randomInt (RNG rng) = Internal.getRandomInt rng
+ randomFloat (RNG rng) = Internal.getRandomFloat rng
+ randomDouble (RNG rng) = Internal.getRandomDouble rng
+ spawnRng (RNG rng) n = map RNG `fmap` Internal.spawnRng rng n
+ initRng (RNG rng) = Internal.initRng rng
+
+instance SprngGen LFG where
+ newRng = RNG `fmap` Internal.newRng Internal.LFG
+
+instance SprngGen LCG where
+ newRng = RNG `fmap` Internal.newRng Internal.LCG
+
+instance SprngGen LCG64 where
+ newRng = RNG `fmap` Internal.newRng Internal.LCG64
+
+instance SprngGen CMRG where
+ newRng = RNG `fmap` Internal.newRng Internal.CMRG
+
+instance SprngGen MLFG where
+ newRng = RNG `fmap` Internal.newRng Internal.MLFG
+
+instance SprngGen PMLCG where
+ newRng = RNG `fmap` Internal.newRng Internal.PMLCG
View
71 src/Sprng/Internal.hs
@@ -1,33 +1,72 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
module Sprng.Internal
- ( SprngPtr
- , new_rng
- , init_rng
- , get_rn_int
- , get_rn_flt
- , get_rn_dbl
- , free_rng
- , print_rng
- , spawn_rng
+ ( Sprng
+ , RngType (..)
+ , newRng
+ , initRng
+ , getRandomInt
+ , getRandomFloat
+ , getRandomDouble
+ , printRng
+ , spawnRng
) where
-import Foreign.Ptr (Ptr)
+import Foreign.Ptr (Ptr, FunPtr)
+import Foreign.ForeignPtr (newForeignPtr, withForeignPtr, ForeignPtr)
import Foreign.C.Types (CInt, CFloat, CDouble)
import Foreign.Marshal.Array (peekArray)
+type Sprng = ForeignPtr ()
type SprngPtr = Ptr ()
+data RngType = LFG | LCG | LCG64 | CMRG | MLFG | PMLCG
+ deriving (Eq, Show, Enum)
foreign import ccall "new_rng" new_rng :: CInt -> IO SprngPtr
foreign import ccall "init_rng" init_rng :: SprngPtr -> CInt -> CInt -> CInt -> CInt -> IO ()
foreign import ccall "get_rn_int" get_rn_int :: SprngPtr -> IO CInt
foreign import ccall "get_rn_flt" get_rn_flt :: SprngPtr -> IO CFloat
foreign import ccall "get_rn_dbl" get_rn_dbl :: SprngPtr -> IO CDouble
-foreign import ccall "free_rng" free_rng :: SprngPtr -> IO ()
foreign import ccall "print_rng" print_rng :: SprngPtr -> IO ()
-foreign import ccall "spawn_rng" spawn_rng_ :: SprngPtr -> CInt -> IO (Ptr SprngPtr)
+foreign import ccall "spawn_rng" spawn_rng :: SprngPtr -> CInt -> IO (Ptr SprngPtr)
+foreign import ccall "&free_rng" freeRngFunPtr :: FunPtr (SprngPtr -> IO ())
+foreign import ccall "free_spawn_buffer" freeSpawnBuffer :: Ptr (SprngPtr) -> IO ()
+
+newRng :: RngType -> IO Sprng
+newRng ty = do
+ ptr <- new_rng $ fromIntegral $ fromEnum ty
+ newForeignPtr freeRngFunPtr ptr
+
+initRng :: Sprng -> Int -> Int -> Int -> Int -> IO ()
+initRng rng streamnum nstreams seed param =
+ withForeignPtr rng $ \ptr ->
+ init_rng ptr (fromIntegral streamnum)
+ (fromIntegral nstreams)
+ (fromIntegral seed)
+ (fromIntegral param)
+
+-- Haskell Int is machine word sized, which is safe to fit a C int.
+getRandomInt :: Sprng -> IO Int
+getRandomInt rng =
+ withForeignPtr rng $ \ptr -> fromIntegral `fmap` get_rn_int ptr
+
+getRandomFloat :: Sprng -> IO Float
+getRandomFloat rng =
+ withForeignPtr rng $ \ptr -> realToFrac `fmap` get_rn_flt ptr
+
+getRandomDouble :: Sprng -> IO Double
+getRandomDouble rng =
+ withForeignPtr rng $ \ptr -> realToFrac `fmap` get_rn_dbl ptr
+
+printRng :: Sprng -> IO ()
+printRng rng = withForeignPtr rng $ print_rng
-spawn_rng :: SprngPtr -> Int -> IO [SprngPtr]
-spawn_rng rng num = do
- arr <- spawn_rng_ rng $ fromIntegral num
- peekArray num arr
+spawnRng :: Sprng -> Int -> IO [Sprng]
+spawnRng rng num =
+ withForeignPtr rng $ \ptr -> do
+ arr <- spawn_rng ptr $ fromIntegral num
+ ptrs <- peekArray num arr
+ rngs <- mapM (newForeignPtr freeRngFunPtr) ptrs
+ freeSpawnBuffer arr
+ return rngs
View
11 src/cbits/sprng_wrapper.cpp
@@ -1,15 +1,13 @@
#include "sprng_wrapper.h"
-// Sprng * new_rng(Rng_type type)
-// XXX should use the enum type instead.
Sprng * new_rng(int type)
{
return SelectType(type);
}
-void init_rng(Sprng *rng, int streamnum, int nstreams, int seed, int pa)
+void init_rng(Sprng *rng, int streamnum, int nstreams, int seed, int param)
{
- rng->init_rng(streamnum, nstreams, seed, pa);
+ rng->init_rng(streamnum, nstreams, seed, param);
}
int get_rn_int(Sprng *rng)
@@ -43,3 +41,8 @@ Sprng **spawn_rng(Sprng *rng, int num)
rng->spawn_rng(num, &new_rngs);
return new_rngs;
}
+
+void free_spawn_buffer(Sprng **buffer)
+{
+ free(buffer);
+}
View
4 src/include/sprng_wrapper.h
@@ -4,9 +4,6 @@
#include "sprng.h"
#include "sprng_cpp.h"
-typedef enum { LFG, LCG, LCG64, CMRG, MLFG, PMLCG } Rng_type;
-
-//extern "C" Sprng * new_rng(Rng_type);
extern "C" Sprng * new_rng(int);
extern "C" void init_rng(Sprng *, int, int, int, int);
extern "C" int get_rn_int(Sprng *);
@@ -15,5 +12,6 @@ extern "C" double get_rn_dbl(Sprng *);
extern "C" void free_rng(Sprng *);
extern "C" void print_rng(Sprng *);
extern "C" Sprng **spawn_rng(Sprng *, int);
+extern "C" void free_spawn_buffer(Sprng **);
#endif
Please sign in to comment.
Something went wrong with that request. Please try again.