{-# LANGUAGE TypeFamilies #-}
{- |
Very simple random number generator according to Knuth
which should be fast and should suffice for generating just noise.
<http://www.softpanorama.org/Algorithms/random_generators.shtml>
-}
module Synthesizer.LLVM.Random where

import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Vector as Vector

import qualified LLVM.Extra.Arithmetic as A

import qualified LLVM.Core.Guided as Guided
import LLVM.Core
          (CodeGenFunction, Value, Vector,
           zext, trunc, lshr, valueOf)
import qualified LLVM.Core as LLVM
import qualified Type.Data.Num.Decimal as TypeNum

import qualified Data.NonEmpty.Class as NonEmptyC
import Data.Function.HT (nest)

import Data.Int (Int32)
import Data.Word (Word32, Word64)


factor :: Integral a => a
factor :: forall a. Integral a => a
factor = a
40692

modulus :: Integral a => a
modulus :: forall a. Integral a => a
modulus = a
2147483399 -- 2^31-249

{-
We have to split the 32 bit integer in order to avoid overflow on multiplication.
'split' must be chosen, such that 'splitRem' is below 2^16.
-}
split :: Word32
split :: Word32
split = Word32 -> Word32
forall a. Enum a => a -> a
succ (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
div Word32
forall a. Integral a => a
modulus Word32
forall a. Integral a => a
factor

splitRem :: Word32
splitRem :: Word32
splitRem = Word32
split Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
forall a. Integral a => a
factor Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
forall a. Integral a => a
modulus


{- |
efficient computation of @mod (s*factor) modulus@
without Integer or Word64, as in 'next64'.
-}
next :: Word32 -> Word32
next :: Word32 -> Word32
next Word32
s =
   let (Word32
sHigh, Word32
sLow) = Word32 -> Word32 -> (Word32, Word32)
forall a. Integral a => a -> a -> (a, a)
divMod Word32
s Word32
split
   in  (Word32 -> Word32 -> Word32) -> Word32 -> Word32 -> Word32
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
mod Word32
forall a. Integral a => a
modulus (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$
       Word32
splitRemWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
*Word32
sHigh Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
forall a. Integral a => a
factorWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
*Word32
sLow

next64 :: Word32 -> Word32
next64 :: Word32 -> Word32
next64 Word32
s =
   Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> Word64 -> Word32
forall a b. (a -> b) -> a -> b
$
   (Word64 -> Word64 -> Word64) -> Word64 -> Word64 -> Word64
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
mod Word64
forall a. Integral a => a
modulus (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$
   Word64
forall a. Integral a => a
factor Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
s :: Word64)

nextCG32 :: Value Word32 -> CodeGenFunction r (Value Word32)
nextCG32 :: forall r. Value Word32 -> CodeGenFunction r (Value Word32)
nextCG32 Value Word32
s = do
   Value Word32
sHigh <- Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
forall r.
Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
A.mul (Word32 -> Value Word32
forall a. IsConst a => a -> Value a
valueOf Word32
splitRem) (Value Word32 -> CodeGenFunction r (Value Word32))
-> CodeGenFunction r (Value Word32)
-> CodeGenFunction r (Value Word32)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value Word32
-> Value Word32
-> CodeGenFunction r (BinOpValue Value Value Word32)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.idiv Value Word32
s (Word32 -> Value Word32
forall a. IsConst a => a -> Value a
valueOf Word32
split)
   Value Word32
sLow  <- Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
forall r.
Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
A.mul (Word32 -> Value Word32
forall a. IsConst a => a -> Value a
valueOf Word32
forall a. Integral a => a
factor)   (Value Word32 -> CodeGenFunction r (Value Word32))
-> CodeGenFunction r (Value Word32)
-> CodeGenFunction r (Value Word32)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value Word32
-> Value Word32
-> CodeGenFunction r (BinOpValue Value Value Word32)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.irem Value Word32
s (Word32 -> Value Word32
forall a. IsConst a => a -> Value a
valueOf Word32
split)
   (Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32))
-> Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
A.irem (Word32 -> Value Word32
forall a. IsConst a => a -> Value a
valueOf Word32
forall a. Integral a => a
modulus) (Value Word32 -> CodeGenFunction r (Value Word32))
-> CodeGenFunction r (Value Word32)
-> CodeGenFunction r (Value Word32)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
forall a r. Additive a => a -> a -> CodeGenFunction r a
forall r.
Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
A.add Value Word32
sHigh Value Word32
sLow

nextCG64 :: Value Word32 -> CodeGenFunction r (Value Word32)
nextCG64 :: forall r. Value Word32 -> CodeGenFunction r (Value Word32)
nextCG64 Value Word32
s =
   Value Word64 -> CodeGenFunction r (Value Word32)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b,
 IsSized a, IsSized b, SizeOf a :>: SizeOf b) =>
value a -> CodeGenFunction r (value b)
trunc (Value Word64 -> CodeGenFunction r (Value Word32))
-> CodeGenFunction r (Value Word64)
-> CodeGenFunction r (Value Word32)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
   {-
   This is slow on x86 since the native @div@ is not used
   since LLVM wants to prevent overflow.
   We know that there cannot be an overflow,
   but I do not know how to tell LLVM.
   -}
   (Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64))
-> Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
A.irem (Word64 -> Value Word64
forall a. IsConst a => a -> Value a
valueOf (Word64
forall a. Integral a => a
modulus :: Word64)) (Value Word64 -> CodeGenFunction r (Value Word64))
-> CodeGenFunction r (Value Word64)
-> CodeGenFunction r (Value Word64)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
   Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
forall r.
Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
A.mul (Word64 -> Value Word64
forall a. IsConst a => a -> Value a
valueOf Word64
forall a. Integral a => a
factor) (Value Word64 -> CodeGenFunction r (Value Word64))
-> CodeGenFunction r (Value Word64)
-> CodeGenFunction r (Value Word64)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
   Value Word32 -> CodeGenFunction r (Value Word64)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b,
 IsSized a, IsSized b, SizeOf a :<: SizeOf b) =>
value a -> CodeGenFunction r (value b)
zext Value Word32
s

nextCG :: Value Word32 -> CodeGenFunction r (Value Word32)
nextCG :: forall r. Value Word32 -> CodeGenFunction r (Value Word32)
nextCG Value Word32
s = do
   Value Word64
x <- Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
forall r.
Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
A.mul (Word64 -> Value Word64
forall a. IsConst a => a -> Value a
valueOf (Word64 -> Value Word64) -> Word64 -> Value Word64
forall a b. (a -> b) -> a -> b
$ Word64
forall a. Integral a => a
factor :: Value Word64) (Value Word64 -> CodeGenFunction r (Value Word64))
-> CodeGenFunction r (Value Word64)
-> CodeGenFunction r (Value Word64)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value Word32 -> CodeGenFunction r (Value Word64)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b,
 IsSized a, IsSized b, SizeOf a :<: SizeOf b) =>
value a -> CodeGenFunction r (value b)
zext Value Word32
s
   {-
   split 64 result between bit 30 and bit 31
   we cannot split above bit 31,
   since then 'low' can be up to 2^32-1
   and then later addition overflows.
   -}
   let p2e31 :: Word32
p2e31 = Word32
2Word32 -> Int -> Word32
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
31::Int)
   Value Word32
low <- Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
forall a r. Logic a => a -> a -> CodeGenFunction r a
forall r.
Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
A.and (Word32 -> Value Word32
forall a. IsConst a => a -> Value a
valueOf (Word32 -> Value Word32) -> Word32 -> Value Word32
forall a b. (a -> b) -> a -> b
$ Word32
p2e31Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
-Word32
1) (Value Word32 -> CodeGenFunction r (Value Word32))
-> CodeGenFunction r (Value Word32)
-> CodeGenFunction r (Value Word32)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value Word64 -> CodeGenFunction r (Value Word32)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b,
 IsSized a, IsSized b, SizeOf a :>: SizeOf b) =>
value a -> CodeGenFunction r (value b)
trunc Value Word64
x
   Value Word32
high <- Value Word64 -> CodeGenFunction r (Value Word32)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b,
 IsSized a, IsSized b, SizeOf a :>: SizeOf b) =>
value a -> CodeGenFunction r (value b)
trunc (Value Word64 -> CodeGenFunction r (Value Word32))
-> CodeGenFunction r (Value Word64)
-> CodeGenFunction r (Value Word32)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64))
-> Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value Word64 -> Value Word64 -> CodeGenFunction r (Value Word64)
Value Word64
-> Value Word64
-> CodeGenFunction r (BinOpValue Value Value Word64)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
lshr (Word64 -> Value Word64
forall a. IsConst a => a -> Value a
valueOf (Word64
31 :: Word64)) Value Word64
x
   -- fac = mod (2^31) modulus
   let fac :: Word32
fac = Word32
p2e31 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
forall a. Integral a => a
modulus
   {-
   fac < 250
   high < factor
   fac*high < factor*250
   low < 2^31
   low + fac*high
      < 2^31 + factor*250
      < 2*modulus
   Thus modulo by modulus needs at most one subtraction.
   -}
   Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
forall a r.
Real a =>
Value a -> Value a -> CodeGenFunction r (Value a)
subtractIfPossible (Word32 -> Value Word32
forall a. IsConst a => a -> Value a
valueOf Word32
forall a. Integral a => a
modulus)
      (Value Word32 -> CodeGenFunction r (Value Word32))
-> CodeGenFunction r (Value Word32)
-> CodeGenFunction r (Value Word32)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
forall a r. Additive a => a -> a -> CodeGenFunction r a
forall r.
Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
A.add Value Word32
low
      (Value Word32 -> CodeGenFunction r (Value Word32))
-> CodeGenFunction r (Value Word32)
-> CodeGenFunction r (Value Word32)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
forall r.
Value Word32 -> Value Word32 -> CodeGenFunction r (Value Word32)
A.mul (Word32 -> Value Word32
forall a. IsConst a => a -> Value a
valueOf Word32
fac) Value Word32
high


{-
How to vectorise?
E.g. by repeated distribution of modulus and split at bit 31.
Can we replace div by modulus by mul with (2^31+249) ?
-}
vectorParameter ::
   Integral a =>
   Int -> a
vectorParameter :: forall a. Integral a => Int -> a
vectorParameter Int
n =
   Word32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> a) -> Word32 -> a
forall a b. (a -> b) -> a -> b
$ Int -> (Word32 -> Word32) -> Word32 -> Word32
forall a. Int -> (a -> a) -> a -> a
nest Int
n Word32 -> Word32
next Word32
1

vectorSeed ::
   (TypeNum.Positive n) =>
   Word32 -> Vector n Word32
vectorSeed :: forall n. Positive n => Word32 -> Vector n Word32
vectorSeed Word32
seed =
   T [] Word32 -> Vector n Word32
forall n a. Positive n => T [] a -> Vector n a
LLVM.cyclicVector (T [] Word32 -> Vector n Word32) -> T [] Word32 -> Vector n Word32
forall a b. (a -> b) -> a -> b
$ (Word32 -> Word32) -> Word32 -> T [] Word32
forall a. (a -> a) -> a -> T [] a
forall (f :: * -> *) a. Iterate f => (a -> a) -> a -> f a
NonEmptyC.iterate Word32 -> Word32
next Word32
seed
-- vector $ NonEmptyC.iterate next seed

vector64 :: Value (Vector n Word64) -> Value (Vector n Word64)
vector64 :: forall n. Value (Vector n Word64) -> Value (Vector n Word64)
vector64 = Value (Vector n Word64) -> Value (Vector n Word64)
forall a. a -> a
id

{-
In case of a vector random generator the factor depends on the vector size
and thus we cannot do optimizations on a constant factor as in nextCG.
Thus we just compute the product @factor*seed@ as is
(this is of type @Word32 -> Word32 -> Word64@)
and try to compute @urem@ without using LLVM's @urem@
that calls __umoddi3 on every element.
Instead we optimize on the constant modulus
and utilize that is slightly smaller than 2^31.

We split the product:
  factor*seed = high0*2^31 + low0

Now it is
mod (factor*seed) modulus
  = mod (high0*2^31 + low0) modulus
  = mod (high0 * mod (2^31) modulus + low0) modulus
  = mod (high0 * 249 + low0) modulus

However, high0 * 249 + low0 is still too big,
it can be up to (excluding) 2^31 * 250.
Thus we repeat the split
high0 * 249 + low0 = high1 * 2^31 + low1

It is high1 < 250, and thus high1*249 < 62500,
high1 * 249 + low1 < 2*modulus.
With x = high1 * 249 + low1
we have
mod (factor*seed) modulus
  = if x<modulus
      then x
      else x-modulus


An alternative approach would be to still multiply @let p = factor*seed@ exactly,
then do an approximate division @let q = approxdiv p modulus@,
then compute @p - q*modulus@ and
do a final adjustment in order to fix rounding errors.
The approximate division could be done by a floating point multiplication
or an integer multiplication with some shifting.
But in the end we will need at least the same number of multiplications
as in the approach that is implemented here.
-}
nextVector ::
   (TypeNum.Positive n) =>
   Value (Vector n Word32) ->
   CodeGenFunction r (Value (Vector n Word32))
nextVector :: forall n r.
Positive n =>
Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word32))
nextVector Value (Vector n Word32)
s = do
   {-
   It seems that LLVM-2.6 on x86 does not make use of the fact,
   that the upper doublewords are zero.
   It seems to implement a full 64x64 multiplication in terms of pmuludq.
   -}
   (Value (Vector n Word32)
low0, Value (Vector n Word32)
high0) <-
      Value (Vector n Word64)
-> CodeGenFunction
     r (Value (Vector n Word32), Value (Vector n Word32))
forall n r.
Positive n =>
Value (Vector n Word64)
-> CodeGenFunction
     r (Value (Vector n Word32), Value (Vector n Word32))
splitVector31 (Value (Vector n Word64)
 -> CodeGenFunction
      r (Value (Vector n Word32), Value (Vector n Word32)))
-> CodeGenFunction r (Value (Vector n Word64))
-> CodeGenFunction
     r (Value (Vector n Word32), Value (Vector n Word32))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word64))
forall n r.
Positive n =>
Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word64))
umul32to64 (Scalar (Vector n Word32) -> Value (Vector n Word32)
forall v. (IsConst (Scalar v), Replicate v) => Scalar v -> Value v
SoV.replicateOf (Int -> Word32
forall a. Integral a => Int -> a
vectorParameter (Value (Vector n Word32) -> Int
forall n a. Positive n => Value (Vector n a) -> Int
Vector.size Value (Vector n Word32)
s))) Value (Vector n Word32)
s
   -- fac = mod (2^31) modulus
   let fac :: Integral a => a
       fac :: forall a. Integral a => a
fac = a
2a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
31::Int) a -> a -> a
forall a. Num a => a -> a -> a
- a
forall a. Integral a => a
modulus
   (Value (Vector n Word32)
low1, Value (Vector n Word32)
high1) <-
      Value (Vector n Word64)
-> CodeGenFunction
     r (Value (Vector n Word32), Value (Vector n Word32))
forall n r.
Positive n =>
Value (Vector n Word64)
-> CodeGenFunction
     r (Value (Vector n Word32), Value (Vector n Word32))
splitVector31 (Value (Vector n Word64)
 -> CodeGenFunction
      r (Value (Vector n Word32), Value (Vector n Word32)))
-> CodeGenFunction r (Value (Vector n Word64))
-> CodeGenFunction
     r (Value (Vector n Word32), Value (Vector n Word32))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      (\Value (Vector n Word64)
x -> Value (Vector n Word64)
-> Value (Vector n Word64)
-> CodeGenFunction r (Value (Vector n Word64))
forall a r. Additive a => a -> a -> CodeGenFunction r a
forall r.
Value (Vector n Word64)
-> Value (Vector n Word64)
-> CodeGenFunction r (Value (Vector n Word64))
A.add Value (Vector n Word64)
x (Value (Vector n Word64)
 -> CodeGenFunction r (Value (Vector n Word64)))
-> CodeGenFunction r (Value (Vector n Word64))
-> CodeGenFunction r (Value (Vector n Word64))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Element (Value (Vector n Word32))
 -> CodeGenFunction r (Element (Value (Vector n Word64))))
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word64))
forall v w r.
(C v, C w, Size v ~ Size w) =>
(Element v -> CodeGenFunction r (Element w))
-> v -> CodeGenFunction r w
Vector.map Element (Value (Vector n Word32))
-> CodeGenFunction r (Element (Value (Vector n Word64)))
Value Word32 -> CodeGenFunction r (Value Word64)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b,
 IsSized a, IsSized b, SizeOf a :<: SizeOf b) =>
value a -> CodeGenFunction r (value b)
zext Value (Vector n Word32)
low0) (Value (Vector n Word64)
 -> CodeGenFunction r (Value (Vector n Word64)))
-> CodeGenFunction r (Value (Vector n Word64))
-> CodeGenFunction r (Value (Vector n Word64))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word64))
forall n r.
Positive n =>
Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word64))
umul32to64 (Scalar (Vector n Word32) -> Value (Vector n Word32)
forall v. (IsConst (Scalar v), Replicate v) => Scalar v -> Value v
SoV.replicateOf Word32
Scalar (Vector n Word32)
forall a. Integral a => a
fac) Value (Vector n Word32)
high0

   Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word32))
forall a r.
Real a =>
Value a -> Value a -> CodeGenFunction r (Value a)
subtractIfPossible (Scalar (Vector n Word32) -> Value (Vector n Word32)
forall v. (IsConst (Scalar v), Replicate v) => Scalar v -> Value v
SoV.replicateOf Word32
Scalar (Vector n Word32)
forall a. Integral a => a
modulus)
      (Value (Vector n Word32)
 -> CodeGenFunction r (Value (Vector n Word32)))
-> CodeGenFunction r (Value (Vector n Word32))
-> CodeGenFunction r (Value (Vector n Word32))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word32))
forall a r. Additive a => a -> a -> CodeGenFunction r a
forall r.
Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word32))
A.add Value (Vector n Word32)
low1
      (Value (Vector n Word32)
 -> CodeGenFunction r (Value (Vector n Word32)))
-> CodeGenFunction r (Value (Vector n Word32))
-> CodeGenFunction r (Value (Vector n Word32))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word32))
forall a n r.
(Arithmetic a, Positive n) =>
Value (Vector n a)
-> Value (Vector n a) -> CodeGenFunction r (Value (Vector n a))
forall n r.
Positive n =>
Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word32))
Vector.mul (Scalar (Vector n Word32) -> Value (Vector n Word32)
forall v. (IsConst (Scalar v), Replicate v) => Scalar v -> Value v
SoV.replicateOf Word32
Scalar (Vector n Word32)
forall a. Integral a => a
fac) Value (Vector n Word32)
high1

{- |
@subtractIfPossible d x@ returns @A.sub x d@
if this is possible without underflow.
Otherwise it returns @x@.

Only works for unsigned types.
-}
subtractIfPossible ::
   (SoV.Real a) =>
   Value a -> Value a -> CodeGenFunction r (Value a)
subtractIfPossible :: forall a r.
Real a =>
Value a -> Value a -> CodeGenFunction r (Value a)
subtractIfPossible Value a
d Value a
x = do
   {-
   An element should become smaller by subtraction.
   If it becomes greater, then there was an overflow
   and 'min' chooses the value before subtraction.
   -}
   Value a -> Value a -> CodeGenFunction r (Value a)
forall a r.
Real a =>
Value a -> Value a -> CodeGenFunction r (Value a)
forall r. Value a -> Value a -> CodeGenFunction r (Value a)
SoV.min Value a
x (Value a -> CodeGenFunction r (Value a))
-> CodeGenFunction r (Value a) -> CodeGenFunction r (Value a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value a -> Value a -> CodeGenFunction r (Value a)
forall a r. Additive a => a -> a -> CodeGenFunction r a
forall r. Value a -> Value a -> CodeGenFunction r (Value a)
A.sub Value a
x Value a
d
   -- alternatively (slower):
   --   flip selectNonNegativeGeneric x =<< A.sub x d

{- |
Select non-negative elements from the first vector,
otherwise select corresponding elements from the second vector.
-}
selectNonNegativeGeneric ::
   (TypeNum.Positive n) =>
   Value (Vector n Int32) ->
   Value (Vector n Int32) ->
   CodeGenFunction r (Value (Vector n Int32))
selectNonNegativeGeneric :: forall n r.
Positive n =>
Value (Vector n Int32)
-> Value (Vector n Int32)
-> CodeGenFunction r (Value (Vector n Int32))
selectNonNegativeGeneric Value (Vector n Int32)
x Value (Vector n Int32)
y = do
   Value (Vector n Bool)
b <- CmpPredicate
-> Value (Vector n Int32)
-> Value (Vector n Int32)
-> CodeGenFunction r (CmpResult (Value (Vector n Int32)))
forall r.
CmpPredicate
-> Value (Vector n Int32)
-> Value (Vector n Int32)
-> CodeGenFunction r (CmpResult (Value (Vector n Int32)))
forall a r.
Comparison a =>
CmpPredicate -> a -> a -> CodeGenFunction r (CmpResult a)
A.cmp CmpPredicate
LLVM.CmpGE Value (Vector n Int32)
x Value (Vector n Int32)
forall a. Additive a => a
A.zero
   Value (CmpResult (Vector n Int32))
-> Value (Vector n Int32)
-> Value (Vector n Int32)
-> CodeGenFunction r (Value (Vector n Int32))
forall a r.
CmpRet a =>
Value (CmpResult a)
-> Value a -> Value a -> CodeGenFunction r (Value a)
LLVM.select Value (CmpResult (Vector n Int32))
Value (Vector n Bool)
b Value (Vector n Int32)
x Value (Vector n Int32)
y


splitVector31 ::
   (TypeNum.Positive n) =>
   Value (Vector n Word64) ->
   CodeGenFunction r (Value (Vector n Word32), Value (Vector n Word32))
splitVector31 :: forall n r.
Positive n =>
Value (Vector n Word64)
-> CodeGenFunction
     r (Value (Vector n Word32), Value (Vector n Word32))
splitVector31 Value (Vector n Word64)
x = do
   Value (Vector n Word32)
low  <- Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word32))
forall a r. Logic a => a -> a -> CodeGenFunction r a
forall r.
Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word32))
A.and (Scalar (Vector n Word32) -> Value (Vector n Word32)
forall v. (IsConst (Scalar v), Replicate v) => Scalar v -> Value v
SoV.replicateOf (Word32
2Word32 -> Int -> Word32
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
31::Int)Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
-Word32
1)) (Value (Vector n Word32)
 -> CodeGenFunction r (Value (Vector n Word32)))
-> CodeGenFunction r (Value (Vector n Word32))
-> CodeGenFunction r (Value (Vector n Word32))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Element (Value (Vector n Word64))
 -> CodeGenFunction r (Element (Value (Vector n Word32))))
-> Value (Vector n Word64)
-> CodeGenFunction r (Value (Vector n Word32))
forall v w r.
(C v, C w, Size v ~ Size w) =>
(Element v -> CodeGenFunction r (Element w))
-> v -> CodeGenFunction r w
Vector.map Element (Value (Vector n Word64))
-> CodeGenFunction r (Element (Value (Vector n Word32)))
Value Word64 -> CodeGenFunction r (Value Word32)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b,
 IsSized a, IsSized b, SizeOf a :>: SizeOf b) =>
value a -> CodeGenFunction r (value b)
trunc Value (Vector n Word64)
x
   Value (Vector n Word32)
high <- (Element (Value (Vector n Word64))
 -> CodeGenFunction r (Element (Value (Vector n Word32))))
-> Value (Vector n Word64)
-> CodeGenFunction r (Value (Vector n Word32))
forall v w r.
(C v, C w, Size v ~ Size w) =>
(Element v -> CodeGenFunction r (Element w))
-> v -> CodeGenFunction r w
Vector.map Element (Value (Vector n Word64))
-> CodeGenFunction r (Element (Value (Vector n Word32)))
Value Word64 -> CodeGenFunction r (Value Word32)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b,
 IsSized a, IsSized b, SizeOf a :>: SizeOf b) =>
value a -> CodeGenFunction r (value b)
trunc (Value (Vector n Word64)
 -> CodeGenFunction r (Value (Vector n Word32)))
-> CodeGenFunction r (Value (Vector n Word64))
-> CodeGenFunction r (Value (Vector n Word32))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Value (Vector n Word64)
 -> Value (Vector n Word64)
 -> CodeGenFunction r (Value (Vector n Word64)))
-> Value (Vector n Word64)
-> Value (Vector n Word64)
-> CodeGenFunction r (Value (Vector n Word64))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value (Vector n Word64)
-> Value (Vector n Word64)
-> CodeGenFunction r (Value (Vector n Word64))
Value (Vector n Word64)
-> Value (Vector n Word64)
-> CodeGenFunction r (BinOpValue Value Value (Vector n Word64))
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
lshr (Scalar (Vector n Word64) -> Value (Vector n Word64)
forall v. (IsConst (Scalar v), Replicate v) => Scalar v -> Value v
SoV.replicateOf (Word64
31 :: Word64) Value (Vector n Word64)
-> Value (Vector n Word64) -> Value (Vector n Word64)
forall a. a -> a -> a
`asTypeOf` Value (Vector n Word64)
x) Value (Vector n Word64)
x
   (Value (Vector n Word32), Value (Vector n Word32))
-> CodeGenFunction
     r (Value (Vector n Word32), Value (Vector n Word32))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (Vector n Word32)
low, Value (Vector n Word32)
high)

{- |
This is the most obvious implementation
but unfortunately calls the expensive __umoddi3.
-}
nextVector64 ::
   (TypeNum.Positive n) =>
   Value (Vector n Word32) ->
   CodeGenFunction r (Value (Vector n Word32))
nextVector64 :: forall n r.
Positive n =>
Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word32))
nextVector64 Value (Vector n Word32)
s =
   (Element (Value (Vector n Word64))
 -> CodeGenFunction r (Element (Value (Vector n Word32))))
-> Value (Vector n Word64)
-> CodeGenFunction r (Value (Vector n Word32))
forall v w r.
(C v, C w, Size v ~ Size w) =>
(Element v -> CodeGenFunction r (Element w))
-> v -> CodeGenFunction r w
Vector.map Element (Value (Vector n Word64))
-> CodeGenFunction r (Element (Value (Vector n Word32)))
Value Word64 -> CodeGenFunction r (Value Word32)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsInteger b, ShapeOf a ~ ShapeOf b,
 IsSized a, IsSized b, SizeOf a :>: SizeOf b) =>
value a -> CodeGenFunction r (value b)
trunc (Value (Vector n Word64)
 -> CodeGenFunction r (Value (Vector n Word32)))
-> CodeGenFunction r (Value (Vector n Word64))
-> CodeGenFunction r (Value (Vector n Word32))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
   (Value (Vector n Word64)
 -> Value (Vector n Word64)
 -> CodeGenFunction r (Value (Vector n Word64)))
-> Value (Vector n Word64)
-> Value (Vector n Word64)
-> CodeGenFunction r (Value (Vector n Word64))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value (Vector n Word64)
-> Value (Vector n Word64)
-> CodeGenFunction r (Value (Vector n Word64))
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
A.irem (Scalar (Vector n Word64) -> Value (Vector n Word64)
forall v. (IsConst (Scalar v), Replicate v) => Scalar v -> Value v
SoV.replicateOf Word64
Scalar (Vector n Word64)
forall a. Integral a => a
modulus) (Value (Vector n Word64)
 -> CodeGenFunction r (Value (Vector n Word64)))
-> CodeGenFunction r (Value (Vector n Word64))
-> CodeGenFunction r (Value (Vector n Word64))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
   Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word64))
forall n r.
Positive n =>
Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word64))
umul32to64 (Scalar (Vector n Word32) -> Value (Vector n Word32)
forall v. (IsConst (Scalar v), Replicate v) => Scalar v -> Value v
SoV.replicateOf (Int -> Word32
forall a. Integral a => Int -> a
vectorParameter (Value (Vector n Word32) -> Int
forall n a. Positive n => Value (Vector n a) -> Int
Vector.size Value (Vector n Word32)
s))) Value (Vector n Word32)
s

umul32to64 ::
   (TypeNum.Positive n) =>
   Value (Vector n Word32) ->
   Value (Vector n Word32) ->
   CodeGenFunction r (Value (Vector n Word64))
umul32to64 :: forall n r.
Positive n =>
Value (Vector n Word32)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word64))
umul32to64 Value (Vector n Word32)
x Value (Vector n Word32)
y = do
   Value (Vector n Word64)
x64 <- Guide (VectorShape n) (Word32, Word64)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word64))
forall (value :: * -> *) a b bv shape av r.
(ValueCons value, IsInteger a, IsInteger b, IsType bv,
 Signed a ~ Signed b, IsPrimitive a, IsPrimitive b,
 Type shape a ~ av, Type shape b ~ bv, IsSized a, IsSized b,
 SizeOf a :<: SizeOf b) =>
Guide shape (a, b) -> value av -> CodeGenFunction r (value bv)
Guided.ext Guide (VectorShape n) (Word32, Word64)
forall n a. Positive n => Guide (VectorShape n) a
Guided.vector Value (Vector n Word32)
x
   Value (Vector n Word64)
y64 <- Guide (VectorShape n) (Word32, Word64)
-> Value (Vector n Word32)
-> CodeGenFunction r (Value (Vector n Word64))
forall (value :: * -> *) a b bv shape av r.
(ValueCons value, IsInteger a, IsInteger b, IsType bv,
 Signed a ~ Signed b, IsPrimitive a, IsPrimitive b,
 Type shape a ~ av, Type shape b ~ bv, IsSized a, IsSized b,
 SizeOf a :<: SizeOf b) =>
Guide shape (a, b) -> value av -> CodeGenFunction r (value bv)
Guided.ext Guide (VectorShape n) (Word32, Word64)
forall n a. Positive n => Guide (VectorShape n) a
Guided.vector Value (Vector n Word32)
y
   Value (Vector n Word64)
-> Value (Vector n Word64)
-> CodeGenFunction r (Value (Vector n Word64))
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
forall r.
Value (Vector n Word64)
-> Value (Vector n Word64)
-> CodeGenFunction r (Value (Vector n Word64))
A.mul Value (Vector n Word64)
x64 Value (Vector n Word64)
y64