content: {-# LANGUAGE TupleSections #-}
  
  module RewritePerfPlugin where
  -- Testing performance of rewriting type-family applications.
  
  -- ghc
  import GHC.Core
    ( Expr(Coercion) )
  import GHC.Core.Coercion
    ( mkUnivCo )
  import GHC.Core.TyCo.Rep
    ( Type, UnivCoProvenance(PluginProv) )
  import GHC.Core.TyCon
    ( TyCon )
  import GHC.Core.TyCo.Compare
    ( eqType )
  import GHC.Core.Type
    ( mkTyConApp, splitTyConApp_maybe )
  import GHC.Plugins
    ( Plugin(..), defaultPlugin, purePlugin )
  import GHC.Tc.Plugin
    ( TcPluginM
    , findImportedModule, lookupOrig
    , tcLookupClass, tcLookupDataCon, tcLookupTyCon
    , unsafeTcPluginTcM
    )
  import GHC.Tc.Types
    ( TcPlugin(..)
    , TcPluginSolveResult(..), TcPluginRewriteResult(..)
    , TcPluginRewriter, RewriteEnv
    )
  import GHC.Tc.Types.Constraint
    ( Ct(..), CanEqLHS(..)
    , ctPred
    )
  import GHC.Types.Name.Occurrence
    ( mkTcOcc )
  import GHC.Types.Unique.FM
    ( UniqFM, listToUFM )
  import GHC.Types.PkgQual
  import GHC.Unit.Finder
    ( FindResult(..) )
  import GHC.Unit.Module
    ( Module
    , mkModuleName
    )
  
  --------------------------------------------------------------------------------
  
  -- In this test, we write a plugin which returns "TcPluginNoRewrite"
  -- for all the type families in RewritePerfDefs.
  --
  -- Comparing the result with T9872b gives an indication of the performance
  -- impact of rewriting plugins in code that heavily rewrites type families.
  
  type PluginDefs = [ TyCon ]
  
  definitionsModule :: TcPluginM Module
  definitionsModule = do
    findResult <- findImportedModule ( mkModuleName "RewritePerfDefs" ) NoPkgQual
    case findResult of
      Found _ res     -> pure res
      FoundMultiple _ -> error $ "RewritePerfPlugin: found multiple modules named 'RewritePerfDefs'."
      _               -> error $ "RewritePerfPlugin: could not find any module named 'RewritePerfDefs'."
  
  lookupDefs :: TcPluginM PluginDefs
  lookupDefs = do
    defs <- definitionsModule
    traverse ( \ tyConName -> lookupOrig defs ( mkTcOcc tyConName ) >>= tcLookupTyCon )
      [ "And", "NE", "EQ", "All", "ListConcat", "AppendIf", "Apply"
      , "Map", "MapAppend", "MapAppend2", "MapAppend3"
      , "Iterate2", "Iterate3", "Iterate4"
      , "Orientations", "Compatible", "Allowed"
      , "MatchingOrientations", "AllowedCombinations"
      , "Solutions"
      ]
  
  plugin :: Plugin
  plugin =
    defaultPlugin
      { tcPlugin        = \ _args -> Just $ rewritingPlugin
      , pluginRecompile = purePlugin
      }
  
  rewritingPlugin :: TcPlugin
  rewritingPlugin =
    TcPlugin
      { tcPluginInit    = lookupDefs
      , tcPluginSolve   = \ _ _ _ _ -> pure $ TcPluginOk [] []
      , tcPluginRewrite = rewriter
      , tcPluginStop    = \ _ -> pure ()
      }
  
  rewriter :: PluginDefs -> UniqFM TyCon TcPluginRewriter
  rewriter tyCons =
    listToUFM $ map ( , don'tRewrite ) tyCons
  
  don'tRewrite :: RewriteEnv -> [ Ct ] -> [ Type ] -> TcPluginM TcPluginRewriteResult
  don'tRewrite _ _ _ = pure TcPluginNoRewrite
  