{-# LANGUAGE PatternSynonyms #-}

-- | One-shot endomorphisms

-- One-shot endomorphisms
-- Like GHC.Internal.Data.Semigroup.Internal.Endo, but using
-- the one-shot trick from
--    Note [The one-shot state monad trick] in  GHC.Utils.Monad.
--
-- It is also strict: see the (<>) method in he Semigroup instance

module GHC.Utils.EndoOS( EndoOS(EndoOS, runEndoOS ) ) where

import GHC.Prelude

import Data.Semigroup
import GHC.Exts (oneShot)

newtype EndoOS a = EndoOS' { forall a. EndoOS a -> a -> a
runEndoOS :: a -> a }


instance Semigroup (EndoOS a) where
  EndoOS' a -> a
f <> :: EndoOS a -> EndoOS a -> EndoOS a
<> EndoOS' a -> a
g = (a -> a) -> EndoOS a
forall a. (a -> a) -> EndoOS a
EndoOS (\a
x -> a -> a
g (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$! a -> a
f a
x)
     -- NB1: Strict application, to avoid thunk creation
     --      See (FV3) in Note [Finding free variables]
     --      in GHC.Types.Var.FV
     -- NB2: We apply `f` to the acccumulator first, then `g`
     --      So if we traverse a type left-to-right, the insertion
     --      order for (say) free type variables is left-to-right
     --      See (FV4) in Note [Finding free variables]
     --      in GHC.Types.Var.FV

instance Monoid (EndoOS a) where
   mempty :: EndoOS a
mempty  = (a -> a) -> EndoOS a
forall a. (a -> a) -> EndoOS a
EndoOS a -> a
forall a. a -> a
id

pattern EndoOS :: (a->a) -> EndoOS a
{-# COMPLETE EndoOS #-}
pattern $mEndoOS :: forall {r} {a}. EndoOS a -> ((a -> a) -> r) -> ((# #) -> r) -> r
$bEndoOS :: forall a. (a -> a) -> EndoOS a
EndoOS f <- EndoOS' f
      where
        EndoOS a -> a
f = (a -> a) -> EndoOS a
forall a. (a -> a) -> EndoOS a
EndoOS' ((a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
oneShot a -> a
f)
         -- oneShot: this is the core of the one-shot trick!
         -- Note [The one-shot state monad trick] in  GHC.Utils.Monad.