{-# LANGUAGE
ScopedTypeVariables, BangPatterns, TupleSections, ExplicitForAll,
LambdaCase, MultiWayIf, Unsafe, RecordWildCards, FlexibleContexts, CPP,
NoMonomorphismRestriction, GADTs, PatternGuards, MagicHash,
UnboxedTuples, InstanceSigs, DataKinds, TypeOperators,
RankNTypes, EmptyDataDecls, EmptyCase, ViewPatterns, PolyKinds,
TypeFamilies, OverloadedStrings, FlexibleInstances, UndecidableInstances,
DefaultSignatures, GeneralizedNewtypeDeriving, StandaloneDeriving,
DeriveGeneric, DeriveFunctor, DeriveDataTypeable, DeriveFoldable,
DeriveTraversable, DeriveDataTypeable, FlexibleInstances,
MultiParamTypeClasses, TypeApplications, RecordWildCards,
PackageImports, DerivingStrategies, PatternSynonyms,
NumericUnderscores, ConstraintKinds #-}
{-# OPTIONS_GHC -O2 #-}
#include "MachDeps.h"
#define PHASE_FUSED [1]
#define PHASE_INNER [0]
#define INLINE_FUSED INLINE PHASE_FUSED
#define INLINE_INNER INLINE PHASE_INNER
import Prelude
import Data.Bits
import Data.List as Lst
import Data.Maybe
import Data.Tuple
import Data.Ord
import Data.Int
import Data.Word
import Data.Char
import Data.Ratio
import Data.Function
import Data.STRef
import Data.IORef
import Data.Monoid
import Data.Functor
import Data.Functor.Identity
import Data.Data
import Data.Typeable
import Data.Bifunctor
import Data.Foldable as Fld
import Data.Traversable as Tr
import GHC.Generics
import System.IO
import System.IO.Unsafe (unsafeDupablePerformIO, unsafePerformIO)
import qualified Control.Arrow as Aw
import Control.Applicative
import Control.Monad
import Control.Monad.Primitive
import Control.Monad.State.Strict
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
-- import Control.Monad.ST.Safe
import Control.DeepSeq
import Data.Coerce
import Data.Primitive.MutVar
import qualified Data.Primitive as Prim
import qualified Data.ByteString as BSW
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as BSLW
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Unsafe as BSU
import qualified Data.ByteString.Internal as BSU
import qualified Data.IntPSQ as IntPSQ
import Data.IntPSQ (IntPSQ)
import qualified Data.OrdPSQ as OrdPSQ
import Data.OrdPSQ (OrdPSQ)
import qualified Data.HashPSQ as HashPSQ
import Data.HashPSQ (HashPSQ)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashMap.Strict as HMS
import qualified Data.HashMap.Lazy as HashMapL
import qualified Data.HashMap.Lazy as HML
import Data.HashMap.Strict (HashMap)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.IntMap.Strict as IMS
import qualified Data.IntMap.Lazy as IntMapL
import qualified Data.IntMap.Lazy as IML
import Data.IntMap (IntMap)
import qualified Data.Map.Strict as Map
import qualified Data.Map.Lazy as MapL
import Data.Map.Strict (Map)
import Data.List as List
import Data.Hashable (Hashable)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import qualified Data.IntSet as IS
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Storable.Mutable as VSM
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Primitive.Mutable as VPM
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Generic.New as VGN
import qualified Data.Vector.Fusion.Bundle.Monadic as VFBM
import qualified Data.Vector.Fusion.Bundle as VFB
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
import qualified Data.Vector.Fusion.Bundle.Size as VFBS
import qualified Data.Vector.Fusion.Util as VFU
import qualified Data.Vector.Algorithms.Intro as VAIT
import qualified Data.Attoparsec.ByteString.Char8 as Atto
import qualified Debug.Trace
import Unsafe.Coerce
import Foreign.ForeignPtr
import GHC.Float (castWord64ToDouble, castDoubleToWord64)
import GHC.Word (Word(..), Word64(..))
import GHC.Exts (build, Int(..),
(+#), (*#), (-#), (<#), (>=#), (==#), quotRemInt#,
remInt#, uncheckedIShiftRL#, andI#, orI#,
Addr#, Ptr(..),
timesWord2#, quotRemWord2#, minusWord#, Word#,
uncheckedShiftRL#, plusWord#, and#, word2Int#,
isTrue#, Int#, not#, negateInt#, int2Word#, ltWord#,
eqWord#, neWord#, or#, ctz#, timesWord#, leWord#,
uncheckedShiftL#, plusWord2#, geWord# )
import GHC.TypeLits ( type (<=) )
import GHC.TypeNats ( KnownNat, Nat )
import qualified GHC.TypeNats as TNats ( natVal )
import Numeric.Natural
import Data.Reflection
import Control.Monad.Primitive (PrimMonad(PrimState))
import Math.NumberTheory.Logarithms (naturalLog2)
import Data.Functor ( (<&>) )
import GHC.Int ( Int(..) )
#if __GLASGOW_HASKELL__ >= 902
import GHC.Num.Integer
import GHC.Int ( Int64(..) )
#endif
main :: IO ()
main = do
[n,a,b,p,q] <- map readInt . words <$> getLine
let !rP = recip (rawRemF p)
!rQ = recip (rawRemF q)
dp <- do
dpLin <- VUM.replicate ((n - a + p) * (n - b + q))
(rawRemF 0, rawRemF 0)
VUM.set (VUM.drop ((n - a) * (n - b + q)) dpLin) (1, 1)
return $! mLinToMat (n-a+p) (n-b+q) dpLin
forM_ (liftA2 (,) [n-a-1, n-a-2 .. 0] [n-b-1, n-b-2 .. 0])
$ \ (!i,!j) -> do
!p1Sum <- (\f -> foldM f (rawRemF 0) [1..p]) $ \ !val !di -> do
(_, !dest) <- VUM.read (dp V.! (i + di)) j
return $! val + dest
let !p1Avg = p1Sum * rP
!p2Sum <- (\f -> foldM f (rawRemF 0) [1..q]) $ \ !val !dj -> do
(!dest, _) <- VUM.read (dp V.! i) (j + dj)
return $! val + dest
let !p2Avg = p2Sum * rQ
VUM.write (dp V.! i) j (p1Avg, p2Avg)
(!res, _) <- VUM.read (dp V.! 0) 0
print res
return ()
debug :: Bool
debug = True
-- FixedModulus
type FixedModulus = W998244353
type RemF = Rem FixedModulus
pattern RawRemF :: Word -> RemF
pattern RawRemF x = RawRem x
remFromIntegralF :: Integral a => a -> RemF
{-# INLINE remFromIntegralF #-}
remFromIntegralF = remFromIntegral
rawRemF :: Integral a => a -> RemF
{-# INLINE rawRemF #-}
rawRemF = RawRemF . fromIntegral
{-
-- ShowAsBuilder
instance ShowAsBuilder (Rem m) where
{-# INLINE showAsBuilder #-}
showAsBuilder = coerce (showAsBuilder @Word)
-}
reflectProxy :: Reifies s a => proxy s -> a
{-# INLINE reflectProxy #-}
reflectProxy = f reflect
where
{-# INLINE f #-}
f :: (Proxy s -> a) -> proxy s -> a
f reflect = const (reflect Proxy)
data AsWord (n :: Nat)
type W1000000007 = AsWord 1000000007 -- 10^9+7
type W1097 = W1000000007
type W998244353 = AsWord 998244353
#if WORD_SIZE_IN_BITS == 32
type WordMaxBound = 0xFFFFFFFF :: Nat
#elif WORD_SIZE_IN_BITS == 64
type WordMaxBound = 0xFFFFFFFFFFFFFFFF :: Nat
#endif
instance (KnownNat n, n <= WordMaxBound) => Reifies (AsWord n) Word where
reflect :: (KnownNat n, n <= WordMaxBound) => proxy (AsWord n) -> Word
reflect pxy = fromIntegral $ TNats.natVal (f pxy)
where
f :: proxy (AsWord n) -> Proxy n
f _ = Proxy
class Reifies m Word => ReifiesWordPrime m
instance ReifiesWordPrime W1000000007
instance ReifiesWordPrime W998244353
data AssertPrime m
instance Reifies m Word => Reifies (AssertPrime m) Word where
reflect :: Reifies m Word => proxy (AssertPrime m) -> Word
{-# INLINE reflect #-}
reflect = reflect . f
where
f :: proxy (AssertPrime m) -> Proxy m
{-# INLINE f #-}
f = const Proxy
instance Reifies m Word => ReifiesWordPrime (AssertPrime m)
reifyAssertWordPrime
:: Word
-> (forall (s :: *). ReifiesWordPrime s => Proxy s -> r)
-> r
{-# INLINE reifyAssertWordPrime #-}
reifyAssertWordPrime w f = reify w (f . convertPxy)
where
convertPxy :: Proxy a -> Proxy (AssertPrime a)
convertPxy = const Proxy
reifyCheckedWordPrime
:: Word
-> (forall (s :: *). ReifiesWordPrime s => Proxy s -> r)
-> Maybe r
{-# INLINE reifyCheckedWordPrime #-}
reifyCheckedWordPrime w f
| testPrimalityWord w = Just $ reifyAssertWordPrime w f
| otherwise = Nothing
reifyWordPrime
:: Word
-> (forall (s :: *). ReifiesWordPrime s => Proxy s -> r)
-> r
{-# INLINE reifyWordPrime #-}
reifyWordPrime w f
| testPrimalityWord w = reifyAssertWordPrime w f
| otherwise = error "reifyWordPrime: value non-prime"
-- Remainder type definition
newtype Rem m = Rem { unRem :: Word }
deriving (Eq)
deriving newtype instance Show (Rem m)
deriving newtype instance Read (Rem m)
type Rem1000000007 = Rem W1000000007
type Rem1097 = Rem W1097
type Rem998244353 = Rem W998244353
--- Num implementation, except for fromInteger
instance Reifies m Word => Num (Rem m) where
abs, signum :: Reifies m Word => Rem m -> Rem m
{-# INLINE abs #-}
abs = reflectArg absRemError
{-# NOINLINE signum #-}
signum = error "Rem: signum is not well-defined for Remainder ring"
negate :: Reifies m Word => Rem m -> Rem m
{-# INLINE negate #-}
negate = reflectArg unsafeNegateRemWithMod
(+), (-), (*) :: Reifies m Word => Rem m -> Rem m -> Rem m
{-# INLINE (+) #-}
(+) = reflectArg unsafeAddRemWithMod
{-# INLINE (-) #-}
(-) = reflectArg unsafeSubRemWithMod
{-# INLINE (*) #-}
(*) = reflectArg unsafeMultRemWithMod
fromInteger :: Reifies m Word => Integer -> Rem m
{-# INLINE fromInteger #-}
fromInteger = integerToRem
absRemError :: Word -> Rem m -> Rem m
{-# NOINLINE absRemError #-}
absRemError = error "Rem: abs in not well-defined for Remainder ring"
unsafeNegateRemWithMod :: Word -> Rem m -> Rem m
unsafeNegateRemWithMod (W# m#) (Rem (W# x#))
= Rem $ W# (unsafeNegRem# m# x#)
unsafeNegRem# :: Word# -> Word# -> Word#
unsafeNegRem# m# x# = idWordIf# (neWord# x# 0##) (minusWord# m# x#)
unsafeAddRemWithMod :: Word -> Rem m -> Rem m -> Rem m
unsafeAddRemWithMod (W# m#) (Rem (W# x#)) (Rem (W# y#))
= Rem $ W# (unsafeAddRem# m# x# y#)
unsafeAddRem# :: Word# -> Word# -> Word# -> Word#
unsafeAddRem# m# x# y#
= lo# `minusWord#` idWordIf# (geWord# lo# m# `orI#` word2Int# carry#) m#
where
!(# !carry#, !lo# #) = plusWord2# x# y#
unsafeSubRemWithMod :: Word -> Rem m -> Rem m -> Rem m
unsafeSubRemWithMod (W# m#) (Rem (W# x#)) (Rem (W# y#))
= Rem $ W# (unsafeSubRem# m# x# y#)
unsafeSubRem# :: Word# -> Word# -> Word# -> Word#
unsafeSubRem# m# x# y#
= minusWord# x# y# `plusWord#` idWordIf# (x# `ltWord#` y#) m#
unsafeMultRemWithMod :: Word -> Rem m -> Rem m -> Rem m
unsafeMultRemWithMod m (Rem x) (Rem y) = Rem $ unsafeModMult m x y
unsafeModMult :: Word -> Word -> Word -> Word
unsafeModMult (W# m#) (W# x#) (W# y#) = W# (unsafeModMult# m# x# y#)
unsafeModMult# :: Word# -> Word# -> Word# -> Word#
unsafeModMult# m# x# y# = res#
where
!(# !hi#, !lo# #) = timesWord2# x# y#
!(# !_, !res# #) = quotRemWord2# hi# lo# m#
--- fast implementation of mod pow.
unsafePowRemNaturalWithMod :: Word -> Word -> Natural -> Rem m
unsafePowRemNaturalWithMod (W# m#) (W# x#) !e = Rem (W# val#)
where
!val# | e == 0 = int2Word# (neWord# m# 1##)
| isTrue# (x# `leWord#` 1##) = x#
| otherwise = let I# i# = naturalLog2 e - 1
in go x# i#
go acc# i#
| isTrue# (i# <# 0#) = acc#
go acc# i#
| testBit e (I# i#) = go (unsafeModMult# m# x# sq#) (i# -# 1#)
| otherwise = go sq# (i# -# 1#)
where
!sq# = unsafeModMult# m# acc# acc#
unsafePowRemNNegIntegerWithMod :: Word -> Word -> Integer -> Rem m
unsafePowRemNNegIntegerWithMod !m !x !e
| e >= 0 = unsafePowRemNaturalWithMod m x (fromInteger e)
| otherwise
= error "(^) :: Rem m -> Integer -> Rem m : negative exponent"
unsafePowRemIntegerMaybeWithMod :: Word -> Word -> Integer -> Maybe (Rem m)
unsafePowRemIntegerMaybeWithMod !m !x !e
| e >= 0 = Just $ unsafePowRemNaturalWithMod m x (fromInteger e)
| otherwise
= unsafeRemInvMaybeEBWithMod m (Rem x) <&> \(Rem !x) ->
unsafePowRemNaturalWithMod m x $ absIntegerInNatural e
{-# SPECIALIZE
unsafePowRemNNegBitsWithMod :: Word -> Word -> Int -> Rem m #-}
{-# SPECIALIZE
unsafePowRemNNegBitsWithMod :: Word -> Word -> Int64 -> Rem m #-}
{-# SPECIALIZE
unsafePowRemNNegBitsWithMod :: Word -> Word -> Word -> Rem m #-}
{-# SPECIALIZE
unsafePowRemNNegBitsWithMod :: Word -> Word -> Word64 -> Rem m #-}
unsafePowRemNNegBitsWithMod
:: (Bits a, Integral a)
=> Word -> Word -> a -> Rem m
unsafePowRemNNegBitsWithMod (W# m#) (W# x#) !e = case compare e 0 of
GT -> Rem (W# (go 1## x# e))
LT -> error "(^) : negative exponent"
EQ -> Rem (W# (int2Word# (neWord# m# 1##)))
where
go !acc# !base# !e
| e2 == 0 = acc2#
| otherwise = go acc2# (unsafeModMult# m# base# base#) e2
where
!acc2# | testBit e 0 = unsafeModMult# m# acc# base#
| otherwise = acc#
!e2 = shiftR e 1
unsafePowRemNNegImpl
:: Integral a => Word -> Word -> a -> Rem m
unsafePowRemNNegImpl (W# m#) (W# x#) !e = case compare e 0 of
GT -> Rem (W# (go 1## x# e))
LT -> error "(^) : negative exponent"
EQ -> Rem (W# (int2Word# (neWord# m# 1##)))
where
go !acc# !base# !e
| e2 == 0 = acc2#
| otherwise = go acc2# (unsafeModMult# m# base# base#) e2
where
!acc2# | rm /= 0 = unsafeModMult# m# acc# base#
| otherwise = acc#
!(!e2, !rm) = e `quotRem` 2
--- Bad dark magic for simplification of (^).
modulusFromNumRem :: Num (Rem m) => proxy m -> Word
{-# INLINE modulusFromNumRem #-}
modulusFromNumRem
= unsafeModulusFromNumRemImpl abs negate . proxy
where
proxy :: proxy m -> Proxy m
proxy = const Proxy
unsafeModulusFromNumRemImpl
:: (Rem m -> Rem m)
-> (Rem m -> Rem m)
-> Proxy m
-> Word
{-# NOINLINE unsafeModulusFromNumRemImpl #-}
unsafeModulusFromNumRemImpl _abs negate _
= unRem (negate (Rem 1)) + 1
{-# RULES
"unsafeModulusFromNumRemImpl/simplify" forall m.
unsafeModulusFromNumRemImpl (absRemError m)
= const (const m)
"(^)/Rem" (^) = \x -> unsafePowRemNNegImpl (modulusFromNumRem x) (unRem x)
#-}
--- Integral -> Rem m Conversion, including fromInteger
integerToRem :: Reifies m Word => Integer -> Rem m
{-# INLINE integerToRem #-}
integerToRem = go Proxy
where
go :: Reifies m Word => Proxy m -> Integer -> Rem m
{-# INLINE go #-}
go pxy = unsafeIntegerToRemWithMod (reflect pxy)
unsafeIntegerToRemWithMod :: Word -> Integer -> Rem m
{-# INLINE unsafeIntegerToRemWithMod #-}
unsafeIntegerToRemWithMod !m x
| m /= 0 = uncheckedIntegerToRemWithMod m x
| otherwise = integralToRemModZeroErr
uncheckedIntegerToRemWithMod :: Word -> Integer -> Rem m
{-# NOINLINE uncheckedIntegerToRemWithMod #-}
uncheckedIntegerToRemWithMod !m x
= Rem $ fromInteger $ x `mod` toInteger m
uncheckedNarrowToRemWithMod :: Integral a => Word -> a -> Rem m
{-# INLINE uncheckedNarrowToRemWithMod #-}
uncheckedNarrowToRemWithMod !m x
= Rem $ fromIntegral $ x `mod` fromIntegral m
uncheckedUWidenToRemWithMod :: Integral a => Word -> a -> Rem m
{-# INLINE uncheckedUWidenToRemWithMod #-}
uncheckedUWidenToRemWithMod !m x = Rem $ xW `mod` m
where
!xW = fromIntegral x
uncheckedIntToRemWithMod :: Word -> Int -> Rem m
uncheckedIntToRemWithMod !m !xI
| xI >= 0 = Rem $ fromIntegral xI `mod` m
| otherwise = let !r = fromIntegral (-xI) `mod` m
in unsafeNegateRemWithMod m (Rem r)
uncheckedSWidenToRemWithMod :: Integral a => Word -> a -> Rem m
{-# INLINE uncheckedSWidenToRemWithMod #-}
uncheckedSWidenToRemWithMod m = uncheckedIntToRemWithMod m . fromIntegral
integralToRemModZeroErr :: a
{-# NOINLINE integralToRemModZeroErr #-}
integralToRemModZeroErr
= error "Conversion (Integral a => a -> Rem m): modulus zero"
#if !MIN_VERSION_base(4,16,0)
-- We are on GHC <= 9.0.x (base <= 4.15.x.y),
-- so we are using the legacy rewrite rules for fromIntegral with
-- NOINLINE [1] fromIntegral.
-- In this case, we need to rewrite fromIntegral itself.
integerToRemForRule :: Num (Rem m) => Integer -> Rem m
{-# INLINE integerToRemForRule #-}
integerToRemForRule = fromInteger
toIntegerForRemRule :: Integral a => a -> Integer
{-# INLINE [1] toIntegerForRemRule #-}
toIntegerForRemRule = toInteger
{-# RULES
"force inline fromIntegral :: a -> Rem m"
fromIntegral = integerToRemForRule . toIntegerForRemRule
"Word8 -> Integer -> Rem m" forall m (x :: Word8).
uncheckedIntegerToRemWithMod m (toIntegerForRemRule x)
= uncheckedUWidenToRemWithMod m x
"Word16 -> Integer -> Rem m" forall m (x :: Word16).
uncheckedIntegerToRemWithMod m (toIntegerForRemRule x)
= uncheckedUWidenToRemWithMod m x
"Word32 -> Integer -> Rem m" forall m (x :: Word32).
uncheckedIntegerToRemWithMod m (toIntegerForRemRule x)
= uncheckedUWidenToRemWithMod m x
"Word -> Integer -> Rem m" forall m (x :: Word).
uncheckedIntegerToRemWithMod m (toIntegerForRemRule x)
= uncheckedUWidenToRemWithMod m x
"Word64 -> Integer -> Rem m" forall m (x :: Word64).
uncheckedIntegerToRemWithMod m (toIntegerForRemRule x)
= uncheckedNarrowToRemWithMod m x
"Int8 -> Integer -> Rem m" forall m (x :: Int8).
uncheckedIntegerToRemWithMod m (toIntegerForRemRule x)
= uncheckedSWidenToRemWithMod m x
"Int16 -> Integer -> Rem m" forall m (x :: Int16).
uncheckedIntegerToRemWithMod m (toIntegerForRemRule x)
= uncheckedSWidenToRemWithMod m x
"Int32 -> Integer -> Rem m" forall m (x :: Int32).
uncheckedIntegerToRemWithMod m (toIntegerForRemRule x)
= uncheckedSWidenToRemWithMod m x
"Int -> Integer -> Rem m" forall m (x :: Int).
uncheckedIntegerToRemWithMod m (toIntegerForRemRule x)
= uncheckedIntToRemWithMod m x
"Natural -> Integer -> Rem m" forall m (x :: Natural).
uncheckedIntegerToRemWithMod m (toIntegerForRemRule x)
= uncheckedNarrowToRemWithMod m x
"toIntegerForRemRule :: Integer -> Integer"
toIntegerForRemRule = id
#-}
#if WORD_SIZE_IN_BITS >= 64
{-# RULES
"Int64 -> Integer -> Rem m" forall m (x :: Int64).
uncheckedIntegerToRemWithMod m (toIntegerForRemRule x)
= uncheckedSWidenToRemWithMod m x
#-}
#else
{-# RULES
"Int64 -> Integer -> Rem m" forall m (x :: Int64).
uncheckedIntegerToRemWithMod m (toIntegerForRemRule x)
= uncheckedNarrowToRemWithMod m x
#-}
#endif
#elif __GLASGOW_HASKELL__ >= 902
-- With GHC >= 9.0.1 (base >= 4.15.0.0),
-- ghc-bignum gives a unified API for Integer backend.
-- GHC >= 9.2.1 (base >= 4.16.0.0), which this case treats,
-- takes advantage of that API and gives RULEs to
-- conversion primitives from ghc-bignum, instead of to fromIntegral
-- (in fact we have "INLINE fromIntegral"!).
-- We need to give rules to the combinations of
-- these conversion primitives.
{-# RULES
"Int# -> Integer -> Rem m" forall m x.
uncheckedIntegerToRemWithMod m (IS x) = uncheckedIntToRemWithMod m (I# x)
"Word# -> Integer -> Rem m" forall m x.
uncheckedIntegerToRemWithMod m (integerFromWord# x)
= uncheckedUWidenToRemWithMod m (W# x)
"Natural -> Integer -> Rem m" forall m x.
uncheckedIntegerToRemWithMod m (integerFromNatural x)
= uncheckedNarrowToRemWithMod m x
#-}
#if WORD_SIZE_IN_BITS < 64 || MIN_VERSION_ghc_bignum(1,3,0)
{-# RULES
"Word64# -> Integer -> Rem m" forall m x.
uncheckedIntegerToRemWithMod m (integerFromWord64# x)
= uncheckedNarrowToRemWithMod m (W64# x)
#-}
#endif
#if WORD_SIZE_IN_BITS < 64
{-# RULES
"Int64# -> Integer -> Rem m" forall m x.
uncheckedIntegerToRemWithMod m (integerFromInt64# x)
= uncheckedNarrowToRemWithMod m (I64# x)
#-}
#elif MIN_VERSION_ghc_bignum(1,3,0)
{-# RULES
"Int64# -> Integer -> Rem m" forall m x.
uncheckedIntegerToRemWithMod m (integerFromInt64# x)
= uncheckedSWidenToRemWithMod m (I64# x)
#-}
#endif
#endif
remFromIntegralP
:: forall m a proxy. (Integral a, Reifies m Word)
=> proxy m
-> a
-> Rem m
{-# INLINE remFromIntegralP #-}
remFromIntegralP = const fromIntegral
remFromIntegral
:: forall m a. (Integral a, Reifies m Word)
=> a
-> Rem m
{-# INLINE remFromIntegral #-}
remFromIntegral = fromIntegral
rawRem :: forall m a. (Integral a, Reifies m Word) => a -> Rem m
{-# INLINE rawRem #-}
rawRem = Rem . fromIntegral
rawRemP
:: forall m a proxy. (Integral a, Reifies m Word)
=> proxy m
-> a
-> Rem m
{-# INLINE rawRemP #-}
rawRemP = const rawRem
pattern RawRem :: Reifies m Word => Word -> Rem m
pattern RawRem x = Rem x
-- implementation of inverse, Fractional
instance ReifiesWordPrime m => Fractional (Rem m) where
{-# INLINE recip #-}
recip = pRemInv
{-# INLINE (/) #-}
(/) = pRemDiv
{-# INLINE fromRational #-}
fromRational x
= fromInteger (numerator x) / fromInteger (denominator x)
remInvMaybe :: Reifies m Word => Rem m -> Maybe (Rem m)
{-# INLINE remInvMaybe #-}
remInvMaybe = reflectArg unsafeRemInvMaybeEBWithMod
unsafeRemInvMaybeWithModulus :: Word -> Word -> Maybe (Rem m)
unsafeRemInvMaybeWithModulus !m !x = go 0 m 1 x
where
go :: Int -> Word -> Int -> Word -> Maybe (Rem m)
go !s !u !t 0
| u == 1 = Just $! Rem $ fromIntegral s + if s < 0 then m else 0
| otherwise = Nothing
go !s !u !t !v = go t v (s - fromIntegral q * t) r
where
(!q,!r) = u `quotRem` v
unsafeRemInvMaybeEBWithMod :: Word -> Rem m -> Maybe (Rem m)
{-# INLINE unsafeRemInvMaybeEBWithMod #-}
unsafeRemInvMaybeEBWithMod (W# m#) (Rem (W# x#))
= case invRemWithExtBinGcd# m# x# of
(# (# #) | #) -> Nothing
(# | r# #) -> Just (Rem (W# r#))
invRemWithExtBinGcd# :: Word# -> Word# -> (# (# #) | Word# #)
invRemWithExtBinGcd# m# x#
| isTrue# (evenWord# (m# `or#` x#)) = (# (# #) | #)
invRemWithExtBinGcd# m# x#
= case extBinGCDForInvRemOdd# mOdd# x# of
(# (# #) | #) -> (# (# #) | #)
(# | r# #) -> (# | go2# r# (timesWord# x# r# `minusWord#` 1##) #)
where
!tzM# = ctz# m#
!mOdd# = uncheckedShiftRL# m# (word2Int# tzM#)
!xmOdd# = x# `timesWord#` mOdd#
go2# :: Word# -> Word# -> Word#
go2# r# prd#
| isTrue# (tzPrd# `ltWord#` tzM#)
= go2# (r# `plusWord#` uncheckedShiftL# mOdd# tzPrdI#)
(prd# `plusWord#` uncheckedShiftL# xmOdd# tzPrdI#)
| otherwise = r#
where
!tzPrd# = ctz# prd#
!tzPrdI# = word2Int# tzPrd#
extBinGCDForInvRemOdd# :: Word# -> Word# -> (# (# #) | Word# #)
extBinGCDForInvRemOdd# 1## 0## = (# | 0## #)
extBinGCDForInvRemOdd# !_ 0## = (# (# #) | #)
extBinGCDForInvRemOdd# !m# !x0# = go 0## m# 1## x0#
where
half# :: Word# -> Word#
half# x# = uncheckedShiftRL# x# 1#
halfM# :: Word#
!halfM# = 1## `plusWord#` half# m#
modHalf# :: Word# -> Word#
modHalf# x# = half# x# `plusWord#` idWordIf# (oddWord# x#) halfM#
go a# x# b# y#
| isTrue# (evenWord# y#) = go a# x# (modHalf# b#) (half# y#)
| isTrue# (ltWord# y# x#)
= go b# y# (modHalf# (unsafeSubRem# m# a# b#))
(half# (x# `minusWord#` y#))
| isTrue# (ltWord# x# y#)
= go a# x# (modHalf# (unsafeSubRem# m# b# a#))
(half# (y# `minusWord#` x#))
| isTrue# (eqWord# x# 1##) = (# | a# #)
| otherwise = (# (# #) | #)
go :: Word# -> Word# -> Word# -> Word# -> (# (# #) | Word# #)
pRemInvUnchecked :: ReifiesWordPrime m => Rem m -> Rem m
{-# INLINE pRemInvUnchecked #-}
pRemInvUnchecked x = x ^ (reflectProxy x - 2)
pRemInv :: ReifiesWordPrime m => Rem m -> Rem m
{-# INLINE pRemInv #-}
pRemInv x | x /= Rem 0 = pRemInvUnchecked x
| otherwise = error "pRemInv: 0 has no inverse"
pRemInvMaybe :: ReifiesWordPrime m => Rem m -> Maybe (Rem m)
{-# INLINE pRemInvMaybe #-}
pRemInvMaybe x | x /= Rem 0 = Just $ pRemInvUnchecked x
| otherwise = Nothing
pRemDiv :: ReifiesWordPrime m => Rem m -> Rem m -> Rem m
{-# INLINE pRemDiv #-}
pRemDiv x y = x * recip y
remInvsVec :: Reifies m Word => Int -> VU.Vector (Rem m)
{-# INLINE remInvsVec #-}
remInvsVec = remInvsVecP Proxy
remInvsVecP :: Reifies m Word => proxy m -> Int -> VU.Vector (Rem m)
{-# INLINE remInvsVecP #-}
remInvsVecP pxy = unsafeRemInvsVecWithMod (reflectProxy pxy)
unsafeRemInvsVecWithMod :: Word -> Int -> VU.Vector (Rem m)
unsafeRemInvsVecWithMod !m !n
= VU.constructN (fromIntegral $ min m $ fromIntegral $ max 0 n)
$ \ !v ->
if VU.length v <= 1
then Rem $ fromIntegral $ VU.length v
else
let !(!q,!r) = m `quotRem` fromIntegral (VU.length v)
in Rem $
unsafeModMult m (m-q) $ unRem $ v VU.! fromIntegral r
--- Factorial vector
factorialsVecTill
:: Reifies m Word
=> Int
-> VU.Vector (Rem m)
{-# INLINE factorialsVecTill #-}
factorialsVecTill = factorialsVecTillP Proxy
factorialsVecTillP
:: Reifies m Word
=> proxy m
-> Int
-> VU.Vector (Rem m)
{-# INLINE factorialsVecTillP #-}
factorialsVecTillP pxy = unsafeFactorialsVecTillWithMod (reflectProxy pxy)
unsafeFactorialsVecTillWithMod :: Word -> Int -> VU.Vector (Rem m)
unsafeFactorialsVecTillWithMod m@(W# m#) !n
= VU.scanl' (unsafeMultRemWithMod m)
(Rem $ W# (int2Word# (m# `neWord#` 1##)))
$ VU.generate (if m == 0 then 0 else n)
(Rem . fromIntegral . (+1))
factosAndInvsVecTill
:: ReifiesWordPrime m
=> Int
-> (VU.Vector (Rem m), VU.Vector (Rem m))
{-# INLINE factosAndInvsVecTill #-}
factosAndInvsVecTill = factosAndInvsVecTillP Proxy
factosAndInvsVecTillP
:: ReifiesWordPrime m
=> proxy m
-> Int
-> (VU.Vector (Rem m), VU.Vector (Rem m))
{-# INLINE factosAndInvsVecTillP #-}
factosAndInvsVecTillP pxy !n = (factos, invFactos)
where
!m = reflectProxy pxy
!factos = factorialsVecTillP pxy n'
!invLst = recip (VU.unsafeLast factos)
!invFactos = unsafeInvFactosVecFromLastWithMod m n' invLst
!n' | m == 0 = 0
| otherwise = fromIntegral $ min (m - 1) $ fromIntegral $ max 0 n
unsafeInvFactosVecFromLastWithMod
:: Word
-> Int
-> Rem m
-> VU.Vector (Rem m)
unsafeInvFactosVecFromLastWithMod !m !n !lst
= VG.unstreamR
$ VG.stream
$ VU.scanl' (unsafeMultRemWithMod m) lst
$ VU.generate n (Rem . fromIntegral . (n-))
-- Primality test for Word
testPrimalityWord :: Word -> Bool
testPrimalityWord 1 = False
testPrimalityWord 2 = True
testPrimalityWord !x | even x = False
testPrimalityWord !x
#if WORD_SIZE_IN_BITS <= 32
= reify x $ \pxy -> all (test pxy) [2, 7, 61]
#else
| x < 273919523041
= reify x $ \pxy -> all (test pxy) [15, 7363882082, 992620450144556]
| otherwise
= reify x $ \pxy -> all (test pxy)
[2, 325, 9375, 28178, 450775, 9780504, 1795265022]
#endif
where
!cnt = countTrailingZeros (x-1)
!oddpart = (x-1) `shiftR` cnt
test :: Reifies m Word => proxy m -> Word -> Bool
test pxy !base = v0 == Rem 0 || vinit == Rem 1 || go cnt vinit
where
!v0 = remFromIntegralP pxy base
vinit = v0 ^ oddpart
go !cnt !val = val == Rem (x-1)
|| (cnt > 1 && val /= Rem 1 && go (cnt-1) (val * val))
-- Unboxed Vector Implementation
newtype instance VUM.MVector s (Rem m) = MV_Rem (VUM.MVector s Word)
newtype instance VU.Vector (Rem m) = V_Rem (VU.Vector Word)
instance VUM.Unbox (Rem m)
instance VGM.MVector VUM.MVector (Rem m) where
basicLength :: VUM.MVector s (Rem m) -> Int
{-# INLINE basicLength #-}
basicLength = coerce `asTypeOf` (\f (MV_Rem v) -> f v) $ VGM.basicLength
basicUnsafeSlice :: Int -> Int -> VUM.MVector s (Rem m)
-> VUM.MVector s (Rem m)
{-# INLINE basicUnsafeSlice #-}
basicUnsafeSlice
= coerce `asTypeOf` (\f x y (MV_Rem v) -> MV_Rem $ f x y v)
$ VGM.basicUnsafeSlice
basicOverlaps :: VUM.MVector s (Rem m) -> VUM.MVector s (Rem m) -> Bool
{-# INLINE basicOverlaps #-}
basicOverlaps = coerce `asTypeOf` (\f (MV_Rem v) (MV_Rem w) -> f v w)
$ VGM.basicOverlaps
basicUnsafeNew :: PrimMonad pm
=> Int -> pm (VUM.MVector (PrimState pm) (Rem m))
{-# INLINE basicUnsafeNew #-}
basicUnsafeNew = fmap MV_Rem . VGM.basicUnsafeNew
basicInitialize :: PrimMonad pm
=> VUM.MVector (PrimState pm) (Rem m) -> pm ()
{-# INLINE basicInitialize #-}
basicInitialize = coerce `asTypeOf` (\ f (MV_Rem v) -> f v)
$ VGM.basicInitialize
basicUnsafeReplicate :: PrimMonad pm
=> Int -> Rem m -> pm (VUM.MVector (PrimState pm) (Rem m))
{-# INLINE basicUnsafeReplicate #-}
basicUnsafeReplicate !n
= fmap MV_Rem . VGM.basicUnsafeReplicate n . unRem
basicUnsafeRead :: PrimMonad pm =>
VUM.MVector (PrimState pm) (Rem m) -> Int -> pm (Rem m)
{-# INLINE basicUnsafeRead #-}
basicUnsafeRead (MV_Rem v) !i
= Rem <$> VGM.basicUnsafeRead v i
basicUnsafeWrite :: PrimMonad pm
=> VUM.MVector (PrimState pm) (Rem m) -> Int -> Rem m -> pm ()
{-# INLINE basicUnsafeWrite #-}
basicUnsafeWrite
= coerce `asTypeOf` (\f (MV_Rem v) n (Rem x) -> f v n x)
$ VGM.basicUnsafeWrite
basicClear :: PrimMonad pm
=> VUM.MVector (PrimState pm) (Rem m) -> pm ()
{-# INLINE basicClear #-}
basicClear = coerce `asTypeOf` (\ f (MV_Rem v) -> f v) $ VGM.basicClear
basicSet :: PrimMonad pm
=> VUM.MVector (PrimState pm) (Rem m) -> Rem m -> pm ()
{-# INLINE basicSet #-}
basicSet = coerce `asTypeOf` (\f (MV_Rem v) (Rem x) -> f v x)
$ VGM.basicSet
basicUnsafeCopy :: PrimMonad pm
=> VUM.MVector (PrimState pm) (Rem m)
-> VUM.MVector (PrimState pm) (Rem m)
-> pm ()
{-# INLINE basicUnsafeCopy #-}
basicUnsafeCopy = coerce `asTypeOf` (\f (MV_Rem v) (MV_Rem w) -> f v w)
$ VGM.basicUnsafeCopy
basicUnsafeMove :: PrimMonad pm
=> VUM.MVector (PrimState pm) (Rem m)
-> VUM.MVector (PrimState pm) (Rem m)
-> pm ()
{-# INLINE basicUnsafeMove #-}
basicUnsafeMove = coerce `asTypeOf` (\f (MV_Rem v) (MV_Rem w) -> f v w)
$ VGM.basicUnsafeMove
basicUnsafeGrow :: PrimMonad pm
=> VUM.MVector (PrimState pm) (Rem m)
-> Int
-> pm (VUM.MVector (PrimState pm) (Rem m))
{-# INLINE basicUnsafeGrow #-}
basicUnsafeGrow (MV_Rem v) !n = MV_Rem <$> VGM.basicUnsafeGrow v n
instance VG.Vector VU.Vector (Rem m) where
basicUnsafeFreeze
:: PrimMonad pm
=> VG.Mutable VU.Vector (PrimState pm) (Rem m)
-> pm (VU.Vector (Rem m))
{-# INLINE basicUnsafeFreeze #-}
basicUnsafeFreeze (MV_Rem v)
= V_Rem <$> VG.basicUnsafeFreeze v
basicUnsafeThaw
:: PrimMonad pm
=> VU.Vector (Rem m)
-> pm (VG.Mutable VU.Vector (PrimState pm) (Rem m))
{-# INLINE basicUnsafeThaw #-}
basicUnsafeThaw (V_Rem v)
= MV_Rem <$> VG.basicUnsafeThaw v
basicLength :: VU.Vector (Rem m) -> Int
{-# INLINE basicLength #-}
basicLength = coerce `asTypeOf` (\f (V_Rem v) -> f v) $ VG.basicLength
basicUnsafeSlice :: Int -> Int -> VU.Vector (Rem m) -> VU.Vector (Rem m)
{-# INLINE basicUnsafeSlice #-}
basicUnsafeSlice
= coerce `asTypeOf` (\f i l (V_Rem v) -> V_Rem $ f i l v)
$ VG.basicUnsafeSlice
basicUnsafeIndexM
:: Monad md
=> VU.Vector (Rem m)
-> Int
-> md (Rem m)
{-# INLINE basicUnsafeIndexM #-}
basicUnsafeIndexM (V_Rem !v) !i = Rem <$> VG.basicUnsafeIndexM v i
basicUnsafeCopy :: PrimMonad pm
=> VG.Mutable VU.Vector (PrimState pm) (Rem m)
-> VU.Vector (Rem m)
-> pm ()
{-# INLINE basicUnsafeCopy #-}
basicUnsafeCopy
= coerce `asTypeOf` (\f (MV_Rem mv) (V_Rem v) -> f mv v)
$ VG.basicUnsafeCopy
elemseq :: VU.Vector (Rem m) -> Rem m -> b -> b
{-# INLINE elemseq #-}
elemseq = const seq
--- internal helper functions
reflectArg :: (Word -> p m -> a) -> Reifies m Word => p m -> a
{-# INLINE reflectArg #-}
reflectArg f = go f Proxy
where
go :: Reifies m Word => (Word -> p m -> a) -> Proxy m -> p m -> a
{-# INLINE go #-}
go f pxy = f (reflect pxy)
boolToMask# :: Int# -> Word#
boolToMask# b# = int2Word# (negateInt# b#)
idWordIf# :: Int# -> Word# -> Word#
idWordIf# b# = and# (boolToMask# b#)
evenWord# :: Word# -> Int#
evenWord# x# = word2Int# (not# x# `and#` 1##)
oddWord# :: Word# -> Int#
oddWord# x# = word2Int# (x# `and#` 1##)
absIntegerInNatural :: Integer -> Natural
#if defined(MIN_VERSION_ghc_bignum)
absIntegerInNatural = naturalFromInteger
#else
absIntegerInNatural = fromInteger . abs
#endif
#define DefDebugAux(fct,ty,debugvar,dbg,rel)\
fct :: ty; {-# INLINE fct #-}; fct | debugvar = dbg | otherwise = rel
#define DefDebug(fct,ty,rel) DefDebugAux(fct,ty,debug,Debug.Trace.fct,rel)
#define DefDebugC(fct,ty,rel) DefDebug(fct,ty,const (rel))
DefDebugC(trace, String -> a -> a, id)
DefDebug(traceId, String -> String, id)
DefDebugC(traceShow, Show b => b -> a -> a, id)
DefDebug(traceShowId, Show a => a -> a, id)
DefDebugC(traceStack, String -> a -> a, id)
DefDebugC(traceIO, String -> IO (), return ())
DefDebugC(traceM, Applicative f => String -> f (), pure ())
DefDebugC(traceShowM, (Show a, Applicative f) => a -> f (), pure ())
DefDebugC(traceEvent, String -> a -> a, id)
DefDebugC(traceEventIO, String -> IO (), pure ())
DefDebugC(traceMarker, String -> a -> a, id)
DefDebugC(traceMarkerIO, String -> IO (), pure ())
#undef DefDebugAux
#undef DefDebug
#undef DefDebugC
traceShowIO :: Show a => a -> IO ()
{-# INLINE traceShowIO #-}
traceShowIO | debug = Debug.Trace.traceIO . show
| otherwise = const $ pure ()
#define IL(f) {-# INLINE f #-}; f
IL(putBuilder) = BSB.hPutBuilder stdout
printVecInLines, printVecInSpcSepLn ::
(VG.Vector v a, ShowAsBuilder a) => v a -> IO ()
IL(printVecInLines) = putBuilder . v2BLines
IL(printVecInSpcSepLn) = putBuilder . v2BSpcSepLn
class ShowAsBuilder a where
showAsBuilder :: a -> BSB.Builder
default showAsBuilder :: (Show a) => a -> BSB.Builder
IL(showAsBuilder) = BSB.string8 . show
-- Inconsistent with show
instance {-# INCOHERENT #-} (ShowAsBuilder a, VG.Vector v a) => ShowAsBuilder (v a) where
IL(showAsBuilder) = v2BSpcSep
#define INS(t,f) instance ShowAsBuilder t where { IL(showAsBuilder)=f }
INS(Int,BSB.intDec)
INS(Int8,BSB.int8Dec)
INS(Int16,BSB.int16Dec)
INS(Int32,BSB.int32Dec)
INS(Int64,BSB.int64Dec)
INS(Word,BSB.wordDec)
INS(Word8,BSB.word8Dec)
INS(Word16,BSB.word16Dec)
INS(Word32,BSB.word32Dec)
INS(Word64,BSB.word64Dec)
INS(Integer,BSB.integerDec)
INS(Float,BSB.floatDec)
INS(Double,BSB.doubleDec)
-- INS(String,BSB.string8) -- Inconsistent with Show
-- INS(BS.ByteString,BSB.byteString) -- Inconsistent with Show
-- INS(BSL.ByteString,BSB.lazyByteString) -- Inconsisitent with Show
#undef INS
-- Inconsistent with Show
instance (ShowAsBuilder a, ShowAsBuilder b) => ShowAsBuilder (a,b) where
IL(showAsBuilder) = showTupAsBuilder
instance (ShowAsBuilder a, ShowAsBuilder b, ShowAsBuilder c) =>
ShowAsBuilder (a,b,c) where
IL(showAsBuilder) = showTup3AsBuilder
instance (ShowAsBuilder a, ShowAsBuilder b, ShowAsBuilder c, ShowAsBuilder d) =>
ShowAsBuilder (a,b,c,d) where
IL(showAsBuilder) = showTup4AsBuilder
IL(showTupAsBuilderWith)
:: (a -> BSB.Builder) -> (b -> BSB.Builder) -> (a,b) -> BSB.Builder
showTupAsBuilderWith showA showB
= \(a,b) -> (showA a <>) $ BSB.char7 ' ' <> showB b
IL(showTupAsBuilder) :: (ShowAsBuilder a, ShowAsBuilder b)
=> (a,b) -> BSB.Builder
showTupAsBuilder = showTupAsBuilderWith showAsBuilder showAsBuilder
IL(showTup3AsBuilderWith) :: (a -> BSB.Builder) -> (b -> BSB.Builder) ->
(c -> BSB.Builder) -> (a,b,c) -> BSB.Builder
showTup3AsBuilderWith showA showB showC
= \(a,b,c) -> (showA a <>) $ (BSB.char7 ' ' <>) $ (showB b <>)
$ (BSB.char7 ' ' <>) $ showC c
IL(showTup3AsBuilder) :: (ShowAsBuilder a, ShowAsBuilder b, ShowAsBuilder c)
=> (a,b,c) -> BSB.Builder
showTup3AsBuilder
= showTup3AsBuilderWith showAsBuilder showAsBuilder showAsBuilder
IL(showTup4AsBuilderWith) :: (a -> BSB.Builder) -> (b -> BSB.Builder) ->
(c -> BSB.Builder) -> (d -> BSB.Builder) -> (a,b,c,d) -> BSB.Builder
showTup4AsBuilderWith showA showB showC showD
= \(a,b,c,d) -> (showA a <>) $ (BSB.char7 ' ' <>)
$ showTup3AsBuilderWith showB showC showD (b,c,d)
IL(showTup4AsBuilder) ::
(ShowAsBuilder a, ShowAsBuilder b, ShowAsBuilder c, ShowAsBuilder d) =>
(a,b,c,d) -> BSB.Builder
showTup4AsBuilder = showTup4AsBuilderWith showAsBuilder showAsBuilder
showAsBuilder showAsBuilder
v2BSpcSepLn, v2BSpcSep, v2BConcat, v2BLines ::
(VG.Vector v a, ShowAsBuilder a)
=> v a -> BSB.Builder
IL(v2BSpcSepLn) = v2BSpcSepLnWith showAsBuilder
IL(v2BSpcSep) = v2BSpcSepWith showAsBuilder
IL(v2BConcat) = v2BConcatWith showAsBuilder
IL(v2BLines) = v2BLinesWith showAsBuilder
v2BSpcSepLnWith, v2BSpcSepWith, v2BConcatWith, v2BLinesWith ::
(VG.Vector v a)
=> (a -> BSB.Builder) -- ^ show function
-> v a -> BSB.Builder
IL(v2BSpcSepLnWith) = v2BSpcSepPostfWith $ BS.singleton '\n'
IL(v2BSpcSepWith) = v2BSpcSepPostfWith BS.empty
IL(v2BConcatWith) showFct = VG.foldr ((<>) . showFct) mempty
IL(v2BLinesWith) showFct
= VG.foldr (\ a -> (showFct a <>) . (BSB.char7 '\n' <>)) mempty
v2BSpcSepPostf :: (VG.Vector v a, ShowAsBuilder a)
=> BS.ByteString -- ^ postfix
-> v a -> BSB.Builder
IL(v2BSpcSepPostf) = (`v2BSpcSepPostfWith` showAsBuilder)
v2BSpcSepPostfWith :: (VG.Vector v a)
=> BS.ByteString -- ^ postfix
-> (a -> BSB.Builder) -- ^ show function
-> v a -> BSB.Builder
IL(v2BSpcSepPostfWith) = vecToBuilder BS.empty $ BS.singleton ' '
IL(vecToBuilder) :: (VG.Vector v a)
=> BS.ByteString -- ^ prefix
-> BS.ByteString -- ^ separator
-> BS.ByteString -- ^ postfix
-> (a -> BSB.Builder) -- ^ show function
-> v a -> BSB.Builder
vecToBuilder !prefix !separator !postfix
= vecToBuilder_ (BSB.byteString prefix)
(BSB.byteString separator)
(BSB.byteString postfix)
IL(vecToBuilder_) :: (VG.Vector v a)
=> BSB.Builder -- ^ prefix
-> BSB.Builder -- ^ separator
-> BSB.Builder -- ^ postfix
-> (a -> BSB.Builder) -- ^ show function
-> v a -> BSB.Builder
vecToBuilder_ !prefix !separator !postfix showFct = \vec -> prefix <>
VG.foldr
(\ a rest !prefx -> prefx <> (showFct a <> rest separator))
(const postfix) vec mempty
IL(evalVals) :: [a] -> [a]
evalVals xs = build $ \c n -> foldr (c $!) n xs
IL(forceVals) :: (NFData a) => [a] -> [a]
forceVals xs = build $ \c n -> foldr (c $!!) n xs
IL(readLnWith) :: StateT BS.ByteString Maybe a -> IO a
readLnWith parser = fromJust . evalStateT parser <$> BS.getLine
IL(readContentWith) :: StateT BSL.ByteString Maybe a -> IO a
readContentWith parser = fromJust . evalStateT parser <$> BSL.getContents
IL(getVecGLn) :: (VG.Vector v a) =>
Int -> StateT BS.ByteString Maybe a -> IO (v a)
getVecGLn n s = VG.unfoldrN n (runStateT s) <$> BS.getLine
IL(getVecGRest) :: (VG.Vector v a) =>
Int -> StateT BSL.ByteString Maybe a -> IO (v a)
getVecGRest n s = VG.unfoldrN n (runStateT s) <$> BSL.getContents
IL(getVecLn) :: Int -> StateT BS.ByteString Maybe a -> IO (V.Vector a)
getVecLn = getVecGLn
IL(getVecRest) :: Int -> StateT BSL.ByteString Maybe a -> IO (V.Vector a)
getVecRest = getVecGRest
IL(getVecULn) :: (VU.Unbox a) =>
Int -> StateT BS.ByteString Maybe a -> IO (VU.Vector a)
getVecULn = getVecGLn
IL(getVecURest) :: (VU.Unbox a) =>
Int -> StateT BSL.ByteString Maybe a -> IO (VU.Vector a)
getVecURest = getVecGRest
IL(ord8) :: Char -> Word8
ord8 = fromIntegral . fromEnum
IL(chr8) :: Word8 -> Char
chr8 = toEnum . fromIntegral
IL(rIntL) :: StateT BSL.ByteString Maybe Int
rIntL = skipSpecialL $ StateT BSL.readInt
IL(rIntS) :: StateT BS.ByteString Maybe Int
rIntS = skipSpecialS $ StateT BS.readInt
IL(rInt1L) :: StateT BSL.ByteString Maybe Int
rInt1L = subtract 1 <$> rIntL
IL(rInt1S) :: StateT BS.ByteString Maybe Int
rInt1S = subtract 1 <$> rIntS
IL(rIntegerL) :: StateT BSL.ByteString Maybe Integer
rIntegerL = skipSpecialL $ StateT BSL.readInteger
IL(rIntegerS) :: StateT BS.ByteString Maybe Integer
rIntegerS = skipSpecialS $ StateT BS.readInteger
IL(rInteger1L) :: StateT BSL.ByteString Maybe Integer
rInteger1L = subtract 1 <$> rIntegerL
IL(rInteger1S) :: StateT BS.ByteString Maybe Integer
rInteger1S = subtract 1 <$> rIntegerS
IL(rStrL) :: (MonadState BSL.ByteString m) => m BS.ByteString
rStrL = skipSpecialL $ BSL.toStrict <$> state (BSLW.span (>= ord8 '!'))
IL(rStrS) :: (MonadState BS.ByteString m) => m BS.ByteString
rStrS = skipSpecialS $ state $ BSW.span (>= ord8 '!')
IL(rCharL) :: StateT BSL.ByteString Maybe Char
rCharL = StateT BSL.uncons
IL(rCharS) :: StateT BS.ByteString Maybe Char
rCharS = StateT BS.uncons
IL(rCharWL) :: StateT BSL.ByteString Maybe Word8
rCharWL = StateT BSLW.uncons
IL(rCharWS) :: StateT BS.ByteString Maybe Word8
rCharWS = StateT BSW.uncons
IL(dropSpecialL) :: (MonadState BSL.ByteString m) => m ()
dropSpecialL = modify $ BSLW.dropWhile (< ord8 '!')
IL(dropSpecialS) :: (MonadState BS.ByteString m) => m ()
dropSpecialS = modify $ BSW.dropWhile (< ord8 '!')
IL(skipSpecialL) :: (MonadState BSL.ByteString m) => m a -> m a
skipSpecialL = (dropSpecialL *>)
IL(skipSpecialS) :: (MonadState BS.ByteString m) => m a -> m a
skipSpecialS = (dropSpecialS *>)
IL(linToMat) :: (VG.Vector v a) => Int -> Int -> v a -> V.Vector (v a)
linToMat h w lvec = vEvalElemsId $ V.generate h (\i -> VG.slice (i*w) w lvec)
IL(mLinToMat) :: (VGM.MVector v a) => Int -> Int -> v s a -> V.Vector (v s a)
mLinToMat h w lvec = vEvalElemsId $ V.generate h (\i -> VGM.slice (i*w) w lvec)
IL(unsafeAddrToSVec) :: Int -> Addr# -> VS.Vector Word8
unsafeAddrToSVec n addr
= (`VS.unsafeFromForeignPtr0` n)
$ unsafeDupablePerformIO
$ newForeignPtr_ $ Ptr addr
IL(vEvalElemsId) :: (VG.Vector v a) => v a -> v a
vEvalElemsId = vMapFoldl (\ !_ !x -> (x,())) ()
IL(vEvalElems) :: (VG.Vector v a) => v a -> ()
vEvalElems = VG.foldl' (\ !_ !_ -> ()) ()
IL(vMapFoldl) :: (VG.Vector v b, VG.Vector v c) =>
(a -> b -> (c,a)) -> a -> v b -> v c
vMapFoldl f a
= VG.unstream . VFB.inplace (streamMapFoldl f a) id . VG.stream
streamMapFoldl :: (Functor m) =>
(a -> b -> (c,a)) -> a -> VFSM.Stream m b -> VFSM.Stream m c
{-# INLINE_FUSED streamMapFoldl #-}
streamMapFoldl f a (VFSM.Stream step s) = VFSM.Stream step1 (a,s)
where
{-# INLINE_INNER step1 #-}
step1 (a0,s0) = (<$> step s0) $ \r -> case r of
VFSM.Yield b s1 -> case f a0 b of (c,a1) -> VFSM.Yield c (a1,s1)
VFSM.Skip s1 -> VFSM.Skip (a0,s1)
VFSM.Done -> VFSM.Done
IL(svecToBS) :: VS.Vector Word8 -> BS.ByteString
svecToBS vec = BSU.fromForeignPtr ptr 0 len
where (ptr, len) = VS.unsafeToForeignPtr0 vec
IL(vLength) :: VG.Vector v a => v a -> Int
vLength = VFB.length . VG.stream
unlessM, whenM :: (Monad m) => m Bool -> m () -> m ()
IL(whenM) = (. flip when) . (>>=)
IL(unlessM) = (. flip unless) . (>>=)
IL(wrA) = A.writeArray
IL(rdA) = A.readArray
IL(mdA) = \arr f !i -> do
ai <- rdA arr i
let fai = f ai
wrA arr i fai
return (ai,fai)
{-# INLINE mdA' #-}
mdA' = \arr f !i -> do
!ai <- rdA arr i
let !fai = f ai
wrA arr i fai
return (ai,fai)
IL(swapA) = \arr !i !j -> do
ai <- rdA arr i
wrA arr i =<< rdA arr j
wrA arr j ai
#define D(f,r,d)\
IL(f) :: Integral a=>a->d; f=fromIntegral;\
IL(r) :: String->d; r=read
#define C(f,r,g,h,d) D(f,r,d);\
g,h :: RealFrac a=>a->d; IL(g)=floor; IL(h)=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C
#define TS(f,a,m,init)\
IL(f) :: forall e i s. (C(a,m) A.Ix i) => (i,i) -> init m (a i e); f
#define N(f,g,h,a,m)\
TS(f,a,m,e->)=A.newArray;\
TS(g,a,m,)=A.newArray_;\
TS(h,a,m,[e]->)=A.newListArray
#define C(a,m)
N(newIOA,newIOA_,newIOAL,IOArray,IO)
N(newSTA,newSTA_,newSTAL,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,newIOUAL,IOUArray,IO)
N(newSTUA,newSTUA_,newSTUAL,STUArray s,ST s)
#undef C
#undef N
#undef TS
#undef IL