{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      :   Grisette.Core.Data.Class.Mergeable
-- Copyright   :   (c) Sirui Lu 2021-2023
-- License     :   BSD-3-Clause (see the LICENSE file)
--
-- Maintainer  :   siruilu@cs.washington.edu
-- Stability   :   Experimental
-- Portability :   GHC only
module Grisette.Core.Data.Class.Mergeable
  ( -- * Merging strategy
    MergingStrategy (..),

    -- * Mergeable
    Mergeable (..),
    Mergeable1 (..),
    rootStrategy1,
    Mergeable2 (..),
    rootStrategy2,
    Mergeable3 (..),
    rootStrategy3,
    Mergeable' (..),
    derivedRootStrategy,

    -- * Combinators for manually building merging strategies
    wrapStrategy,
    product2Strategy,
    DynamicSortedIdx (..),
    StrategyList (..),
    buildStrategyList,
    resolveStrategy,
    resolveStrategy',
  )
where

import Control.Exception
import Control.Monad.Cont
import Control.Monad.Except
import Control.Monad.Identity
import qualified Control.Monad.RWS.Lazy as RWSLazy
import qualified Control.Monad.RWS.Strict as RWSStrict
import Control.Monad.Reader
import qualified Control.Monad.State.Lazy as StateLazy
import qualified Control.Monad.State.Strict as StateStrict
import Control.Monad.Trans.Maybe
import qualified Control.Monad.Writer.Lazy as WriterLazy
import qualified Control.Monad.Writer.Strict as WriterStrict
import qualified Data.ByteString as B
import Data.Functor.Classes
import Data.Functor.Sum
import Data.Int
import Data.Kind
import qualified Data.Monoid as Monoid
import Data.Typeable
import Data.Word
import GHC.Natural
import qualified GHC.TypeLits
import GHC.TypeNats
import Generics.Deriving
import Grisette.Core.Data.BV
import Grisette.Core.Data.Class.Bool
import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim
import Unsafe.Coerce

-- | Helper type for combining arbitrary number of indices into one.
-- Useful when trying to write efficient merge strategy for lists/vectors.
data DynamicSortedIdx where
  DynamicSortedIdx :: forall idx. (Show idx, Ord idx, Typeable idx) => idx -> DynamicSortedIdx

instance Eq DynamicSortedIdx where
  (DynamicSortedIdx (idx
a :: a)) == :: DynamicSortedIdx -> DynamicSortedIdx -> Bool
== (DynamicSortedIdx (idx
b :: b)) = case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @b of
    Just idx :~: idx
Refl -> idx
a forall a. Eq a => a -> a -> Bool
== idx
b
    Maybe (idx :~: idx)
_ -> Bool
False
  {-# INLINE (==) #-}

instance Ord DynamicSortedIdx where
  compare :: DynamicSortedIdx -> DynamicSortedIdx -> Ordering
compare (DynamicSortedIdx (idx
a :: a)) (DynamicSortedIdx (idx
b :: b)) = case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @a @b of
    Just idx :~: idx
Refl -> forall a. Ord a => a -> a -> Ordering
compare idx
a idx
b
    Maybe (idx :~: idx)
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"This Ord is incomplete"
  {-# INLINE compare #-}

instance Show DynamicSortedIdx where
  show :: DynamicSortedIdx -> [Char]
show (DynamicSortedIdx idx
a) = forall a. Show a => a -> [Char]
show idx
a

-- | Resolves the indices and the terminal merge strategy for a value of some 'Mergeable' type.
resolveStrategy :: forall x. MergingStrategy x -> x -> ([DynamicSortedIdx], MergingStrategy x)
resolveStrategy :: forall x.
MergingStrategy x -> x -> ([DynamicSortedIdx], MergingStrategy x)
resolveStrategy MergingStrategy x
s x
x = forall x.
x -> MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
resolveStrategy' x
x MergingStrategy x
s
{-# INLINE resolveStrategy #-}

-- | Resolves the indices and the terminal merge strategy for a value given a merge strategy for its type.
resolveStrategy' :: forall x. x -> MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
resolveStrategy' :: forall x.
x -> MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
resolveStrategy' x
x = MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
go
  where
    go :: MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
    go :: MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
go (SortedStrategy x -> idx
idxFun idx -> MergingStrategy x
subStrategy) = case MergingStrategy x -> ([DynamicSortedIdx], MergingStrategy x)
go MergingStrategy x
ss of
      ([DynamicSortedIdx]
idxs, MergingStrategy x
r) -> (forall bool.
(Show bool, Ord bool, Typeable bool) =>
bool -> DynamicSortedIdx
DynamicSortedIdx idx
idx forall a. a -> [a] -> [a]
: [DynamicSortedIdx]
idxs, MergingStrategy x
r)
      where
        idx :: idx
idx = x -> idx
idxFun x
x
        ss :: MergingStrategy x
ss = idx -> MergingStrategy x
subStrategy idx
idx
    go MergingStrategy x
s = ([], MergingStrategy x
s)
{-# INLINE resolveStrategy' #-}

-- | Merging strategies.
--
-- __You probably do not need to know the details of this type if you are only going__
-- __to use algebraic data types. You can get merging strategies for them with type__
-- __derivation.__
--
-- In Grisette, a merged union (if-then-else tree) follows the __/hierarchical/__
-- __/sorted representation invariant/__ with regards to some merging strategy.
--
-- A merging strategy encodes how to merge a __/subset/__ of the values of a
-- given type. We have three types of merging strategies:
--
-- * Simple strategy
-- * Sorted strategy
-- * No strategy
--
-- The 'SimpleStrategy' merges values with a simple merge function.
-- For example,
--
--    * the symbolic boolean values can be directly merged with 'ites'.
--
--    * the set @{1}@, which is a subset of the values of the type @Integer@,
--        can be simply merged as the set contains only a single value.
--
--    * all the 'Just' values of the type @Maybe SymBool@ can be simply merged
--        by merging the wrapped symbolic boolean with 'ites'.
--
-- The 'SortedStrategy' merges values by first grouping the values with an
-- indexing function, and the values with the same index will be organized as
-- a sub-tree in the if-then-else structure of 'Grisette.Core.Data.UnionBase.UnionBase'.
-- Each group (sub-tree) will be further merged with a sub-strategy for the
-- index.
-- The index type should be a totally ordered type (with the 'Ord'
-- type class). Grisette will use the indexing function to partition the values
-- into sub-trees, and organize them in a sorted way. The sub-trees will further
-- be merged with the sub-strategies. For example,
--
--    * all the integers can be merged with 'SortedStrategy' by indexing with
--      the identity function and use the 'SimpleStrategy' shown before as the
--      sub-strategies.
--
--    * all the @Maybe SymBool@ values can be merged with 'SortedStrategy' by
--      indexing with 'Data.Maybe.isJust', the 'Nothing' and 'Just' values can then
--      then be merged with different simple strategies as sub-strategies.
--
-- The 'NoStrategy' does not perform any merging.
-- For example, we cannot merge values with function types that returns concrete
-- lists.
--
-- For ADTs, we can automatically derive the 'Mergeable' type class, which
-- provides a merging strategy.
--
-- If the derived version does not work for you, you should determine
-- if your type can be directly merged with a merging function. If so, you can
-- implement the merging strategy as a 'SimpleStrategy'.
-- If the type cannot be directly merged with a merging function, but could be
-- partitioned into subsets of values that can be simply merged with a function,
-- you should implement the merging strategy as a 'SortedStrategy'.
-- For easier building of the merging strategies, check out the combinators
-- like `wrapStrategy`.
--
-- For more details, please see the documents of the constructors, or refer to
-- [Grisette's paper](https://lsrcz.github.io/files/POPL23.pdf).
data MergingStrategy a where
  -- | Simple mergeable strategy.
  --
  -- For symbolic booleans, we can implement its merge strategy as follows:
  --
  -- > SimpleStrategy ites :: MergingStrategy SymBool
  SimpleStrategy ::
    -- | Merge function.
    (SymBool -> a -> a -> a) ->
    MergingStrategy a
  -- | Sorted mergeable strategy.
  --
  -- For Integers, we can implement its merge strategy as follows:
  --
  -- > SortedStrategy id (\_ -> SimpleStrategy $ \_ t _ -> t)
  --
  -- For @Maybe SymBool@, we can implement its merge strategy as follows:
  --
  -- > SortedStrategy
  -- >   (\case; Nothing -> False; Just _ -> True)
  -- >   (\idx ->
  -- >      if idx
  -- >        then SimpleStrategy $ \_ t _ -> t
  -- >        else SimpleStrategy $ \cond (Just l) (Just r) -> Just $ ites cond l r)
  SortedStrategy ::
    (Ord idx, Typeable idx, Show idx) =>
    -- | Indexing function
    (a -> idx) ->
    -- | Sub-strategy function
    (idx -> MergingStrategy a) ->
    MergingStrategy a
  -- | For preventing the merging intentionally. This could be
  -- useful for keeping some value concrete and may help generate more efficient
  -- formulas.
  --
  -- See [Grisette's paper](https://lsrcz.github.io/files/POPL23.pdf) for
  -- details.
  NoStrategy :: MergingStrategy a

-- | Useful utility function for building merge strategies manually.
--
-- For example, to build the merge strategy for the just branch of @Maybe a@,
-- one could write
--
-- > wrapStrategy Just fromMaybe rootStrategy :: MergingStrategy (Maybe a)
wrapStrategy ::
  -- | The merge strategy to be wrapped
  MergingStrategy a ->
  -- | The wrap function
  (a -> b) ->
  -- | The unwrap function, which does not have to be defined for every value
  (b -> a) ->
  MergingStrategy b
wrapStrategy :: forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (SimpleStrategy SymBool -> a -> a -> a
m) a -> b
wrap b -> a
unwrap =
  forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy
    ( \SymBool
cond b
ifTrue b
ifFalse ->
        a -> b
wrap forall a b. (a -> b) -> a -> b
$ SymBool -> a -> a -> a
m SymBool
cond (b -> a
unwrap b
ifTrue) (b -> a
unwrap b
ifFalse)
    )
wrapStrategy (SortedStrategy a -> idx
idxFun idx -> MergingStrategy a
substrategy) a -> b
wrap b -> a
unwrap =
  forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy
    (a -> idx
idxFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
unwrap)
    (\idx
idx -> forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (idx -> MergingStrategy a
substrategy idx
idx) a -> b
wrap b -> a
unwrap)
wrapStrategy MergingStrategy a
NoStrategy a -> b
_ b -> a
_ = forall a. MergingStrategy a
NoStrategy
{-# INLINE wrapStrategy #-}

-- | Each type is associated with a root merge strategy given by 'rootStrategy'.
-- The root merge strategy should be able to merge every value of the type.
-- Grisette will use the root merge strategy to merge the values of the type in
-- a union.
--
-- __Note 1:__ This type class can be derived for algebraic data types.
-- You may need the @DerivingVia@ and @DerivingStrategies@ extensions.
--
-- > data X = ... deriving Generic deriving Mergeable via (Default X)
class Mergeable a where
  -- | The root merging strategy for the type.
  rootStrategy :: MergingStrategy a

instance (Generic a, Mergeable' (Rep a)) => Mergeable (Default a) where
  rootStrategy :: MergingStrategy (Default a)
rootStrategy = forall a b. a -> b
unsafeCoerce (forall a. (Generic a, Mergeable' (Rep a)) => MergingStrategy a
derivedRootStrategy :: MergingStrategy a)
  {-# NOINLINE rootStrategy #-}

-- | Generic derivation for the 'Mergeable' class.
--
-- Usually you can derive the merging strategy with the @DerivingVia@ and
-- @DerivingStrategies@ extension.
--
-- > data X = ... deriving (Generic) deriving Mergeable via (Default X)
derivedRootStrategy :: (Generic a, Mergeable' (Rep a)) => MergingStrategy a
derivedRootStrategy :: forall a. (Generic a, Mergeable' (Rep a)) => MergingStrategy a
derivedRootStrategy = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy forall (f :: * -> *) a. Mergeable' f => MergingStrategy (f a)
rootStrategy' forall a x. Generic a => Rep a x -> a
to forall a x. Generic a => a -> Rep a x
from
{-# INLINE derivedRootStrategy #-}

-- | Lifting of the 'Mergeable' class to unary type constructors.
class Mergeable1 (u :: Type -> Type) where
  -- | Lift merge strategy through the type constructor.
  liftRootStrategy :: MergingStrategy a -> MergingStrategy (u a)

-- | Lift the root merge strategy through the unary type constructor.
rootStrategy1 :: (Mergeable a, Mergeable1 u) => MergingStrategy (u a)
rootStrategy1 :: forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1 = forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy forall a. Mergeable a => MergingStrategy a
rootStrategy
{-# INLINE rootStrategy1 #-}

-- | Lifting of the 'Mergeable' class to binary type constructors.
class Mergeable2 (u :: Type -> Type -> Type) where
  -- | Lift merge strategy through the type constructor.
  liftRootStrategy2 :: MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)

-- | Lift the root merge strategy through the binary type constructor.
rootStrategy2 :: (Mergeable a, Mergeable b, Mergeable2 u) => MergingStrategy (u a b)
rootStrategy2 :: forall a b (u :: * -> * -> *).
(Mergeable a, Mergeable b, Mergeable2 u) =>
MergingStrategy (u a b)
rootStrategy2 = forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 forall a. Mergeable a => MergingStrategy a
rootStrategy forall a. Mergeable a => MergingStrategy a
rootStrategy
{-# INLINE rootStrategy2 #-}

-- | Lifting of the 'Mergeable' class to ternary type constructors.
class Mergeable3 (u :: Type -> Type -> Type -> Type) where
  -- | Lift merge strategy through the type constructor.
  liftRootStrategy3 :: MergingStrategy a -> MergingStrategy b -> MergingStrategy c -> MergingStrategy (u a b c)

-- | Lift the root merge strategy through the binary type constructor.
rootStrategy3 :: (Mergeable a, Mergeable b, Mergeable c, Mergeable3 u) => MergingStrategy (u a b c)
rootStrategy3 :: forall a b c (u :: * -> * -> * -> *).
(Mergeable a, Mergeable b, Mergeable c, Mergeable3 u) =>
MergingStrategy (u a b c)
rootStrategy3 = forall (u :: * -> * -> * -> *) a b c.
Mergeable3 u =>
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (u a b c)
liftRootStrategy3 forall a. Mergeable a => MergingStrategy a
rootStrategy forall a. Mergeable a => MergingStrategy a
rootStrategy forall a. Mergeable a => MergingStrategy a
rootStrategy
{-# INLINE rootStrategy3 #-}

instance (Generic1 u, Mergeable1' (Rep1 u)) => Mergeable1 (Default1 u) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (Default1 u a)
liftRootStrategy = forall a b. a -> b
unsafeCoerce (forall (u :: * -> *) a.
(Generic1 u, Mergeable1' (Rep1 u)) =>
MergingStrategy a -> MergingStrategy (u a)
derivedLiftMergingStrategy :: MergingStrategy a -> MergingStrategy (u a))
  {-# NOINLINE liftRootStrategy #-}

class Mergeable1' (u :: Type -> Type) where
  liftRootStrategy' :: MergingStrategy a -> MergingStrategy (u a)

instance Mergeable1' U1 where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy (U1 a)
liftRootStrategy' MergingStrategy a
_ = forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy (\SymBool
_ U1 a
t U1 a
_ -> U1 a
t)
  {-# INLINE liftRootStrategy' #-}

instance Mergeable1' V1 where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy (V1 a)
liftRootStrategy' MergingStrategy a
_ = forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy (\SymBool
_ V1 a
t V1 a
_ -> V1 a
t)
  {-# INLINE liftRootStrategy' #-}

instance Mergeable1' Par1 where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy (Par1 a)
liftRootStrategy' MergingStrategy a
m = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy a
m forall p. p -> Par1 p
Par1 forall p. Par1 p -> p
unPar1
  {-# INLINE liftRootStrategy' #-}

instance Mergeable1 f => Mergeable1' (Rec1 f) where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy (Rec1 f a)
liftRootStrategy' MergingStrategy a
m = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m) forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1
  {-# INLINE liftRootStrategy' #-}

instance Mergeable c => Mergeable1' (K1 i c) where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy (K1 i c a)
liftRootStrategy' MergingStrategy a
_ = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy forall a. Mergeable a => MergingStrategy a
rootStrategy forall k i c (p :: k). c -> K1 i c p
K1 forall k i c (p :: k). K1 i c p -> c
unK1
  {-# INLINE liftRootStrategy' #-}

instance Mergeable1' a => Mergeable1' (M1 i c a) where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy (M1 i c a a)
liftRootStrategy' MergingStrategy a
m = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1' u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy' MergingStrategy a
m) forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  {-# INLINE liftRootStrategy' #-}

instance (Mergeable1' a, Mergeable1' b) => Mergeable1' (a :+: b) where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy ((:+:) a b a)
liftRootStrategy' MergingStrategy a
m =
    forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy
      ( \case
          L1 a a
_ -> Bool
False
          R1 b a
_ -> Bool
True
      )
      ( \Bool
idx ->
          if Bool -> Bool
not Bool
idx
            then forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1' u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy' MergingStrategy a
m) forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (\case (L1 a a
v) -> a a
v; (:+:) a b a
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
            else forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1' u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy' MergingStrategy a
m) forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (\case (R1 b a
v) -> b a
v; (:+:) a b a
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
      )
  {-# INLINE liftRootStrategy' #-}

instance (Mergeable1' a, Mergeable1' b) => Mergeable1' (a :*: b) where
  liftRootStrategy' :: forall a. MergingStrategy a -> MergingStrategy ((:*:) a b a)
liftRootStrategy' MergingStrategy a
m = forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (\(a a
a :*: b a
b) -> (a a
a, b a
b)) (forall (u :: * -> *) a.
Mergeable1' u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy' MergingStrategy a
m) (forall (u :: * -> *) a.
Mergeable1' u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy' MergingStrategy a
m)
  {-# INLINE liftRootStrategy' #-}

-- | Generic derivation for the 'Mergeable' class.
derivedLiftMergingStrategy :: (Generic1 u, Mergeable1' (Rep1 u)) => MergingStrategy a -> MergingStrategy (u a)
derivedLiftMergingStrategy :: forall (u :: * -> *) a.
(Generic1 u, Mergeable1' (Rep1 u)) =>
MergingStrategy a -> MergingStrategy (u a)
derivedLiftMergingStrategy MergingStrategy a
m = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1' u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy' MergingStrategy a
m) forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1
{-# INLINE derivedLiftMergingStrategy #-}

-- | Auxiliary class for the generic derivation for the 'Mergeable' class.
class Mergeable' f where
  rootStrategy' :: MergingStrategy (f a)

instance Mergeable' U1 where
  rootStrategy' :: forall a. MergingStrategy (U1 a)
rootStrategy' = forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy (\SymBool
_ U1 a
t U1 a
_ -> U1 a
t)
  {-# INLINE rootStrategy' #-}

instance Mergeable' V1 where
  rootStrategy' :: forall a. MergingStrategy (V1 a)
rootStrategy' = forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy (\SymBool
_ V1 a
t V1 a
_ -> V1 a
t)
  {-# INLINE rootStrategy' #-}

instance (Mergeable c) => Mergeable' (K1 i c) where
  rootStrategy' :: forall a. MergingStrategy (K1 i c a)
rootStrategy' = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy forall a. Mergeable a => MergingStrategy a
rootStrategy forall k i c (p :: k). c -> K1 i c p
K1 forall k i c (p :: k). K1 i c p -> c
unK1
  {-# INLINE rootStrategy' #-}

instance (Mergeable' a) => Mergeable' (M1 i c a) where
  rootStrategy' :: forall a. MergingStrategy (M1 i c a a)
rootStrategy' = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy forall (f :: * -> *) a. Mergeable' f => MergingStrategy (f a)
rootStrategy' forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  {-# INLINE rootStrategy' #-}

instance (Mergeable' a, Mergeable' b) => Mergeable' (a :+: b) where
  rootStrategy' :: forall a. MergingStrategy ((:+:) a b a)
rootStrategy' =
    forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy
      ( \case
          L1 a a
_ -> Bool
False
          R1 b a
_ -> Bool
True
      )
      ( \Bool
idx ->
          if Bool -> Bool
not Bool
idx
            then forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy forall (f :: * -> *) a. Mergeable' f => MergingStrategy (f a)
rootStrategy' forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (\case (L1 a a
v) -> a a
v; (:+:) a b a
_ -> forall a. HasCallStack => a
undefined)
            else forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy forall (f :: * -> *) a. Mergeable' f => MergingStrategy (f a)
rootStrategy' forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (\case (R1 b a
v) -> b a
v; (:+:) a b a
_ -> forall a. HasCallStack => a
undefined)
      )
  {-# INLINE rootStrategy' #-}

-- | Useful utility function for building merge strategies for product types
-- manually.
--
-- For example, to build the merge strategy for the following product type,
-- one could write
--
-- > data X = X { x1 :: Int, x2 :: Bool }
-- > product2Strategy X (\(X a b) -> (a, b)) rootStrategy rootStrategy
-- >   :: MergingStrategy X
product2Strategy ::
  -- | The wrap function
  (a -> b -> r) ->
  -- | The unwrap function, which does not have to be defined for every value
  (r -> (a, b)) ->
  -- | The first merge strategy to be wrapped
  MergingStrategy a ->
  -- | The second merge strategy to be wrapped
  MergingStrategy b ->
  MergingStrategy r
product2Strategy :: forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy a -> b -> r
wrap r -> (a, b)
unwrap MergingStrategy a
strategy1 MergingStrategy b
strategy2 =
  case (MergingStrategy a
strategy1, MergingStrategy b
strategy2) of
    (MergingStrategy a
NoStrategy, MergingStrategy b
_) -> forall a. MergingStrategy a
NoStrategy
    (MergingStrategy a
_, MergingStrategy b
NoStrategy) -> forall a. MergingStrategy a
NoStrategy
    (SimpleStrategy SymBool -> a -> a -> a
m1, SimpleStrategy SymBool -> b -> b -> b
m2) ->
      forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy forall a b. (a -> b) -> a -> b
$ \SymBool
cond r
t r
f -> case (r -> (a, b)
unwrap r
t, r -> (a, b)
unwrap r
f) of
        ((a
hdt, b
tlt), (a
hdf, b
tlf)) ->
          a -> b -> r
wrap (SymBool -> a -> a -> a
m1 SymBool
cond a
hdt a
hdf) (SymBool -> b -> b -> b
m2 SymBool
cond b
tlt b
tlf)
    (s1 :: MergingStrategy a
s1@(SimpleStrategy SymBool -> a -> a -> a
_), SortedStrategy b -> idx
idxf idx -> MergingStrategy b
subf) ->
      forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy (b -> idx
idxf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> (a, b)
unwrap) (forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy a -> b -> r
wrap r -> (a, b)
unwrap MergingStrategy a
s1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. idx -> MergingStrategy b
subf)
    (SortedStrategy a -> idx
idxf idx -> MergingStrategy a
subf, MergingStrategy b
s2) ->
      forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy (a -> idx
idxf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> (a, b)
unwrap) (\idx
idx -> forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy a -> b -> r
wrap r -> (a, b)
unwrap (idx -> MergingStrategy a
subf idx
idx) MergingStrategy b
s2)
{-# INLINE product2Strategy #-}

instance (Mergeable' a, Mergeable' b) => Mergeable' (a :*: b) where
  rootStrategy' :: forall a. MergingStrategy ((:*:) a b a)
rootStrategy' = forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (\(a a
a :*: b a
b) -> (a a
a, b a
b)) forall (f :: * -> *) a. Mergeable' f => MergingStrategy (f a)
rootStrategy' forall (f :: * -> *) a. Mergeable' f => MergingStrategy (f a)
rootStrategy'
  {-# INLINE rootStrategy' #-}

-- instances

#define CONCRETE_ORD_MERGEABLE(type) \
instance Mergeable type where \
  rootStrategy = \
    let sub = SimpleStrategy $ \_ t _ -> t \
     in SortedStrategy id $ const sub

#define CONCRETE_ORD_MERGEABLE_BV(type) \
instance (KnownNat n, 1 <= n) => Mergeable (type n) where \
  rootStrategy = \
    let sub = SimpleStrategy $ \_ t _ -> t \
     in SortedStrategy id $ const sub

#if 1
CONCRETE_ORD_MERGEABLE(Bool)
CONCRETE_ORD_MERGEABLE(Integer)
CONCRETE_ORD_MERGEABLE(Char)
CONCRETE_ORD_MERGEABLE(Int)
CONCRETE_ORD_MERGEABLE(Int8)
CONCRETE_ORD_MERGEABLE(Int16)
CONCRETE_ORD_MERGEABLE(Int32)
CONCRETE_ORD_MERGEABLE(Int64)
CONCRETE_ORD_MERGEABLE(Word)
CONCRETE_ORD_MERGEABLE(Word8)
CONCRETE_ORD_MERGEABLE(Word16)
CONCRETE_ORD_MERGEABLE(Word32)
CONCRETE_ORD_MERGEABLE(Word64)
CONCRETE_ORD_MERGEABLE(B.ByteString)
CONCRETE_ORD_MERGEABLE_BV(WordN)
CONCRETE_ORD_MERGEABLE_BV(IntN)
#endif

instance Mergeable SomeIntN where
  rootStrategy :: MergingStrategy SomeIntN
rootStrategy =
    forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy @Natural
      (\(SomeIntN (IntN n
v :: IntN n)) -> forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall {k} (t :: k). Proxy t
Proxy @n))
      ( \Nat
n ->
          forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy @Integer
            (\(SomeIntN (IntN Integer
i)) -> forall a. Integral a => a -> Integer
toInteger Integer
i)
            (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy forall a b. (a -> b) -> a -> b
$ \SymBool
_ SomeIntN
l SomeIntN
_ -> SomeIntN
l)
      )

instance Mergeable SomeWordN where
  rootStrategy :: MergingStrategy SomeWordN
rootStrategy =
    forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy @Natural
      (\(SomeWordN (WordN n
v :: WordN n)) -> forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall {k} (t :: k). Proxy t
Proxy @n))
      ( \Nat
n ->
          forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy @Integer
            (\(SomeWordN (WordN Integer
i)) -> forall a. Integral a => a -> Integer
toInteger Integer
i)
            (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy forall a b. (a -> b) -> a -> b
$ \SymBool
_ SomeWordN
l SomeWordN
_ -> SomeWordN
l)
      )

-- ()
deriving via (Default ()) instance Mergeable ()

-- Either
deriving via (Default (Either e a)) instance (Mergeable e, Mergeable a) => Mergeable (Either e a)

deriving via (Default1 (Either e)) instance (Mergeable e) => Mergeable1 (Either e)

instance Mergeable2 Either where
  liftRootStrategy2 :: forall a b.
MergingStrategy a
-> MergingStrategy b -> MergingStrategy (Either a b)
liftRootStrategy2 MergingStrategy a
m1 MergingStrategy b
m2 =
    forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy
      ( \case
          Left a
_ -> Bool
False
          Right b
_ -> Bool
True
      )
      ( \case
          Bool
False -> forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy a
m1 forall a b. a -> Either a b
Left (\case (Left a
v) -> a
v; Either a b
_ -> forall a. HasCallStack => a
undefined)
          Bool
True -> forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy b
m2 forall a b. b -> Either a b
Right (\case (Right b
v) -> b
v; Either a b
_ -> forall a. HasCallStack => a
undefined)
      )
  {-# INLINE liftRootStrategy2 #-}

-- Maybe
deriving via (Default (Maybe a)) instance (Mergeable a) => Mergeable (Maybe a)

deriving via (Default1 Maybe) instance Mergeable1 Maybe

-- | Helper type for building efficient merge strategy for list-like containers.
data StrategyList container where
  StrategyList ::
    forall bool a container.
    container [DynamicSortedIdx] ->
    container (MergingStrategy a) ->
    StrategyList container

-- | Helper function for building efficient merge strategy for list-like containers.
buildStrategyList ::
  forall bool a container.
  (Functor container) =>
  MergingStrategy a ->
  container a ->
  StrategyList container
buildStrategyList :: forall bool a (container :: * -> *).
Functor container =>
MergingStrategy a -> container a -> StrategyList container
buildStrategyList MergingStrategy a
s container a
l = forall bool a (container :: * -> *).
container [DynamicSortedIdx]
-> container (MergingStrategy a) -> StrategyList container
StrategyList container [DynamicSortedIdx]
idxs container (MergingStrategy a)
strategies
  where
    r :: container ([DynamicSortedIdx], MergingStrategy a)
r = forall x.
MergingStrategy x -> x -> ([DynamicSortedIdx], MergingStrategy x)
resolveStrategy MergingStrategy a
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> container a
l
    idxs :: container [DynamicSortedIdx]
idxs = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> container ([DynamicSortedIdx], MergingStrategy a)
r
    strategies :: container (MergingStrategy a)
strategies = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> container ([DynamicSortedIdx], MergingStrategy a)
r
{-# INLINE buildStrategyList #-}

instance Eq1 container => Eq (StrategyList container) where
  (StrategyList container [DynamicSortedIdx]
idxs1 container (MergingStrategy a)
_) == :: StrategyList container -> StrategyList container -> Bool
== (StrategyList container [DynamicSortedIdx]
idxs2 container (MergingStrategy a)
_) = forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1 container [DynamicSortedIdx]
idxs1 container [DynamicSortedIdx]
idxs2
  {-# INLINE (==) #-}

instance Ord1 container => Ord (StrategyList container) where
  compare :: StrategyList container -> StrategyList container -> Ordering
compare (StrategyList container [DynamicSortedIdx]
idxs1 container (MergingStrategy a)
_) (StrategyList container [DynamicSortedIdx]
idxs2 container (MergingStrategy a)
_) = forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1 container [DynamicSortedIdx]
idxs1 container [DynamicSortedIdx]
idxs2
  {-# INLINE compare #-}

instance Show1 container => Show (StrategyList container) where
  showsPrec :: Int -> StrategyList container -> ShowS
showsPrec Int
i (StrategyList container [DynamicSortedIdx]
idxs1 container (MergingStrategy a)
_) = forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 Int
i container [DynamicSortedIdx]
idxs1

-- List
instance (Mergeable a) => Mergeable [a] where
  rootStrategy :: MergingStrategy [a]
rootStrategy = case forall a. Mergeable a => MergingStrategy a
rootStrategy :: MergingStrategy a of
    SimpleStrategy SymBool -> a -> a -> a
m ->
      forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ \Int
_ ->
        forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy forall a b. (a -> b) -> a -> b
$ \SymBool
cond -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (SymBool -> a -> a -> a
m SymBool
cond)
    MergingStrategy a
NoStrategy ->
      forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. MergingStrategy a
NoStrategy
    MergingStrategy a
_ -> forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ \Int
_ ->
      forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy (forall bool a (container :: * -> *).
Functor container =>
MergingStrategy a -> container a -> StrategyList container
buildStrategyList forall a. Mergeable a => MergingStrategy a
rootStrategy) forall a b. (a -> b) -> a -> b
$ \(StrategyList [[DynamicSortedIdx]]
_ [MergingStrategy a]
strategies) ->
        let [MergingStrategy a]
s :: [MergingStrategy a] = forall a b. a -> b
unsafeCoerce [MergingStrategy a]
strategies
            allSimple :: Bool
allSimple = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case SimpleStrategy SymBool -> a -> a -> a
_ -> Bool
True; MergingStrategy a
_ -> Bool
False) [MergingStrategy a]
s
         in if Bool
allSimple
              then forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy forall a b. (a -> b) -> a -> b
$ \SymBool
cond [a]
l [a]
r ->
                (\case (SimpleStrategy SymBool -> a -> a -> a
f, a
l1, a
r1) -> SymBool -> a -> a -> a
f SymBool
cond a
l1 a
r1; (MergingStrategy a, a, a)
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"impossible") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [MergingStrategy a]
s [a]
l [a]
r
              else forall a. MergingStrategy a
NoStrategy
  {-# INLINE rootStrategy #-}

instance Mergeable1 [] where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy [a]
liftRootStrategy (MergingStrategy a
ms :: MergingStrategy a) = case MergingStrategy a
ms of
    SimpleStrategy SymBool -> a -> a -> a
m ->
      forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ \Int
_ ->
        forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy forall a b. (a -> b) -> a -> b
$ \SymBool
cond -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (SymBool -> a -> a -> a
m SymBool
cond)
    MergingStrategy a
NoStrategy ->
      forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. MergingStrategy a
NoStrategy
    MergingStrategy a
_ -> forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ \Int
_ ->
      forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy (forall bool a (container :: * -> *).
Functor container =>
MergingStrategy a -> container a -> StrategyList container
buildStrategyList MergingStrategy a
ms) forall a b. (a -> b) -> a -> b
$ \(StrategyList [[DynamicSortedIdx]]
_ [MergingStrategy a]
strategies) ->
        let [MergingStrategy a]
s :: [MergingStrategy a] = forall a b. a -> b
unsafeCoerce [MergingStrategy a]
strategies
            allSimple :: Bool
allSimple = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case SimpleStrategy SymBool -> a -> a -> a
_ -> Bool
True; MergingStrategy a
_ -> Bool
False) [MergingStrategy a]
s
         in if Bool
allSimple
              then forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy forall a b. (a -> b) -> a -> b
$ \SymBool
cond [a]
l [a]
r ->
                (\case (SimpleStrategy SymBool -> a -> a -> a
f, a
l1, a
r1) -> SymBool -> a -> a -> a
f SymBool
cond a
l1 a
r1; (MergingStrategy a, a, a)
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"impossible") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [MergingStrategy a]
s [a]
l [a]
r
              else forall a. MergingStrategy a
NoStrategy
  {-# INLINE liftRootStrategy #-}

-- (,)
deriving via (Default (a, b)) instance (Mergeable a, Mergeable b) => Mergeable (a, b)

deriving via (Default1 ((,) a)) instance (Mergeable a) => Mergeable1 ((,) a)

instance Mergeable2 (,) where
  liftRootStrategy2 :: forall a b.
MergingStrategy a -> MergingStrategy b -> MergingStrategy (a, b)
liftRootStrategy2 = forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy (,) forall a. a -> a
id
  {-# INLINE liftRootStrategy2 #-}

-- (,,)
deriving via
  (Default (a, b, c))
  instance
    (Mergeable a, Mergeable b, Mergeable c) => Mergeable (a, b, c)

deriving via
  (Default1 ((,,) a b))
  instance
    (Mergeable a, Mergeable b) => Mergeable1 ((,,) a b)

instance (Mergeable a) => Mergeable2 ((,,) a) where
  liftRootStrategy2 :: forall a b.
MergingStrategy a -> MergingStrategy b -> MergingStrategy (a, a, b)
liftRootStrategy2 = forall (u :: * -> * -> * -> *) a b c.
Mergeable3 u =>
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (u a b c)
liftRootStrategy3 forall a. Mergeable a => MergingStrategy a
rootStrategy
  {-# INLINE liftRootStrategy2 #-}

instance Mergeable3 (,,) where
  liftRootStrategy3 :: forall a b c.
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (a, b, c)
liftRootStrategy3 MergingStrategy a
m1 MergingStrategy b
m2 MergingStrategy c
m3 =
    forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy
      (\a
a (b
b, c
c) -> (a
a, b
b, c
c))
      (\(a
a, b
b, c
c) -> (a
a, (b
b, c
c)))
      MergingStrategy a
m1
      (forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy b
m2 MergingStrategy c
m3)
  {-# INLINE liftRootStrategy3 #-}

-- (,,,)
deriving via
  (Default (a, b, c, d))
  instance
    (Mergeable a, Mergeable b, Mergeable c, Mergeable d) =>
    Mergeable (a, b, c, d)

deriving via
  (Default1 ((,,,) a b c))
  instance
    (Mergeable a, Mergeable b, Mergeable c) =>
    Mergeable1 ((,,,) a b c)

-- (,,,,)
deriving via
  (Default (a, b, c, d, e))
  instance
    (Mergeable a, Mergeable b, Mergeable c, Mergeable d, Mergeable e) =>
    Mergeable (a, b, c, d, e)

deriving via
  (Default1 ((,,,,) a b c d))
  instance
    (Mergeable a, Mergeable b, Mergeable c, Mergeable d) =>
    Mergeable1 ((,,,,) a b c d)

-- (,,,,,)
deriving via
  (Default (a, b, c, d, e, f))
  instance
    ( Mergeable a,
      Mergeable b,
      Mergeable c,
      Mergeable d,
      Mergeable e,
      Mergeable f
    ) =>
    Mergeable (a, b, c, d, e, f)

deriving via
  (Default1 ((,,,,,) a b c d e))
  instance
    (Mergeable a, Mergeable b, Mergeable c, Mergeable d, Mergeable e) =>
    Mergeable1 ((,,,,,) a b c d e)

-- (,,,,,,)
deriving via
  (Default (a, b, c, d, e, f, g))
  instance
    ( Mergeable a,
      Mergeable b,
      Mergeable c,
      Mergeable d,
      Mergeable e,
      Mergeable f,
      Mergeable g
    ) =>
    Mergeable (a, b, c, d, e, f, g)

deriving via
  (Default1 ((,,,,,,) a b c d e f))
  instance
    ( Mergeable a,
      Mergeable b,
      Mergeable c,
      Mergeable d,
      Mergeable e,
      Mergeable f
    ) =>
    Mergeable1 ((,,,,,,) a b c d e f)

-- (,,,,,,,)
deriving via
  (Default (a, b, c, d, e, f, g, h))
  instance
    ( Mergeable a,
      Mergeable b,
      Mergeable c,
      Mergeable d,
      Mergeable e,
      Mergeable f,
      Mergeable g,
      Mergeable h
    ) =>
    Mergeable (a, b, c, d, e, f, g, h)

deriving via
  (Default1 ((,,,,,,,) a b c d e f g))
  instance
    ( Mergeable a,
      Mergeable b,
      Mergeable c,
      Mergeable d,
      Mergeable e,
      Mergeable f,
      Mergeable g
    ) =>
    Mergeable1 ((,,,,,,,) a b c d e f g)

-- function
instance (Mergeable b) => Mergeable (a -> b) where
  rootStrategy :: MergingStrategy (a -> b)
rootStrategy = case forall a. Mergeable a => MergingStrategy a
rootStrategy @b of
    SimpleStrategy SymBool -> b -> b -> b
m -> forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy forall a b. (a -> b) -> a -> b
$ \SymBool
cond a -> b
t a -> b
f a
v -> SymBool -> b -> b -> b
m SymBool
cond (a -> b
t a
v) (a -> b
f a
v)
    MergingStrategy b
_ -> forall a. MergingStrategy a
NoStrategy
  {-# INLINE rootStrategy #-}

instance Mergeable1 ((->) a) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (a -> a)
liftRootStrategy MergingStrategy a
ms = case MergingStrategy a
ms of
    SimpleStrategy SymBool -> a -> a -> a
m -> forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy forall a b. (a -> b) -> a -> b
$ \SymBool
cond a -> a
t a -> a
f a
v -> SymBool -> a -> a -> a
m SymBool
cond (a -> a
t a
v) (a -> a
f a
v)
    MergingStrategy a
_ -> forall a. MergingStrategy a
NoStrategy
  {-# INLINE liftRootStrategy #-}

-- MaybeT
instance (Mergeable1 m, Mergeable a) => Mergeable (MaybeT m a) where
  rootStrategy :: MergingStrategy (MaybeT m a)
rootStrategy = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1 forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
  {-# INLINE rootStrategy #-}

instance (Mergeable1 m) => Mergeable1 (MaybeT m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (MaybeT m a)
liftRootStrategy MergingStrategy a
m = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m)) forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
  {-# INLINE liftRootStrategy #-}

-- ExceptT
instance
  (Mergeable1 m, Mergeable e, Mergeable a) =>
  Mergeable (ExceptT e m a)
  where
  rootStrategy :: MergingStrategy (ExceptT e m a)
rootStrategy = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1 forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
  {-# INLINE rootStrategy #-}

instance (Mergeable1 m, Mergeable e) => Mergeable1 (ExceptT e m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (ExceptT e m a)
liftRootStrategy MergingStrategy a
m = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m)) forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
  {-# INLINE liftRootStrategy #-}

-- state
instance
  (Mergeable s, Mergeable a, Mergeable1 m) =>
  Mergeable (StateLazy.StateT s m a)
  where
  rootStrategy :: MergingStrategy (StateT s m a)
rootStrategy = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1) forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateLazy.StateT forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StateLazy.runStateT
  {-# INLINE rootStrategy #-}

instance (Mergeable s, Mergeable1 m) => Mergeable1 (StateLazy.StateT s m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (StateT s m a)
liftRootStrategy MergingStrategy a
m =
    forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
m forall a. Mergeable a => MergingStrategy a
rootStrategy)))
      forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateLazy.StateT
      forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StateLazy.runStateT
  {-# INLINE liftRootStrategy #-}

instance
  (Mergeable s, Mergeable a, Mergeable1 m) =>
  Mergeable (StateStrict.StateT s m a)
  where
  rootStrategy :: MergingStrategy (StateT s m a)
rootStrategy =
    forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1) forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateStrict.StateT forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StateStrict.runStateT
  {-# INLINE rootStrategy #-}

instance (Mergeable s, Mergeable1 m) => Mergeable1 (StateStrict.StateT s m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (StateT s m a)
liftRootStrategy MergingStrategy a
m =
    forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
m forall a. Mergeable a => MergingStrategy a
rootStrategy)))
      forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateStrict.StateT
      forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StateStrict.runStateT
  {-# INLINE liftRootStrategy #-}

-- writer
instance
  (Mergeable s, Mergeable a, Mergeable1 m) =>
  Mergeable (WriterLazy.WriterT s m a)
  where
  rootStrategy :: MergingStrategy (WriterT s m a)
rootStrategy = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1) forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterLazy.WriterT forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WriterLazy.runWriterT
  {-# INLINE rootStrategy #-}

instance (Mergeable s, Mergeable1 m) => Mergeable1 (WriterLazy.WriterT s m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (WriterT s m a)
liftRootStrategy MergingStrategy a
m =
    forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
m forall a. Mergeable a => MergingStrategy a
rootStrategy))
      forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterLazy.WriterT
      forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WriterLazy.runWriterT
  {-# INLINE liftRootStrategy #-}

instance
  (Mergeable s, Mergeable a, Mergeable1 m) =>
  Mergeable (WriterStrict.WriterT s m a)
  where
  rootStrategy :: MergingStrategy (WriterT s m a)
rootStrategy = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1) forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterStrict.WriterT forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WriterStrict.runWriterT
  {-# INLINE rootStrategy #-}

instance (Mergeable s, Mergeable1 m) => Mergeable1 (WriterStrict.WriterT s m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (WriterT s m a)
liftRootStrategy MergingStrategy a
m =
    forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy a
m forall a. Mergeable a => MergingStrategy a
rootStrategy))
      forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterStrict.WriterT
      forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WriterStrict.runWriterT
  {-# INLINE liftRootStrategy #-}

-- reader
instance
  (Mergeable a, Mergeable1 m) =>
  Mergeable (ReaderT s m a)
  where
  rootStrategy :: MergingStrategy (ReaderT s m a)
rootStrategy = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1) forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
  {-# INLINE rootStrategy #-}

instance (Mergeable1 m) => Mergeable1 (ReaderT s m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (ReaderT s m a)
liftRootStrategy MergingStrategy a
m =
    forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m))
      forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
      forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
  {-# INLINE liftRootStrategy #-}

-- Sum
instance
  (Mergeable1 l, Mergeable1 r, Mergeable x) =>
  Mergeable (Sum l r x)
  where
  rootStrategy :: MergingStrategy (Sum l r x)
rootStrategy =
    forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy
      ( \case
          InL l x
_ -> Bool
False
          InR r x
_ -> Bool
True
      )
      ( \case
          Bool
False -> forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1 forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (\case (InL l x
v) -> l x
v; Sum l r x
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
          Bool
True -> forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1 forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (\case (InR r x
v) -> r x
v; Sum l r x
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
      )
  {-# INLINE rootStrategy #-}

instance (Mergeable1 l, Mergeable1 r) => Mergeable1 (Sum l r) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (Sum l r a)
liftRootStrategy MergingStrategy a
m =
    forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy
      ( \case
          InL l a
_ -> Bool
False
          InR r a
_ -> Bool
True
      )
      ( \case
          Bool
False -> forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m) forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (\case (InL l a
v) -> l a
v; Sum l r a
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
          Bool
True -> forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m) forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (\case (InR r a
v) -> r a
v; Sum l r a
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
      )
  {-# INLINE liftRootStrategy #-}

-- Ordering
deriving via
  (Default Ordering)
  instance
    Mergeable Ordering

-- Generic
deriving via
  (Default (U1 x))
  instance
    Mergeable (U1 x)

deriving via
  (Default (V1 x))
  instance
    Mergeable (V1 x)

deriving via
  (Default (K1 i c x))
  instance
    (Mergeable c) => Mergeable (K1 i c x)

deriving via
  (Default (M1 i c a x))
  instance
    (Mergeable (a x)) => Mergeable (M1 i c a x)

deriving via
  (Default ((a :+: b) x))
  instance
    (Mergeable (a x), Mergeable (b x)) => Mergeable ((a :+: b) x)

deriving via
  (Default ((a :*: b) x))
  instance
    (Mergeable (a x), Mergeable (b x)) => Mergeable ((a :*: b) x)

-- Identity
instance (Mergeable a) => Mergeable (Identity a) where
  rootStrategy :: MergingStrategy (Identity a)
rootStrategy = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy forall a. Mergeable a => MergingStrategy a
rootStrategy forall a. a -> Identity a
Identity forall a. Identity a -> a
runIdentity
  {-# INLINE rootStrategy #-}

instance Mergeable1 Identity where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (Identity a)
liftRootStrategy MergingStrategy a
m = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy MergingStrategy a
m forall a. a -> Identity a
Identity forall a. Identity a -> a
runIdentity
  {-# INLINE liftRootStrategy #-}

-- IdentityT
instance (Mergeable1 m, Mergeable a) => Mergeable (IdentityT m a) where
  rootStrategy :: MergingStrategy (IdentityT m a)
rootStrategy = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1 forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT
  {-# INLINE rootStrategy #-}

instance (Mergeable1 m) => Mergeable1 (IdentityT m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (IdentityT m a)
liftRootStrategy MergingStrategy a
m = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m) forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT
  {-# INLINE liftRootStrategy #-}

-- ContT
instance (Mergeable1 m, Mergeable r) => Mergeable (ContT r m a) where
  rootStrategy :: MergingStrategy (ContT r m a)
rootStrategy =
    forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1)
      forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT
      (\(ContT (a -> m r) -> m r
v) -> (a -> m r) -> m r
v)
  {-# INLINE rootStrategy #-}

instance (Mergeable1 m, Mergeable r) => Mergeable1 (ContT r m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (ContT r m a)
liftRootStrategy MergingStrategy a
_ =
    forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1)
      forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT
      (\(ContT (a -> m r) -> m r
v) -> (a -> m r) -> m r
v)
  {-# INLINE liftRootStrategy #-}

-- RWS
instance
  (Mergeable s, Mergeable w, Mergeable a, Mergeable1 m) =>
  Mergeable (RWSLazy.RWST r w s m a)
  where
  rootStrategy :: MergingStrategy (RWST r w s m a)
rootStrategy = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1)) forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWSLazy.RWST (\(RWSLazy.RWST r -> s -> m (a, s, w)
m) -> r -> s -> m (a, s, w)
m)
  {-# INLINE rootStrategy #-}

instance
  (Mergeable s, Mergeable w, Mergeable1 m) =>
  Mergeable1 (RWSLazy.RWST r w s m)
  where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (RWST r w s m a)
liftRootStrategy MergingStrategy a
m =
    forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> * -> * -> *) a b c.
Mergeable3 u =>
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (u a b c)
liftRootStrategy3 MergingStrategy a
m forall a. Mergeable a => MergingStrategy a
rootStrategy forall a. Mergeable a => MergingStrategy a
rootStrategy))))
      forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWSLazy.RWST
      (\(RWSLazy.RWST r -> s -> m (a, s, w)
rws) -> r -> s -> m (a, s, w)
rws)
  {-# INLINE liftRootStrategy #-}

instance
  (Mergeable s, Mergeable w, Mergeable a, Mergeable1 m) =>
  Mergeable (RWSStrict.RWST r w s m a)
  where
  rootStrategy :: MergingStrategy (RWST r w s m a)
rootStrategy = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1)) forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWSStrict.RWST (\(RWSStrict.RWST r -> s -> m (a, s, w)
m) -> r -> s -> m (a, s, w)
m)
  {-# INLINE rootStrategy #-}

instance
  (Mergeable s, Mergeable w, Mergeable1 m) =>
  Mergeable1 (RWSStrict.RWST r w s m)
  where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (RWST r w s m a)
liftRootStrategy MergingStrategy a
m =
    forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (forall (u :: * -> * -> * -> *) a b c.
Mergeable3 u =>
MergingStrategy a
-> MergingStrategy b
-> MergingStrategy c
-> MergingStrategy (u a b c)
liftRootStrategy3 MergingStrategy a
m forall a. Mergeable a => MergingStrategy a
rootStrategy forall a. Mergeable a => MergingStrategy a
rootStrategy))))
      forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWSStrict.RWST
      (\(RWSStrict.RWST r -> s -> m (a, s, w)
rws) -> r -> s -> m (a, s, w)
rws)
  {-# INLINE liftRootStrategy #-}

-- Data.Monoid module
deriving via
  (Default (Monoid.Sum a))
  instance
    (Mergeable a) => Mergeable (Monoid.Sum a)

deriving via (Default1 Monoid.Sum) instance Mergeable1 Monoid.Sum

#define MERGEABLE_SIMPLE(symtype) \
instance Mergeable symtype where \
  rootStrategy = SimpleStrategy ites

#define MERGEABLE_BV(symtype) \
instance (KnownNat n, 1 <= n) => Mergeable (symtype n) where \
  rootStrategy = SimpleStrategy ites

#define MERGEABLE_BV_SOME(symtype) \
instance Mergeable symtype where \
  rootStrategy = SimpleStrategy ites

#define MERGEABLE_FUN(op) \
instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => Mergeable (sa op sb) where \
  rootStrategy = SimpleStrategy ites

#if 1
MERGEABLE_SIMPLE(SymBool)
MERGEABLE_SIMPLE(SymInteger)
MERGEABLE_BV(SymIntN)
MERGEABLE_BV(SymWordN)
MERGEABLE_BV_SOME(SomeSymIntN)
MERGEABLE_BV_SOME(SomeSymWordN)
MERGEABLE_FUN(=~>)
MERGEABLE_FUN(-~>)
#endif

-- Exceptions
instance Mergeable ArithException where
  rootStrategy :: MergingStrategy ArithException
rootStrategy =
    forall bool a.
(Ord bool, Typeable bool, Show bool) =>
(a -> bool) -> (bool -> MergingStrategy a) -> MergingStrategy a
SortedStrategy
      ( \case
          ArithException
Overflow -> Int
0 :: Int
          ArithException
Underflow -> Int
1 :: Int
          ArithException
LossOfPrecision -> Int
2 :: Int
          ArithException
DivideByZero -> Int
3 :: Int
          ArithException
Denormal -> Int
4 :: Int
          ArithException
RatioZeroDenominator -> Int
5 :: Int
      )
      (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy forall a b. (a -> b) -> a -> b
$ \SymBool
_ ArithException
l ArithException
r -> ArithException
l)

deriving via (Default BitwidthMismatch) instance (Mergeable BitwidthMismatch)