{-# LANGUAGE BangPatterns, CPP, DerivingStrategies, DerivingVia #-} {-# LANGUAGE GeneralizedNewtypeDeriving, MultiWayIf, StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} module Control.Subcategory.Semialign ( CSemialign(..), CAlign(..), csalign, cpadZip, cpadZipWith ) where import Control.Applicative (ZipList) import Control.Monad (forM_) import Control.Monad.ST.Strict (runST) import Control.Subcategory.Functor import Control.Subcategory.Wrapper.Internal import Data.Bifunctor (Bifunctor (bimap)) import Data.Coerce import Data.Containers import Data.Functor.Compose (Compose (..)) import Data.Functor.Identity (Identity) import qualified Data.Functor.Product as SOP import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import Data.IntMap.Strict (IntMap) import qualified Data.IntSet as IS import Data.List.NonEmpty (NonEmpty) import Data.Map (Map) import Data.MonoTraversable import qualified Data.Primitive.Array as A import qualified Data.Primitive.PrimArray as PA import qualified Data.Primitive.SmallArray as SA import Data.Proxy (Proxy) import Data.Semialign #if !MIN_VERSION_base(4,16,0) import Data.Semigroup (Option (..)) #endif import Data.Sequence (Seq) import qualified Data.Sequences as MT import Data.These (These (..), fromThese, mergeThese) import Data.Tree (Tree) import qualified Data.Vector as V import qualified Data.Vector.Primitive as P import qualified Data.Vector.Storable as S import qualified Data.Vector.Unboxed as U import GHC.Generics ((:*:) (..), (:.:) (..)) class CFunctor f => CSemialign f where {-# MINIMAL calignWith #-} calignWith :: (Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c calign :: (Dom f a, Dom f b, Dom f (These a b)) => f a -> f b -> f (These a b) {-# INLINE [1] calign #-} calign = (These a b -> These a b) -> f a -> f b -> f (These a b) forall a b c. (Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c forall (f :: * -> *) a b c. (CSemialign f, Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c calignWith These a b -> These a b forall a. a -> a id instance Semialign f => CSemialign (WrapFunctor f) where calignWith :: forall a b c. (Dom (WrapFunctor f) a, Dom (WrapFunctor f) b, Dom (WrapFunctor f) c) => (These a b -> c) -> WrapFunctor f a -> WrapFunctor f b -> WrapFunctor f c calignWith = (These a b -> c) -> WrapFunctor f a -> WrapFunctor f b -> WrapFunctor f c forall a b c. (These a b -> c) -> WrapFunctor f a -> WrapFunctor f b -> WrapFunctor f c forall (f :: * -> *) a b c. Semialign f => (These a b -> c) -> f a -> f b -> f c alignWith {-# INLINE [1] calignWith #-} calign :: forall a b. (Dom (WrapFunctor f) a, Dom (WrapFunctor f) b, Dom (WrapFunctor f) (These a b)) => WrapFunctor f a -> WrapFunctor f b -> WrapFunctor f (These a b) calign = WrapFunctor f a -> WrapFunctor f b -> WrapFunctor f (These a b) forall a b. WrapFunctor f a -> WrapFunctor f b -> WrapFunctor f (These a b) forall (f :: * -> *) a b. Semialign f => f a -> f b -> f (These a b) align {-# INLINE [1] calign #-} instance {-# OVERLAPPING #-} CSemialign (WrapMono IS.IntSet) where calignWith :: forall a b c. (Dom (WrapMono IntSet) a, Dom (WrapMono IntSet) b, Dom (WrapMono IntSet) c) => (These a b -> c) -> WrapMono IntSet a -> WrapMono IntSet b -> WrapMono IntSet c calignWith These a b -> c f = forall mono r. (Coercible (WrapMono mono (Element mono)) mono => r) -> r withMonoCoercible @IS.IntSet ((Coercible (WrapMono IntSet (Element IntSet)) IntSet => WrapMono IntSet a -> WrapMono IntSet b -> WrapMono IntSet c) -> WrapMono IntSet a -> WrapMono IntSet b -> WrapMono IntSet c) -> (Coercible (WrapMono IntSet (Element IntSet)) IntSet => WrapMono IntSet a -> WrapMono IntSet b -> WrapMono IntSet c) -> WrapMono IntSet a -> WrapMono IntSet b -> WrapMono IntSet c forall a b. (a -> b) -> a -> b $ forall a b. Coercible a b => a -> b forall a b. Coercible a b => a -> b coerce @(IS.IntSet -> IS.IntSet -> IS.IntSet) ((IntSet -> IntSet -> IntSet) -> WrapMono IntSet a -> WrapMono IntSet b -> WrapMono IntSet c) -> (IntSet -> IntSet -> IntSet) -> WrapMono IntSet a -> WrapMono IntSet b -> WrapMono IntSet c forall a b. (a -> b) -> a -> b $ \ IntSet l IntSet r -> let ints :: IntSet ints = IntSet l IntSet -> IntSet -> IntSet `IS.intersection` IntSet r in [IntSet] -> IntSet forall (f :: * -> *). Foldable f => f IntSet -> IntSet IS.unions [ (Int -> Int) -> IntSet -> IntSet IS.map (These a b -> c These a b -> Int f (These a b -> Int) -> (Int -> These a b) -> Int -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> These a b Int -> These Int b forall a b. a -> These a b This) IntSet l , (Int -> Int) -> IntSet -> IntSet IS.map (These a b -> c These a b -> Int f (These a b -> Int) -> (Int -> These a b) -> Int -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> These a b Int -> These a Int forall a b. b -> These a b That) IntSet r , (Int -> Int) -> IntSet -> IntSet IS.map (\Int x -> These a b -> c f (These a b -> c) -> These a b -> c forall a b. (a -> b) -> a -> b $ a -> b -> These a b forall a b. a -> b -> These a b These a Int x b Int x) IntSet ints ] {-# INLINE [1] calignWith #-} class CSemialign f => CAlign f where cnil :: Dom f a => f a instance Align f => CAlign (WrapFunctor f) where cnil :: forall a. Dom (WrapFunctor f) a => WrapFunctor f a cnil = f a -> WrapFunctor f a forall (f :: * -> *) a. f a -> WrapFunctor f a WrapFunctor f a forall a. f a forall (f :: * -> *) a. Align f => f a nil {-# INLINE [1] cnil #-} deriving via WrapFunctor [] instance CSemialign [] deriving via WrapFunctor [] instance CAlign [] deriving via WrapFunctor Maybe instance CSemialign Maybe deriving via WrapFunctor Maybe instance CAlign Maybe #if !MIN_VERSION_base(4,16,0) #if MIN_VERSION_semialign(1,1,0) deriving via WrapFunctor Option instance CSemialign Option deriving via WrapFunctor Option instance CAlign Option #else deriving newtype instance CSemialign Option deriving newtype instance CAlign Option #endif #endif deriving via WrapFunctor ZipList instance CSemialign ZipList deriving via WrapFunctor ZipList instance CAlign ZipList deriving via WrapFunctor Identity instance CSemialign Identity deriving via WrapFunctor NonEmpty instance CSemialign NonEmpty deriving via WrapFunctor IntMap instance CSemialign IntMap deriving via WrapFunctor IntMap instance CAlign IntMap deriving via WrapFunctor Tree instance CSemialign Tree deriving via WrapFunctor Seq instance CSemialign Seq deriving via WrapFunctor Seq instance CAlign Seq deriving via WrapFunctor V.Vector instance CSemialign V.Vector deriving via WrapFunctor V.Vector instance CAlign V.Vector deriving via WrapFunctor Proxy instance CSemialign Proxy deriving via WrapFunctor Proxy instance CAlign Proxy deriving via WrapFunctor (Map k) instance Ord k => CSemialign (Map k) deriving via WrapFunctor (Map k) instance Ord k => CAlign (Map k) deriving via WrapFunctor (HashMap k) instance (Eq k, Hashable k) => CSemialign (HashMap k) deriving via WrapFunctor (HashMap k) instance (Eq k, Hashable k) => CAlign (HashMap k) deriving via WrapFunctor ((->) s) instance CSemialign ((->) s) instance (CSemialign f, CSemialign g) => CSemialign (SOP.Product f g) where calign :: forall a b. (Dom (Product f g) a, Dom (Product f g) b, Dom (Product f g) (These a b)) => Product f g a -> Product f g b -> Product f g (These a b) calign (SOP.Pair f a a g a b) (SOP.Pair f b c g b d) = f (These a b) -> g (These a b) -> Product f g (These a b) forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> g a -> Product f g a SOP.Pair (f a -> f b -> f (These a b) forall a b. (Dom f a, Dom f b, Dom f (These a b)) => f a -> f b -> f (These a b) forall (f :: * -> *) a b. (CSemialign f, Dom f a, Dom f b, Dom f (These a b)) => f a -> f b -> f (These a b) calign f a a f b c) (g a -> g b -> g (These a b) forall a b. (Dom g a, Dom g b, Dom g (These a b)) => g a -> g b -> g (These a b) forall (f :: * -> *) a b. (CSemialign f, Dom f a, Dom f b, Dom f (These a b)) => f a -> f b -> f (These a b) calign g a b g b d) {-# INLINE [1] calign #-} calignWith :: forall a b c. (Dom (Product f g) a, Dom (Product f g) b, Dom (Product f g) c) => (These a b -> c) -> Product f g a -> Product f g b -> Product f g c calignWith These a b -> c f (SOP.Pair f a a g a b) (SOP.Pair f b c g b d) = f c -> g c -> Product f g c forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> g a -> Product f g a SOP.Pair ((These a b -> c) -> f a -> f b -> f c forall a b c. (Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c forall (f :: * -> *) a b c. (CSemialign f, Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c calignWith These a b -> c f f a a f b c) ((These a b -> c) -> g a -> g b -> g c forall a b c. (Dom g a, Dom g b, Dom g c) => (These a b -> c) -> g a -> g b -> g c forall (f :: * -> *) a b c. (CSemialign f, Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c calignWith These a b -> c f g a b g b d) {-# INLINE [1] calignWith #-} instance (CAlign f, CAlign g) => CAlign (SOP.Product f g) where cnil :: forall a. Dom (Product f g) a => Product f g a cnil = f a -> g a -> Product f g a forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> g a -> Product f g a SOP.Pair f a forall a. Dom f a => f a forall (f :: * -> *) a. (CAlign f, Dom f a) => f a cnil g a forall a. Dom g a => g a forall (f :: * -> *) a. (CAlign f, Dom f a) => f a cnil {-# INLINE [1] cnil #-} instance (CSemialign f, CSemialign g) => CSemialign (f :*: g) where calign :: forall a b. (Dom (f :*: g) a, Dom (f :*: g) b, Dom (f :*: g) (These a b)) => (:*:) f g a -> (:*:) f g b -> (:*:) f g (These a b) calign ((:*:) f a a g a b) ((:*:) f b c g b d) = f (These a b) -> g (These a b) -> (:*:) f g (These a b) forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> g p -> (:*:) f g p (:*:) (f a -> f b -> f (These a b) forall a b. (Dom f a, Dom f b, Dom f (These a b)) => f a -> f b -> f (These a b) forall (f :: * -> *) a b. (CSemialign f, Dom f a, Dom f b, Dom f (These a b)) => f a -> f b -> f (These a b) calign f a a f b c) (g a -> g b -> g (These a b) forall a b. (Dom g a, Dom g b, Dom g (These a b)) => g a -> g b -> g (These a b) forall (f :: * -> *) a b. (CSemialign f, Dom f a, Dom f b, Dom f (These a b)) => f a -> f b -> f (These a b) calign g a b g b d) {-# INLINE [1] calign #-} calignWith :: forall a b c. (Dom (f :*: g) a, Dom (f :*: g) b, Dom (f :*: g) c) => (These a b -> c) -> (:*:) f g a -> (:*:) f g b -> (:*:) f g c calignWith These a b -> c f ((:*:) f a a g a b) ((:*:) f b c g b d) = f c -> g c -> (:*:) f g c forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> g p -> (:*:) f g p (:*:) ((These a b -> c) -> f a -> f b -> f c forall a b c. (Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c forall (f :: * -> *) a b c. (CSemialign f, Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c calignWith These a b -> c f f a a f b c) ((These a b -> c) -> g a -> g b -> g c forall a b c. (Dom g a, Dom g b, Dom g c) => (These a b -> c) -> g a -> g b -> g c forall (f :: * -> *) a b c. (CSemialign f, Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c calignWith These a b -> c f g a b g b d) {-# INLINE [1] calignWith #-} instance (CAlign f, CAlign g) => CAlign (f :*: g) where cnil :: forall a. Dom (f :*: g) a => (:*:) f g a cnil = f a forall a. Dom f a => f a forall (f :: * -> *) a. (CAlign f, Dom f a) => f a cnil f a -> g a -> (:*:) f g a forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> g p -> (:*:) f g p :*: g a forall a. Dom g a => g a forall (f :: * -> *) a. (CAlign f, Dom f a) => f a cnil {-# INLINE [1] cnil #-} instance (CSemialign f, CSemialign g) => CSemialign (Compose f g) where calignWith :: forall a b c. (Dom (Compose f g) a, Dom (Compose f g) b, Dom (Compose f g) c) => (These a b -> c) -> Compose f g a -> Compose f g b -> Compose f g c calignWith These a b -> c f (Compose f (g a) x) (Compose f (g b) y) = f (g c) -> Compose f g c forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1). f (g a) -> Compose f g a Compose ((These (g a) (g b) -> g c) -> f (g a) -> f (g b) -> f (g c) forall a b c. (Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c forall (f :: * -> *) a b c. (CSemialign f, Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c calignWith These (g a) (g b) -> g c g f (g a) x f (g b) y) where g :: These (g a) (g b) -> g c g (This g a ga) = (a -> c) -> g a -> g c forall a b. (Dom g a, Dom g b) => (a -> b) -> g a -> g b forall (f :: * -> *) a b. (CFunctor f, Dom f a, Dom f b) => (a -> b) -> f a -> f b cmap (These a b -> c f (These a b -> c) -> (a -> These a b) -> a -> c forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> These a b forall a b. a -> These a b This) g a ga g (That g b gb) = (b -> c) -> g b -> g c forall a b. (Dom g a, Dom g b) => (a -> b) -> g a -> g b forall (f :: * -> *) a b. (CFunctor f, Dom f a, Dom f b) => (a -> b) -> f a -> f b cmap (These a b -> c f (These a b -> c) -> (b -> These a b) -> b -> c forall b c a. (b -> c) -> (a -> b) -> a -> c . b -> These a b forall a b. b -> These a b That) g b gb g (These g a ga g b gb) = (These a b -> c) -> g a -> g b -> g c forall a b c. (Dom g a, Dom g b, Dom g c) => (These a b -> c) -> g a -> g b -> g c forall (f :: * -> *) a b c. (CSemialign f, Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c calignWith These a b -> c f g a ga g b gb {-# INLINE [1] calignWith #-} instance (CAlign f, CSemialign g) => CAlign (Compose f g) where cnil :: forall a. Dom (Compose f g) a => Compose f g a cnil = f (g a) -> Compose f g a forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1). f (g a) -> Compose f g a Compose f (g a) forall a. Dom f a => f a forall (f :: * -> *) a. (CAlign f, Dom f a) => f a cnil {-# INLINE [1] cnil #-} instance (CSemialign f, CSemialign g) => CSemialign ((:.:) f g) where calignWith :: forall a b c. (Dom (f :.: g) a, Dom (f :.: g) b, Dom (f :.: g) c) => (These a b -> c) -> (:.:) f g a -> (:.:) f g b -> (:.:) f g c calignWith These a b -> c f (Comp1 f (g a) x) (Comp1 f (g b) y) = f (g c) -> (:.:) f g c forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). f (g p) -> (:.:) f g p Comp1 ((These (g a) (g b) -> g c) -> f (g a) -> f (g b) -> f (g c) forall a b c. (Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c forall (f :: * -> *) a b c. (CSemialign f, Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c calignWith These (g a) (g b) -> g c g f (g a) x f (g b) y) where g :: These (g a) (g b) -> g c g (This g a ga) = (a -> c) -> g a -> g c forall a b. (Dom g a, Dom g b) => (a -> b) -> g a -> g b forall (f :: * -> *) a b. (CFunctor f, Dom f a, Dom f b) => (a -> b) -> f a -> f b cmap (These a b -> c f (These a b -> c) -> (a -> These a b) -> a -> c forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> These a b forall a b. a -> These a b This) g a ga g (That g b gb) = (b -> c) -> g b -> g c forall a b. (Dom g a, Dom g b) => (a -> b) -> g a -> g b forall (f :: * -> *) a b. (CFunctor f, Dom f a, Dom f b) => (a -> b) -> f a -> f b cmap (These a b -> c f (These a b -> c) -> (b -> These a b) -> b -> c forall b c a. (b -> c) -> (a -> b) -> a -> c . b -> These a b forall a b. b -> These a b That) g b gb g (These g a ga g b gb) = (These a b -> c) -> g a -> g b -> g c forall a b c. (Dom g a, Dom g b, Dom g c) => (These a b -> c) -> g a -> g b -> g c forall (f :: * -> *) a b c. (CSemialign f, Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c calignWith These a b -> c f g a ga g b gb {-# INLINE [1] calignWith #-} instance (CAlign f, CSemialign g) => CAlign ((:.:) f g) where cnil :: forall a. Dom (f :.: g) a => (:.:) f g a cnil = f (g a) -> (:.:) f g a forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). f (g p) -> (:.:) f g p Comp1 f (g a) forall a. Dom f a => f a forall (f :: * -> *) a. (CAlign f, Dom f a) => f a cnil {-# INLINE [1] cnil #-} instance CSemialign U.Vector where calignWith :: forall a b c. (Dom Vector a, Dom Vector b, Dom Vector c) => (These a b -> c) -> Vector a -> Vector b -> Vector c calignWith = (These a b -> c) -> Vector a -> Vector b -> Vector c forall (v :: * -> *) a b c. (Vector v a, Vector v b, Vector v c) => (These a b -> c) -> v a -> v b -> v c alignVectorWith {-# INLINE [1] calignWith #-} instance CAlign U.Vector where cnil :: forall a. Dom Vector a => Vector a cnil = Vector a forall a. Unbox a => Vector a U.empty {-# INLINE [1] cnil #-} instance CSemialign S.Vector where calignWith :: forall a b c. (Dom Vector a, Dom Vector b, Dom Vector c) => (These a b -> c) -> Vector a -> Vector b -> Vector c calignWith = (These a b -> c) -> Vector a -> Vector b -> Vector c forall (v :: * -> *) a b c. (Vector v a, Vector v b, Vector v c) => (These a b -> c) -> v a -> v b -> v c alignVectorWith {-# INLINE [1] calignWith #-} instance CAlign S.Vector where cnil :: forall a. Dom Vector a => Vector a cnil = Vector a forall a. Storable a => Vector a S.empty {-# INLINE [1] cnil #-} instance CSemialign P.Vector where calignWith :: forall a b c. (Dom Vector a, Dom Vector b, Dom Vector c) => (These a b -> c) -> Vector a -> Vector b -> Vector c calignWith = (These a b -> c) -> Vector a -> Vector b -> Vector c forall (v :: * -> *) a b c. (Vector v a, Vector v b, Vector v c) => (These a b -> c) -> v a -> v b -> v c alignVectorWith {-# INLINE [1] calignWith #-} instance CAlign P.Vector where cnil :: forall a. Dom Vector a => Vector a cnil = Vector a forall a. Prim a => Vector a P.empty {-# INLINE [1] cnil #-} instance CSemialign SA.SmallArray where calignWith :: forall a b c. (Dom SmallArray a, Dom SmallArray b, Dom SmallArray c) => (These a b -> c) -> SmallArray a -> SmallArray b -> SmallArray c calignWith These a b -> c f SmallArray a l SmallArray b r = (forall s. ST s (SmallArray c)) -> SmallArray c forall a. (forall s. ST s a) -> a runST ((forall s. ST s (SmallArray c)) -> SmallArray c) -> (forall s. ST s (SmallArray c)) -> SmallArray c forall a b. (a -> b) -> a -> b $ do let !lenL :: Int lenL = SmallArray a -> Int forall a. SmallArray a -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length SmallArray a l !lenR :: Int lenR = SmallArray b -> Int forall a. SmallArray a -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length SmallArray b r (Bool isLftShort, Int thresh, Int len) | Int lenL Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int lenR = (Bool True, Int lenL, Int lenR) | Bool otherwise = (Bool False, Int lenR, Int lenL) SmallMutableArray s c sa <- Int -> c -> ST s (SmallMutableArray (PrimState (ST s)) c) forall (m :: * -> *) a. PrimMonad m => Int -> a -> m (SmallMutableArray (PrimState m) a) SA.newSmallArray Int len ([Char] -> c forall a. HasCallStack => [Char] -> a error [Char] "Uninitialised element") [Int] -> (Int -> ST s ()) -> ST s () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ [Int 0..Int lenInt -> Int -> Int forall a. Num a => a -> a -> a -Int 1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s () forall a b. (a -> b) -> a -> b $ \Int n -> if | Int n Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int len -> () -> ST s () forall a. a -> ST s a forall (f :: * -> *) a. Applicative f => a -> f a pure () | Int n Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int thresh -> SmallMutableArray (PrimState (ST s)) c -> Int -> c -> ST s () forall (m :: * -> *) a. PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> a -> m () SA.writeSmallArray SmallMutableArray s c SmallMutableArray (PrimState (ST s)) c sa Int n (c -> ST s ()) -> c -> ST s () forall a b. (a -> b) -> a -> b $ These a b -> c f (These a b -> c) -> These a b -> c forall a b. (a -> b) -> a -> b $ a -> b -> These a b forall a b. a -> b -> These a b These (SmallArray a -> Int -> a forall a. SmallArray a -> Int -> a SA.indexSmallArray SmallArray a l Int n) (SmallArray b -> Int -> b forall a. SmallArray a -> Int -> a SA.indexSmallArray SmallArray b r Int n) | Bool isLftShort -> SmallMutableArray (PrimState (ST s)) c -> Int -> c -> ST s () forall (m :: * -> *) a. PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> a -> m () SA.writeSmallArray SmallMutableArray s c SmallMutableArray (PrimState (ST s)) c sa Int n (c -> ST s ()) -> c -> ST s () forall a b. (a -> b) -> a -> b $ These a b -> c f (These a b -> c) -> These a b -> c forall a b. (a -> b) -> a -> b $ b -> These a b forall a b. b -> These a b That (b -> These a b) -> b -> These a b forall a b. (a -> b) -> a -> b $ SmallArray b -> Int -> b forall a. SmallArray a -> Int -> a SA.indexSmallArray SmallArray b r Int n | Bool otherwise -> SmallMutableArray (PrimState (ST s)) c -> Int -> c -> ST s () forall (m :: * -> *) a. PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> a -> m () SA.writeSmallArray SmallMutableArray s c SmallMutableArray (PrimState (ST s)) c sa Int n (c -> ST s ()) -> c -> ST s () forall a b. (a -> b) -> a -> b $ These a b -> c f (These a b -> c) -> These a b -> c forall a b. (a -> b) -> a -> b $ a -> These a b forall a b. a -> These a b This (a -> These a b) -> a -> These a b forall a b. (a -> b) -> a -> b $ SmallArray a -> Int -> a forall a. SmallArray a -> Int -> a SA.indexSmallArray SmallArray a l Int n SmallMutableArray (PrimState (ST s)) c -> ST s (SmallArray c) forall (m :: * -> *) a. PrimMonad m => SmallMutableArray (PrimState m) a -> m (SmallArray a) SA.unsafeFreezeSmallArray SmallMutableArray s c SmallMutableArray (PrimState (ST s)) c sa {-# INLINE [1] calignWith #-} instance CAlign SA.SmallArray where cnil :: forall a. Dom SmallArray a => SmallArray a cnil = Int -> [a] -> SmallArray a forall a. Int -> [a] -> SmallArray a SA.smallArrayFromListN Int 0 [] {-# INLINE [1] cnil #-} instance CSemialign A.Array where calignWith :: forall a b c. (Dom Array a, Dom Array b, Dom Array c) => (These a b -> c) -> Array a -> Array b -> Array c calignWith These a b -> c f Array a l Array b r = (forall s. ST s (Array c)) -> Array c forall a. (forall s. ST s a) -> a runST ((forall s. ST s (Array c)) -> Array c) -> (forall s. ST s (Array c)) -> Array c forall a b. (a -> b) -> a -> b $ do let !lenL :: Int lenL = Array a -> Int forall a. Array a -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length Array a l !lenR :: Int lenR = Array b -> Int forall a. Array a -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length Array b r (Bool isLftShort, Int thresh, Int len) | Int lenL Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int lenR = (Bool True, Int lenL, Int lenR) | Bool otherwise = (Bool False, Int lenR, Int lenL) MutableArray s c sa <- Int -> c -> ST s (MutableArray (PrimState (ST s)) c) forall (m :: * -> *) a. PrimMonad m => Int -> a -> m (MutableArray (PrimState m) a) A.newArray Int len ([Char] -> c forall a. HasCallStack => [Char] -> a error [Char] "Uninitialised element") [Int] -> (Int -> ST s ()) -> ST s () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ [Int 0..Int lenInt -> Int -> Int forall a. Num a => a -> a -> a -Int 1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s () forall a b. (a -> b) -> a -> b $ \Int n -> if | Int n Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int len -> () -> ST s () forall a. a -> ST s a forall (f :: * -> *) a. Applicative f => a -> f a pure () | Int n Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int thresh -> MutableArray (PrimState (ST s)) c -> Int -> c -> ST s () forall (m :: * -> *) a. PrimMonad m => MutableArray (PrimState m) a -> Int -> a -> m () A.writeArray MutableArray s c MutableArray (PrimState (ST s)) c sa Int n (c -> ST s ()) -> c -> ST s () forall a b. (a -> b) -> a -> b $ These a b -> c f (These a b -> c) -> These a b -> c forall a b. (a -> b) -> a -> b $ a -> b -> These a b forall a b. a -> b -> These a b These (Array a -> Int -> a forall a. Array a -> Int -> a A.indexArray Array a l Int n) (Array b -> Int -> b forall a. Array a -> Int -> a A.indexArray Array b r Int n) | Bool isLftShort -> MutableArray (PrimState (ST s)) c -> Int -> c -> ST s () forall (m :: * -> *) a. PrimMonad m => MutableArray (PrimState m) a -> Int -> a -> m () A.writeArray MutableArray s c MutableArray (PrimState (ST s)) c sa Int n (c -> ST s ()) -> c -> ST s () forall a b. (a -> b) -> a -> b $ These a b -> c f (These a b -> c) -> These a b -> c forall a b. (a -> b) -> a -> b $ b -> These a b forall a b. b -> These a b That (b -> These a b) -> b -> These a b forall a b. (a -> b) -> a -> b $ Array b -> Int -> b forall a. Array a -> Int -> a A.indexArray Array b r Int n | Bool otherwise -> MutableArray (PrimState (ST s)) c -> Int -> c -> ST s () forall (m :: * -> *) a. PrimMonad m => MutableArray (PrimState m) a -> Int -> a -> m () A.writeArray MutableArray s c MutableArray (PrimState (ST s)) c sa Int n (c -> ST s ()) -> c -> ST s () forall a b. (a -> b) -> a -> b $ These a b -> c f (These a b -> c) -> These a b -> c forall a b. (a -> b) -> a -> b $ a -> These a b forall a b. a -> These a b This (a -> These a b) -> a -> These a b forall a b. (a -> b) -> a -> b $ Array a -> Int -> a forall a. Array a -> Int -> a A.indexArray Array a l Int n MutableArray (PrimState (ST s)) c -> ST s (Array c) forall (m :: * -> *) a. PrimMonad m => MutableArray (PrimState m) a -> m (Array a) A.unsafeFreezeArray MutableArray s c MutableArray (PrimState (ST s)) c sa {-# INLINE [1] calignWith #-} instance CAlign A.Array where #if MIN_VERSION_primitive(0,9,0) cnil :: forall a. Dom Array a => Array a cnil = Int -> [a] -> Array a forall a. Int -> [a] -> Array a A.arrayFromListN Int 0 [] #else cnil = A.fromListN 0 [] #endif {-# INLINE [1] cnil #-} instance CSemialign PA.PrimArray where calignWith :: forall a b c. (Dom PrimArray a, Dom PrimArray b, Dom PrimArray c) => (These a b -> c) -> PrimArray a -> PrimArray b -> PrimArray c calignWith These a b -> c f PrimArray a l PrimArray b r = (forall s. ST s (PrimArray c)) -> PrimArray c forall a. (forall s. ST s a) -> a runST ((forall s. ST s (PrimArray c)) -> PrimArray c) -> (forall s. ST s (PrimArray c)) -> PrimArray c forall a b. (a -> b) -> a -> b $ do let !lenL :: Int lenL = PrimArray a -> Int forall a. Prim a => PrimArray a -> Int PA.sizeofPrimArray PrimArray a l !lenR :: Int lenR = PrimArray b -> Int forall a. Prim a => PrimArray a -> Int PA.sizeofPrimArray PrimArray b r (Bool isLftShort, Int thresh, Int len) | Int lenL Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int lenR = (Bool True, Int lenL, Int lenR) | Bool otherwise = (Bool False, Int lenR, Int lenL) MutablePrimArray s c sa <- Int -> ST s (MutablePrimArray (PrimState (ST s)) c) forall (m :: * -> *) a. (PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a) PA.newPrimArray Int len [Int] -> (Int -> ST s ()) -> ST s () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ [Int 0..Int lenInt -> Int -> Int forall a. Num a => a -> a -> a -Int 1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s () forall a b. (a -> b) -> a -> b $ \Int n -> if | Int n Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int len -> () -> ST s () forall a. a -> ST s a forall (f :: * -> *) a. Applicative f => a -> f a pure () | Int n Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int thresh -> MutablePrimArray (PrimState (ST s)) c -> Int -> c -> ST s () forall a (m :: * -> *). (Prim a, PrimMonad m) => MutablePrimArray (PrimState m) a -> Int -> a -> m () PA.writePrimArray MutablePrimArray s c MutablePrimArray (PrimState (ST s)) c sa Int n (c -> ST s ()) -> c -> ST s () forall a b. (a -> b) -> a -> b $ These a b -> c f (These a b -> c) -> These a b -> c forall a b. (a -> b) -> a -> b $ a -> b -> These a b forall a b. a -> b -> These a b These (PrimArray a -> Int -> a forall a. Prim a => PrimArray a -> Int -> a PA.indexPrimArray PrimArray a l Int n) (PrimArray b -> Int -> b forall a. Prim a => PrimArray a -> Int -> a PA.indexPrimArray PrimArray b r Int n) | Bool isLftShort -> MutablePrimArray (PrimState (ST s)) c -> Int -> c -> ST s () forall a (m :: * -> *). (Prim a, PrimMonad m) => MutablePrimArray (PrimState m) a -> Int -> a -> m () PA.writePrimArray MutablePrimArray s c MutablePrimArray (PrimState (ST s)) c sa Int n (c -> ST s ()) -> c -> ST s () forall a b. (a -> b) -> a -> b $ These a b -> c f (These a b -> c) -> These a b -> c forall a b. (a -> b) -> a -> b $ b -> These a b forall a b. b -> These a b That (b -> These a b) -> b -> These a b forall a b. (a -> b) -> a -> b $ PrimArray b -> Int -> b forall a. Prim a => PrimArray a -> Int -> a PA.indexPrimArray PrimArray b r Int n | Bool otherwise -> MutablePrimArray (PrimState (ST s)) c -> Int -> c -> ST s () forall a (m :: * -> *). (Prim a, PrimMonad m) => MutablePrimArray (PrimState m) a -> Int -> a -> m () PA.writePrimArray MutablePrimArray s c MutablePrimArray (PrimState (ST s)) c sa Int n (c -> ST s ()) -> c -> ST s () forall a b. (a -> b) -> a -> b $ These a b -> c f (These a b -> c) -> These a b -> c forall a b. (a -> b) -> a -> b $ a -> These a b forall a b. a -> These a b This (a -> These a b) -> a -> These a b forall a b. (a -> b) -> a -> b $ PrimArray a -> Int -> a forall a. Prim a => PrimArray a -> Int -> a PA.indexPrimArray PrimArray a l Int n MutablePrimArray (PrimState (ST s)) c -> ST s (PrimArray c) forall (m :: * -> *) a. PrimMonad m => MutablePrimArray (PrimState m) a -> m (PrimArray a) PA.unsafeFreezePrimArray MutablePrimArray s c MutablePrimArray (PrimState (ST s)) c sa {-# INLINE [1] calignWith #-} instance CAlign PA.PrimArray where cnil :: forall a. Dom PrimArray a => PrimArray a cnil = Int -> [a] -> PrimArray a forall a. Prim a => Int -> [a] -> PrimArray a PA.primArrayFromListN Int 0 [] {-# INLINE [1] cnil #-} instance (MT.IsSequence mono, MonoZip mono) => CSemialign (WrapMono mono) where calignWith :: forall a b c. (Dom (WrapMono mono) a, Dom (WrapMono mono) b, Dom (WrapMono mono) c) => (These a b -> c) -> WrapMono mono a -> WrapMono mono b -> WrapMono mono c calignWith These a b -> c f = (mono -> mono -> mono) -> WrapMono mono a -> WrapMono mono b -> WrapMono mono c forall a b. Coercible a b => a -> b coerce mono -> mono -> mono go where go :: mono -> mono -> mono go :: mono -> mono -> mono go mono ls mono rs | Int lenL Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int lenR = (Element mono -> Element mono -> Element mono) -> mono -> mono -> mono forall mono. MonoZip mono => (Element mono -> Element mono -> Element mono) -> mono -> mono -> mono ozipWith ((These a b -> c) -> (a -> These a b) -> a -> c forall a b. (a -> b) -> (a -> a) -> a -> b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap These a b -> c f ((a -> These a b) -> a -> c) -> (a -> a -> These a b) -> a -> a -> c forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> a -> These a a a -> a -> These a b forall a b. a -> b -> These a b These) mono ls mono rs | Int lenL Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int lenR = (Element mono -> Element mono -> Element mono) -> mono -> mono -> mono forall mono. MonoZip mono => (Element mono -> Element mono -> Element mono) -> mono -> mono -> mono ozipWith ((These a b -> c) -> (a -> These a b) -> a -> c forall a b. (a -> b) -> (a -> a) -> a -> b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap These a b -> c f ((a -> These a b) -> a -> c) -> (a -> a -> These a b) -> a -> a -> c forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> a -> These a a a -> a -> These a b forall a b. a -> b -> These a b These) mono ls mono rs mono -> mono -> mono forall a. Semigroup a => a -> a -> a <> (Element mono -> Element mono) -> mono -> mono forall mono. MonoFunctor mono => (Element mono -> Element mono) -> mono -> mono omap (These a b -> c f (These a b -> c) -> (b -> These a b) -> b -> c forall b c a. (b -> c) -> (a -> b) -> a -> c . b -> These a b forall a b. b -> These a b That) (Index mono -> mono -> mono forall seq. IsSequence seq => Index seq -> seq -> seq MT.drop (Int -> Index mono forall a b. (Integral a, Num b) => a -> b fromIntegral Int lenL) mono rs) | Bool otherwise = (Element mono -> Element mono -> Element mono) -> mono -> mono -> mono forall mono. MonoZip mono => (Element mono -> Element mono -> Element mono) -> mono -> mono -> mono ozipWith ((These a b -> c) -> (a -> These a b) -> a -> c forall a b. (a -> b) -> (a -> a) -> a -> b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap These a b -> c f ((a -> These a b) -> a -> c) -> (a -> a -> These a b) -> a -> a -> c forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> a -> These a a a -> a -> These a b forall a b. a -> b -> These a b These) mono ls mono rs mono -> mono -> mono forall a. Semigroup a => a -> a -> a <> (Element mono -> Element mono) -> mono -> mono forall mono. MonoFunctor mono => (Element mono -> Element mono) -> mono -> mono omap (These a b -> c f (These a b -> c) -> (a -> These a b) -> a -> c forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> These a b forall a b. a -> These a b This) (Index mono -> mono -> mono forall seq. IsSequence seq => Index seq -> seq -> seq MT.drop (Int -> Index mono forall a b. (Integral a, Num b) => a -> b fromIntegral Int lenL) mono ls) where lenL :: Int lenL = mono -> Int forall mono. MonoFoldable mono => mono -> Int olength mono ls lenR :: Int lenR = mono -> Int forall mono. MonoFoldable mono => mono -> Int olength mono rs instance (MT.IsSequence mono, MonoZip mono) => CAlign (WrapMono mono) where cnil :: forall a. Dom (WrapMono mono) a => WrapMono mono a cnil = mono -> WrapMono mono a forall b mono. (b ~ Element mono, b ~ Element mono) => mono -> WrapMono mono b WrapMono mono forall a. Monoid a => a mempty csalign :: (CSemialign f, Dom f a, Semigroup a) => f a -> f a -> f a {-# INLINE [1] csalign #-} csalign :: forall (f :: * -> *) a. (CSemialign f, Dom f a, Semigroup a) => f a -> f a -> f a csalign = (These a a -> a) -> f a -> f a -> f a forall a b c. (Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c forall (f :: * -> *) a b c. (CSemialign f, Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c calignWith ((These a a -> a) -> f a -> f a -> f a) -> (These a a -> a) -> f a -> f a -> f a forall a b. (a -> b) -> a -> b $ (a -> a -> a) -> These a a -> a forall a. (a -> a -> a) -> These a a -> a mergeThese a -> a -> a forall a. Semigroup a => a -> a -> a (<>) cpadZip :: (CSemialign f, Dom f a, Dom f b, Dom f (Maybe a, Maybe b)) => f a -> f b -> f (Maybe a, Maybe b) {-# INLINE [1] cpadZip #-} cpadZip :: forall (f :: * -> *) a b. (CSemialign f, Dom f a, Dom f b, Dom f (Maybe a, Maybe b)) => f a -> f b -> f (Maybe a, Maybe b) cpadZip = (These a b -> (Maybe a, Maybe b)) -> f a -> f b -> f (Maybe a, Maybe b) forall a b c. (Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c forall (f :: * -> *) a b c. (CSemialign f, Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c calignWith (Maybe a -> Maybe b -> These (Maybe a) (Maybe b) -> (Maybe a, Maybe b) forall a b. a -> b -> These a b -> (a, b) fromThese Maybe a forall a. Maybe a Nothing Maybe b forall a. Maybe a Nothing (These (Maybe a) (Maybe b) -> (Maybe a, Maybe b)) -> (These a b -> These (Maybe a) (Maybe b)) -> These a b -> (Maybe a, Maybe b) forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> Maybe a) -> (b -> Maybe b) -> These a b -> These (Maybe a) (Maybe b) forall a b c d. (a -> b) -> (c -> d) -> These a c -> These b d forall (p :: * -> * -> *) a b c d. Bifunctor p => (a -> b) -> (c -> d) -> p a c -> p b d bimap a -> Maybe a forall a. a -> Maybe a Just b -> Maybe b forall a. a -> Maybe a Just) cpadZipWith :: (CSemialign f, Dom f a, Dom f b, Dom f c) => (Maybe a -> Maybe b -> c) -> f a -> f b -> f c {-# INLINE [1] cpadZipWith #-} cpadZipWith :: forall (f :: * -> *) a b c. (CSemialign f, Dom f a, Dom f b, Dom f c) => (Maybe a -> Maybe b -> c) -> f a -> f b -> f c cpadZipWith Maybe a -> Maybe b -> c f = (These a b -> c) -> f a -> f b -> f c forall a b c. (Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c forall (f :: * -> *) a b c. (CSemialign f, Dom f a, Dom f b, Dom f c) => (These a b -> c) -> f a -> f b -> f c calignWith ((These a b -> c) -> f a -> f b -> f c) -> (These a b -> c) -> f a -> f b -> f c forall a b. (a -> b) -> a -> b $ (Maybe a -> Maybe b -> c) -> (Maybe a, Maybe b) -> c forall a b c. (a -> b -> c) -> (a, b) -> c uncurry Maybe a -> Maybe b -> c f ((Maybe a, Maybe b) -> c) -> (These a b -> (Maybe a, Maybe b)) -> These a b -> c forall b c a. (b -> c) -> (a -> b) -> a -> c . Maybe a -> Maybe b -> These (Maybe a) (Maybe b) -> (Maybe a, Maybe b) forall a b. a -> b -> These a b -> (a, b) fromThese Maybe a forall a. Maybe a Nothing Maybe b forall a. Maybe a Nothing (These (Maybe a) (Maybe b) -> (Maybe a, Maybe b)) -> (These a b -> These (Maybe a) (Maybe b)) -> These a b -> (Maybe a, Maybe b) forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> Maybe a) -> (b -> Maybe b) -> These a b -> These (Maybe a) (Maybe b) forall a b c d. (a -> b) -> (c -> d) -> These a c -> These b d forall (p :: * -> * -> *) a b c d. Bifunctor p => (a -> b) -> (c -> d) -> p a c -> p b d bimap a -> Maybe a forall a. a -> Maybe a Just b -> Maybe b forall a. a -> Maybe a Just