-- |
-- Module      :  Cryptol.Testing.Random
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable
--
-- This module generates random values for Cryptol types.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cryptol.Testing.Random where

import Cryptol.Eval.Monad     (ready,runEval,EvalOpts)
import Cryptol.Eval.Value     (BV(..),Value,GenValue(..),SeqMap(..), WordValue(..), BitWord(..))
import qualified Cryptol.Testing.Concrete as Conc
import Cryptol.TypeCheck.AST  (Type(..), TCon(..), TC(..), tNoUser, tIsFun)
import Cryptol.TypeCheck.SimpType(tRebuild')

import Cryptol.Utils.Ident    (Ident)
import Cryptol.Utils.Panic    (panic)

import Control.Monad          (forM,join)
import Data.List              (unfoldr, genericTake, genericIndex)
import System.Random          (RandomGen, split, random, randomR)
import qualified Data.Sequence as Seq

type Gen g b w i = Integer -> g -> (GenValue b w i, g)


{- | Apply a testable value to some randomly-generated arguments.
     Returns `Nothing` if the function returned `True`, or
     `Just counterexample` if it returned `False`.

    Please note that this function assumes that the generators match
    the supplied value, otherwise we'll panic.
 -}
runOneTest :: RandomGen g
        => EvalOpts   -- ^ how to evaluate things
        -> Value   -- ^ Function under test
        -> [Gen g Bool BV Integer] -- ^ Argument generators
        -> Integer -- ^ Size
        -> g
        -> IO (Conc.TestResult, g)
runOneTest :: EvalOpts
-> Value
-> [Gen g Bool BV Integer]
-> Integer
-> g
-> IO (TestResult, g)
runOneTest evOpts :: EvalOpts
evOpts fun :: Value
fun argGens :: [Gen g Bool BV Integer]
argGens sz :: Integer
sz g0 :: g
g0 = do
  let (args :: [Value]
args, g1 :: g
g1) = (Gen g Bool BV Integer -> ([Value], g) -> ([Value], g))
-> ([Value], g) -> [Gen g Bool BV Integer] -> ([Value], g)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Gen g Bool BV Integer -> ([Value], g) -> ([Value], g)
forall b a b. (Integer -> b -> (a, b)) -> ([a], b) -> ([a], b)
mkArg ([], g
g0) [Gen g Bool BV Integer]
argGens
      mkArg :: (Integer -> b -> (a, b)) -> ([a], b) -> ([a], b)
mkArg argGen :: Integer -> b -> (a, b)
argGen (as :: [a]
as, g :: b
g) = let (a :: a
a, g' :: b
g') = Integer -> b -> (a, b)
argGen Integer
sz b
g in (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as, b
g')
  TestResult
result <- EvalOpts -> Value -> [Value] -> IO TestResult
Conc.runOneTest EvalOpts
evOpts Value
fun [Value]
args
  (TestResult, g) -> IO (TestResult, g)
forall (m :: * -> *) a. Monad m => a -> m a
return (TestResult
result, g
g1)

returnOneTest :: RandomGen g
           => EvalOpts -- ^ How to evaluate things
           -> Value    -- ^ Function to be used to calculate tests
           -> [Gen g Bool BV Integer] -- ^ Argument generators
           -> Integer -- ^ Size
           -> g -- ^ Initial random state
           -> IO ([Value], Value, g) -- ^ Arguments, result, and new random state
returnOneTest :: EvalOpts
-> Value
-> [Gen g Bool BV Integer]
-> Integer
-> g
-> IO ([Value], Value, g)
returnOneTest evOpts :: EvalOpts
evOpts fun :: Value
fun argGens :: [Gen g Bool BV Integer]
argGens sz :: Integer
sz g0 :: g
g0 =
  do let (args :: [Value]
args, g1 :: g
g1) = (Gen g Bool BV Integer -> ([Value], g) -> ([Value], g))
-> ([Value], g) -> [Gen g Bool BV Integer] -> ([Value], g)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Gen g Bool BV Integer -> ([Value], g) -> ([Value], g)
forall b a b. (Integer -> b -> (a, b)) -> ([a], b) -> ([a], b)
mkArg ([], g
g0) [Gen g Bool BV Integer]
argGens
         mkArg :: (Integer -> b -> (a, b)) -> ([a], b) -> ([a], b)
mkArg argGen :: Integer -> b -> (a, b)
argGen (as :: [a]
as, g :: b
g) = let (a :: a
a, g' :: b
g') = Integer -> b -> (a, b)
argGen Integer
sz b
g in (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as, b
g')
     Value
result <- EvalOpts -> Eval Value -> IO Value
forall a. EvalOpts -> Eval a -> IO a
runEval EvalOpts
evOpts (Value -> [Value] -> Eval Value
forall b w i.
GenValue b w i -> [GenValue b w i] -> Eval (GenValue b w i)
go Value
fun [Value]
args)
     ([Value], Value, g) -> IO ([Value], Value, g)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Value]
args, Value
result, g
g1)
   where
     go :: GenValue b w i -> [GenValue b w i] -> Eval (GenValue b w i)
go (VFun f :: Eval (GenValue b w i) -> Eval (GenValue b w i)
f) (v :: GenValue b w i
v : vs :: [GenValue b w i]
vs) = Eval (Eval (GenValue b w i)) -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (GenValue b w i -> [GenValue b w i] -> Eval (GenValue b w i)
go (GenValue b w i -> [GenValue b w i] -> Eval (GenValue b w i))
-> Eval (GenValue b w i)
-> Eval ([GenValue b w i] -> Eval (GenValue b w i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Eval (GenValue b w i) -> Eval (GenValue b w i)
f (GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready GenValue b w i
v)) Eval ([GenValue b w i] -> Eval (GenValue b w i))
-> Eval [GenValue b w i] -> Eval (Eval (GenValue b w i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [GenValue b w i] -> Eval [GenValue b w i]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [GenValue b w i]
vs)
     go (VFun _) [] = String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
panic "Cryptol.Testing.Random" ["Not enough arguments to function while generating tests"]
     go _ (_ : _) = String -> [String] -> Eval (GenValue b w i)
forall a. HasCallStack => String -> [String] -> a
panic "Cryptol.Testing.Random" ["Too many arguments to function while generating tests"]
     go v :: GenValue b w i
v [] = GenValue b w i -> Eval (GenValue b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return GenValue b w i
v


-- | Return a collection of random tests.
returnTests :: RandomGen g
         => g -- ^ The random generator state
         -> EvalOpts -- ^ How to evaluate things
         -> [Gen g Bool BV Integer] -- ^ Generators for the function arguments
         -> Value -- ^ The function itself
         -> Int -- ^ How many tests?
         -> IO [([Value], Value)] -- ^ A list of pairs of random arguments and computed outputs
returnTests :: g
-> EvalOpts
-> [Gen g Bool BV Integer]
-> Value
-> Int
-> IO [([Value], Value)]
returnTests g :: g
g evo :: EvalOpts
evo gens :: [Gen g Bool BV Integer]
gens fun :: Value
fun num :: Int
num = [Gen g Bool BV Integer] -> g -> Int -> IO [([Value], Value)]
forall t.
RandomGen t =>
[Gen t Bool BV Integer] -> t -> Int -> IO [([Value], Value)]
go [Gen g Bool BV Integer]
gens g
g 0
  where
    go :: [Gen t Bool BV Integer] -> t -> Int -> IO [([Value], Value)]
go args :: [Gen t Bool BV Integer]
args g0 :: t
g0 n :: Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
num = [([Value], Value)] -> IO [([Value], Value)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      | Bool
otherwise =
        do let sz :: Integer
sz = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)) Int
num)
           (inputs :: [Value]
inputs, output :: Value
output, g1 :: t
g1) <- EvalOpts
-> Value
-> [Gen t Bool BV Integer]
-> Integer
-> t
-> IO ([Value], Value, t)
forall g.
RandomGen g =>
EvalOpts
-> Value
-> [Gen g Bool BV Integer]
-> Integer
-> g
-> IO ([Value], Value, g)
returnOneTest EvalOpts
evo Value
fun [Gen t Bool BV Integer]
args Integer
sz t
g0
           [([Value], Value)]
more <- [Gen t Bool BV Integer] -> t -> Int -> IO [([Value], Value)]
go [Gen t Bool BV Integer]
args t
g1 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
           [([Value], Value)] -> IO [([Value], Value)]
forall (m :: * -> *) a. Monad m => a -> m a
return (([Value]
inputs, Value
output) ([Value], Value) -> [([Value], Value)] -> [([Value], Value)]
forall a. a -> [a] -> [a]
: [([Value], Value)]
more)

{- | Given a (function) type, compute generators for the function's
arguments. This is like @testableType@, but allows the result to be
any finite type instead of just @Bit@. -}
dumpableType :: forall g. RandomGen g => Type -> Maybe [Gen g Bool BV Integer]
dumpableType :: Type -> Maybe [Gen g Bool BV Integer]
dumpableType ty :: Type
ty =
  case Type -> Maybe (Type, Type)
tIsFun Type
ty of
    Just (t1 :: Type
t1, t2 :: Type
t2) ->
      do Gen g Bool BV Integer
g  <- Type -> Maybe (Gen g Bool BV Integer)
forall b w i g.
(BitWord b w i, RandomGen g) =>
Type -> Maybe (Gen g b w i)
randomValue Type
t1
         [Gen g Bool BV Integer]
as <- Type -> Maybe [Gen g Bool BV Integer]
forall g. RandomGen g => Type -> Maybe [Gen g Bool BV Integer]
testableType Type
t2
         [Gen g Bool BV Integer] -> Maybe [Gen g Bool BV Integer]
forall (m :: * -> *) a. Monad m => a -> m a
return (Gen g Bool BV Integer
g Gen g Bool BV Integer
-> [Gen g Bool BV Integer] -> [Gen g Bool BV Integer]
forall a. a -> [a] -> [a]
: [Gen g Bool BV Integer]
as)
    Nothing ->
      do (Gen g Bool BV Integer
_ :: Gen g Bool BV Integer) <- Type -> Maybe (Gen g Bool BV Integer)
forall b w i g.
(BitWord b w i, RandomGen g) =>
Type -> Maybe (Gen g b w i)
randomValue Type
ty
         [Gen g Bool BV Integer] -> Maybe [Gen g Bool BV Integer]
forall (m :: * -> *) a. Monad m => a -> m a
return []

{- | Given a (function) type, compute generators for
the function's arguments. Currently we do not support polymorphic functions.
In principle, we could apply these to random types, and test the results. -}
testableType :: RandomGen g => Type -> Maybe [Gen g Bool BV Integer]
testableType :: Type -> Maybe [Gen g Bool BV Integer]
testableType ty :: Type
ty =
  case Type -> Type
tNoUser Type
ty of
    TCon (TC TCFun) [t1 :: Type
t1,t2 :: Type
t2] ->
      do Gen g Bool BV Integer
g  <- Type -> Maybe (Gen g Bool BV Integer)
forall b w i g.
(BitWord b w i, RandomGen g) =>
Type -> Maybe (Gen g b w i)
randomValue Type
t1
         [Gen g Bool BV Integer]
as <- Type -> Maybe [Gen g Bool BV Integer]
forall g. RandomGen g => Type -> Maybe [Gen g Bool BV Integer]
testableType Type
t2
         [Gen g Bool BV Integer] -> Maybe [Gen g Bool BV Integer]
forall (m :: * -> *) a. Monad m => a -> m a
return (Gen g Bool BV Integer
g Gen g Bool BV Integer
-> [Gen g Bool BV Integer] -> [Gen g Bool BV Integer]
forall a. a -> [a] -> [a]
: [Gen g Bool BV Integer]
as)
    TCon (TC TCBit) [] -> [Gen g Bool BV Integer] -> Maybe [Gen g Bool BV Integer]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    _ -> Maybe [Gen g Bool BV Integer]
forall a. Maybe a
Nothing


{- | A generator for values of the given type.  This fails if we are
given a type that lacks a suitable random value generator. -}
randomValue :: (BitWord b w i, RandomGen g) => Type -> Maybe (Gen g b w i)
randomValue :: Type -> Maybe (Gen g b w i)
randomValue ty :: Type
ty =
  case Type
ty of
    TCon tc :: TCon
tc ts :: [Type]
ts  ->
      case (TCon
tc, (Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Type -> Type
tRebuild' Bool
False) [Type]
ts) of
        (TC TCBit, [])                        -> Gen g b w i -> Maybe (Gen g b w i)
forall a. a -> Maybe a
Just Gen g b w i
forall b w i g. (BitWord b w i, RandomGen g) => Gen g b w i
randomBit

        (TC TCInteger, [])                    -> Gen g b w i -> Maybe (Gen g b w i)
forall a. a -> Maybe a
Just Gen g b w i
forall b w i g. (BitWord b w i, RandomGen g) => Gen g b w i
randomInteger

        (TC TCIntMod, [TCon (TC (TCNum n :: Integer
n)) []]) ->
          do Gen g b w i -> Maybe (Gen g b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Gen g b w i
forall b w i g.
(BitWord b w i, RandomGen g) =>
Integer -> Gen g b w i
randomIntMod Integer
n)

        (TC TCSeq, [TCon (TC TCInf) [], el :: Type
el])  ->
          do Gen g b w i
mk <- Type -> Maybe (Gen g b w i)
forall b w i g.
(BitWord b w i, RandomGen g) =>
Type -> Maybe (Gen g b w i)
randomValue Type
el
             Gen g b w i -> Maybe (Gen g b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (Gen g b w i -> Gen g b w i
forall g b w i. RandomGen g => Gen g b w i -> Gen g b w i
randomStream Gen g b w i
mk)

        (TC TCSeq, [TCon (TC (TCNum n :: Integer
n)) [], TCon (TC TCBit) []]) ->
            Gen g b w i -> Maybe (Gen g b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Gen g b w i
forall b w i g.
(BitWord b w i, RandomGen g) =>
Integer -> Gen g b w i
randomWord Integer
n)

        (TC TCSeq, [TCon (TC (TCNum n :: Integer
n)) [], el :: Type
el]) ->
          do Gen g b w i
mk <- Type -> Maybe (Gen g b w i)
forall b w i g.
(BitWord b w i, RandomGen g) =>
Type -> Maybe (Gen g b w i)
randomValue Type
el
             Gen g b w i -> Maybe (Gen g b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Gen g b w i -> Gen g b w i
forall g b w i.
RandomGen g =>
Integer -> Gen g b w i -> Gen g b w i
randomSequence Integer
n Gen g b w i
mk)

        (TC (TCTuple _), els :: [Type]
els) ->
          do [Gen g b w i]
mks <- (Type -> Maybe (Gen g b w i)) -> [Type] -> Maybe [Gen g b w i]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> Maybe (Gen g b w i)
forall b w i g.
(BitWord b w i, RandomGen g) =>
Type -> Maybe (Gen g b w i)
randomValue [Type]
els
             Gen g b w i -> Maybe (Gen g b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Gen g b w i] -> Gen g b w i
forall g b w i. RandomGen g => [Gen g b w i] -> Gen g b w i
randomTuple [Gen g b w i]
mks)

        _ -> Maybe (Gen g b w i)
forall a. Maybe a
Nothing

    TVar _      -> Maybe (Gen g b w i)
forall a. Maybe a
Nothing
    TUser _ _ t :: Type
t -> Type -> Maybe (Gen g b w i)
forall b w i g.
(BitWord b w i, RandomGen g) =>
Type -> Maybe (Gen g b w i)
randomValue Type
t
    TRec fs :: [(Ident, Type)]
fs     -> do [(Ident, Gen g b w i)]
gs <- [(Ident, Type)]
-> ((Ident, Type) -> Maybe (Ident, Gen g b w i))
-> Maybe [(Ident, Gen g b w i)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Ident, Type)]
fs (((Ident, Type) -> Maybe (Ident, Gen g b w i))
 -> Maybe [(Ident, Gen g b w i)])
-> ((Ident, Type) -> Maybe (Ident, Gen g b w i))
-> Maybe [(Ident, Gen g b w i)]
forall a b. (a -> b) -> a -> b
$ \(l :: Ident
l,t :: Type
t) -> do Gen g b w i
g <- Type -> Maybe (Gen g b w i)
forall b w i g.
(BitWord b w i, RandomGen g) =>
Type -> Maybe (Gen g b w i)
randomValue Type
t
                                                   (Ident, Gen g b w i) -> Maybe (Ident, Gen g b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident
l,Gen g b w i
g)
                      Gen g b w i -> Maybe (Gen g b w i)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Ident, Gen g b w i)] -> Gen g b w i
forall g b w i.
RandomGen g =>
[(Ident, Gen g b w i)] -> Gen g b w i
randomRecord [(Ident, Gen g b w i)]
gs)

-- | Generate a random bit value.
randomBit :: (BitWord b w i, RandomGen g) => Gen g b w i
randomBit :: Gen g b w i
randomBit _ g :: g
g =
  let (b :: Bool
b,g1 :: g
g1) = g -> (Bool, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random g
g
  in (b -> GenValue b w i
forall b w i. b -> GenValue b w i
VBit (Bool -> b
forall b w i. BitWord b w i => Bool -> b
bitLit Bool
b), g
g1)

randomSize :: RandomGen g => Int -> Int -> g -> (Int, g)
randomSize :: Int -> Int -> g -> (Int, g)
randomSize k :: Int
k n :: Int
n g :: g
g
  | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = (Int
n, g
g')
  | Bool
otherwise = Int -> Int -> g -> (Int, g)
forall g. RandomGen g => Int -> Int -> g -> (Int, g)
randomSize Int
k (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) g
g'
  where (p :: Int
p, g' :: g
g') = (Int, Int) -> g -> (Int, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (1, Int
k) g
g

-- | Generate a random integer value. The size parameter is assumed to
-- vary between 1 and 100, and we use it to generate smaller numbers
-- first.
randomInteger :: (BitWord b w i, RandomGen g) => Gen g b w i
randomInteger :: Gen g b w i
randomInteger w :: Integer
w g :: g
g =
  let (n :: Int
n, g1 :: g
g1) = if Integer
w Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 100 then (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
w, g
g) else Int -> Int -> g -> (Int, g)
forall g. RandomGen g => Int -> Int -> g -> (Int, g)
randomSize 8 100 g
g
      (x :: Integer
x, g2 :: g
g2) = (Integer, Integer) -> g -> (Integer, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (- 256Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n, 256Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
n) g
g1
  in (i -> GenValue b w i
forall b w i. i -> GenValue b w i
VInteger (Integer -> i
forall b w i. BitWord b w i => Integer -> i
integerLit Integer
x), g
g2)

randomIntMod :: (BitWord b w i, RandomGen g) => Integer -> Gen g b w i
randomIntMod :: Integer -> Gen g b w i
randomIntMod modulus :: Integer
modulus _ g :: g
g =
  let (x :: Integer
x, g' :: g
g') = (Integer, Integer) -> g -> (Integer, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (0, Integer
modulusInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1) g
g
  in (i -> GenValue b w i
forall b w i. i -> GenValue b w i
VInteger (Integer -> i
forall b w i. BitWord b w i => Integer -> i
integerLit Integer
x), g
g')

-- | Generate a random word of the given length (i.e., a value of type @[w]@)
-- The size parameter is assumed to vary between 1 and 100, and we use
-- it to generate smaller numbers first.
randomWord :: (BitWord b w i, RandomGen g) => Integer -> Gen g b w i
randomWord :: Integer -> Gen g b w i
randomWord w :: Integer
w _sz :: Integer
_sz g :: g
g =
   let (val :: Integer
val, g1 :: g
g1) = (Integer, Integer) -> g -> (Integer, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (0,2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
wInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1) g
g
   in (Integer -> Eval (WordValue b w i) -> GenValue b w i
forall b w i. Integer -> Eval (WordValue b w i) -> GenValue b w i
VWord Integer
w (WordValue b w i -> Eval (WordValue b w i)
forall a. a -> Eval a
ready (w -> WordValue b w i
forall b w i. w -> WordValue b w i
WordVal (Integer -> Integer -> w
forall b w i. BitWord b w i => Integer -> Integer -> w
wordLit Integer
w Integer
val))), g
g1)

-- | Generate a random infinite stream value.
randomStream :: RandomGen g => Gen g b w i -> Gen g b w i
randomStream :: Gen g b w i -> Gen g b w i
randomStream mkElem :: Gen g b w i
mkElem sz :: Integer
sz g :: g
g =
  let (g1 :: g
g1,g2 :: g
g2) = g -> (g, g)
forall g. RandomGen g => g -> (g, g)
split g
g
  in (SeqMap b w i -> GenValue b w i
forall b w i. SeqMap b w i -> GenValue b w i
VStream (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ [Eval (GenValue b w i)] -> Integer -> Eval (GenValue b w i)
forall i a. Integral i => [a] -> i -> a
genericIndex ((GenValue b w i -> Eval (GenValue b w i))
-> [GenValue b w i] -> [Eval (GenValue b w i)]
forall a b. (a -> b) -> [a] -> [b]
map GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready ((g -> Maybe (GenValue b w i, g)) -> g -> [GenValue b w i]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ((GenValue b w i, g) -> Maybe (GenValue b w i, g)
forall a. a -> Maybe a
Just ((GenValue b w i, g) -> Maybe (GenValue b w i, g))
-> (g -> (GenValue b w i, g)) -> g -> Maybe (GenValue b w i, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen g b w i
mkElem Integer
sz) g
g1)), g
g2)

{- | Generate a random sequence.  This should be used for sequences
other than bits.  For sequences of bits use "randomWord". -}
randomSequence :: RandomGen g => Integer -> Gen g b w i -> Gen g b w i
randomSequence :: Integer -> Gen g b w i -> Gen g b w i
randomSequence w :: Integer
w mkElem :: Gen g b w i
mkElem sz :: Integer
sz g0 :: g
g0 = do
  let (g1 :: g
g1,g2 :: g
g2) = g -> (g, g)
forall g. RandomGen g => g -> (g, g)
split g
g0
  let f :: g -> Maybe (Eval (GenValue b w i), g)
f g :: g
g = let (x :: GenValue b w i
x,g' :: g
g') = Gen g b w i
mkElem Integer
sz g
g
             in GenValue b w i
-> Maybe (Eval (GenValue b w i), g)
-> Maybe (Eval (GenValue b w i), g)
forall a b. a -> b -> b
seq GenValue b w i
x ((Eval (GenValue b w i), g) -> Maybe (Eval (GenValue b w i), g)
forall a. a -> Maybe a
Just (GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready GenValue b w i
x, g
g'))
  let xs :: Seq (Eval (GenValue b w i))
xs = [Eval (GenValue b w i)] -> Seq (Eval (GenValue b w i))
forall a. [a] -> Seq a
Seq.fromList ([Eval (GenValue b w i)] -> Seq (Eval (GenValue b w i)))
-> [Eval (GenValue b w i)] -> Seq (Eval (GenValue b w i))
forall a b. (a -> b) -> a -> b
$ Integer -> [Eval (GenValue b w i)] -> [Eval (GenValue b w i)]
forall i a. Integral i => i -> [a] -> [a]
genericTake Integer
w ([Eval (GenValue b w i)] -> [Eval (GenValue b w i)])
-> [Eval (GenValue b w i)] -> [Eval (GenValue b w i)]
forall a b. (a -> b) -> a -> b
$ (g -> Maybe (Eval (GenValue b w i), g))
-> g -> [Eval (GenValue b w i)]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr g -> Maybe (Eval (GenValue b w i), g)
f g
g1
  Seq (Eval (GenValue b w i))
-> (GenValue b w i, g) -> (GenValue b w i, g)
forall a b. a -> b -> b
seq Seq (Eval (GenValue b w i))
xs (Integer -> SeqMap b w i -> GenValue b w i
forall b w i. Integer -> SeqMap b w i -> GenValue b w i
VSeq Integer
w (SeqMap b w i -> GenValue b w i) -> SeqMap b w i -> GenValue b w i
forall a b. (a -> b) -> a -> b
$ (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall b w i. (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
IndexSeqMap ((Integer -> Eval (GenValue b w i)) -> SeqMap b w i)
-> (Integer -> Eval (GenValue b w i)) -> SeqMap b w i
forall a b. (a -> b) -> a -> b
$ (Seq (Eval (GenValue b w i)) -> Int -> Eval (GenValue b w i)
forall a. Seq a -> Int -> a
Seq.index Seq (Eval (GenValue b w i))
xs (Int -> Eval (GenValue b w i))
-> (Integer -> Int) -> Integer -> Eval (GenValue b w i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger), g
g2)

-- | Generate a random tuple value.
randomTuple :: RandomGen g => [Gen g b w i] -> Gen g b w i
randomTuple :: [Gen g b w i] -> Gen g b w i
randomTuple gens :: [Gen g b w i]
gens sz :: Integer
sz = [Eval (GenValue b w i)]
-> [Gen g b w i] -> g -> (GenValue b w i, g)
forall b w i t.
[Eval (GenValue b w i)]
-> [Integer -> t -> (GenValue b w i, t)]
-> t
-> (GenValue b w i, t)
go [] [Gen g b w i]
gens
  where
  go :: [Eval (GenValue b w i)]
-> [Integer -> t -> (GenValue b w i, t)]
-> t
-> (GenValue b w i, t)
go els :: [Eval (GenValue b w i)]
els [] g :: t
g = ([Eval (GenValue b w i)] -> GenValue b w i
forall b w i. [Eval (GenValue b w i)] -> GenValue b w i
VTuple ([Eval (GenValue b w i)] -> [Eval (GenValue b w i)]
forall a. [a] -> [a]
reverse [Eval (GenValue b w i)]
els), t
g)
  go els :: [Eval (GenValue b w i)]
els (mkElem :: Integer -> t -> (GenValue b w i, t)
mkElem : more :: [Integer -> t -> (GenValue b w i, t)]
more) g :: t
g =
    let (v :: GenValue b w i
v, g1 :: t
g1) = Integer -> t -> (GenValue b w i, t)
mkElem Integer
sz t
g
    in GenValue b w i -> (GenValue b w i, t) -> (GenValue b w i, t)
forall a b. a -> b -> b
seq GenValue b w i
v ([Eval (GenValue b w i)]
-> [Integer -> t -> (GenValue b w i, t)]
-> t
-> (GenValue b w i, t)
go (GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready GenValue b w i
v Eval (GenValue b w i)
-> [Eval (GenValue b w i)] -> [Eval (GenValue b w i)]
forall a. a -> [a] -> [a]
: [Eval (GenValue b w i)]
els) [Integer -> t -> (GenValue b w i, t)]
more t
g1)

-- | Generate a random record value.
randomRecord :: RandomGen g => [(Ident, Gen g b w i)] -> Gen g b w i
randomRecord :: [(Ident, Gen g b w i)] -> Gen g b w i
randomRecord gens :: [(Ident, Gen g b w i)]
gens sz :: Integer
sz = [(Ident, Eval (GenValue b w i))]
-> [(Ident, Gen g b w i)] -> g -> (GenValue b w i, g)
forall b w i t.
[(Ident, Eval (GenValue b w i))]
-> [(Ident, Integer -> t -> (GenValue b w i, t))]
-> t
-> (GenValue b w i, t)
go [] [(Ident, Gen g b w i)]
gens
  where
  go :: [(Ident, Eval (GenValue b w i))]
-> [(Ident, Integer -> t -> (GenValue b w i, t))]
-> t
-> (GenValue b w i, t)
go els :: [(Ident, Eval (GenValue b w i))]
els [] g :: t
g = ([(Ident, Eval (GenValue b w i))] -> GenValue b w i
forall b w i. [(Ident, Eval (GenValue b w i))] -> GenValue b w i
VRecord ([(Ident, Eval (GenValue b w i))]
-> [(Ident, Eval (GenValue b w i))]
forall a. [a] -> [a]
reverse [(Ident, Eval (GenValue b w i))]
els), t
g)
  go els :: [(Ident, Eval (GenValue b w i))]
els ((l :: Ident
l,mkElem :: Integer -> t -> (GenValue b w i, t)
mkElem) : more :: [(Ident, Integer -> t -> (GenValue b w i, t))]
more) g :: t
g =
    let (v :: GenValue b w i
v, g1 :: t
g1) = Integer -> t -> (GenValue b w i, t)
mkElem Integer
sz t
g
    in GenValue b w i -> (GenValue b w i, t) -> (GenValue b w i, t)
forall a b. a -> b -> b
seq GenValue b w i
v ([(Ident, Eval (GenValue b w i))]
-> [(Ident, Integer -> t -> (GenValue b w i, t))]
-> t
-> (GenValue b w i, t)
go ((Ident
l,GenValue b w i -> Eval (GenValue b w i)
forall a. a -> Eval a
ready GenValue b w i
v) (Ident, Eval (GenValue b w i))
-> [(Ident, Eval (GenValue b w i))]
-> [(Ident, Eval (GenValue b w i))]
forall a. a -> [a] -> [a]
: [(Ident, Eval (GenValue b w i))]
els) [(Ident, Integer -> t -> (GenValue b w i, t))]
more t
g1)