{-# LANGUAGE TypeFamilies, UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}
  -- Don't warn that `type instance DsForeignsHooks = ...`
  -- is an orphan; see Note [The Decoupling Abstract Data Hack]
  -- in GHC.Driver.Hooks

-- | Various types used during desugaring.
module GHC.HsToCore.Types (
        DsM, DsLclEnv(..), DsGblEnv(..), LdiNablas(..),
        DsMetaEnv, DsMetaVal(..), CompleteMatches
    ) where

import GHC.Prelude (Int)

import Data.IORef

import GHC.Types.CostCentre.State
import GHC.Types.Error
import GHC.Types.Name.Env
import GHC.Types.SrcLoc
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Name.Reader (GlobalRdrEnv)

import GHC.Hs (LForeignDecl, HsExpr, GhcTc)

import GHC.Tc.Types (TcRnIf, IfGblEnv, IfLclEnv, TcMPluginsRun)

import GHC.HsToCore.Pmc.Types (Nablas)
import GHC.HsToCore.Errors.Types

import GHC.Core (CoreExpr)
import GHC.Core.FamInstEnv
import GHC.Utils.Outputable as Outputable
import GHC.Unit.Module
import GHC.Driver.Hooks (DsForeignsHook)
import GHC.Data.OrdList (OrdList)

import GHC.Types.ForeignStubs (ForeignStubs)
import GHC.Types.CompleteMatch

import Data.Maybe( Maybe )

{-
************************************************************************
*                                                                      *
                Desugarer monad
*                                                                      *
************************************************************************

Now the mondo monad magic (yes, @DsM@ is a silly name)---carry around
a @UniqueSupply@ and some annotations, which
presumably include source-file location information:
-}

-- | Global read-only context and state of the desugarer.
-- The statefulness is implemented through 'IORef's.
data DsGblEnv
  = DsGblEnv
  { DsGblEnv -> Module
ds_mod          :: Module             -- For SCC profiling
  , DsGblEnv -> FamInstEnv
ds_fam_inst_env :: FamInstEnv         -- Like tcg_fam_inst_env
  , DsGblEnv -> GlobalRdrEnv
ds_gbl_rdr_env  :: GlobalRdrEnv       -- needed only for the following reasons:
                                          --    - to know what newtype constructors are in scope
                                          --    - to check whether all members of a COMPLETE pragma are in scope
  , DsGblEnv -> TcMPluginsRun
ds_tcm_plugins :: TcMPluginsRun
      -- ^ 'TcM' plugins, stored here so that we can invoke the typechecker
      -- without having to repeatedly re-initialise them.
      --
      -- See Note [Stop TcM plugins after desugaring] in GHC.Driver.Main.

  , DsGblEnv -> NamePprCtx
ds_name_ppr_ctx :: NamePprCtx
  , DsGblEnv -> IORef (Messages DsMessage)
ds_msgs    :: IORef (Messages DsMessage) -- Diagnostic messages
  , DsGblEnv -> (IfGblEnv, IfLclEnv)
ds_if_env  :: (IfGblEnv, IfLclEnv)    -- Used for looking up global,
                                          -- possibly-imported things

  , DsGblEnv -> DsCompleteMatches
ds_complete_matches :: DsCompleteMatches
     -- Additional complete pattern matches

  , DsGblEnv -> IORef CostCentreState
ds_cc_st   :: IORef CostCentreState
     -- Tracking indices for cost centre annotations

  , DsGblEnv -> IORef (ModuleEnv Int)
ds_next_wrapper_num :: IORef (ModuleEnv Int)
    -- ^ See Note [Generating fresh names for FFI wrappers]

  , DsGblEnv -> IORef (OrdList (Id, CoreExpr))
ds_static_binds :: IORef (OrdList (Id,CoreExpr))
    -- ^ Static bindings
    -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable
  }

instance ContainsModule DsGblEnv where
  extractModule :: DsGblEnv -> Module
extractModule = DsGblEnv -> Module
ds_mod

data LdiNablas
  = NoPmc        -- Do desugaring only, no pattern-match checking
                 --   See (DPM1) in Note [Desugaring HsExpr during pattern-match checking]
  | Ldi Nablas   -- Do pattern match checking; here are "reaching values" Nablas

instance Outputable LdiNablas where
  ppr :: LdiNablas -> SDoc
ppr LdiNablas
NoPmc    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NoPmc"
  ppr (Ldi Nablas
ns) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ldi" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (Nablas -> SDoc
forall a. Outputable a => a -> SDoc
ppr Nablas
ns)

-- | Local state of the desugarer, extended as we lexically descend
data DsLclEnv
  = DsLclEnv
  { DsLclEnv -> DsMetaEnv
dsl_meta    :: DsMetaEnv   -- ^ Template Haskell bindings
  , DsLclEnv -> RealSrcSpan
dsl_loc     :: RealSrcSpan -- ^ To put in pattern-matching error msgs

  , DsLclEnv -> LdiNablas
dsl_nablas  :: LdiNablas
  -- ^ See Note [Desugaring HsExpr during pattern-match checking], esp (DPM1)
  -- The set of reaching values Nablas is augmented as we walk inwards, refined
  -- through each pattern match in turn

  , DsLclEnv -> Maybe VarSet
dsl_unspecables :: Maybe VarSet
  -- ^ See Note [Desugaring non-canonical evidence]
  -- This field collects all un-specialisable evidence variables in scope.
  -- Nothing <=> don't collect this info (used for the LHS of Rules)
  }

-- Inside [| |] brackets, the desugarer looks
-- up variables in the DsMetaEnv
type DsMetaEnv = NameEnv DsMetaVal

data DsMetaVal
  = DsBound Id         -- Bound by a pattern inside the [| |].
                       -- Will be dynamically alpha renamed.
                       -- The Id has type THSyntax.Var

  | DsSplice (HsExpr GhcTc) -- These bindings are introduced by
                            -- the PendingSplices on a Hs*Bracket

-- | Desugaring monad. See also 'TcM'.
type DsM = TcRnIf DsGblEnv DsLclEnv

-- See Note [The Decoupling Abstract Data Hack]
type instance DsForeignsHook = [LForeignDecl GhcTc] -> DsM (ForeignStubs, OrdList (Id, CoreExpr))