{-# 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, DerivingVia,
MultiParamTypeClasses, TypeApplications, RecordWildCards,
PackageImports, DerivingStrategies, PatternSynonyms,
NumericUnderscores, ConstraintKinds #-}
{-# OPTIONS_GHC -O2 -Wno-unused-top-binds -Wno-unused-imports -Wno-orphans #-}
#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.Semigroup
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 qualified Data.Mutable as DMut
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 Math.NumberTheory.Logarithms (naturalLog2)
import GHC.Stack
import GHC.Int
import Data.Bit
import qualified System.Random.MWC as MWC
import System.Random.Stateful
import Data.Tuple.Extra
import Control.Monad.Extra
#if __GLASGOW_HASKELL__ >= 902
import GHC.Num.Integer
#endif
{-# RULES "Force inline VAIT.sort" VAIT.sort = VAIT.sortBy compare #-}
main :: IO ()
main = do
[n,q] <- map readInt . words <$> getLine
s <- getVecULn n $ subtract (ord8 'a') <$> rCharW
qrys <- getVecURest q $ do
qty <- (==2) <$> rInt
if qty then liftA2 (True,,) rInt1 rInt
else liftA2 (False,,) rInt1 $ subtract (ord 'a') . toInt <$> (skipSpecial rCharW)
sd <- MWC.createSystemSeed
let res = query sd s qrys
traceShowIO qrys
printVecInLines $ V.map (\case Bit True -> "Yes" :: BS.ByteString; _ -> "No")
$ V.convert res
return ()
debug :: Bool
debug = False
genPrime :: MWC.Gen s -> ST s Word
genPrime gen = (`loopM` ()) $ \() -> do
val' <- uniformM gen
let !val = top .|. val' .|. 1
if testPrimalityWord val then return (Right val) else return (Left ())
where
top = toWord (minBound :: Int)
query :: MWC.Seed -> VU.Vector Word8 -> VU.Vector (Bool,Int,Int) -> VU.Vector Bit
query sd !initl !queries = VU.create $ do
gn <- thawGen sd
ret <- VUM.replicate (VU.length $ VU.filter fst3 queries) (Bit True)
replicateM_ 8 $ do
prm <- genPrime gn
val <- uniformRM (26, prm-2) gn
reify prm $ \prxy -> zipInPlace (.&.) (queryWith (rawRemP prxy val) initl queries) ret
return ret
queryWith :: Reifies m Word => Rem m
-> VU.Vector Word8 -> VU.Vector (Bool,Int,Int) -> VU.Vector Bit
queryWith x initl queries = runST $ do
!ch <- segTreeFromVector $ traceShowId $ VU.map chToMnd initl
(`VU.mapMaybeM` queries) $ \ (qty,c0,c1) ->
if qty then do
r@(Mnd r0 r1 _) <- sgtIntv ch c0 c1
traceShowM (c0,c1,r)
return $! Just $! Bit $ r0 == r1
else do
sgtWrite ch c0 $ traceShowId $ chToMnd $ toW8 c1
return Nothing
where
chToMnd i
= Mnd (rawRem i) (rawRem i) x
data Mnd m = Mnd {-# UNPACK #-} !(Rem m) {-# UNPACK #-} !(Rem m) {-# UNPACK #-} !(Rem m)
deriving (Show, Eq, Generic)
instance Reifies m Word => Semigroup (Mnd m) where
{-# INLINE (<>) #-}
Mnd x0 x1 xp <> Mnd y0 y1 yp = Mnd (x0 * yp + y0) (x1 + xp * y1) (xp * yp)
stimes = stimesMonoid
instance Reifies m Word => Monoid (Mnd m) where
{-# INLINE mempty #-}
mempty = Mnd (Rem 0) (Rem 0) 1
instance VU.IsoUnbox (Mnd m) (Rem m, Rem m, Rem m) where {}
newtype instance VUM.MVector s (Mnd m) = VUM_Mnd (VUM.MVector s (Rem m, Rem m, Rem m))
newtype instance VU.Vector (Mnd m) = VU_Mnd (VU.Vector (Rem m, Rem m, Rem m))
deriving via (Mnd m `VU.As` (Rem m, Rem m, Rem m)) instance VGM.MVector VUM.MVector (Mnd m)
deriving via (Mnd m `VU.As` (Rem m, Rem m, Rem m)) instance VG.Vector VU.Vector (Mnd m)
instance VU.Unbox (Mnd m)
{-
-- FixedModulus
type FixedModulus = W1000000007
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
{-# INLINE basicLength #-}
basicLength = coerce `asTypeOf` (\f (MV_Rem v) -> f v) $ VGM.basicLength
{-# INLINE basicUnsafeSlice #-}
basicUnsafeSlice
= coerce `asTypeOf` (\f x y (MV_Rem v) -> MV_Rem $ f x y v)
$ VGM.basicUnsafeSlice
{-# INLINE basicOverlaps #-}
basicOverlaps = coerce `asTypeOf` (\f (MV_Rem v) (MV_Rem w) -> f v w)
$ VGM.basicOverlaps
{-# INLINE basicUnsafeNew #-}
basicUnsafeNew = fmap MV_Rem . VGM.basicUnsafeNew
{-# INLINE basicInitialize #-}
basicInitialize = coerce `asTypeOf` (\ f (MV_Rem v) -> f v)
$ VGM.basicInitialize
{-# INLINE basicUnsafeReplicate #-}
basicUnsafeReplicate !n
= fmap MV_Rem . VGM.basicUnsafeReplicate n . unRem
{-# INLINE basicUnsafeRead #-}
basicUnsafeRead (MV_Rem v) !i
= Rem <$> VGM.basicUnsafeRead v i
{-# INLINE basicUnsafeWrite #-}
basicUnsafeWrite
= coerce `asTypeOf` (\f (MV_Rem v) n (Rem x) -> f v n x)
$ VGM.basicUnsafeWrite
{-# INLINE basicClear #-}
basicClear = coerce `asTypeOf` (\ f (MV_Rem v) -> f v) $ VGM.basicClear
{-# INLINE basicSet #-}
basicSet = coerce `asTypeOf` (\f (MV_Rem v) (Rem x) -> f v x)
$ VGM.basicSet
{-# INLINE basicUnsafeCopy #-}
basicUnsafeCopy = coerce `asTypeOf` (\f (MV_Rem v) (MV_Rem w) -> f v w)
$ VGM.basicUnsafeCopy
{-# INLINE basicUnsafeMove #-}
basicUnsafeMove = coerce `asTypeOf` (\f (MV_Rem v) (MV_Rem w) -> f v w)
$ VGM.basicUnsafeMove
{-# INLINE basicUnsafeGrow #-}
basicUnsafeGrow (MV_Rem v) !n = MV_Rem <$> VGM.basicUnsafeGrow v n
instance VG.Vector VU.Vector (Rem m) where
{-# INLINE basicUnsafeFreeze #-}
basicUnsafeFreeze (MV_Rem v)
= V_Rem <$> VG.basicUnsafeFreeze v
{-# INLINE basicUnsafeThaw #-}
basicUnsafeThaw (V_Rem v)
= MV_Rem <$> VG.basicUnsafeThaw v
{-# INLINE basicLength #-}
basicLength = coerce `asTypeOf` (\f (V_Rem v) -> f v) $ VG.basicLength
{-# INLINE basicUnsafeSlice #-}
basicUnsafeSlice
= coerce `asTypeOf` (\f i l (V_Rem v) -> V_Rem $ f i l v)
$ VG.basicUnsafeSlice
{-# INLINE basicUnsafeIndexM #-}
basicUnsafeIndexM (V_Rem !v) !i = Rem <$> VG.basicUnsafeIndexM v i
{-# INLINE basicUnsafeCopy #-}
basicUnsafeCopy
= coerce `asTypeOf` (\f (MV_Rem mv) (V_Rem v) -> f mv v)
$ VG.basicUnsafeCopy
{-# 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 = integerToNatural
#else
absIntegerInNatural = fromInteger . abs
#endif
-- Mutable segment tree.
-- INVARIANTS:
-- 1. sgtMult and sgtUnit must define a monoid structure on a.
-- 2. @VGM.length sgtVec@ must be short by one to a power of 2.
-- 3. @sgtVec[i-1] = sgtVec[2i-1] `sgtMult` sgtVec[2i]@
-- must hold where @0 < i@ and @2i+1 < VGM.length sgtVec@.
data SegTree v s a = SegTree { sgtUnit :: !a,
sgtMult :: a -> a -> a,
sgtVec :: !(v s a) }
type SegTreeU = SegTree VUM.MVector
sgtOffset
:: (VGM.MVector v a)
=> SegTree v s a
-> Int
{-# INLINE sgtOffset #-}
sgtOffset (SegTree _ _ vec)
= fromIntegral $ (fromIntegral (VGM.length vec) + 1 :: Word) `unsafeShiftR` 1
genSegTreeWith
:: forall v a m. (VGM.MVector v a, PrimMonad m)
=> a
-> (a -> a -> a)
-> Int
-> m (SegTree v (PrimState m) a)
{-# INLINE genSegTreeWith #-}
genSegTreeWith !unit mult size
| size <= 0 = SegTree unit mult <$> VGM.new 0
| clz <= 1 = error "genSegTreeWith: required size too big"
| otherwise = SegTree unit mult <$> VGM.replicate capacity unit
where
clz = countLeadingZeros (size-1)
capacity = bit (finiteBitSize size - clz + 1) - 1
genSegTree
:: forall v a m. (VGM.MVector v a, PrimMonad m, Monoid a)
=> Int
-> m (SegTree v (PrimState m) a)
{-# INLINE genSegTree #-}
genSegTree = genSegTreeWith mempty (<>)
segTreeFromVectorWith
:: forall v a m. (VG.Vector v a, PrimMonad m)
=> a
-> (a -> a -> a)
-> v a
-> m (SegTree (VG.Mutable v) (PrimState m) a)
{-# INLINE segTreeFromVectorWith #-}
segTreeFromVectorWith !unit mult vec = stToPrim $ do
res@(SegTree _ _ mvec) <- genSegTreeWith unit mult (VG.length vec)
let off = sgtOffset res
VG.unsafeCopy (VGM.slice (off-1) (VG.length vec) mvec) vec
forDownM_ (off-1) 1 $ \ !i ->
(VGM.unsafeWrite mvec (i-1) $!)
=<< liftA2 mult (VGM.unsafeRead mvec (unsafeShiftL i 1 - 1))
(VGM.unsafeRead mvec (unsafeShiftL i 1))
return res
segTreeFromVector
:: forall v a m. (VG.Vector v a, PrimMonad m, Monoid a)
=> v a
-> m (SegTree (VG.Mutable v) (PrimState m) a)
{-# INLINE segTreeFromVector #-}
segTreeFromVector = segTreeFromVectorWith mempty (<>)
sgtWrite
:: (VGM.MVector v a, PrimMonad m)
=> SegTree v (PrimState m) a
-> Int
-> a
-> m ()
{-# INLINE sgtWrite #-}
sgtWrite sgt@(SegTree _ mult vec) !i !a
| i < 0 || i >= offset
= error $ "sgtWrite: out of range: " ++ show (i,offset)
| otherwise
= stToPrim $ go (offset .|. i) a
where
offset = sgtOffset sgt
go !j !acc = do
VGM.unsafeWrite vec (j - 1) acc
when (j > 1) $ do
!acc <- (if j .&. 1 /= 0 then flip else id) mult acc
<$> VGM.unsafeRead vec ((j `xor` 1) - 1)
go (unsafeShiftR j 1) acc
sgtCommApplyAt
:: (VGM.MVector v a, PrimMonad m)
=> SegTree v (PrimState m) a
-> Int
-> a
-> m ()
{-# INLINE sgtCommApplyAt #-}
sgtCommApplyAt sgt@(SegTree _ mult vec) !i !a
| i < 0 || i >= offset
= error $ "sgtWrite: out of range: " ++ show (i,offset)
| otherwise
= stToPrim $ go (offset .|. i)
where
offset = sgtOffset sgt
go !j | j > 0 = do
!prev <- VGM.unsafeRead vec (j - 1)
VGM.unsafeWrite vec (j - 1) $! mult a prev
go (unsafeShiftR j 1)
| otherwise = return ()
sgtRead
:: (VGM.MVector v a, PrimMonad m)
=> SegTree v (PrimState m) a
-> Int
-> m a
{-# INLINE sgtRead #-}
sgtRead sgt@(SegTree _ _ vec) !i
| i < 0 || i >= offset
= error $ "sgtRead: out of range: " ++ show (i,offset)
| otherwise = VGM.unsafeRead vec ((offset .|. i) - 1)
where
offset = sgtOffset sgt
sgtIntv
:: (VGM.MVector v a, PrimMonad m)
=> SegTree v (PrimState m) a
-> Int
-> Int
-> m a
{-# INLINE sgtIntv #-}
sgtIntv sgt@(SegTree unit mult vec) !from !to
| off <= 0 || from' >= to' = return unit
| from' == 0 && to' == off = VGM.unsafeRead vec 0
| otherwise = stToPrim $ go (stz $ off .|. from') (stz $ off + to') unit unit
where
off = sgtOffset sgt
from' = max 0 from
to' = min off to
stz = stripTrailingZeros
go !l !r !accl !accr
| l < r = do
!vr <- VGM.unsafeRead vec $! r - 2
go l (stz $ r-1) accl (vr `mult` accr)
| clzl < clzr = do
!vl <- VGM.unsafeRead vec $! l - 1
go (stz $ l+1) r (accl `mult` vl) accr
| otherwise = return $! accl `mult` accr
where
clzl = countLeadingZeros l
clzr = countLeadingZeros r
forDownM_ :: Monad m => Int -> Int -> (Int -> m a) -> m ()
{-# INLINE forDownM_ #-}
forDownM_ v0 vEnd f = go v0
where
go !v | v >= vEnd = f v >> go (v-1)
| otherwise = return ()
stripTrailingZeros :: FiniteBits a => a -> a
{-# INLINE stripTrailingZeros #-}
stripTrailingZeros x = shiftR x (countTrailingZeros x)
countTrailingNonZeros :: (FiniteBits a) => a -> Int
{-# INLINE countTrailingNonZeros #-}
countTrailingNonZeros x
= finiteBitSize x - countLeadingZeros x
bitSizeOfRange :: Int -> Int -> Int
bitSizeOfRange from to = countTrailingNonZeros (from `xor` to)
#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
putBuilder :: BSB.Builder -> IO ()
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
vConstrAccN
:: VG.Vector v b
=> Int
-> (v b -> a -> (a, b))
-> a
-> (a, v b)
{-# INLINE vConstrAccN #-}
vConstrAccN n f a0 = runST $ do
res <- VGM.unsafeNew (max 0 n)
let go !i a | i >= n = (a,) <$> VG.unsafeFreeze res
go !i a = do
(a', b) <- (`f` a) <$> VG.unsafeFreeze (VGM.unsafeTake i res)
VGM.unsafeWrite res i b
go (i+1) a'
go 0 a0
-- 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
{-# INLINE rVecGExactN #-}
rVecGExactN :: (VG.Vector v a)
=> Int
-> StateT s Maybe a
-> StateT s Maybe (v a)
rVecGExactN n act = StateT $ \s0 -> runST $ do
res <- VGM.new n
let go !i s | i >= n = Just . (,s) <$> VG.unsafeFreeze res
go !i s1 = case runStateT act s1 of
Nothing -> return Nothing
Just (a, s2) -> do
VGM.unsafeWrite res i a
go (i+1) s2
go 0 s0
{-# INLINE rVecUExactN #-}
rVecUExactN :: (VU.Unbox a)
=> Int
-> StateT s Maybe a
-> StateT s Maybe (VU.Vector a)
rVecUExactN = rVecGExactN
class AtCoderIParsed bytestring where
rInt :: StateT bytestring Maybe Int
rInteger :: StateT bytestring Maybe Integer
rStr :: MonadState bytestring m => m BS.ByteString
rChar :: StateT bytestring Maybe Char
rCharW :: StateT bytestring Maybe Word8
dropSpecial :: MonadState bytestring m => m ()
skipSpecial
:: (AtCoderIParsed bytestring, MonadState bytestring m)
=> m a -> m a
{-# INLINE skipSpecial #-}
skipSpecial = (dropSpecial *>)
rInt1 :: AtCoderIParsed bytestring => StateT bytestring Maybe Int
{-# INLINE rInt1 #-}
rInt1 = subtract 1 <$> rInt
rInteger1 :: AtCoderIParsed bytestring => StateT bytestring Maybe Integer
{-# INLINE rInteger1 #-}
rInteger1 = subtract 1 <$> rInteger
instance AtCoderIParsed BS.ByteString where
{-# INLINE rInt #-}
rInt = skipSpecial $ StateT BS.readInt
{-# INLINE rInteger #-}
rInteger = skipSpecial $ StateT BS.readInteger
{-# INLINE rStr #-}
rStr = skipSpecial $ state $ BSW.span (>= ord8 '!')
{-# INLINE rChar #-}
rChar = StateT BS.uncons
{-# INLINE rCharW #-}
rCharW = StateT BSW.uncons
{-# INLINE dropSpecial #-}
dropSpecial = modify $ BSW.dropWhile (< ord8 '!')
instance AtCoderIParsed BSL.ByteString where
{-# INLINE rInt #-}
rInt = skipSpecial $ StateT BSL.readInt
{-# INLINE rInteger #-}
rInteger = skipSpecial $ StateT BSL.readInteger
{-# INLINE rStr #-}
rStr = skipSpecial $ BSL.toStrict <$> state (BSLW.span (>= ord8 '!'))
{-# INLINE rChar #-}
rChar = StateT BSL.uncons
{-# INLINE rCharW #-}
rCharW = StateT BSLW.uncons
{-# INLINE dropSpecial #-}
dropSpecial = modify $ BSLW.dropWhile (< ord8 '!')
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) . (>>=)
wrA :: (MArray a e m, A.Ix i) => a i e -> i -> e -> m ()
IL(wrA) = A.writeArray
rdA :: (MArray a e m, A.Ix i) => a i e -> i -> m e
IL(rdA) = A.readArray
mdA :: (MArray a b m, A.Ix i) => a i b -> (b -> b) -> i -> m (b, b)
IL(mdA) = \arr f !i -> do
ai <- rdA arr i
let fai = f ai
wrA arr i fai
return (ai,fai)
mdA' :: (MArray a b m, A.Ix i) => a i b -> (b -> b) -> i -> m (b, b)
{-# INLINE mdA' #-}
mdA' = \arr f !i -> do
!ai <- rdA arr i
let !fai = f ai
wrA arr i fai
return (ai,fai)
swapA :: (MArray a e m, A.Ix i) => a i e -> i -> i -> m ()
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,s,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,s,a,m)\
TS(f,a,m,s,e->)=A.newArray;\
TS(g,a,m,s,)=A.newArray_;\
TS(h,a,m,s,[e]->)=A.newListArray
#define C(a,m)
N(newIOA,newIOA_,newIOAL,,IOArray,IO)
N(newSTA,newSTA_,newSTAL,s,(STArray s),(ST s))
#undef C
#define C(a,m) MArray a e m,
N(newIOUA,newIOUA_,newIOUAL,,IOUArray,IO)
N(newSTUA,newSTUA_,newSTUAL,s,(STUArray s),(ST s))
#undef C
#undef N
#undef TS
#undef IL
app/Main.hs:262:7: warning: [-Wname-shadowing]
This binding for ‘reflect’ shadows the existing binding
imported from ‘Data.Reflection’ at app/Main.hs:144:1-22
|
262 | f reflect = const (reflect Proxy)
| ^^^^^^^
app/Main.hs:302:20: warning: [-Wstar-is-type]
Using ‘*’ (or its Unicode variant) to mean ‘Data.Kind.Type’
relies on the StarIsType extension, which will become
deprecated in the future.
Suggested fix: Use ‘Type’ from ‘Data.Kind’ instead.
|
302 | -> (forall (s :: *). ReifiesWordPrime s => Proxy s -> r)
| ^
app/Main.hs:312:20: warning: [-Wstar-is-type]
Using ‘*’ (or its Unicode variant) to mean ‘Data.Kind.Type’
relies on the StarIsType extension, which will become
deprecated in the future.
Suggested fix: Use ‘Type’ from ‘Data.Kind’ instead.
|
312 | -> (forall (s :: *). ReifiesWordPrime s => Proxy s -> r)
| ^
app/Main.hs:321:20: warning: [-Wstar-is-type]
Using ‘*’ (or its Unicode variant) to mean ‘Data.Kind.Type’
relies on the StarIsType extension, which will become
deprecated in the future.
Suggested fix: Use ‘Type’ from ‘Data.Kind’ instead.
|
321 | -> (forall (s :: *). ReifiesWordPrime s => Proxy s -> r)
| ^
app/Main.hs:413:29: warning: [-Wunbanged-strict-patterns]
Pattern bindings containing unlifted types should use
an outermost bang pattern:
I# i# = naturalLog2 e - 1
|
413 | | otherwise = let I# i# = naturalLog2 e - 1
| ^^^^^^^^^^^^^^^^^^^^^^^^^
app/Main.hs:433:53: warning: [-Wname-shadowing]
This binding for ‘x’ shadows the existing binding
bound at app/Main.hs:430:37
|
433 | = unsafeRemInvMaybeEBWithMod m (Rem x) <&> \(Rem !x) ->
| ^
app/Main.hs:452:22: warning: [-Wname-shadowing]
This binding for ‘e’ shadows the existing binding
bound at app/Main.hs:447:46
|
452 | go !acc# !base# !e
| ^
app/Main.hs:467:22: warning: [-Wname-shadowing]
This binding for ‘e’ shadows the existing binding
bound at app/Main.hs:462:39
|
467 | go !acc# !base# !e
| ^
app/Main.hs:491:34: warning: [-Wname-shadowing]
This binding for ‘negate’ shadows the existing binding
imported from ‘Prelude’ at app/Main.hs:23:1-14
(and originally defined in ‘GHC.Num’)
|
491 | unsafeModulusFromNumRemImpl _abs negate _
| ^^^^^^
app/Main.hs:707:15: warning: [-Wunused-matches]
Defined but not used: ‘t’
|
707 | go !s !u !t 0
| ^
app/Main.hs:888:13: warning: [-Wname-shadowing]
This binding for ‘cnt’ shadows the existing binding
bound at app/Main.hs:881:6
|
888 | go !cnt !val = val == Rem (x-1)
| ^^^
app/Main.hs:986:8: warning: [-Wname-shadowing]
This binding for ‘f’ shadows the existing binding
bound at app/Main.hs:982:12
|
986 | go f pxy = f (reflect pxy)
| ^
app/Main.hs:1035:17: warning: [-Wname-shadowing]
This binding for ‘unit’ shadows the existing binding
imported from ‘Control.Monad.Extra’ at app/Main.hs:152:1-26
|
1035 | genSegTreeWith !unit mult size
| ^^^^
app/Main.hs:1057:24: warning: [-Wname-shadowing]
This binding for ‘unit’ shadows the existing binding
imported from ‘Control.Monad.Extra’ at app/Main.hs:152:1-26
|
1057 | segTreeFromVectorWith !unit mult vec = stToPrim $ do
| ^^^^
app/Main.hs:1091:10: warning: [-Wname-shadowing]
This binding for ‘acc’ shadows the existing binding
bound at app/Main.hs:1088:12
|
1091 | !acc <- (if j .&. 1 /= 0 then flip else id) mult acc
| ^^^
app/Main.hs:1135:22: warning: [-Wname-shadowing]
This binding for ‘unit’ shadows the existing binding
imported from ‘Control.Monad.Extra’ at app/Main.hs:152:1-26
|
1135 | sgtIntv sgt@(SegTree unit mult vec) !from !to
| ^^^^
app/Main.hs:1135:38: warning: [-Wname-shadowing]
This binding for ‘from’ shadows the existing binding
imported from ‘GHC.Generics’ at app/Main.hs:45:1-19
|
1135 | sgtIntv sgt@(SegTree unit mult vec) !from !to
| ^^^^
app/Main.hs:1135:44: warning: [-Wname-shadowing]
This binding for ‘to’ shadows the existing binding
imported from ‘GHC.Generics’ at app/Main.hs:45:1-19
|
1135 | sgtIntv sgt@(SegTree unit mult vec) !from !to
| ^^
app/Main.hs:1173:16: warning: [-Wname-shadowing]
This binding for ‘from’ shadows the existing binding
imported from ‘GHC.Generics’ at app/Main.hs:45:1-19
|
1173 | bitSizeOfRange from to = countTrailingNonZeros (from `xor` to)
| ^^^^
app/Main.hs:1173:21: warning: [-Wname-shadowing]
This binding for ‘to’ shadows the existing binding
imported from ‘GHC.Generics’ at app/Main.hs:45:1-19
|
1173 | bitSizeOfRange from to = countTrailingNonZeros (from `xor` to)
| ^^