{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
module GHC.TypeLits.Extra.Solver.Operations
( ExtraOp (..)
, ExtraDefs (..)
, Normalised (..)
, NormaliseResult
, mergeNormalised
, reifyEOP
, mergeMax
, mergeMin
, mergeDiv
, mergeMod
, mergeFLog
, mergeCLog
, mergeLog
, mergeGCD
, mergeLCM
, mergeExp
)
where
import Control.Monad.Trans.Writer.Strict
#if MIN_VERSION_ghc_typelits_natnormalise(0,7,0)
import Data.Set as Set
#endif
import GHC.Base (isTrue#,(==#),(+#))
import GHC.Integer (smallInteger)
import GHC.Integer.Logarithms (integerLogBase#)
import GHC.TypeLits.Normalise.Unify (CType (..), normaliseNat, isNatural)
#if MIN_VERSION_ghc(9,0,0)
import GHC.Builtin.Types.Literals (typeNatExpTyCon, typeNatSubTyCon)
import GHC.Core.TyCon (TyCon)
import GHC.Core.Type (Type, TyVar, mkNumLitTy, mkTyConApp, mkTyVarTy)
import GHC.Utils.Outputable (Outputable (..), (<+>), integer, text)
#else
import Outputable (Outputable (..), (<+>), integer, text)
import TcTypeNats (typeNatExpTyCon, typeNatSubTyCon)
import TyCon (TyCon)
import Type (Type, TyVar, mkNumLitTy, mkTyConApp, mkTyVarTy)
#endif
data Normalised = Normalised | Untouched
deriving Normalised -> Normalised -> Bool
(Normalised -> Normalised -> Bool)
-> (Normalised -> Normalised -> Bool) -> Eq Normalised
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Normalised -> Normalised -> Bool
$c/= :: Normalised -> Normalised -> Bool
== :: Normalised -> Normalised -> Bool
$c== :: Normalised -> Normalised -> Bool
Eq
instance Outputable Normalised where
ppr :: Normalised -> SDoc
ppr Normalised = String -> SDoc
text "Normalised"
ppr Untouched = String -> SDoc
text "Untouched"
mergeNormalised :: Normalised -> Normalised -> Normalised
mergeNormalised :: Normalised -> Normalised -> Normalised
mergeNormalised Normalised _ = Normalised
Normalised
mergeNormalised _ Normalised = Normalised
Normalised
mergeNormalised _ _ = Normalised
Untouched
type NormaliseResult = (ExtraOp, Normalised)
data
= I Integer
| V TyVar
| C CType
| Max ExtraOp ExtraOp
| Min ExtraOp ExtraOp
| Div ExtraOp ExtraOp
| Mod ExtraOp ExtraOp
| FLog ExtraOp ExtraOp
| CLog ExtraOp ExtraOp
| Log ExtraOp ExtraOp
| GCD ExtraOp ExtraOp
| LCM ExtraOp ExtraOp
| Exp ExtraOp ExtraOp
deriving ExtraOp -> ExtraOp -> Bool
(ExtraOp -> ExtraOp -> Bool)
-> (ExtraOp -> ExtraOp -> Bool) -> Eq ExtraOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtraOp -> ExtraOp -> Bool
$c/= :: ExtraOp -> ExtraOp -> Bool
== :: ExtraOp -> ExtraOp -> Bool
$c== :: ExtraOp -> ExtraOp -> Bool
Eq
instance Outputable ExtraOp where
ppr :: ExtraOp -> SDoc
ppr (I i :: Integer
i) = Integer -> SDoc
integer Integer
i
ppr (V v :: TyVar
v) = TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
v
ppr (C c :: CType
c) = CType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CType
c
ppr (Max x :: ExtraOp
x y :: ExtraOp
y) = String -> SDoc
text "Max (" SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
x SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "," SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
y SDoc -> SDoc -> SDoc
<+> String -> SDoc
text ")"
ppr (Min x :: ExtraOp
x y :: ExtraOp
y) = String -> SDoc
text "Min (" SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
x SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "," SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
y SDoc -> SDoc -> SDoc
<+> String -> SDoc
text ")"
ppr (Div x :: ExtraOp
x y :: ExtraOp
y) = String -> SDoc
text "Div (" SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
x SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "," SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
y SDoc -> SDoc -> SDoc
<+> String -> SDoc
text ")"
ppr (Mod x :: ExtraOp
x y :: ExtraOp
y) = String -> SDoc
text "Mod (" SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
x SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "," SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
y SDoc -> SDoc -> SDoc
<+> String -> SDoc
text ")"
ppr (FLog x :: ExtraOp
x y :: ExtraOp
y) = String -> SDoc
text "FLog (" SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
x SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "," SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
y SDoc -> SDoc -> SDoc
<+> String -> SDoc
text ")"
ppr (CLog x :: ExtraOp
x y :: ExtraOp
y) = String -> SDoc
text "CLog (" SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
x SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "," SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
y SDoc -> SDoc -> SDoc
<+> String -> SDoc
text ")"
ppr (Log x :: ExtraOp
x y :: ExtraOp
y) = String -> SDoc
text "Log (" SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
x SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "," SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
y SDoc -> SDoc -> SDoc
<+> String -> SDoc
text ")"
ppr (GCD x :: ExtraOp
x y :: ExtraOp
y) = String -> SDoc
text "GCD (" SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
x SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "," SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
y SDoc -> SDoc -> SDoc
<+> String -> SDoc
text ")"
ppr (LCM x :: ExtraOp
x y :: ExtraOp
y) = String -> SDoc
text "GCD (" SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
x SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "," SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
y SDoc -> SDoc -> SDoc
<+> String -> SDoc
text ")"
ppr (Exp x :: ExtraOp
x y :: ExtraOp
y) = String -> SDoc
text "Exp (" SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
x SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "," SDoc -> SDoc -> SDoc
<+> ExtraOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr ExtraOp
y SDoc -> SDoc -> SDoc
<+> String -> SDoc
text ")"
data =
{ ExtraDefs -> TyCon
maxTyCon :: TyCon
, ExtraDefs -> TyCon
minTyCon :: TyCon
, ExtraDefs -> TyCon
divTyCon :: TyCon
, ExtraDefs -> TyCon
modTyCon :: TyCon
, ExtraDefs -> TyCon
flogTyCon :: TyCon
, ExtraDefs -> TyCon
clogTyCon :: TyCon
, ExtraDefs -> TyCon
logTyCon :: TyCon
, ExtraDefs -> TyCon
gcdTyCon :: TyCon
, ExtraDefs -> TyCon
lcmTyCon :: TyCon
}
reifyEOP :: ExtraDefs -> ExtraOp -> Type
reifyEOP :: ExtraDefs -> ExtraOp -> Type
reifyEOP _ (I i :: Integer
i) = Integer -> Type
mkNumLitTy Integer
i
reifyEOP _ (V v :: TyVar
v) = TyVar -> Type
mkTyVarTy TyVar
v
reifyEOP _ (C (CType c :: Type
c)) = Type
c
reifyEOP defs :: ExtraDefs
defs (Max x :: ExtraOp
x y :: ExtraOp
y) = TyCon -> [Type] -> Type
mkTyConApp (ExtraDefs -> TyCon
maxTyCon ExtraDefs
defs) [ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
x
,ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
y]
reifyEOP defs :: ExtraDefs
defs (Min x :: ExtraOp
x y :: ExtraOp
y) = TyCon -> [Type] -> Type
mkTyConApp (ExtraDefs -> TyCon
minTyCon ExtraDefs
defs) [ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
x
,ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
y]
reifyEOP defs :: ExtraDefs
defs (Div x :: ExtraOp
x y :: ExtraOp
y) = TyCon -> [Type] -> Type
mkTyConApp (ExtraDefs -> TyCon
divTyCon ExtraDefs
defs) [ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
x
,ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
y]
reifyEOP defs :: ExtraDefs
defs (Mod x :: ExtraOp
x y :: ExtraOp
y) = TyCon -> [Type] -> Type
mkTyConApp (ExtraDefs -> TyCon
modTyCon ExtraDefs
defs) [ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
x
,ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
y]
reifyEOP defs :: ExtraDefs
defs (CLog x :: ExtraOp
x y :: ExtraOp
y) = TyCon -> [Type] -> Type
mkTyConApp (ExtraDefs -> TyCon
clogTyCon ExtraDefs
defs) [ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
x
,ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
y]
reifyEOP defs :: ExtraDefs
defs (FLog x :: ExtraOp
x y :: ExtraOp
y) = TyCon -> [Type] -> Type
mkTyConApp (ExtraDefs -> TyCon
flogTyCon ExtraDefs
defs) [ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
x
,ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
y]
reifyEOP defs :: ExtraDefs
defs (Log x :: ExtraOp
x y :: ExtraOp
y) = TyCon -> [Type] -> Type
mkTyConApp (ExtraDefs -> TyCon
logTyCon ExtraDefs
defs) [ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
x
,ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
y]
reifyEOP defs :: ExtraDefs
defs (GCD x :: ExtraOp
x y :: ExtraOp
y) = TyCon -> [Type] -> Type
mkTyConApp (ExtraDefs -> TyCon
gcdTyCon ExtraDefs
defs) [ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
x
,ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
y]
reifyEOP defs :: ExtraDefs
defs (LCM x :: ExtraOp
x y :: ExtraOp
y) = TyCon -> [Type] -> Type
mkTyConApp (ExtraDefs -> TyCon
lcmTyCon ExtraDefs
defs) [ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
x
,ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
y]
reifyEOP defs :: ExtraDefs
defs (Exp x :: ExtraOp
x y :: ExtraOp
y) = TyCon -> [Type] -> Type
mkTyConApp TyCon
typeNatExpTyCon [ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
x
,ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
y]
mergeMax :: ExtraDefs -> ExtraOp -> ExtraOp -> NormaliseResult
mergeMax :: ExtraDefs -> ExtraOp -> ExtraOp -> NormaliseResult
mergeMax _ (I 0) y :: ExtraOp
y = (ExtraOp
y, Normalised
Normalised)
mergeMax _ x :: ExtraOp
x (I 0) = (ExtraOp
x, Normalised
Normalised)
mergeMax defs :: ExtraDefs
defs x :: ExtraOp
x y :: ExtraOp
y =
let x' :: Type
x' = ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
x
y' :: Type
y' = ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
y
z :: CoreSOP
z = (CoreSOP, [(Type, Type)]) -> CoreSOP
forall a b. (a, b) -> a
fst (Writer [(Type, Type)] CoreSOP -> (CoreSOP, [(Type, Type)])
forall w a. Writer w a -> (a, w)
runWriter (Type -> Writer [(Type, Type)] CoreSOP
normaliseNat (TyCon -> [Type] -> Type
mkTyConApp TyCon
typeNatSubTyCon [Type
y',Type
x'])))
#if MIN_VERSION_ghc_typelits_natnormalise(0,7,0)
in case WriterT (Set CType) Maybe Bool -> Maybe (Bool, Set CType)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (CoreSOP -> WriterT (Set CType) Maybe Bool
isNatural CoreSOP
z) of
Just (True , cs :: Set CType
cs) | Set CType -> Bool
forall a. Set a -> Bool
Set.null Set CType
cs -> (ExtraOp
y, Normalised
Normalised)
Just (False, cs :: Set CType
cs) | Set CType -> Bool
forall a. Set a -> Bool
Set.null Set CType
cs -> (ExtraOp
x, Normalised
Normalised)
#else
in case isNatural z of
Just True -> (y, Normalised)
Just False -> (x, Normalised)
#endif
_ -> (ExtraOp -> ExtraOp -> ExtraOp
Max ExtraOp
x ExtraOp
y, Normalised
Untouched)
mergeMin :: ExtraDefs -> ExtraOp -> ExtraOp -> NormaliseResult
mergeMin :: ExtraDefs -> ExtraOp -> ExtraOp -> NormaliseResult
mergeMin defs :: ExtraDefs
defs x :: ExtraOp
x y :: ExtraOp
y =
let x' :: Type
x' = ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
x
y' :: Type
y' = ExtraDefs -> ExtraOp -> Type
reifyEOP ExtraDefs
defs ExtraOp
y
z :: CoreSOP
z = (CoreSOP, [(Type, Type)]) -> CoreSOP
forall a b. (a, b) -> a
fst (Writer [(Type, Type)] CoreSOP -> (CoreSOP, [(Type, Type)])
forall w a. Writer w a -> (a, w)
runWriter (Type -> Writer [(Type, Type)] CoreSOP
normaliseNat (TyCon -> [Type] -> Type
mkTyConApp TyCon
typeNatSubTyCon [Type
y',Type
x'])))
#if MIN_VERSION_ghc_typelits_natnormalise(0,7,0)
in case WriterT (Set CType) Maybe Bool -> Maybe (Bool, Set CType)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (CoreSOP -> WriterT (Set CType) Maybe Bool
isNatural CoreSOP
z) of
Just (True, cs :: Set CType
cs) | Set CType -> Bool
forall a. Set a -> Bool
Set.null Set CType
cs -> (ExtraOp
x, Normalised
Normalised)
Just (False,cs :: Set CType
cs) | Set CType -> Bool
forall a. Set a -> Bool
Set.null Set CType
cs -> (ExtraOp
y, Normalised
Normalised)
#else
in case isNatural z of
Just True -> (x, Normalised)
Just False -> (y, Normalised)
#endif
_ -> (ExtraOp -> ExtraOp -> ExtraOp
Min ExtraOp
x ExtraOp
y, Normalised
Untouched)
mergeDiv :: ExtraOp -> ExtraOp -> Maybe NormaliseResult
mergeDiv :: ExtraOp -> ExtraOp -> Maybe NormaliseResult
mergeDiv _ (I 0) = Maybe NormaliseResult
forall a. Maybe a
Nothing
mergeDiv (I i :: Integer
i) (I j :: Integer
j) = NormaliseResult -> Maybe NormaliseResult
forall a. a -> Maybe a
Just (Integer -> ExtraOp
I (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
i Integer
j), Normalised
Normalised)
mergeDiv x :: ExtraOp
x y :: ExtraOp
y = NormaliseResult -> Maybe NormaliseResult
forall a. a -> Maybe a
Just (ExtraOp -> ExtraOp -> ExtraOp
Div ExtraOp
x ExtraOp
y, Normalised
Untouched)
mergeMod :: ExtraOp -> ExtraOp -> Maybe NormaliseResult
mergeMod :: ExtraOp -> ExtraOp -> Maybe NormaliseResult
mergeMod _ (I 0) = Maybe NormaliseResult
forall a. Maybe a
Nothing
mergeMod (I i :: Integer
i) (I j :: Integer
j) = NormaliseResult -> Maybe NormaliseResult
forall a. a -> Maybe a
Just (Integer -> ExtraOp
I (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
i Integer
j), Normalised
Normalised)
mergeMod x :: ExtraOp
x y :: ExtraOp
y = NormaliseResult -> Maybe NormaliseResult
forall a. a -> Maybe a
Just (ExtraOp -> ExtraOp -> ExtraOp
Mod ExtraOp
x ExtraOp
y, Normalised
Untouched)
mergeFLog :: ExtraOp -> ExtraOp -> Maybe NormaliseResult
mergeFLog :: ExtraOp -> ExtraOp -> Maybe NormaliseResult
mergeFLog (I i :: Integer
i) _ | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = Maybe NormaliseResult
forall a. Maybe a
Nothing
mergeFLog i :: ExtraOp
i (Exp j :: ExtraOp
j k :: ExtraOp
k) | ExtraOp
i ExtraOp -> ExtraOp -> Bool
forall a. Eq a => a -> a -> Bool
== ExtraOp
j = NormaliseResult -> Maybe NormaliseResult
forall a. a -> Maybe a
Just (ExtraOp
k, Normalised
Normalised)
mergeFLog (I i :: Integer
i) (I j :: Integer
j) = (Integer -> NormaliseResult)
-> Maybe Integer -> Maybe NormaliseResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\r :: Integer
r -> (Integer -> ExtraOp
I Integer
r, Normalised
Normalised)) (Integer -> Integer -> Maybe Integer
flogBase Integer
i Integer
j)
mergeFLog x :: ExtraOp
x y :: ExtraOp
y = NormaliseResult -> Maybe NormaliseResult
forall a. a -> Maybe a
Just (ExtraOp -> ExtraOp -> ExtraOp
FLog ExtraOp
x ExtraOp
y, Normalised
Untouched)
mergeCLog :: ExtraOp -> ExtraOp -> Maybe NormaliseResult
mergeCLog :: ExtraOp -> ExtraOp -> Maybe NormaliseResult
mergeCLog (I i :: Integer
i) _ | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = Maybe NormaliseResult
forall a. Maybe a
Nothing
mergeCLog i :: ExtraOp
i (Exp j :: ExtraOp
j k :: ExtraOp
k) | ExtraOp
i ExtraOp -> ExtraOp -> Bool
forall a. Eq a => a -> a -> Bool
== ExtraOp
j = NormaliseResult -> Maybe NormaliseResult
forall a. a -> Maybe a
Just (ExtraOp
k, Normalised
Normalised)
mergeCLog (I i :: Integer
i) (I j :: Integer
j) = (Integer -> NormaliseResult)
-> Maybe Integer -> Maybe NormaliseResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\r :: Integer
r -> (Integer -> ExtraOp
I Integer
r, Normalised
Normalised)) (Integer -> Integer -> Maybe Integer
clogBase Integer
i Integer
j)
mergeCLog x :: ExtraOp
x y :: ExtraOp
y = NormaliseResult -> Maybe NormaliseResult
forall a. a -> Maybe a
Just (ExtraOp -> ExtraOp -> ExtraOp
CLog ExtraOp
x ExtraOp
y, Normalised
Untouched)
mergeLog :: ExtraOp -> ExtraOp -> Maybe NormaliseResult
mergeLog :: ExtraOp -> ExtraOp -> Maybe NormaliseResult
mergeLog (I i :: Integer
i) _ | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = Maybe NormaliseResult
forall a. Maybe a
Nothing
mergeLog b :: ExtraOp
b (Exp b' :: ExtraOp
b' y :: ExtraOp
y) | ExtraOp
b ExtraOp -> ExtraOp -> Bool
forall a. Eq a => a -> a -> Bool
== ExtraOp
b' = NormaliseResult -> Maybe NormaliseResult
forall a. a -> Maybe a
Just (ExtraOp
y, Normalised
Normalised)
mergeLog (I i :: Integer
i) (I j :: Integer
j) = (Integer -> NormaliseResult)
-> Maybe Integer -> Maybe NormaliseResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\r :: Integer
r -> (Integer -> ExtraOp
I Integer
r, Normalised
Normalised)) (Integer -> Integer -> Maybe Integer
exactLogBase Integer
i Integer
j)
mergeLog x :: ExtraOp
x y :: ExtraOp
y = NormaliseResult -> Maybe NormaliseResult
forall a. a -> Maybe a
Just (ExtraOp -> ExtraOp -> ExtraOp
Log ExtraOp
x ExtraOp
y, Normalised
Untouched)
mergeGCD :: ExtraOp -> ExtraOp -> NormaliseResult
mergeGCD :: ExtraOp -> ExtraOp -> NormaliseResult
mergeGCD (I i :: Integer
i) (I j :: Integer
j) = (Integer -> ExtraOp
I (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
gcd Integer
i Integer
j), Normalised
Normalised)
mergeGCD x :: ExtraOp
x y :: ExtraOp
y = (ExtraOp -> ExtraOp -> ExtraOp
GCD ExtraOp
x ExtraOp
y, Normalised
Untouched)
mergeLCM :: ExtraOp -> ExtraOp -> NormaliseResult
mergeLCM :: ExtraOp -> ExtraOp -> NormaliseResult
mergeLCM (I i :: Integer
i) (I j :: Integer
j) = (Integer -> ExtraOp
I (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
lcm Integer
i Integer
j), Normalised
Normalised)
mergeLCM x :: ExtraOp
x y :: ExtraOp
y = (ExtraOp -> ExtraOp -> ExtraOp
LCM ExtraOp
x ExtraOp
y, Normalised
Untouched)
mergeExp :: ExtraOp -> ExtraOp -> NormaliseResult
mergeExp :: ExtraOp -> ExtraOp -> NormaliseResult
mergeExp (I i :: Integer
i) (I j :: Integer
j) = (Integer -> ExtraOp
I (Integer
iInteger -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
j), Normalised
Normalised)
mergeExp b :: ExtraOp
b (Log b' :: ExtraOp
b' y :: ExtraOp
y) | ExtraOp
b ExtraOp -> ExtraOp -> Bool
forall a. Eq a => a -> a -> Bool
== ExtraOp
b' = (ExtraOp
y, Normalised
Normalised)
mergeExp x :: ExtraOp
x y :: ExtraOp
y = (ExtraOp -> ExtraOp -> ExtraOp
Exp ExtraOp
x ExtraOp
y, Normalised
Untouched)
flogBase :: Integer -> Integer -> Maybe Integer
flogBase :: Integer -> Integer -> Maybe Integer
flogBase x :: Integer
x y :: Integer
y | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Int# -> Integer
smallInteger (Integer -> Integer -> Int#
integerLogBase# Integer
x Integer
y))
flogBase _ _ = Maybe Integer
forall a. Maybe a
Nothing
clogBase :: Integer -> Integer -> Maybe Integer
clogBase :: Integer -> Integer -> Maybe Integer
clogBase x :: Integer
x y :: Integer
y | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0 =
let z1 :: Int#
z1 = Integer -> Integer -> Int#
integerLogBase# Integer
x Integer
y
z2 :: Int#
z2 = Integer -> Integer -> Int#
integerLogBase# Integer
x (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)
in case Integer
y of
1 -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just 0
_ | Int# -> Bool
isTrue# (Int#
z1 Int# -> Int# -> Int#
==# Int#
z2) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Int# -> Integer
smallInteger (Int#
z1 Int# -> Int# -> Int#
+# 1#))
| Bool
otherwise -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Int# -> Integer
smallInteger Int#
z1)
clogBase _ _ = Maybe Integer
forall a. Maybe a
Nothing
exactLogBase :: Integer -> Integer -> Maybe Integer
exactLogBase :: Integer -> Integer -> Maybe Integer
exactLogBase x :: Integer
x y :: Integer
y | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0 =
let z1 :: Int#
z1 = Integer -> Integer -> Int#
integerLogBase# Integer
x Integer
y
z2 :: Int#
z2 = Integer -> Integer -> Int#
integerLogBase# Integer
x (Integer
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)
in case Integer
y of
1 -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just 0
_ | Int# -> Bool
isTrue# (Int#
z1 Int# -> Int# -> Int#
==# Int#
z2) -> Maybe Integer
forall a. Maybe a
Nothing
| Bool
otherwise -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Int# -> Integer
smallInteger Int#
z1)
exactLogBase _ _ = Maybe Integer
forall a. Maybe a
Nothing