{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module GHC.Tc.Types.TH (
    SpliceType(..)
  , SpliceOrBracket(..)
  , ThLevel(.., TypedBrack, UntypedBrack)
  , PendingStuff(..)
  , ThLevelIndex
  , topLevel
  , topAnnLevel
  , topSpliceLevel
  , thLevelIndex
  , topLevelIndex
  , spliceLevelIndex
  , quoteLevelIndex
  , thLevelIndexFromImportLevel
  ) where

import GHC.Prelude
import GHCi.RemoteTypes
import qualified GHC.Boot.TH.Syntax as TH
import GHC.Tc.Types.Evidence
import GHC.Utils.Outputable
import GHC.Tc.Types.TcRef
import GHC.Tc.Types.Constraint
import GHC.Hs.Expr ( PendingTcSplice, PendingRnSplice )
import GHC.Types.ThLevelIndex

---------------------------
-- Template Haskell stages and levels
---------------------------

data SpliceType = Typed | Untyped
data SpliceOrBracket = IsSplice | IsBracket

data ThLevel    -- See Note [Template Haskell state diagram]
                -- and Note [Template Haskell levels] in GHC.Tc.Gen.Splice
    -- Start at:   Comp
    -- At bracket: wrap current stage in Brack
    -- At splice:  wrap current stage in Splice
  = Splice SpliceType ThLevel -- Inside a splice

  | RunSplice (TcRef [ForeignRef (TH.Q ())])
      -- Set when running a splice, i.e. NOT when renaming or typechecking the
      -- Haskell code for the splice. See Note [RunSplice ThLevel].
      --
      -- Contains a list of mod finalizers collected while executing the splice.
      --
      -- 'addModFinalizer' inserts finalizers here, and from here they are taken
      -- to construct an @HsSpliced@ annotation for untyped splices. See Note
      -- [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice.
      --
      -- For typed splices, the typechecker takes finalizers from here and
      -- inserts them in the list of finalizers in the global environment.
      --
      -- See Note [Collecting modFinalizers in typed splices] in "GHC.Tc.Gen.Splice".

  | Comp        -- Ordinary Haskell code
                -- Binding level = 0

  | Brack                       -- Inside brackets
      ThLevel                   --  Enclosing level
      PendingStuff

data PendingStuff
  = RnPending                     -- Renaming the inside of a bracket
      (TcRef [PendingRnSplice])   -- Pending splices in here

  | RnPendingTyped                -- Renaming the inside of a *typed* bracket

  | TcPending                     -- Typechecking the inside of a typed bracket
      (TcRef [PendingTcSplice])   --   Accumulate pending splices here
      (TcRef WantedConstraints)   --     and type constraints here
      QuoteWrapper                -- A type variable and evidence variable
                                  -- for the overall monad of
                                  -- the bracket. Splices are checked
                                  -- against this monad. The evidence
                                  -- variable is used for desugaring
                                  -- `lift`.

isTypedPending :: PendingStuff -> Bool
isTypedPending :: PendingStuff -> Bool
isTypedPending (RnPending TcRef [PendingRnSplice]
_) = Bool
False
isTypedPending (PendingStuff
RnPendingTyped) = Bool
True
isTypedPending (TcPending TcRef [PendingTcSplice]
_ TcRef WantedConstraints
_ QuoteWrapper
_) = Bool
True

pattern UntypedBrack :: ThLevel -> TcRef [PendingRnSplice] -> ThLevel
pattern $mUntypedBrack :: forall {r}.
ThLevel
-> (ThLevel -> TcRef [PendingRnSplice] -> r) -> ((# #) -> r) -> r
$bUntypedBrack :: ThLevel -> TcRef [PendingRnSplice] -> ThLevel
UntypedBrack lvl tc_ref = Brack lvl (RnPending tc_ref)
pattern TypedBrack :: ThLevel -> ThLevel
pattern $mTypedBrack :: forall {r}. ThLevel -> (ThLevel -> r) -> ((# #) -> r) -> r
TypedBrack lvl <- Brack lvl (isTypedPending -> True)

topLevel, topAnnLevel, topSpliceLevel :: ThLevel
topLevel :: ThLevel
topLevel       = ThLevel
Comp
topAnnLevel :: ThLevel
topAnnLevel    = SpliceType -> ThLevel -> ThLevel
Splice SpliceType
Untyped ThLevel
Comp
topSpliceLevel :: ThLevel
topSpliceLevel = SpliceType -> ThLevel -> ThLevel
Splice SpliceType
Untyped ThLevel
Comp


instance Outputable ThLevel where
   ppr :: ThLevel -> SDoc
ppr (Splice SpliceType
_ ThLevel
s)  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Splice" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (ThLevel -> SDoc
forall a. Outputable a => a -> SDoc
ppr ThLevel
s)
   ppr (RunSplice TcRef [ForeignRef (Q ())]
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RunSplice"
   ppr ThLevel
Comp          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Comp"
   ppr (Brack ThLevel
s PendingStuff
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Brack" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (ThLevel -> SDoc
forall a. Outputable a => a -> SDoc
ppr ThLevel
s)


thLevelIndex :: ThLevel -> ThLevelIndex
thLevelIndex :: ThLevel -> ThLevelIndex
thLevelIndex (Splice SpliceType
_ ThLevel
s)  = ThLevelIndex -> ThLevelIndex
decThLevelIndex (ThLevel -> ThLevelIndex
thLevelIndex ThLevel
s)
thLevelIndex ThLevel
Comp          = ThLevelIndex
topLevelIndex
thLevelIndex (Brack ThLevel
s PendingStuff
_) = ThLevelIndex -> ThLevelIndex
incThLevelIndex (ThLevel -> ThLevelIndex
thLevelIndex ThLevel
s)
thLevelIndex (RunSplice TcRef [ForeignRef (Q ())]
_) = ThLevel -> ThLevelIndex
thLevelIndex (SpliceType -> ThLevel -> ThLevel
Splice SpliceType
Untyped ThLevel
Comp) -- previously: panic "thLevel: called when running a splice"
                        -- See Note [RunSplice ThLevel].


{- Note [RunSplice ThLevel]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The 'RunSplice' level is set when executing a splice, and only when running a
splice. In particular it is not set when the splice is renamed or typechecked.

However, this is not true. `reifyInstances` for example does rename the given type,
and these types may contain variables (#9262 allow free variables in reifyInstances).
Therefore here we assume that thLevel (RunSplice _) = 0
Proper fix would probably require renaming argument `reifyInstances` separately prior
to evaluation of the overall splice.

'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert
the finalizer (see Note [Delaying modFinalizers in untyped splices]), and
'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to
set 'RunSplice' when renaming or typechecking the splice, where 'Splice',
'Brack' or 'Comp' are used instead.

-}