MWC Via FFI

MwcFFI.hs

{-# OPTIONS_GHC -Wall                 #-}

{-# LANGUAGE ForeignFunctionInterface #-}

module TestPcgViaR where

import Foreign
import Foreign.C.Types

import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Storable as VS

import System.Random ( next )
import System.Random ( RandomGen )

import Control.Monad.ST
import System.Random.PCG

import qualified System.Random.MWC as MWC

import Control.Monad.Primitive
import System.IO.Unsafe

foreign export ccall singleUniformR :: Ptr CDouble -> IO ()

singleUniform :: Double
singleUniform = runST $ do
  g <- create
  uniform g

singleUniformR :: Ptr CDouble -> IO ()
singleUniformR result = do
  let x = singleUniform
  let cResult :: CDouble
      cResult = realToFrac x
  poke result cResult

data MWCRNG = MWCRNG { mWCRNG :: MWC.Gen (PrimState IO) }

instance RandomGen MWCRNG where
  next g@(MWCRNG gen) = unsafeDupablePerformIO $
   do v <- MWC.uniform gen
      return (v, g)

randHsMwc :: ForeignPtr Word32 -> CInt -> IO (CInt, ForeignPtr Word32, CInt)
randHsMwc f1 l = do
  let v1 :: VU.Vector Word32
      v1 = V.convert $ VS.unsafeFromForeignPtr0 f1 (fromIntegral l)
  g1 <- MWC.restore $ MWC.toSeed v1
  let (r, g2) = next (MWCRNG g1)
  s2 <- MWC.save $ mWCRNG g2
  let (f2, l2) = VS.unsafeToForeignPtr0 $ V.convert $ MWC.fromSeed s2
  return (fromIntegral r, f2, fromIntegral l2)