-----------------------------------------------------------------------------
--
-- Module      :  $Headers
-- Copyright   :  (c) 2021 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <code@functionally.io>
-- Stability   :  Experimental
-- Portability :  Portable
--
-- | Random-number generator.
--
-----------------------------------------------------------------------------


{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE Trustworthy       #-}


module Plutus.OnChain.Random (
-- * Types
  RandomGenerator
-- * Functions
, makeRandomGenerator
, nextInteger64
) where


import PlutusTx.Prelude

import Plutus.OnChain.Bits (xor)

import qualified Prelude


-- | A splittable random-number generator. See <https://doi.org/10.1145/2660193.2660195> and the "splitmix" Haskell package.
data RandomGenerator =
  RandomGenerator
  {
    RandomGenerator -> Integer
seed  :: Integer -- ^ The seed.
  , RandomGenerator -> Integer
gamma :: Integer -- ^ The gamma constant.
  }
    deriving (Int -> RandomGenerator -> ShowS
[RandomGenerator] -> ShowS
RandomGenerator -> String
(Int -> RandomGenerator -> ShowS)
-> (RandomGenerator -> String)
-> ([RandomGenerator] -> ShowS)
-> Show RandomGenerator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RandomGenerator] -> ShowS
$cshowList :: [RandomGenerator] -> ShowS
show :: RandomGenerator -> String
$cshow :: RandomGenerator -> String
showsPrec :: Int -> RandomGenerator -> ShowS
$cshowsPrec :: Int -> RandomGenerator -> ShowS
Prelude.Show)


{-# INLINABLE makeRandomGenerator #-}

-- | Initialize the random-number generator.
makeRandomGenerator :: Integer         -- ^ The seed.
                    -> RandomGenerator -- ^ The random-number generator.
makeRandomGenerator :: Integer -> RandomGenerator
makeRandomGenerator Integer
seed =
  RandomGenerator :: Integer -> Integer -> RandomGenerator
RandomGenerator
  {
    seed :: Integer
seed = Integer -> Integer
truncate64 Integer
seed
  , gamma :: Integer
gamma = Integer
goldenGamma
  }
    where
      goldenGamma :: Integer
goldenGamma = Integer
0x9e3779b97f4a7c15


{-# INLINABLE nextInteger64 #-}

-- | Return the next 64-bit non-negative integer.
nextInteger64 :: RandomGenerator            -- ^ The random-number generator.
              -> (Integer, RandomGenerator) -- ^ The random number and the modified random-number generator.
nextInteger64 :: RandomGenerator -> (Integer, RandomGenerator)
nextInteger64 RandomGenerator
rg =
  let
    rg' :: RandomGenerator
rg' = RandomGenerator -> RandomGenerator
nextSeed RandomGenerator
rg
  in
    (Integer -> Integer
mix64 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ RandomGenerator -> Integer
seed RandomGenerator
rg', RandomGenerator
rg')


{-# INLINABLE nextSeed #-}
      
-- | Update the random-number generator with its next seed.
nextSeed :: RandomGenerator -- ^ The random-number generator.
         -> RandomGenerator -- ^ The modified random-number generator.
nextSeed :: RandomGenerator -> RandomGenerator
nextSeed rg :: RandomGenerator
rg@RandomGenerator{Integer
gamma :: Integer
seed :: Integer
gamma :: RandomGenerator -> Integer
seed :: RandomGenerator -> Integer
..} =
  RandomGenerator
rg
  {
    seed :: Integer
seed = Integer -> Integer
truncate64 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
seed Integer -> Integer -> Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ Integer
gamma
  }


{-# INLINABLE mix64 #-}

-- | Mix bits of a 64-bit non-negative integer.
mix64 :: Integer -- ^ Before mixing.
      -> Integer -- ^ After mixing.
mix64 :: Integer -> Integer
mix64 Integer
z =
  let
    xorShift :: Integer -> Integer
xorShift Integer
w = Integer
w Integer -> Integer -> Integer
`xor` Integer -> Integer
shift33 Integer
w
    z' :: Integer
z'  = Integer -> Integer
truncate64 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
xorShift Integer
z  Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
* Integer
0xff51afd7ed558ccd
    z'' :: Integer
z'' = Integer -> Integer
truncate64 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
xorShift Integer
z' Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
* Integer
0xc4ceb9fe1a85ec53
  in
    Integer -> Integer
truncate64 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
xorShift Integer
z''


{-# INLINABLE shift33 #-}

-- | Shift a non-negative integer to the right by 33 bits.
shift33 :: Integer -- ^ The integer.
        -> Integer -- ^ The right-shifted integer.
shift33 :: Integer -> Integer
shift33 = (Integer -> Integer -> Integer
`divide` Integer
0x200000000)


{-# INLINABLE truncate64 #-}

-- | Discard all but the last 64 bits of a non-negative integer.
truncate64 :: Integer -- ^ The integer.
           -> Integer -- ^ The truncated integer.
truncate64 :: Integer -> Integer
truncate64 = (Integer -> Integer -> Integer
`modulo` Integer
0x10000000000000000)