    {-|
      Copyright  :  (C) 2012-2016, University of Twente,
                        2016     , Myrtle Software Ltd,
                        2017     , Google Inc.,
                        2021-2022, QBayLogic B.V.
      License    :  BSD2 (see the file LICENSE)
      Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

      Type and instance definitions for Rewrite modules
    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE DerivingStrategies #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TemplateHaskell #-}

    module Clash.Rewrite.Types where

    import Control.Concurrent.Supply             (Supply, freshId)
    import Control.DeepSeq                       (NFData)
    import Control.Lens                          (Lens', use, (.=))
    import qualified Control.Lens as Lens
    import Control.Monad.Fix                     (MonadFix)
    import Control.Monad.State.Strict            (State)
    #if MIN_VERSION_transformers(0,5,6)
    import Control.Monad.Reader                  (MonadReader (..))
    import Control.Monad.State                   (MonadState (..))
    import Control.Monad.Trans.RWS.CPS           (RWST)
    import qualified Control.Monad.Trans.RWS.CPS as RWS
    import Control.Monad.Writer                  (MonadWriter (..))
    #else
    import Control.Monad.Trans.RWS.Strict        (RWST)
    import qualified Control.Monad.Trans.RWS.Strict as RWS
    #endif
    import Data.Binary                           (Binary)
    import Data.HashMap.Strict                   (HashMap)
    import Data.IntMap.Strict                    (IntMap)
    import Data.Monoid                           (Any)
    import Data.Text                             (Text)
    import GHC.Generics

    import Clash.Core.PartialEval as PE          (Evaluator)
    import Clash.Core.Evaluator.Types as WHNF    (Evaluator, PrimHeap)

    import Clash.Core.Term           (Term, Context)
    import Clash.Core.Type           (Type)
    import Clash.Core.TyCon          (TyConMap, TyConName)
    import Clash.Core.Var            (Id)
    import Clash.Core.VarEnv         (InScopeSet, VarSet, VarEnv)
    import Clash.Driver.Types        (ClashEnv(..), ClashOpts(..), BindingMap, DebugOpts)
    import Clash.Netlist.Types       (FilteredHWType, HWMap)
    import Clash.Primitives.Types    (CompiledPrimMap)
    import Clash.Rewrite.WorkFree    (isWorkFree)
    import Clash.Util

    import Clash.Annotations.BitRepresentation.Internal (CustomReprs)

    -- | State used by the inspection mechanism for recording rewrite steps.
    data RewriteStep
      = RewriteStep
      { RewriteStep -> Context
    t_ctx    :: Context
      -- ^ current context
      , RewriteStep -> String
    t_name   :: String
      -- ^ Name of the transformation
      , RewriteStep -> String
    t_bndrS  :: String
      -- ^ Name of the current binder
      , RewriteStep -> Term
    t_before :: Term
      -- ^ Term before `apply`
      , RewriteStep -> Term
    t_after  :: Term
      -- ^ Term after `apply`
      } deriving (Int -> RewriteStep -> ShowS
    [RewriteStep] -> ShowS
    RewriteStep -> String
    (Int -> RewriteStep -> ShowS)
    -> (RewriteStep -> String)
    -> ([RewriteStep] -> ShowS)
    -> Show RewriteStep
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> RewriteStep -> ShowS
    showsPrec :: Int -> RewriteStep -> ShowS
    $cshow :: RewriteStep -> String
    show :: RewriteStep -> String
    $cshowList :: [RewriteStep] -> ShowS
    showList :: [RewriteStep] -> ShowS
    Show, (forall x. RewriteStep -> Rep RewriteStep x)
    -> (forall x. Rep RewriteStep x -> RewriteStep)
    -> Generic RewriteStep
    forall x. Rep RewriteStep x -> RewriteStep
    forall x. RewriteStep -> Rep RewriteStep x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. RewriteStep -> Rep RewriteStep x
    from :: forall x. RewriteStep -> Rep RewriteStep x
    $cto :: forall x. Rep RewriteStep x -> RewriteStep
    to :: forall x. Rep RewriteStep x -> RewriteStep
    Generic, RewriteStep -> ()
    (RewriteStep -> ()) -> NFData RewriteStep
    forall a. (a -> ()) -> NFData a
    $crnf :: RewriteStep -> ()
    rnf :: RewriteStep -> ()
    NFData, Get RewriteStep
    [RewriteStep] -> Put
    RewriteStep -> Put
    (RewriteStep -> Put)
    -> Get RewriteStep -> ([RewriteStep] -> Put) -> Binary RewriteStep
    forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
    $cput :: RewriteStep -> Put
    put :: RewriteStep -> Put
    $cget :: Get RewriteStep
    get :: Get RewriteStep
    $cputList :: [RewriteStep] -> Put
    putList :: [RewriteStep] -> Put
    Binary)

    -- | State of a rewriting session
    data RewriteState extra
      = RewriteState
        -- TODO Given we now keep transformCounters, this should just be 'fold'
        -- over that map, otherwise the two counts could fall out of sync.
      { forall extra. RewriteState extra -> Word
    _transformCounter :: {-# UNPACK #-} !Word
      -- ^ Total number of applied transformations
      , forall extra. RewriteState extra -> HashMap Text Word
    _transformCounters :: HashMap Text Word
      -- ^ Map that tracks how many times each transformation is applied
      , forall extra. RewriteState extra -> BindingMap
    _bindings         :: !BindingMap
      -- ^ Global binders
      , forall extra. RewriteState extra -> Supply
    _uniqSupply       :: !Supply
      -- ^ Supply of unique numbers
      , forall extra. RewriteState extra -> (Id, SrcSpan)
    _curFun           :: (Id,SrcSpan) -- Initially set to undefined: no strictness annotation
      -- ^ Function which is currently normalized
      , forall extra. RewriteState extra -> Int
    _nameCounter      :: {-# UNPACK #-} !Int
      -- ^ Used for 'Fresh'
      , forall extra. RewriteState extra -> PrimHeap
    _globalHeap       :: PrimHeap
      -- ^ Used as a heap for compile-time evaluation of primitives that live in I/O
      , forall extra. RewriteState extra -> VarEnv Bool
    _workFreeBinders  :: VarEnv Bool
      -- ^ Map telling whether a binder's definition is work-free
      , forall extra. RewriteState extra -> extra
    _extra            :: !extra
      -- ^ Additional state
      }

    Lens.makeLenses ''RewriteState

    -- | Read-only environment of a rewriting session
    data RewriteEnv
      = RewriteEnv
      { RewriteEnv -> ClashEnv
    _clashEnv       :: ClashEnv
      -- ^ The global environment of the compiler
      , RewriteEnv
    -> CustomReprs
    -> TyConMap
    -> Type
    -> State HWMap (Maybe (Either String FilteredHWType))
    _typeTranslator :: CustomReprs
                        -> TyConMap
                        -> Type
                        -> State HWMap (Maybe (Either String FilteredHWType))
      -- ^ Hardcode Type -> FilteredHWType translator
      , RewriteEnv -> Evaluator
    _peEvaluator    :: PE.Evaluator
      -- ^ Hardcoded evaluator for partial evaluation
      , RewriteEnv -> Evaluator
    _evaluator      :: WHNF.Evaluator
      -- ^ Hardcoded evaluator for WHNF (old evaluator)
      , RewriteEnv -> VarSet
    _topEntities    :: VarSet
      -- ^ Functions that are considered TopEntities
      }

    Lens.makeLenses ''RewriteEnv

    debugOpts :: Lens.Getter RewriteEnv DebugOpts
    debugOpts :: Getter RewriteEnv DebugOpts
    debugOpts = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((DebugOpts -> f DebugOpts) -> ClashEnv -> f ClashEnv)
    -> (DebugOpts -> f DebugOpts)
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> DebugOpts)
    -> (DebugOpts -> f DebugOpts) -> ClashEnv -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to (ClashOpts -> DebugOpts
    opt_debug (ClashOpts -> DebugOpts)
    -> (ClashEnv -> ClashOpts) -> ClashEnv -> DebugOpts
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClashEnv -> ClashOpts
    envOpts)

    aggressiveXOpt :: Lens.Getter RewriteEnv Bool
    aggressiveXOpt :: Getter RewriteEnv Bool
    aggressiveXOpt = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((Bool -> f Bool) -> ClashEnv -> f ClashEnv)
    -> (Bool -> f Bool)
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> Bool) -> (Bool -> f Bool) -> ClashEnv -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to (ClashOpts -> Bool
    opt_aggressiveXOpt (ClashOpts -> Bool) -> (ClashEnv -> ClashOpts) -> ClashEnv -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClashEnv -> ClashOpts
    envOpts)

    tcCache :: Lens.Getter RewriteEnv TyConMap
    tcCache :: Getter RewriteEnv TyConMap
    tcCache = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((TyConMap -> f TyConMap) -> ClashEnv -> f ClashEnv)
    -> (TyConMap -> f TyConMap)
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> TyConMap)
    -> (TyConMap -> f TyConMap) -> ClashEnv -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to ClashEnv -> TyConMap
    envTyConMap

    tupleTcCache :: Lens.Getter RewriteEnv (IntMap TyConName)
    tupleTcCache :: Getter RewriteEnv (IntMap TyConName)
    tupleTcCache = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((IntMap TyConName -> f (IntMap TyConName))
        -> ClashEnv -> f ClashEnv)
    -> (IntMap TyConName -> f (IntMap TyConName))
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> IntMap TyConName)
    -> (IntMap TyConName -> f (IntMap TyConName))
    -> ClashEnv
    -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to ClashEnv -> IntMap TyConName
    envTupleTyCons

    customReprs :: Lens.Getter RewriteEnv CustomReprs
    customReprs :: Getter RewriteEnv CustomReprs
    customReprs = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((CustomReprs -> f CustomReprs) -> ClashEnv -> f ClashEnv)
    -> (CustomReprs -> f CustomReprs)
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> CustomReprs)
    -> (CustomReprs -> f CustomReprs) -> ClashEnv -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to ClashEnv -> CustomReprs
    envCustomReprs

    fuelLimit :: Lens.Getter RewriteEnv Word
    fuelLimit :: Getter RewriteEnv Word
    fuelLimit = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((Word -> f Word) -> ClashEnv -> f ClashEnv)
    -> (Word -> f Word)
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> Word) -> (Word -> f Word) -> ClashEnv -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to (ClashOpts -> Word
    opt_evaluatorFuelLimit (ClashOpts -> Word) -> (ClashEnv -> ClashOpts) -> ClashEnv -> Word
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClashEnv -> ClashOpts
    envOpts)

    primitives :: Lens.Getter RewriteEnv CompiledPrimMap
    primitives :: Getter RewriteEnv CompiledPrimMap
    primitives = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((CompiledPrimMap -> f CompiledPrimMap)
        -> ClashEnv -> f ClashEnv)
    -> (CompiledPrimMap -> f CompiledPrimMap)
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> CompiledPrimMap)
    -> (CompiledPrimMap -> f CompiledPrimMap) -> ClashEnv -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to ClashEnv -> CompiledPrimMap
    envPrimitives

    inlineLimit :: Lens.Getter RewriteEnv Int
    inlineLimit :: Getter RewriteEnv Int
    inlineLimit = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((Int -> f Int) -> ClashEnv -> f ClashEnv)
    -> (Int -> f Int)
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> Int) -> (Int -> f Int) -> ClashEnv -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to (ClashOpts -> Int
    opt_inlineLimit (ClashOpts -> Int) -> (ClashEnv -> ClashOpts) -> ClashEnv -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClashEnv -> ClashOpts
    envOpts)

    inlineFunctionLimit :: Lens.Getter RewriteEnv Word
    inlineFunctionLimit :: Getter RewriteEnv Word
    inlineFunctionLimit = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((Word -> f Word) -> ClashEnv -> f ClashEnv)
    -> (Word -> f Word)
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> Word) -> (Word -> f Word) -> ClashEnv -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to (ClashOpts -> Word
    opt_inlineFunctionLimit (ClashOpts -> Word) -> (ClashEnv -> ClashOpts) -> ClashEnv -> Word
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClashEnv -> ClashOpts
    envOpts)

    inlineConstantLimit :: Lens.Getter RewriteEnv Word
    inlineConstantLimit :: Getter RewriteEnv Word
    inlineConstantLimit = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((Word -> f Word) -> ClashEnv -> f ClashEnv)
    -> (Word -> f Word)
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> Word) -> (Word -> f Word) -> ClashEnv -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to (ClashOpts -> Word
    opt_inlineConstantLimit (ClashOpts -> Word) -> (ClashEnv -> ClashOpts) -> ClashEnv -> Word
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClashEnv -> ClashOpts
    envOpts)

    inlineWFCacheLimit :: Lens.Getter RewriteEnv Word
    inlineWFCacheLimit :: Getter RewriteEnv Word
    inlineWFCacheLimit = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((Word -> f Word) -> ClashEnv -> f ClashEnv)
    -> (Word -> f Word)
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> Word) -> (Word -> f Word) -> ClashEnv -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to (ClashOpts -> Word
    opt_inlineWFCacheLimit (ClashOpts -> Word) -> (ClashEnv -> ClashOpts) -> ClashEnv -> Word
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClashEnv -> ClashOpts
    envOpts)

    newInlineStrategy :: Lens.Getter RewriteEnv Bool
    newInlineStrategy :: Getter RewriteEnv Bool
    newInlineStrategy = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((Bool -> f Bool) -> ClashEnv -> f ClashEnv)
    -> (Bool -> f Bool)
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> Bool) -> (Bool -> f Bool) -> ClashEnv -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to (ClashOpts -> Bool
    opt_newInlineStrat (ClashOpts -> Bool) -> (ClashEnv -> ClashOpts) -> ClashEnv -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClashEnv -> ClashOpts
    envOpts)

    specializationLimit :: Lens.Getter RewriteEnv Int
    specializationLimit :: Getter RewriteEnv Int
    specializationLimit = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((Int -> f Int) -> ClashEnv -> f ClashEnv)
    -> (Int -> f Int)
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> Int) -> (Int -> f Int) -> ClashEnv -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to (ClashOpts -> Int
    opt_specLimit (ClashOpts -> Int) -> (ClashEnv -> ClashOpts) -> ClashEnv -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClashEnv -> ClashOpts
    envOpts)

    normalizeUltra :: Lens.Getter RewriteEnv Bool
    normalizeUltra :: Getter RewriteEnv Bool
    normalizeUltra = (ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv
    Lens' RewriteEnv ClashEnv
    clashEnv ((ClashEnv -> f ClashEnv) -> RewriteEnv -> f RewriteEnv)
    -> ((Bool -> f Bool) -> ClashEnv -> f ClashEnv)
    -> (Bool -> f Bool)
    -> RewriteEnv
    -> f RewriteEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ClashEnv -> Bool) -> (Bool -> f Bool) -> ClashEnv -> f ClashEnv
    forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    Lens.to (ClashOpts -> Bool
    opt_ultra (ClashOpts -> Bool) -> (ClashEnv -> ClashOpts) -> ClashEnv -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClashEnv -> ClashOpts
    envOpts)

    -- | Monad that keeps track how many transformations have been applied and can
    -- generate fresh variables and unique identifiers. In addition, it keeps track
    -- if a transformation/rewrite has been successfully applied.
    newtype RewriteMonad extra a = R
      { forall extra a.
    RewriteMonad extra a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    unR :: RWST RewriteEnv Any (RewriteState extra) IO a }
      deriving newtype
        ( Functor (RewriteMonad extra)
    Functor (RewriteMonad extra)
    -> (forall a. a -> RewriteMonad extra a)
    -> (forall a b.
        RewriteMonad extra (a -> b)
        -> RewriteMonad extra a -> RewriteMonad extra b)
    -> (forall a b c.
        (a -> b -> c)
        -> RewriteMonad extra a
        -> RewriteMonad extra b
        -> RewriteMonad extra c)
    -> (forall a b.
        RewriteMonad extra a
        -> RewriteMonad extra b -> RewriteMonad extra b)
    -> (forall a b.
        RewriteMonad extra a
        -> RewriteMonad extra b -> RewriteMonad extra a)
    -> Applicative (RewriteMonad extra)
    forall {extra}. Functor (RewriteMonad extra)
    forall a. a -> RewriteMonad extra a
    forall extra a. a -> RewriteMonad extra a
    forall a b.
    RewriteMonad extra a
    -> RewriteMonad extra b -> RewriteMonad extra a
    forall a b.
    RewriteMonad extra a
    -> RewriteMonad extra b -> RewriteMonad extra b
    forall a b.
    RewriteMonad extra (a -> b)
    -> RewriteMonad extra a -> RewriteMonad extra b
    forall extra a b.
    RewriteMonad extra a
    -> RewriteMonad extra b -> RewriteMonad extra a
    forall extra a b.
    RewriteMonad extra a
    -> RewriteMonad extra b -> RewriteMonad extra b
    forall extra a b.
    RewriteMonad extra (a -> b)
    -> RewriteMonad extra a -> RewriteMonad extra b
    forall a b c.
    (a -> b -> c)
    -> RewriteMonad extra a
    -> RewriteMonad extra b
    -> RewriteMonad extra c
    forall extra a b c.
    (a -> b -> c)
    -> RewriteMonad extra a
    -> RewriteMonad extra b
    -> RewriteMonad extra c
    forall (f :: Type -> Type).
    Functor f
    -> (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall extra a. a -> RewriteMonad extra a
    pure :: forall a. a -> RewriteMonad extra a
    $c<*> :: forall extra a b.
    RewriteMonad extra (a -> b)
    -> RewriteMonad extra a -> RewriteMonad extra b
    <*> :: forall a b.
    RewriteMonad extra (a -> b)
    -> RewriteMonad extra a -> RewriteMonad extra b
    $cliftA2 :: forall extra a b c.
    (a -> b -> c)
    -> RewriteMonad extra a
    -> RewriteMonad extra b
    -> RewriteMonad extra c
    liftA2 :: forall a b c.
    (a -> b -> c)
    -> RewriteMonad extra a
    -> RewriteMonad extra b
    -> RewriteMonad extra c
    $c*> :: forall extra a b.
    RewriteMonad extra a
    -> RewriteMonad extra b -> RewriteMonad extra b
    *> :: forall a b.
    RewriteMonad extra a
    -> RewriteMonad extra b -> RewriteMonad extra b
    $c<* :: forall extra a b.
    RewriteMonad extra a
    -> RewriteMonad extra b -> RewriteMonad extra a
    <* :: forall a b.
    RewriteMonad extra a
    -> RewriteMonad extra b -> RewriteMonad extra a
    Applicative
        , (forall a b.
     (a -> b) -> RewriteMonad extra a -> RewriteMonad extra b)
    -> (forall a b. a -> RewriteMonad extra b -> RewriteMonad extra a)
    -> Functor (RewriteMonad extra)
    forall a b. a -> RewriteMonad extra b -> RewriteMonad extra a
    forall a b.
    (a -> b) -> RewriteMonad extra a -> RewriteMonad extra b
    forall extra a b. a -> RewriteMonad extra b -> RewriteMonad extra a
    forall extra a b.
    (a -> b) -> RewriteMonad extra a -> RewriteMonad extra b
    forall (f :: Type -> Type).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall extra a b.
    (a -> b) -> RewriteMonad extra a -> RewriteMonad extra b
    fmap :: forall a b.
    (a -> b) -> RewriteMonad extra a -> RewriteMonad extra b
    $c<$ :: forall extra a b. a -> RewriteMonad extra b -> RewriteMonad extra a
    <$ :: forall a b. a -> RewriteMonad extra b -> RewriteMonad extra a
    Functor
        , Applicative (RewriteMonad extra)
    Applicative (RewriteMonad extra)
    -> (forall a b.
        RewriteMonad extra a
        -> (a -> RewriteMonad extra b) -> RewriteMonad extra b)
    -> (forall a b.
        RewriteMonad extra a
        -> RewriteMonad extra b -> RewriteMonad extra b)
    -> (forall a. a -> RewriteMonad extra a)
    -> Monad (RewriteMonad extra)
    forall extra. Applicative (RewriteMonad extra)
    forall a. a -> RewriteMonad extra a
    forall extra a. a -> RewriteMonad extra a
    forall a b.
    RewriteMonad extra a
    -> RewriteMonad extra b -> RewriteMonad extra b
    forall a b.
    RewriteMonad extra a
    -> (a -> RewriteMonad extra b) -> RewriteMonad extra b
    forall extra a b.
    RewriteMonad extra a
    -> RewriteMonad extra b -> RewriteMonad extra b
    forall extra a b.
    RewriteMonad extra a
    -> (a -> RewriteMonad extra b) -> RewriteMonad extra b
    forall (m :: Type -> Type).
    Applicative m
    -> (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall extra a b.
    RewriteMonad extra a
    -> (a -> RewriteMonad extra b) -> RewriteMonad extra b
    >>= :: forall a b.
    RewriteMonad extra a
    -> (a -> RewriteMonad extra b) -> RewriteMonad extra b
    $c>> :: forall extra a b.
    RewriteMonad extra a
    -> RewriteMonad extra b -> RewriteMonad extra b
    >> :: forall a b.
    RewriteMonad extra a
    -> RewriteMonad extra b -> RewriteMonad extra b
    $creturn :: forall extra a. a -> RewriteMonad extra a
    return :: forall a. a -> RewriteMonad extra a
    Monad
        , Monad (RewriteMonad extra)
    Monad (RewriteMonad extra)
    -> (forall a. (a -> RewriteMonad extra a) -> RewriteMonad extra a)
    -> MonadFix (RewriteMonad extra)
    forall extra. Monad (RewriteMonad extra)
    forall a. (a -> RewriteMonad extra a) -> RewriteMonad extra a
    forall extra a. (a -> RewriteMonad extra a) -> RewriteMonad extra a
    forall (m :: Type -> Type).
    Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
    $cmfix :: forall extra a. (a -> RewriteMonad extra a) -> RewriteMonad extra a
    mfix :: forall a. (a -> RewriteMonad extra a) -> RewriteMonad extra a
    MonadFix
        )
    #if MIN_VERSION_transformers(0,5,6) && MIN_VERSION_mtl(2,3,0)
      deriving newtype
        ( MonadState (RewriteState extra)
        , MonadWriter Any
        , MonadReader RewriteEnv
        )
    #endif

    -- | Run the computation in the RewriteMonad
    runR
      :: RewriteMonad extra a
      -> RewriteEnv
      -> RewriteState extra
      -> IO (a, RewriteState extra, Any)
    runR :: forall extra a.
    RewriteMonad extra a
    -> RewriteEnv
    -> RewriteState extra
    -> IO (a, RewriteState extra, Any)
    runR RewriteMonad extra a
    m = RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteEnv
    -> RewriteState extra
    -> IO (a, RewriteState extra, Any)
    forall w r s (m :: Type -> Type) a.
    Monoid w =>
    RWST r w s m a -> r -> s -> m (a, s, w)
    RWS.runRWST (RewriteMonad extra a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    forall extra a.
    RewriteMonad extra a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    unR RewriteMonad extra a
    m)

    #if MIN_VERSION_transformers(0,5,6) && !MIN_VERSION_mtl(2,3,0)
    -- For Control.Monad.Trans.RWS.Strict these are already defined, however the
    -- CPS version of RWS is not included in `mtl` yet.

    instance MonadState (RewriteState extra) (RewriteMonad extra) where
      get :: RewriteMonad extra (RewriteState extra)
    get = RWST RewriteEnv Any (RewriteState extra) IO (RewriteState extra)
    -> RewriteMonad extra (RewriteState extra)
    forall extra a.
    RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    R RWST RewriteEnv Any (RewriteState extra) IO (RewriteState extra)
    forall (m :: Type -> Type) r w s. Monad m => RWST r w s m s
    RWS.get
      {-# INLINE get #-}
      put :: RewriteState extra -> RewriteMonad extra ()
    put = RWST RewriteEnv Any (RewriteState extra) IO ()
    -> RewriteMonad extra ()
    forall extra a.
    RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    R (RWST RewriteEnv Any (RewriteState extra) IO ()
     -> RewriteMonad extra ())
    -> (RewriteState extra
        -> RWST RewriteEnv Any (RewriteState extra) IO ())
    -> RewriteState extra
    -> RewriteMonad extra ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RewriteState extra
    -> RWST RewriteEnv Any (RewriteState extra) IO ()
    forall (m :: Type -> Type) s r w. Monad m => s -> RWST r w s m ()
    RWS.put
      {-# INLINE put #-}
      state :: forall a.
    (RewriteState extra -> (a, RewriteState extra))
    -> RewriteMonad extra a
    state = RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    forall extra a.
    RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    R (RWST RewriteEnv Any (RewriteState extra) IO a
     -> RewriteMonad extra a)
    -> ((RewriteState extra -> (a, RewriteState extra))
        -> RWST RewriteEnv Any (RewriteState extra) IO a)
    -> (RewriteState extra -> (a, RewriteState extra))
    -> RewriteMonad extra a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (RewriteState extra -> (a, RewriteState extra))
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    forall (m :: Type -> Type) s a r w.
    Monad m =>
    (s -> (a, s)) -> RWST r w s m a
    RWS.state
      {-# INLINE state #-}

    instance MonadWriter Any (RewriteMonad extra) where
      writer :: forall a. (a, Any) -> RewriteMonad extra a
    writer = RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    forall extra a.
    RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    R (RWST RewriteEnv Any (RewriteState extra) IO a
     -> RewriteMonad extra a)
    -> ((a, Any) -> RWST RewriteEnv Any (RewriteState extra) IO a)
    -> (a, Any)
    -> RewriteMonad extra a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, Any) -> RWST RewriteEnv Any (RewriteState extra) IO a
    forall w (m :: Type -> Type) a r s.
    (Monoid w, Monad m) =>
    (a, w) -> RWST r w s m a
    RWS.writer
      {-# INLINE writer #-}
      tell :: Any -> RewriteMonad extra ()
    tell = RWST RewriteEnv Any (RewriteState extra) IO ()
    -> RewriteMonad extra ()
    forall extra a.
    RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    R (RWST RewriteEnv Any (RewriteState extra) IO ()
     -> RewriteMonad extra ())
    -> (Any -> RWST RewriteEnv Any (RewriteState extra) IO ())
    -> Any
    -> RewriteMonad extra ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> RWST RewriteEnv Any (RewriteState extra) IO ()
    forall w (m :: Type -> Type) r s.
    (Monoid w, Monad m) =>
    w -> RWST r w s m ()
    RWS.tell
      {-# INLINE tell #-}
      listen :: forall a. RewriteMonad extra a -> RewriteMonad extra (a, Any)
    listen = RWST RewriteEnv Any (RewriteState extra) IO (a, Any)
    -> RewriteMonad extra (a, Any)
    forall extra a.
    RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    R (RWST RewriteEnv Any (RewriteState extra) IO (a, Any)
     -> RewriteMonad extra (a, Any))
    -> (RewriteMonad extra a
        -> RWST RewriteEnv Any (RewriteState extra) IO (a, Any))
    -> RewriteMonad extra a
    -> RewriteMonad extra (a, Any)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RWST RewriteEnv Any (RewriteState extra) IO a
    -> RWST RewriteEnv Any (RewriteState extra) IO (a, Any)
    forall w (m :: Type -> Type) r s a.
    (Monoid w, Monad m) =>
    RWST r w s m a -> RWST r w s m (a, w)
    RWS.listen (RWST RewriteEnv Any (RewriteState extra) IO a
     -> RWST RewriteEnv Any (RewriteState extra) IO (a, Any))
    -> (RewriteMonad extra a
        -> RWST RewriteEnv Any (RewriteState extra) IO a)
    -> RewriteMonad extra a
    -> RWST RewriteEnv Any (RewriteState extra) IO (a, Any)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RewriteMonad extra a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    forall extra a.
    RewriteMonad extra a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    unR
      {-# INLINE listen #-}
      pass :: forall a.
    RewriteMonad extra (a, Any -> Any) -> RewriteMonad extra a
    pass = RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    forall extra a.
    RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    R (RWST RewriteEnv Any (RewriteState extra) IO a
     -> RewriteMonad extra a)
    -> (RewriteMonad extra (a, Any -> Any)
        -> RWST RewriteEnv Any (RewriteState extra) IO a)
    -> RewriteMonad extra (a, Any -> Any)
    -> RewriteMonad extra a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RWST RewriteEnv Any (RewriteState extra) IO (a, Any -> Any)
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    forall w w' (m :: Type -> Type) r s a.
    (Monoid w, Monoid w', Monad m) =>
    RWST r w s m (a, w -> w') -> RWST r w' s m a
    RWS.pass (RWST RewriteEnv Any (RewriteState extra) IO (a, Any -> Any)
     -> RWST RewriteEnv Any (RewriteState extra) IO a)
    -> (RewriteMonad extra (a, Any -> Any)
        -> RWST RewriteEnv Any (RewriteState extra) IO (a, Any -> Any))
    -> RewriteMonad extra (a, Any -> Any)
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RewriteMonad extra (a, Any -> Any)
    -> RWST RewriteEnv Any (RewriteState extra) IO (a, Any -> Any)
    forall extra a.
    RewriteMonad extra a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    unR
      {-# INLINE pass #-}

    instance MonadReader RewriteEnv (RewriteMonad extra) where
       ask :: RewriteMonad extra RewriteEnv
    ask = RWST RewriteEnv Any (RewriteState extra) IO RewriteEnv
    -> RewriteMonad extra RewriteEnv
    forall extra a.
    RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    R RWST RewriteEnv Any (RewriteState extra) IO RewriteEnv
    forall (m :: Type -> Type) r w s. Monad m => RWST r w s m r
    RWS.ask
       {-# INLINE ask #-}
       local :: forall a.
    (RewriteEnv -> RewriteEnv)
    -> RewriteMonad extra a -> RewriteMonad extra a
    local RewriteEnv -> RewriteEnv
    f = RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    forall extra a.
    RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    R (RWST RewriteEnv Any (RewriteState extra) IO a
     -> RewriteMonad extra a)
    -> (RewriteMonad extra a
        -> RWST RewriteEnv Any (RewriteState extra) IO a)
    -> RewriteMonad extra a
    -> RewriteMonad extra a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (RewriteEnv -> RewriteEnv)
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    forall r w s (m :: Type -> Type) a.
    (r -> r) -> RWST r w s m a -> RWST r w s m a
    RWS.local RewriteEnv -> RewriteEnv
    f (RWST RewriteEnv Any (RewriteState extra) IO a
     -> RWST RewriteEnv Any (RewriteState extra) IO a)
    -> (RewriteMonad extra a
        -> RWST RewriteEnv Any (RewriteState extra) IO a)
    -> RewriteMonad extra a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RewriteMonad extra a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    forall extra a.
    RewriteMonad extra a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    unR
       {-# INLINE local #-}
       reader :: forall a. (RewriteEnv -> a) -> RewriteMonad extra a
    reader = RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    forall extra a.
    RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    R (RWST RewriteEnv Any (RewriteState extra) IO a
     -> RewriteMonad extra a)
    -> ((RewriteEnv -> a)
        -> RWST RewriteEnv Any (RewriteState extra) IO a)
    -> (RewriteEnv -> a)
    -> RewriteMonad extra a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (RewriteEnv -> a) -> RWST RewriteEnv Any (RewriteState extra) IO a
    forall (m :: Type -> Type) r a w s.
    Monad m =>
    (r -> a) -> RWST r w s m a
    RWS.reader
       {-# INLINE reader #-}
    #endif

    instance MonadUnique (RewriteMonad extra) where
      getUniqueM :: RewriteMonad extra Int
    getUniqueM = do
        Supply
    sup <- Getting Supply (RewriteState extra) Supply
    -> RewriteMonad extra Supply
    forall s (m :: Type -> Type) a.
    MonadState s m =>
    Getting a s a -> m a
    use Getting Supply (RewriteState extra) Supply
    forall extra (f :: Type -> Type).
    Functor f =>
    (Supply -> f Supply)
    -> RewriteState extra -> f (RewriteState extra)
    uniqSupply
        let (Int
    a,Supply
    sup') = Supply -> (Int, Supply)
    freshId Supply
    sup
        (Supply -> Identity Supply)
    -> RewriteState extra -> Identity (RewriteState extra)
    forall extra (f :: Type -> Type).
    Functor f =>
    (Supply -> f Supply)
    -> RewriteState extra -> f (RewriteState extra)
    uniqSupply ((Supply -> Identity Supply)
     -> RewriteState extra -> Identity (RewriteState extra))
    -> Supply -> RewriteMonad extra ()
    forall s (m :: Type -> Type) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= Supply
    sup'
        Int
    a Int -> RewriteMonad extra Int -> RewriteMonad extra Int
    forall a b. a -> b -> b
    `seq` Int -> RewriteMonad extra Int
    forall a. a -> RewriteMonad extra a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Int
    a

    censor :: (Any -> Any) -> RewriteMonad extra a -> RewriteMonad extra a
    censor :: forall extra a.
    (Any -> Any) -> RewriteMonad extra a -> RewriteMonad extra a
    censor Any -> Any
    f = RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    forall extra a.
    RWST RewriteEnv Any (RewriteState extra) IO a
    -> RewriteMonad extra a
    R (RWST RewriteEnv Any (RewriteState extra) IO a
     -> RewriteMonad extra a)
    -> (RewriteMonad extra a
        -> RWST RewriteEnv Any (RewriteState extra) IO a)
    -> RewriteMonad extra a
    -> RewriteMonad extra a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Any -> Any)
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    forall w (m :: Type -> Type) r s a.
    (Monoid w, Monad m) =>
    (w -> w) -> RWST r w s m a -> RWST r w s m a
    RWS.censor Any -> Any
    f (RWST RewriteEnv Any (RewriteState extra) IO a
     -> RWST RewriteEnv Any (RewriteState extra) IO a)
    -> (RewriteMonad extra a
        -> RWST RewriteEnv Any (RewriteState extra) IO a)
    -> RewriteMonad extra a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RewriteMonad extra a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    forall extra a.
    RewriteMonad extra a
    -> RWST RewriteEnv Any (RewriteState extra) IO a
    unR
    {-# INLINE censor #-}

    data TransformContext
      = TransformContext
      { TransformContext -> InScopeSet
    tfInScope :: !InScopeSet
      , TransformContext -> Context
    tfContext :: Context
      }

    -- | Monadic action that transforms a term given a certain context
    type Transform m = TransformContext -> Term -> m Term

    -- | A 'Transform' action in the context of the 'RewriteMonad'
    type Rewrite extra = Transform (RewriteMonad extra)

    -- Moved into Clash.Rewrite.WorkFree
    {-# SPECIALIZE isWorkFree
          :: Lens' (RewriteState extra) (VarEnv Bool)
          -> BindingMap
          -> Term
          -> RewriteMonad extra Bool
      #-}