{-|
Copyright  :  (C) 2015-2016, University of Twente,
                  2017     , QBayLogic B.V.
License    :  BSD2 (see the file LICENSE)
Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>
-}

{-# LANGUAGE CPP       #-}
{-# LANGUAGE MagicHash #-}

module GHC.TypeLits.Extra.Solver.Operations
  ( ExtraOp (..)
  , ExtraDefs (..)
  , reifyEOP
  , mergeMax
  , mergeMin
  , mergeDiv
  , mergeMod
  , mergeFLog
  , mergeCLog
  , mergeLog
  , mergeGCD
  , mergeLCM
  , mergeExp
  )
where

-- external
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)

-- GHC API
import Outputable (Outputable (..), (<+>), integer, text)
import TcTypeNats (typeNatExpTyCon, typeNatSubTyCon)
import TyCon      (TyCon)
import Type       (Type, TyVar, mkNumLitTy, mkTyConApp, mkTyVarTy)

data ExtraOp
  = 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 = ExtraDefs
  { 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 -> ExtraOp
mergeMax :: ExtraDefs -> ExtraOp -> ExtraOp -> ExtraOp
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
        Just (False, cs :: Set CType
cs) | Set CType -> Bool
forall a. Set a -> Bool
Set.null Set CType
cs -> ExtraOp
x
#else
  in  case isNatural z of
        Just True  -> y
        Just False -> x
#endif
        _ -> ExtraOp -> ExtraOp -> ExtraOp
Max ExtraOp
x ExtraOp
y

mergeMin :: ExtraDefs -> ExtraOp -> ExtraOp -> ExtraOp
mergeMin :: ExtraDefs -> ExtraOp -> ExtraOp -> ExtraOp
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
        Just (False,cs :: Set CType
cs) | Set CType -> Bool
forall a. Set a -> Bool
Set.null Set CType
cs -> ExtraOp
y
#else
  in  case isNatural z of
        Just True  -> x
        Just False -> y
#endif
        _ -> ExtraOp -> ExtraOp -> ExtraOp
Min ExtraOp
x ExtraOp
y

mergeDiv :: ExtraOp -> ExtraOp -> Maybe ExtraOp
mergeDiv :: ExtraOp -> ExtraOp -> Maybe ExtraOp
mergeDiv _     (I 0)      = Maybe ExtraOp
forall a. Maybe a
Nothing
mergeDiv (I i :: Integer
i) (I j :: Integer
j)      = ExtraOp -> Maybe ExtraOp
forall a. a -> Maybe a
Just (Integer -> ExtraOp
I (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
i Integer
j))
mergeDiv x :: ExtraOp
x y :: ExtraOp
y              = ExtraOp -> Maybe ExtraOp
forall a. a -> Maybe a
Just (ExtraOp -> ExtraOp -> ExtraOp
Div ExtraOp
x ExtraOp
y)

mergeMod :: ExtraOp -> ExtraOp -> Maybe ExtraOp
mergeMod :: ExtraOp -> ExtraOp -> Maybe ExtraOp
mergeMod _     (I 0)      = Maybe ExtraOp
forall a. Maybe a
Nothing
mergeMod (I i :: Integer
i) (I j :: Integer
j)      = ExtraOp -> Maybe ExtraOp
forall a. a -> Maybe a
Just (Integer -> ExtraOp
I (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
i Integer
j))
mergeMod x :: ExtraOp
x y :: ExtraOp
y              = ExtraOp -> Maybe ExtraOp
forall a. a -> Maybe a
Just (ExtraOp -> ExtraOp -> ExtraOp
Mod ExtraOp
x ExtraOp
y)

mergeFLog :: ExtraOp -> ExtraOp -> Maybe ExtraOp
mergeFLog :: ExtraOp -> ExtraOp -> Maybe ExtraOp
mergeFLog (I i :: Integer
i) _         | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 2  = Maybe ExtraOp
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 = ExtraOp -> Maybe ExtraOp
forall a. a -> Maybe a
Just ExtraOp
k
mergeFLog (I i :: Integer
i) (I j :: Integer
j)              = Integer -> ExtraOp
I (Integer -> ExtraOp) -> Maybe Integer -> Maybe ExtraOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Maybe Integer
flogBase Integer
i Integer
j
mergeFLog x :: ExtraOp
x     y :: ExtraOp
y                  = ExtraOp -> Maybe ExtraOp
forall a. a -> Maybe a
Just (ExtraOp -> ExtraOp -> ExtraOp
FLog ExtraOp
x ExtraOp
y)

mergeCLog :: ExtraOp -> ExtraOp -> Maybe ExtraOp
mergeCLog :: ExtraOp -> ExtraOp -> Maybe ExtraOp
mergeCLog (I i :: Integer
i) _         | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 2  = Maybe ExtraOp
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 = ExtraOp -> Maybe ExtraOp
forall a. a -> Maybe a
Just ExtraOp
k
mergeCLog (I i :: Integer
i) (I j :: Integer
j)              = Integer -> ExtraOp
I (Integer -> ExtraOp) -> Maybe Integer -> Maybe ExtraOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Maybe Integer
clogBase Integer
i Integer
j
mergeCLog x :: ExtraOp
x     y :: ExtraOp
y                  = ExtraOp -> Maybe ExtraOp
forall a. a -> Maybe a
Just (ExtraOp -> ExtraOp -> ExtraOp
CLog ExtraOp
x ExtraOp
y)

mergeLog :: ExtraOp -> ExtraOp -> Maybe ExtraOp
mergeLog :: ExtraOp -> ExtraOp -> Maybe ExtraOp
mergeLog (I i :: Integer
i) _          | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 2   = Maybe ExtraOp
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' = ExtraOp -> Maybe ExtraOp
forall a. a -> Maybe a
Just ExtraOp
y
mergeLog (I i :: Integer
i) (I j :: Integer
j)                = Integer -> ExtraOp
I (Integer -> ExtraOp) -> Maybe Integer -> Maybe ExtraOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Maybe Integer
exactLogBase Integer
i Integer
j
mergeLog x :: ExtraOp
x     y :: ExtraOp
y                    = ExtraOp -> Maybe ExtraOp
forall a. a -> Maybe a
Just (ExtraOp -> ExtraOp -> ExtraOp
Log ExtraOp
x ExtraOp
y)

mergeGCD :: ExtraOp -> ExtraOp -> ExtraOp
mergeGCD :: ExtraOp -> ExtraOp -> ExtraOp
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)
mergeGCD x :: ExtraOp
x     y :: ExtraOp
y     = ExtraOp -> ExtraOp -> ExtraOp
GCD ExtraOp
x ExtraOp
y

mergeLCM :: ExtraOp -> ExtraOp -> ExtraOp
mergeLCM :: ExtraOp -> ExtraOp -> ExtraOp
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)
mergeLCM x :: ExtraOp
x     y :: ExtraOp
y     = ExtraOp -> ExtraOp -> ExtraOp
LCM ExtraOp
x ExtraOp
y

mergeExp :: ExtraOp -> ExtraOp -> ExtraOp
mergeExp :: ExtraOp -> ExtraOp -> ExtraOp
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)
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
mergeExp x :: ExtraOp
x     y :: ExtraOp
y                    = ExtraOp -> ExtraOp -> ExtraOp
Exp ExtraOp
x ExtraOp
y

-- | \x y -> logBase x y, x > 1 && y > 0
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

-- | \x y -> ceiling (logBase x y), x > 1 && y > 0
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

-- | \x y -> logBase x y, x > 1 && y > 0, logBase x y == ceiling (logBase x y)
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