1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main (main) where
import Prelude ()
import Prelude.Compat
import Data.Char (isSpace)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Maybe (fromMaybe)
import Data.Word (Word32)
import System.Environment (getArgs)
import System.IO.Unsafe (unsafePerformIO)
import qualified System.Random.SplitMix as SM64
import qualified System.Random.SplitMix32 as SM32
-------------------------------------------------------------------------------
-- SplitMix32
-------------------------------------------------------------------------------
sm32ref :: IORef SM32.SMGen
sm32ref = unsafePerformIO $ newIORef $ SM32.mkSMGen 42
{-# NOINLINE sm32ref #-}
foreign export ccall haskell_splitmix32 :: IO Word32
foreign export ccall haskell_splitmix32_double :: IO Double
haskell_splitmix32 :: IO Word32
haskell_splitmix32 = do
g <- readIORef sm32ref
let !(w32, g') = SM32.nextWord32 g
writeIORef sm32ref g'
return w32
haskell_splitmix32_double :: IO Double
haskell_splitmix32_double = do
g <- readIORef sm32ref
let !(d, g') = SM32.nextDouble g
writeIORef sm32ref g'
return d
-------------------------------------------------------------------------------
-- SplitMix64
-------------------------------------------------------------------------------
sm64ref :: IORef SM64.SMGen
sm64ref = unsafePerformIO $ newIORef $ SM64.mkSMGen 42
{-# NOINLINE sm64ref #-}
foreign export ccall haskell_splitmix64 :: IO Word32
foreign export ccall haskell_splitmix64_double :: IO Double
haskell_splitmix64 :: IO Word32
haskell_splitmix64 = do
g <- readIORef sm64ref
let !(w32, g') = SM64.nextWord32 g
writeIORef sm64ref g'
return w32
haskell_splitmix64_double :: IO Double
haskell_splitmix64_double = do
g <- readIORef sm64ref
let !(d, g') = SM64.nextDouble g
writeIORef sm64ref g'
return d
-------------------------------------------------------------------------------
-- Main
-------------------------------------------------------------------------------
foreign import ccall "run_testu01" run_testu01_c :: Int -> Int -> IO ()
main :: IO ()
main = do
args <- getArgs
(gen, bat) <- parseArgsIO args $ (,)
<$> optDef "-g" SplitMix
<*> optDef "-b" SmallCrush
run_testu01_c (fromEnum gen) (fromEnum bat)
data Gen
= SplitMixDouble
| SplitMix
| SplitMix32Double
| SplitMix32
| SplitMix32Native
deriving (Read, Enum)
data Bat
= SmallCrush
| Crush
| BigCrush
| Sample
deriving (Read, Enum)
-------------------------------------------------------------------------------
-- readMaybe
-------------------------------------------------------------------------------
readEither :: Read a => String -> Either String a
readEither s =
case [ x | (x,rest) <- reads s, all isSpace rest ] of
[x] -> Right x
[] -> Left "Prelude.read: no parse"
_ -> Left "Prelude.read: ambiguous parse"
readMaybe :: Read a => String -> Maybe a
readMaybe s = case readEither s of
Left _ -> Nothing
Right a -> Just a
-------------------------------------------------------------------------------
-- Do it yourself command line parsing
-------------------------------------------------------------------------------
-- | 'Parser' is not an 'Alternative', only a *commutative* 'Applicative'.
--
-- Useful for quick cli parsers, like parametrising tests.
data Parser a where
Pure :: a -> Parser a
Ap :: Arg b -> Parser (b -> a) -> Parser a
instance Functor Parser where
fmap f (Pure a) = Pure (f a)
fmap f (Ap x y) = Ap x (fmap (f .) y)
instance Applicative Parser where
pure = Pure
Pure f <*> z = fmap f z
Ap x y <*> z = Ap x (flip <$> y <*> z)
data Arg a where
Flag :: String -> Arg Bool
Opt :: String -> (String -> Maybe a) -> Arg (Maybe a)
Arg :: Arg String
-- arg :: Parser String
-- arg = Ap Arg (Pure id)
--
-- flag :: String -> Parser Bool
-- flag n = Ap (Flag n) (Pure id)
--
-- opt :: Read a => String -> Parser (Maybe a)
-- opt n = Ap (Opt n readMaybe) (Pure id)
optDef :: Read a => String -> a -> Parser a
optDef n d = Ap (Opt n readMaybe) (Pure (fromMaybe d))
parseArgsIO :: [String] -> Parser a -> IO a
parseArgsIO args p = either fail pure (parseArgs args p)
parseArgs :: [String] -> Parser a -> Either String a
parseArgs [] p = parserToEither p
parseArgs (x : xs) p = do
(xs', p') <- singleArg p x xs
parseArgs xs' p'
singleArg :: Parser a -> String -> [String] -> Either String ([String], Parser a)
singleArg (Pure _) x _ = Left $ "Extra argument " ++ x
singleArg (Ap Arg p) x xs
| null x || head x /= '-' = Right (xs, fmap ($ x) p)
| otherwise = fmap2 (Ap Arg) (singleArg p x xs)
singleArg (Ap f@(Flag n) p) x xs
| x == n = Right (xs, fmap ($ True) p)
| otherwise = fmap2 (Ap f) (singleArg p x xs)
singleArg (Ap o@(Opt n r) p) x xs
| x == n = case xs of
[] -> Left $ "Expected an argument for " ++ n
(x' : xs') -> case r x' of
Nothing -> Left $ "Cannot read an argument of " ++ n ++ ": " ++ x'
Just y -> Right (xs', fmap ($ Just y) p)
| otherwise = fmap2 (Ap o) (singleArg p x xs)
fmap2 :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
fmap2 = fmap . fmap
-- | Convert parser to 'Right' if there are only defaultable pieces left.
parserToEither :: Parser a -> Either String a
parserToEither (Pure x) = pure x
parserToEither (Ap (Flag _) p) = parserToEither $ fmap ($ False) p
parserToEither (Ap (Opt _ _) p) = parserToEither $ fmap ($ Nothing) p
parserToEither (Ap Arg _) = Left "argument required"
|
