__module__ DSL __where__
__import__ Prelude hiding (sequence)
__import__ Control.Monad.State __as__ CMS hiding (sequence)
__import__ System.Random (StdGen, randomR, newStdGen)
__type__ Sem a = CMS.State StdGen a
-- |nextBoundedBy bound| for |0 < bound| returns a random result |0 <= result < bound|
nextBoundedBy :: Int -> Sem Int
nextBoundedBy bound = state $ randomR (0,bound-1)
-- Not asked for in the exam question
-- a)
elements = oneof . map returnGen
oneof = frequency . map ((,) 1) -- Alternatively: zip (repeat 1)
fmapGen f g = bindGen g $ \x -> return $ f x
sequence [] = returnGen []
sequence (g**:**gs) = bindGen g $ \x -> bindGen (sequence gs) $ \xs -> return (x**:**xs)
-- b)
__type__ Gen a = Sem a
returnGen a = CMS.state $ \s -> (a, s)
bindGen g f = CMS.state $ \s -> __let__ (a, s') = runState g s __in__ runState (f a) s'
frequency igs = __do__ __let__ tot = sum $ map fst igs
j <- nextBoundedBy tot
pick j igs
pick :: Int -> [(Int, a)] -> a
pick j [] = error "pick: Out of bound"
pick j ((i, a)**:**ias) | j < i = a
| otherwise = pick (j-i) ias
run :: Gen a -> Int -> StdGen -> [a]
run g n = take n . runInf g
runInf :: State s a -> s -> [a]
runInf g = evalState (sequence $ repeat g)
----
-- Testing code - not part of the exam question
runIO :: Gen a -> Int -> IO [a]
runIO g n = run g n `fmap` newStdGen
test = runIO (frequency
[ (3, return False),
(1,return True)
]) 10