{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies     #-}

{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

{-
(c) The University of Glasgow 2006
(c) The AQUA Project, Glasgow University, 1996-1998

-}

-- | Specialisations of the @HsSyn@ syntax for the typechecker
--
-- This module is an extension of @HsSyn@ syntax, for use in the type checker.
module GHC.Tc.Utils.Zonk (
        -- * Other HsSyn functions
        mkHsDictLet, mkHsApp,
        mkHsAppTy, mkHsCaseAlt,
        tcShortCutLit, shortCutLit, hsOverLitName,
        conLikeResTy,

        -- * re-exported from TcMonad
        TcId, TcIdSet,

        -- * Zonking
        -- | For a description of "zonking", see Note [What is zonking?]
        -- in "GHC.Tc.Utils.TcMType"
        zonkTopDecls, zonkTopExpr, zonkTopLExpr,
        zonkTopBndrs,
        ZonkEnv, ZonkFlexi(..), emptyZonkEnv, mkEmptyZonkEnv, initZonkEnv,
        zonkTyVarBindersX, zonkTyVarBinderX,
        zonkTyBndrs, zonkTyBndrsX,
        zonkTcTypeToType,  zonkTcTypeToTypeX,
        zonkTcTypesToTypesX, zonkScaledTcTypesToTypesX,
        zonkTyVarOcc,
        zonkCoToCo,
        zonkEvBinds, zonkTcEvBinds,
        zonkTcMethInfoToMethInfoX,
        lookupTyVarX
  ) where

import GHC.Prelude

import GHC.Platform

import GHC.Builtin.Types
import GHC.Builtin.Names

import GHC.Hs

import {-# SOURCE #-} GHC.Tc.Gen.Splice (runTopSplice)
import GHC.Tc.Utils.Monad
import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo )
import GHC.Tc.Utils.TcType
import GHC.Tc.Utils.TcMType
import GHC.Tc.Utils.Env   ( tcLookupGlobalOnly )
import GHC.Tc.Types.Evidence

import GHC.Core.TyCo.Ppr ( pprTyVar )
import GHC.Core.TyCon
import GHC.Core.Type
import GHC.Core.Coercion
import GHC.Core.ConLike
import GHC.Core.DataCon

import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain

import GHC.Core.Multiplicity
import GHC.Core
import GHC.Core.Predicate

import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Id
import GHC.Types.TypeEnv
import GHC.Types.SourceText
import GHC.Types.Basic
import GHC.Types.SrcLoc
import GHC.Types.Unique.FM
import GHC.Types.TyThing
import GHC.Driver.Session( getDynFlags, targetPlatform )

import GHC.Data.Maybe
import GHC.Data.Bag

import Control.Monad
import Data.List  ( partition )
import Control.Arrow ( second )

{- *********************************************************************
*                                                                      *
         Short-cuts for overloaded numeric literals
*                                                                      *
********************************************************************* -}

-- Overloaded literals. Here mainly because it uses isIntTy etc

{- Note [Short cut for overloaded literals]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A literal like "3" means (fromInteger @ty (dNum :: Num ty) (3::Integer)).
But if we have a list like
  [4,2,3,2,4,4,2]::[Int]
we use a lot of compile time and space generating and solving all those Num
constraints, and generating calls to fromInteger etc.  Better just to cut to
the chase, and cough up an Int literal. Large collections of literals like this
sometimes appear in source files, so it's quite a worthwhile fix.

So we try to take advantage of whatever nearby type information we have,
to short-cut the process for built-in types.  We can do this in two places;

* In the typechecker, when we are about to typecheck the literal.
* If that fails, in the desugarer, once we know the final type.
-}

tcShortCutLit :: HsOverLit GhcRn -> ExpRhoType -> TcM (Maybe (HsOverLit GhcTc))
tcShortCutLit :: HsOverLit GhcRn -> ExpRhoType -> TcM (Maybe (HsOverLit GhcTc))
tcShortCutLit lit :: HsOverLit GhcRn
lit@(OverLit { ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = OverLitVal
val, ol_ext :: forall p. HsOverLit p -> XOverLit p
ol_ext = OverLitRn rebindable _}) ExpRhoType
exp_res_ty
  | Bool -> Bool
not Bool
rebindable
  , Just TcType
res_ty <- ExpRhoType -> Maybe TcType
checkingExpType_maybe ExpRhoType
exp_res_ty
  = do { DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       ; let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
       ; case Platform -> OverLitVal -> TcType -> Maybe (HsExpr GhcTc)
shortCutLit Platform
platform OverLitVal
val TcType
res_ty of
            Just HsExpr GhcTc
expr -> Maybe (HsOverLit GhcTc) -> TcM (Maybe (HsOverLit GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (HsOverLit GhcTc) -> TcM (Maybe (HsOverLit GhcTc)))
-> Maybe (HsOverLit GhcTc) -> TcM (Maybe (HsOverLit GhcTc))
forall a b. (a -> b) -> a -> b
$ HsOverLit GhcTc -> Maybe (HsOverLit GhcTc)
forall a. a -> Maybe a
Just (HsOverLit GhcTc -> Maybe (HsOverLit GhcTc))
-> HsOverLit GhcTc -> Maybe (HsOverLit GhcTc)
forall a b. (a -> b) -> a -> b
$
                         HsOverLit GhcRn
lit { ol_ext :: XOverLit GhcTc
ol_ext = Bool -> HsExpr GhcTc -> TcType -> OverLitTc
OverLitTc Bool
False HsExpr GhcTc
expr TcType
res_ty }
            Maybe (HsExpr GhcTc)
Nothing   -> Maybe (HsOverLit GhcTc) -> TcM (Maybe (HsOverLit GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (HsOverLit GhcTc)
forall a. Maybe a
Nothing }
  | Bool
otherwise
  = Maybe (HsOverLit GhcTc) -> TcM (Maybe (HsOverLit GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (HsOverLit GhcTc)
forall a. Maybe a
Nothing

shortCutLit :: Platform -> OverLitVal -> TcType -> Maybe (HsExpr GhcTc)
shortCutLit :: Platform -> OverLitVal -> TcType -> Maybe (HsExpr GhcTc)
shortCutLit Platform
platform OverLitVal
val TcType
res_ty
  = case OverLitVal
val of
      HsIntegral IntegralLit
int_lit    -> IntegralLit -> Maybe (HsExpr GhcTc)
go_integral IntegralLit
int_lit
      HsFractional FractionalLit
frac_lit -> FractionalLit -> Maybe (HsExpr GhcTc)
go_fractional FractionalLit
frac_lit
      HsIsString SourceText
s FastString
src      -> SourceText -> FastString -> Maybe (HsExpr GhcTc)
go_string   SourceText
s FastString
src
  where
    go_integral :: IntegralLit -> Maybe (HsExpr GhcTc)
go_integral int :: IntegralLit
int@(IL SourceText
src Bool
neg Integer
i)
      | TcType -> Bool
isIntTy TcType
res_ty  Bool -> Bool -> Bool
&& Platform -> Integer -> Bool
platformInIntRange  Platform
platform Integer
i
      = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
forall a. EpAnn a
noAnn (XHsInt GhcTc -> IntegralLit -> HsLit GhcTc
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt NoExtField
XHsInt GhcTc
noExtField IntegralLit
int))
      | TcType -> Bool
isWordTy TcType
res_ty Bool -> Bool -> Bool
&& Platform -> Integer -> Bool
platformInWordRange Platform
platform Integer
i
      = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit DataCon
wordDataCon (XHsWordPrim GhcTc -> Integer -> HsLit GhcTc
forall x. XHsWordPrim x -> Integer -> HsLit x
HsWordPrim XHsWordPrim GhcTc
SourceText
src Integer
i))
      | TcType -> Bool
isIntegerTy TcType
res_ty
      = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
forall a. EpAnn a
noAnn (XHsInteger GhcTc -> Integer -> TcType -> HsLit GhcTc
forall x. XHsInteger x -> Integer -> TcType -> HsLit x
HsInteger XHsInteger GhcTc
SourceText
src Integer
i TcType
res_ty))
      | Bool
otherwise
      = FractionalLit -> Maybe (HsExpr GhcTc)
go_fractional (Bool -> Integer -> FractionalLit
integralFractionalLit Bool
neg Integer
i)
        -- The 'otherwise' case is important
        -- Consider (3 :: Float).  Syntactically it looks like an IntLit,
        -- so we'll call shortCutIntLit, but of course it's a float
        -- This can make a big difference for programs with a lot of
        -- literals, compiled without -O

    go_fractional :: FractionalLit -> Maybe (HsExpr GhcTc)
go_fractional FractionalLit
f
      | TcType -> Bool
isFloatTy TcType
res_ty Bool -> Bool -> Bool
&& Bool
valueInRange  = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit DataCon
floatDataCon  (XHsFloatPrim GhcTc -> FractionalLit -> HsLit GhcTc
forall x. XHsFloatPrim x -> FractionalLit -> HsLit x
HsFloatPrim NoExtField
XHsFloatPrim GhcTc
noExtField FractionalLit
f))
      | TcType -> Bool
isDoubleTy TcType
res_ty Bool -> Bool -> Bool
&& Bool
valueInRange = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit DataCon
doubleDataCon (XHsDoublePrim GhcTc -> FractionalLit -> HsLit GhcTc
forall x. XHsDoublePrim x -> FractionalLit -> HsLit x
HsDoublePrim NoExtField
XHsDoublePrim GhcTc
noExtField FractionalLit
f))
      | Bool
otherwise                         = Maybe (HsExpr GhcTc)
forall a. Maybe a
Nothing
      where
        valueInRange :: Bool
valueInRange =
          case FractionalLit
f of
            FL { fl_exp :: FractionalLit -> Integer
fl_exp = Integer
e } -> (-Integer
100) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
e Bool -> Bool -> Bool
&& Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
100
            -- We limit short-cutting Fractional Literals to when their power of 10
            -- is less than 100, which ensures desugaring isn't slow.

    go_string :: SourceText -> FastString -> Maybe (HsExpr GhcTc)
go_string SourceText
src FastString
s
      | TcType -> Bool
isStringTy TcType
res_ty = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
forall a. EpAnn a
noAnn (XHsString GhcTc -> FastString -> HsLit GhcTc
forall x. XHsString x -> FastString -> HsLit x
HsString XHsString GhcTc
SourceText
src FastString
s))
      | Bool
otherwise         = Maybe (HsExpr GhcTc)
forall a. Maybe a
Nothing

mkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit DataCon
con HsLit GhcTc
lit = XApp GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcTc
EpAnnCO
noComments (DataCon -> LHsExpr GhcTc
nlHsDataCon DataCon
con) (HsLit GhcTc -> LHsExpr GhcTc
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit HsLit GhcTc
lit)

------------------------------
hsOverLitName :: OverLitVal -> Name
-- Get the canonical 'fromX' name for a particular OverLitVal
hsOverLitName :: OverLitVal -> Name
hsOverLitName (HsIntegral {})   = Name
fromIntegerName
hsOverLitName (HsFractional {}) = Name
fromRationalName
hsOverLitName (HsIsString {})   = Name
fromStringName

{-
************************************************************************
*                                                                      *
\subsection[BackSubst-HsBinds]{Running a substitution over @HsBinds@}
*                                                                      *
************************************************************************

The rest of the zonking is done *after* typechecking.
The main zonking pass runs over the bindings

 a) to convert TcTyVars to TyVars etc, dereferencing any bindings etc
 b) convert unbound TcTyVar to Void
 c) convert each TcId to an Id by zonking its type

The type variables are converted by binding mutable tyvars to immutable ones
and then zonking as normal.

The Ids are converted by binding them in the normal Tc envt; that
way we maintain sharing; eg an Id is zonked at its binding site and they
all occurrences of that Id point to the common zonked copy

It's all pretty boring stuff, because HsSyn is such a large type, and
the environment manipulation is tiresome.
-}

-- Confused by zonking? See Note [What is zonking?] in GHC.Tc.Utils.TcMType.

-- | See Note [The ZonkEnv]
-- Confused by zonking? See Note [What is zonking?] in "GHC.Tc.Utils.TcMType".
data ZonkEnv  -- See Note [The ZonkEnv]
  = ZonkEnv { ZonkEnv -> ZonkFlexi
ze_flexi  :: ZonkFlexi
            , ZonkEnv -> TyCoVarEnv TyCoVar
ze_tv_env :: TyCoVarEnv TyCoVar
            , ZonkEnv -> TyCoVarEnv TyCoVar
ze_id_env :: IdEnv      Id
            , ZonkEnv -> TcRef (TyVarEnv TcType)
ze_meta_tv_env :: TcRef (TyVarEnv Type) }

{- Note [The ZonkEnv]
~~~~~~~~~~~~~~~~~~~~~
* ze_flexi :: ZonkFlexi says what to do with a
  unification variable that is still un-unified.
  See Note [Un-unified unification variables]

* ze_tv_env :: TyCoVarEnv TyCoVar promotes sharing. At a binding site
  of a tyvar or covar, we zonk the kind right away and add a mapping
  to the env. This prevents re-zonking the kind at every
  occurrence. But this is *just* an optimisation.

* ze_id_env : IdEnv Id promotes sharing among Ids, by making all
  occurrences of the Id point to a single zonked copy, built at the
  binding site.

  Unlike ze_tv_env, it is knot-tied: see extendIdZonkEnvRec.
  In a mutually recursive group
     rec { f = ...g...; g = ...f... }
  we want the occurrence of g to point to the one zonked Id for g,
  and the same for f.

  Because it is knot-tied, we must be careful to consult it lazily.
  Specifically, zonkIdOcc is not monadic.

* ze_meta_tv_env: see Note [Sharing when zonking to Type]


Notes:
  * We must be careful never to put coercion variables (which are Ids,
    after all) in the knot-tied ze_id_env, because coercions can
    appear in types, and we sometimes inspect a zonked type in this
    module.  [Question: where, precisely?]

  * In zonkTyVarOcc we consult ze_tv_env in a monadic context,
    a second reason that ze_tv_env can't be monadic.

  * An obvious suggestion would be to have one VarEnv Var to
    replace both ze_id_env and ze_tv_env, but that doesn't work
    because of the knot-tying stuff mentioned above.

Note [Un-unified unification variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
What should we do if we find a Flexi unification variable?
There are three possibilities:

* DefaultFlexi: this is the common case, in situations like
     length @alpha ([] @alpha)
  It really doesn't matter what type we choose for alpha.  But
  we must choose a type!  We can't leave mutable unification
  variables floating around: after typecheck is complete, every
  type variable occurrence must have a binding site.

  So we default it to 'Any' of the right kind.

  All this works for both type and kind variables (indeed
  the two are the same thing).

* SkolemiseFlexi: is a special case for the LHS of RULES.
  See Note [Zonking the LHS of a RULE]

* RuntimeUnkFlexi: is a special case for the GHCi debugger.
  It's a way to have a variable that is not a mutable
  unification variable, but doesn't have a binding site
  either.

* NoFlexi: See Note [Error on unconstrained meta-variables]
  in GHC.Tc.Utils.TcMType. This mode will panic on unfilled
  meta-variables.
-}

data ZonkFlexi   -- See Note [Un-unified unification variables]
  = DefaultFlexi    -- Default unbound unification variables to Any
  | SkolemiseFlexi  -- Skolemise unbound unification variables
                    -- See Note [Zonking the LHS of a RULE]
  | RuntimeUnkFlexi -- Used in the GHCi debugger
  | NoFlexi         -- Panic on unfilled meta-variables
                    -- See Note [Error on unconstrained meta-variables]
                    -- in GHC.Tc.Utils.TcMType

instance Outputable ZonkEnv where
  ppr :: ZonkEnv -> SDoc
ppr (ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv TyCoVar
ze_tv_env = TyCoVarEnv TyCoVar
tv_env
               , ze_id_env :: ZonkEnv -> TyCoVarEnv TyCoVar
ze_id_env = TyCoVarEnv TyCoVar
id_env })
    = String -> SDoc
text String
"ZE" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
braces ([SDoc] -> SDoc
vcat
         [ String -> SDoc
text String
"ze_tv_env =" SDoc -> SDoc -> SDoc
<+> TyCoVarEnv TyCoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCoVarEnv TyCoVar
tv_env
         , String -> SDoc
text String
"ze_id_env =" SDoc -> SDoc -> SDoc
<+> TyCoVarEnv TyCoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCoVarEnv TyCoVar
id_env ])

-- The EvBinds have to already be zonked, but that's usually the case.
emptyZonkEnv :: TcM ZonkEnv
emptyZonkEnv :: TcM ZonkEnv
emptyZonkEnv = ZonkFlexi -> TcM ZonkEnv
mkEmptyZonkEnv ZonkFlexi
DefaultFlexi

mkEmptyZonkEnv :: ZonkFlexi -> TcM ZonkEnv
mkEmptyZonkEnv :: ZonkFlexi -> TcM ZonkEnv
mkEmptyZonkEnv ZonkFlexi
flexi
  = do { TcRef (TyVarEnv TcType)
mtv_env_ref <- TyVarEnv TcType
-> TcRnIf TcGblEnv TcLclEnv (TcRef (TyVarEnv TcType))
forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
newTcRef TyVarEnv TcType
forall a. VarEnv a
emptyVarEnv
       ; ZonkEnv -> TcM ZonkEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv :: ZonkFlexi
-> TyCoVarEnv TyCoVar
-> TyCoVarEnv TyCoVar
-> TcRef (TyVarEnv TcType)
-> ZonkEnv
ZonkEnv { ze_flexi :: ZonkFlexi
ze_flexi = ZonkFlexi
flexi
                         , ze_tv_env :: TyCoVarEnv TyCoVar
ze_tv_env = TyCoVarEnv TyCoVar
forall a. VarEnv a
emptyVarEnv
                         , ze_id_env :: TyCoVarEnv TyCoVar
ze_id_env = TyCoVarEnv TyCoVar
forall a. VarEnv a
emptyVarEnv
                         , ze_meta_tv_env :: TcRef (TyVarEnv TcType)
ze_meta_tv_env = TcRef (TyVarEnv TcType)
mtv_env_ref }) }

initZonkEnv :: (ZonkEnv -> TcM b) -> TcM b
initZonkEnv :: (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ZonkEnv -> TcM b
thing_inside = do { ZonkEnv
ze <- ZonkFlexi -> TcM ZonkEnv
mkEmptyZonkEnv ZonkFlexi
DefaultFlexi
                              ; ZonkEnv -> TcM b
thing_inside ZonkEnv
ze }

-- | Extend the knot-tied environment.
extendIdZonkEnvRec :: ZonkEnv -> [Var] -> ZonkEnv
extendIdZonkEnvRec :: ZonkEnv -> [TyCoVar] -> ZonkEnv
extendIdZonkEnvRec ze :: ZonkEnv
ze@(ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv TyCoVar
ze_id_env = TyCoVarEnv TyCoVar
id_env }) [TyCoVar]
ids
    -- NB: Don't look at the var to decide which env't to put it in. That
    -- would end up knot-tying all the env'ts.
  = ZonkEnv
ze { ze_id_env :: TyCoVarEnv TyCoVar
ze_id_env = TyCoVarEnv TyCoVar -> [(TyCoVar, TyCoVar)] -> TyCoVarEnv TyCoVar
forall a. VarEnv a -> [(TyCoVar, a)] -> VarEnv a
extendVarEnvList TyCoVarEnv TyCoVar
id_env [(TyCoVar
id,TyCoVar
id) | TyCoVar
id <- [TyCoVar]
ids] }
  -- Given coercion variables will actually end up here. That's OK though:
  -- coercion variables are never looked up in the knot-tied env't, so zonking
  -- them simply doesn't get optimised. No one gets hurt. An improvement (?)
  -- would be to do SCC analysis in zonkEvBinds and then only knot-tie the
  -- recursive groups. But perhaps the time it takes to do the analysis is
  -- more than the savings.

extendZonkEnv :: ZonkEnv -> [Var] -> ZonkEnv
extendZonkEnv :: ZonkEnv -> [TyCoVar] -> ZonkEnv
extendZonkEnv ze :: ZonkEnv
ze@(ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv TyCoVar
ze_tv_env = TyCoVarEnv TyCoVar
tyco_env, ze_id_env :: ZonkEnv -> TyCoVarEnv TyCoVar
ze_id_env = TyCoVarEnv TyCoVar
id_env }) [TyCoVar]
vars
  = ZonkEnv
ze { ze_tv_env :: TyCoVarEnv TyCoVar
ze_tv_env = TyCoVarEnv TyCoVar -> [(TyCoVar, TyCoVar)] -> TyCoVarEnv TyCoVar
forall a. VarEnv a -> [(TyCoVar, a)] -> VarEnv a
extendVarEnvList TyCoVarEnv TyCoVar
tyco_env [(TyCoVar
tv,TyCoVar
tv) | TyCoVar
tv <- [TyCoVar]
tycovars]
       , ze_id_env :: TyCoVarEnv TyCoVar
ze_id_env = TyCoVarEnv TyCoVar -> [(TyCoVar, TyCoVar)] -> TyCoVarEnv TyCoVar
forall a. VarEnv a -> [(TyCoVar, a)] -> VarEnv a
extendVarEnvList TyCoVarEnv TyCoVar
id_env   [(TyCoVar
id,TyCoVar
id) | TyCoVar
id <- [TyCoVar]
ids] }
  where
    ([TyCoVar]
tycovars, [TyCoVar]
ids) = (TyCoVar -> Bool) -> [TyCoVar] -> ([TyCoVar], [TyCoVar])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition TyCoVar -> Bool
isTyCoVar [TyCoVar]
vars

extendIdZonkEnv :: ZonkEnv -> Var -> ZonkEnv
extendIdZonkEnv :: ZonkEnv -> TyCoVar -> ZonkEnv
extendIdZonkEnv ze :: ZonkEnv
ze@(ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv TyCoVar
ze_id_env = TyCoVarEnv TyCoVar
id_env }) TyCoVar
id
  = ZonkEnv
ze { ze_id_env :: TyCoVarEnv TyCoVar
ze_id_env = TyCoVarEnv TyCoVar -> TyCoVar -> TyCoVar -> TyCoVarEnv TyCoVar
forall a. VarEnv a -> TyCoVar -> a -> VarEnv a
extendVarEnv TyCoVarEnv TyCoVar
id_env TyCoVar
id TyCoVar
id }

extendTyZonkEnv :: ZonkEnv -> TyVar -> ZonkEnv
extendTyZonkEnv :: ZonkEnv -> TyCoVar -> ZonkEnv
extendTyZonkEnv ze :: ZonkEnv
ze@(ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv TyCoVar
ze_tv_env = TyCoVarEnv TyCoVar
ty_env }) TyCoVar
tv
  = ZonkEnv
ze { ze_tv_env :: TyCoVarEnv TyCoVar
ze_tv_env = TyCoVarEnv TyCoVar -> TyCoVar -> TyCoVar -> TyCoVarEnv TyCoVar
forall a. VarEnv a -> TyCoVar -> a -> VarEnv a
extendVarEnv TyCoVarEnv TyCoVar
ty_env TyCoVar
tv TyCoVar
tv }

setZonkType :: ZonkEnv -> ZonkFlexi -> ZonkEnv
setZonkType :: ZonkEnv -> ZonkFlexi -> ZonkEnv
setZonkType ZonkEnv
ze ZonkFlexi
flexi = ZonkEnv
ze { ze_flexi :: ZonkFlexi
ze_flexi = ZonkFlexi
flexi }

zonkEnvIds :: ZonkEnv -> TypeEnv
zonkEnvIds :: ZonkEnv -> TypeEnv
zonkEnvIds (ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv TyCoVar
ze_id_env = TyCoVarEnv TyCoVar
id_env})
  = [(Name, TyThing)] -> TypeEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(TyCoVar -> Name
forall a. NamedThing a => a -> Name
getName TyCoVar
id, TyCoVar -> TyThing
AnId TyCoVar
id) | TyCoVar
id <- TyCoVarEnv TyCoVar -> [TyCoVar]
forall key elt. UniqFM key elt -> [elt]
nonDetEltsUFM TyCoVarEnv TyCoVar
id_env]
  -- It's OK to use nonDetEltsUFM here because we forget the ordering
  -- immediately by creating a TypeEnv

zonkLIdOcc :: ZonkEnv -> LocatedN TcId -> LocatedN Id
zonkLIdOcc :: ZonkEnv -> LocatedN TyCoVar -> LocatedN TyCoVar
zonkLIdOcc ZonkEnv
env = (TyCoVar -> TyCoVar) -> LocatedN TyCoVar -> LocatedN TyCoVar
forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc (ZonkEnv -> TyCoVar -> TyCoVar
zonkIdOcc ZonkEnv
env)

zonkIdOcc :: ZonkEnv -> TcId -> Id
-- Ids defined in this module should be in the envt;
-- ignore others.  (Actually, data constructors are also
-- not LocalVars, even when locally defined, but that is fine.)
-- (Also foreign-imported things aren't currently in the ZonkEnv;
--  that's ok because they don't need zonking.)
--
-- Actually, Template Haskell works in 'chunks' of declarations, and
-- an earlier chunk won't be in the 'env' that the zonking phase
-- carries around.  Instead it'll be in the tcg_gbl_env, already fully
-- zonked.  There's no point in looking it up there (except for error
-- checking), and it's not conveniently to hand; hence the simple
-- 'orElse' case in the LocalVar branch.
--
-- Even without template splices, in module Main, the checking of
-- 'main' is done as a separate chunk.
zonkIdOcc :: ZonkEnv -> TyCoVar -> TyCoVar
zonkIdOcc (ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv TyCoVar
ze_id_env = TyCoVarEnv TyCoVar
id_env}) TyCoVar
id
  | TyCoVar -> Bool
isLocalVar TyCoVar
id = TyCoVarEnv TyCoVar -> TyCoVar -> Maybe TyCoVar
forall a. VarEnv a -> TyCoVar -> Maybe a
lookupVarEnv TyCoVarEnv TyCoVar
id_env TyCoVar
id Maybe TyCoVar -> TyCoVar -> TyCoVar
forall a. Maybe a -> a -> a
`orElse`
                    TyCoVar
id
  | Bool
otherwise     = TyCoVar
id

zonkIdOccs :: ZonkEnv -> [TcId] -> [Id]
zonkIdOccs :: ZonkEnv -> [TyCoVar] -> [TyCoVar]
zonkIdOccs ZonkEnv
env [TyCoVar]
ids = (TyCoVar -> TyCoVar) -> [TyCoVar] -> [TyCoVar]
forall a b. (a -> b) -> [a] -> [b]
map (ZonkEnv -> TyCoVar -> TyCoVar
zonkIdOcc ZonkEnv
env) [TyCoVar]
ids

-- zonkIdBndr is used *after* typechecking to get the Id's type
-- to its final form.  The TyVarEnv give
zonkIdBndr :: ZonkEnv -> TcId -> TcM Id
zonkIdBndr :: ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env TyCoVar
v
  = do Scaled TcType
w' TcType
ty' <- ZonkEnv -> Scaled TcType -> TcM (Scaled TcType)
zonkScaledTcTypeToTypeX ZonkEnv
env (TyCoVar -> Scaled TcType
idScaledType TyCoVar
v)
       TyCoVar -> TcM TyCoVar
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCoVar -> TcType -> TyCoVar
setIdMult (TyCoVar -> TcType -> TyCoVar
setIdType TyCoVar
v TcType
ty') TcType
w')

zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id]
zonkIdBndrs :: ZonkEnv -> [TyCoVar] -> TcM [TyCoVar]
zonkIdBndrs ZonkEnv
env [TyCoVar]
ids = (TyCoVar -> TcM TyCoVar) -> [TyCoVar] -> TcM [TyCoVar]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env) [TyCoVar]
ids

zonkTopBndrs :: [TcId] -> TcM [Id]
zonkTopBndrs :: [TyCoVar] -> TcM [TyCoVar]
zonkTopBndrs [TyCoVar]
ids = (ZonkEnv -> TcM [TyCoVar]) -> TcM [TyCoVar]
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM [TyCoVar]) -> TcM [TyCoVar])
-> (ZonkEnv -> TcM [TyCoVar]) -> TcM [TyCoVar]
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze -> ZonkEnv -> [TyCoVar] -> TcM [TyCoVar]
zonkIdBndrs ZonkEnv
ze [TyCoVar]
ids

zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc ZonkEnv
env (FieldOcc XCFieldOcc GhcTc
sel XRec GhcTc RdrName
lbl)
  = (TyCoVar -> FieldOcc GhcTc) -> TcM TyCoVar -> TcM (FieldOcc GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((TyCoVar -> GenLocated SrcSpanAnnN RdrName -> FieldOcc GhcTc)
-> GenLocated SrcSpanAnnN RdrName -> TyCoVar -> FieldOcc GhcTc
forall a b c. (a -> b -> c) -> b -> a -> c
flip TyCoVar -> GenLocated SrcSpanAnnN RdrName -> FieldOcc GhcTc
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc) XRec GhcTc RdrName
GenLocated SrcSpanAnnN RdrName
lbl) (TcM TyCoVar -> TcM (FieldOcc GhcTc))
-> TcM TyCoVar -> TcM (FieldOcc GhcTc)
forall a b. (a -> b) -> a -> b
$ ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env XCFieldOcc GhcTc
TyCoVar
sel

zonkEvBndrsX :: ZonkEnv -> [EvVar] -> TcM (ZonkEnv, [Var])
zonkEvBndrsX :: ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
zonkEvBndrsX = (ZonkEnv
 -> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar))
-> ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonkEvBndrX

zonkEvBndrX :: ZonkEnv -> EvVar -> TcM (ZonkEnv, EvVar)
-- Works for dictionaries and coercions
zonkEvBndrX :: ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonkEvBndrX ZonkEnv
env TyCoVar
var
  = do { TyCoVar
var' <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkEvBndr ZonkEnv
env TyCoVar
var
       ; (ZonkEnv, TyCoVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> [TyCoVar] -> ZonkEnv
extendZonkEnv ZonkEnv
env [TyCoVar
var'], TyCoVar
var') }

zonkEvBndr :: ZonkEnv -> EvVar -> TcM EvVar
-- Works for dictionaries and coercions
-- Does not extend the ZonkEnv
zonkEvBndr :: ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkEvBndr ZonkEnv
env TyCoVar
var
  = (TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType)
-> TyCoVar -> TcM TyCoVar
forall (m :: * -> *).
Monad m =>
(TcType -> m TcType) -> TyCoVar -> m TyCoVar
updateIdTypeAndMultM ({-# SCC "zonkEvBndr_zonkTcTypeToType" #-} ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env) TyCoVar
var

{-
zonkEvVarOcc :: ZonkEnv -> EvVar -> TcM EvTerm
zonkEvVarOcc env v
  | isCoVar v
  = EvCoercion <$> zonkCoVarOcc env v
  | otherwise
  = return (EvId $ zonkIdOcc env v)
-}

zonkCoreBndrX :: ZonkEnv -> Var -> TcM (ZonkEnv, Var)
zonkCoreBndrX :: ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonkCoreBndrX ZonkEnv
env TyCoVar
v
  | TyCoVar -> Bool
isId TyCoVar
v = do { TyCoVar
v' <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env TyCoVar
v
                ; (ZonkEnv, TyCoVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> TyCoVar -> ZonkEnv
extendIdZonkEnv ZonkEnv
env TyCoVar
v', TyCoVar
v') }
  | Bool
otherwise = ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonkTyBndrX ZonkEnv
env TyCoVar
v

zonkCoreBndrsX :: ZonkEnv -> [Var] -> TcM (ZonkEnv, [Var])
zonkCoreBndrsX :: ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
zonkCoreBndrsX = (ZonkEnv
 -> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar))
-> ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonkCoreBndrX

zonkTyBndrs :: [TcTyVar] -> TcM (ZonkEnv, [TyVar])
zonkTyBndrs :: [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
zonkTyBndrs [TyCoVar]
tvs = (ZonkEnv -> TcM (ZonkEnv, [TyCoVar])) -> TcM (ZonkEnv, [TyCoVar])
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM (ZonkEnv, [TyCoVar])) -> TcM (ZonkEnv, [TyCoVar]))
-> (ZonkEnv -> TcM (ZonkEnv, [TyCoVar]))
-> TcM (ZonkEnv, [TyCoVar])
forall a b. (a -> b) -> a -> b
$ \ZonkEnv
ze -> ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
zonkTyBndrsX ZonkEnv
ze [TyCoVar]
tvs

zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])
zonkTyBndrsX :: ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
zonkTyBndrsX = (ZonkEnv
 -> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar))
-> ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonkTyBndrX

zonkTyBndrX :: ZonkEnv -> TcTyVar -> TcM (ZonkEnv, TyVar)
-- This guarantees to return a TyVar (not a TcTyVar)
-- then we add it to the envt, so all occurrences are replaced
--
-- It does not clone: the new TyVar has the sane Name
-- as the old one.  This important when zonking the
-- TyVarBndrs of a TyCon, whose Names may scope.
zonkTyBndrX :: ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonkTyBndrX ZonkEnv
env TyCoVar
tv
  = Bool
-> SDoc
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (TyCoVar -> Bool
isImmutableTyVar TyCoVar
tv) (TyCoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCoVar
tv SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCoVar -> TcType
tyVarKind TyCoVar
tv)) (IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
 -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar))
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
forall a b. (a -> b) -> a -> b
$
    do { TcType
ki <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env (TyCoVar -> TcType
tyVarKind TyCoVar
tv)
               -- Internal names tidy up better, for iface files.
       ; let tv' :: TyCoVar
tv' = Name -> TcType -> TyCoVar
mkTyVar (TyCoVar -> Name
tyVarName TyCoVar
tv) TcType
ki
       ; (ZonkEnv, TyCoVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> TyCoVar -> ZonkEnv
extendTyZonkEnv ZonkEnv
env TyCoVar
tv', TyCoVar
tv') }

zonkTyVarBindersX :: ZonkEnv -> [VarBndr TcTyVar vis]
                             -> TcM (ZonkEnv, [VarBndr TyVar vis])
zonkTyVarBindersX :: ZonkEnv
-> [VarBndr TyCoVar vis] -> TcM (ZonkEnv, [VarBndr TyCoVar vis])
zonkTyVarBindersX = (ZonkEnv
 -> VarBndr TyCoVar vis
 -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, VarBndr TyCoVar vis))
-> ZonkEnv
-> [VarBndr TyCoVar vis]
-> TcM (ZonkEnv, [VarBndr TyCoVar vis])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv
-> VarBndr TyCoVar vis
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, VarBndr TyCoVar vis)
forall vis.
ZonkEnv
-> VarBndr TyCoVar vis -> TcM (ZonkEnv, VarBndr TyCoVar vis)
zonkTyVarBinderX

zonkTyVarBinderX :: ZonkEnv -> VarBndr TcTyVar vis
                            -> TcM (ZonkEnv, VarBndr TyVar vis)
-- Takes a TcTyVar and guarantees to return a TyVar
zonkTyVarBinderX :: ZonkEnv
-> VarBndr TyCoVar vis -> TcM (ZonkEnv, VarBndr TyCoVar vis)
zonkTyVarBinderX ZonkEnv
env (Bndr TyCoVar
tv vis
vis)
  = do { (ZonkEnv
env', TyCoVar
tv') <- ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonkTyBndrX ZonkEnv
env TyCoVar
tv
       ; (ZonkEnv, VarBndr TyCoVar vis)
-> TcM (ZonkEnv, VarBndr TyCoVar vis)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', TyCoVar -> vis -> VarBndr TyCoVar vis
forall var argf. var -> argf -> VarBndr var argf
Bndr TyCoVar
tv' vis
vis) }

zonkTopExpr :: HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkTopExpr :: HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkTopExpr HsExpr GhcTc
e = (ZonkEnv -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc)
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc))
-> (ZonkEnv -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze -> ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
ze HsExpr GhcTc
e

zonkTopLExpr :: LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkTopLExpr :: LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkTopLExpr LHsExpr GhcTc
e = (ZonkEnv -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
 -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> (ZonkEnv -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze -> ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
ze LHsExpr GhcTc
e

zonkTopDecls :: Bag EvBind
             -> LHsBinds GhcTc
             -> [LRuleDecl GhcTc] -> [LTcSpecPrag]
             -> [LForeignDecl GhcTc]
             -> TcM (TypeEnv,
                     Bag EvBind,
                     LHsBinds GhcTc,
                     [LForeignDecl GhcTc],
                     [LTcSpecPrag],
                     [LRuleDecl    GhcTc])
zonkTopDecls :: Bag EvBind
-> LHsBinds GhcTc
-> [LRuleDecl GhcTc]
-> [LTcSpecPrag]
-> [LForeignDecl GhcTc]
-> TcM
     (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
      [LTcSpecPrag], [LRuleDecl GhcTc])
zonkTopDecls Bag EvBind
ev_binds LHsBinds GhcTc
binds [LRuleDecl GhcTc]
rules [LTcSpecPrag]
imp_specs [LForeignDecl GhcTc]
fords
  = do  { (ZonkEnv
env1, Bag EvBind
ev_binds') <- (ZonkEnv -> TcM (ZonkEnv, Bag EvBind)) -> TcM (ZonkEnv, Bag EvBind)
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM (ZonkEnv, Bag EvBind))
 -> TcM (ZonkEnv, Bag EvBind))
-> (ZonkEnv -> TcM (ZonkEnv, Bag EvBind))
-> TcM (ZonkEnv, Bag EvBind)
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze -> ZonkEnv -> Bag EvBind -> TcM (ZonkEnv, Bag EvBind)
zonkEvBinds ZonkEnv
ze Bag EvBind
ev_binds
        ; (ZonkEnv
env2, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
binds')    <- ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds ZonkEnv
env1 LHsBinds GhcTc
binds
                        -- Top level is implicitly recursive
        ; [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
rules' <- ZonkEnv -> [LRuleDecl GhcTc] -> TcM [LRuleDecl GhcTc]
zonkRules ZonkEnv
env2 [LRuleDecl GhcTc]
rules
        ; [LTcSpecPrag]
specs' <- ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
zonkLTcSpecPrags ZonkEnv
env2 [LTcSpecPrag]
imp_specs
        ; [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
fords' <- ZonkEnv -> [LForeignDecl GhcTc] -> TcM [LForeignDecl GhcTc]
zonkForeignExports ZonkEnv
env2 [LForeignDecl GhcTc]
fords
        ; (TypeEnv, Bag EvBind,
 Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
 [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)], [LTcSpecPrag],
 [GenLocated SrcSpanAnnA (RuleDecl GhcTc)])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (TypeEnv, Bag EvBind,
      Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
      [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)], [LTcSpecPrag],
      [GenLocated SrcSpanAnnA (RuleDecl GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> TypeEnv
zonkEnvIds ZonkEnv
env2, Bag EvBind
ev_binds', Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
binds', [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
fords', [LTcSpecPrag]
specs', [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
rules') }

---------------------------------------------
zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTc
               -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env (EmptyLocalBinds XEmptyLocalBinds GhcTc GhcTc
x)
  = (ZonkEnv, HsLocalBinds GhcTc) -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, (XEmptyLocalBinds GhcTc GhcTc -> HsLocalBinds GhcTc
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds GhcTc GhcTc
x))

zonkLocalBinds ZonkEnv
_ (HsValBinds XHsValBinds GhcTc GhcTc
_ (ValBinds {}))
  = String -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall a. String -> a
panic String
"zonkLocalBinds" -- Not in typechecker output

zonkLocalBinds ZonkEnv
env (HsValBinds XHsValBinds GhcTc GhcTc
x (XValBindsLR (NValBinds binds sigs)))
  = do  { (ZonkEnv
env1, [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
new_binds) <- ZonkEnv
-> [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv,
      [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
forall a.
ZonkEnv
-> [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv,
      [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
go ZonkEnv
env [(RecFlag, LHsBinds GhcTc)]
[(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
binds
        ; (ZonkEnv, HsLocalBinds GhcTc) -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, XHsValBinds GhcTc GhcTc
-> HsValBindsLR GhcTc GhcTc -> HsLocalBinds GhcTc
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcTc GhcTc
x (XXValBindsLR GhcTc GhcTc -> HsValBindsLR GhcTc GhcTc
forall idL idR. XXValBindsLR idL idR -> HsValBindsLR idL idR
XValBindsLR ([(RecFlag, LHsBinds GhcTc)] -> [LSig GhcRn] -> NHsValBindsLR GhcTc
forall idL.
[(RecFlag, LHsBinds idL)] -> [LSig GhcRn] -> NHsValBindsLR idL
NValBinds [(RecFlag, LHsBinds GhcTc)]
[(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
new_binds [LSig GhcRn]
sigs))) }
  where
    go :: ZonkEnv
-> [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv,
      [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
go ZonkEnv
env []
      = (ZonkEnv,
 [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv,
      [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, [])
    go ZonkEnv
env ((a
r,Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
b):[(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
bs)
      = do { (ZonkEnv
env1, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
b')  <- ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds ZonkEnv
env LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
b
           ; (ZonkEnv
env2, [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
bs') <- ZonkEnv
-> [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv,
      [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
go ZonkEnv
env1 [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
bs
           ; (ZonkEnv,
 [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv,
      [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, (a
r,Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
b')(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
-> [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
forall a. a -> [a] -> [a]
:[(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
bs') }

zonkLocalBinds ZonkEnv
env (HsIPBinds XHsIPBinds GhcTc GhcTc
x (IPBinds XIPBinds GhcTc
dict_binds [LIPBind GhcTc]
binds )) = do
    [GenLocated SrcSpanAnnA (IPBind GhcTc)]
new_binds <- (GenLocated SrcSpanAnnA (IPBind GhcTc)
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (IPBind GhcTc)))
-> [GenLocated SrcSpanAnnA (IPBind GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv) [GenLocated SrcSpanAnnA (IPBind GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((IPBind GhcTc -> TcM (IPBind GhcTc))
-> GenLocated SrcSpanAnnA (IPBind GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (IPBind GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA IPBind GhcTc -> TcM (IPBind GhcTc)
zonk_ip_bind) [LIPBind GhcTc]
[GenLocated SrcSpanAnnA (IPBind GhcTc)]
binds
    let
        env1 :: ZonkEnv
env1 = ZonkEnv -> [TyCoVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env
                 [ XCIPBind GhcTc
TyCoVar
n | (L SrcSpanAnnA
_ (IPBind XCIPBind GhcTc
n XRec GhcTc HsIPName
_ LHsExpr GhcTc
_)) <- [GenLocated SrcSpanAnnA (IPBind GhcTc)]
new_binds]
    (ZonkEnv
env2, TcEvBinds
new_dict_binds) <- ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds)
zonkTcEvBinds ZonkEnv
env1 TcEvBinds
XIPBinds GhcTc
dict_binds
    (ZonkEnv, HsLocalBinds GhcTc) -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, XHsIPBinds GhcTc GhcTc -> HsIPBinds GhcTc -> HsLocalBinds GhcTc
forall idL idR.
XHsIPBinds idL idR -> HsIPBinds idR -> HsLocalBindsLR idL idR
HsIPBinds XHsIPBinds GhcTc GhcTc
x (XIPBinds GhcTc -> [LIPBind GhcTc] -> HsIPBinds GhcTc
forall id. XIPBinds id -> [LIPBind id] -> HsIPBinds id
IPBinds TcEvBinds
XIPBinds GhcTc
new_dict_binds [LIPBind GhcTc]
[GenLocated SrcSpanAnnA (IPBind GhcTc)]
new_binds))
  where
    zonk_ip_bind :: IPBind GhcTc -> TcM (IPBind GhcTc)
zonk_ip_bind (IPBind XCIPBind GhcTc
dict_id XRec GhcTc HsIPName
n LHsExpr GhcTc
e)
        = do TyCoVar
dict_id' <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env XCIPBind GhcTc
TyCoVar
dict_id
             GenLocated SrcSpanAnnA (HsExpr GhcTc)
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
             IPBind GhcTc -> TcM (IPBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCIPBind GhcTc
-> XRec GhcTc HsIPName -> LHsExpr GhcTc -> IPBind GhcTc
forall id.
XCIPBind id -> XRec id HsIPName -> LHsExpr id -> IPBind id
IPBind XCIPBind GhcTc
TyCoVar
dict_id' XRec GhcTc HsIPName
n LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
e')

---------------------------------------------
zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds ZonkEnv
env LHsBinds GhcTc
binds
 = ((ZonkEnv, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (ZonkEnv, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM (\ ~(ZonkEnv
_, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_binds) -> do
        { let env1 :: ZonkEnv
env1 = ZonkEnv -> [TyCoVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env (CollectFlag GhcTc -> LHsBinds GhcTc -> [IdP GhcTc]
forall p idR.
CollectPass p =>
CollectFlag p -> LHsBindsLR p idR -> [IdP p]
collectHsBindsBinders CollectFlag GhcTc
forall p. CollectFlag p
CollNoDictBinders LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_binds)
        ; Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
binds' <- ZonkEnv -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
zonkMonoBinds ZonkEnv
env1 LHsBinds GhcTc
binds
        ; (ZonkEnv, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
binds') })

---------------------------------------------
zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
zonkMonoBinds ZonkEnv
env LHsBinds GhcTc
binds = (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM (ZonkEnv -> LHsBind GhcTc -> TcM (LHsBind GhcTc)
zonk_lbind ZonkEnv
env) LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
binds

zonk_lbind :: ZonkEnv -> LHsBind GhcTc -> TcM (LHsBind GhcTc)
zonk_lbind :: ZonkEnv -> LHsBind GhcTc -> TcM (LHsBind GhcTc)
zonk_lbind ZonkEnv
env = (HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc))
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
zonk_bind ZonkEnv
env)

zonk_bind :: ZonkEnv -> HsBind GhcTc -> TcM (HsBind GhcTc)
zonk_bind :: ZonkEnv -> HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
zonk_bind ZonkEnv
env bind :: HsBindLR GhcTc GhcTc
bind@(PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat GhcTc
pat, pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_rhs = GRHSs GhcTc (LHsExpr GhcTc)
grhss
                            , pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
pat_ext = XPatBind GhcTc GhcTc
ty})
  = do  { (ZonkEnv
_env, GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat) <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat            -- Env already extended
        ; GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_grhss <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> TcM (GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> GRHSs GhcTc (LocatedA (body GhcTc))
-> TcM (GRHSs GhcTc (LocatedA (body GhcTc)))
zonkGRHSs ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
zonkLExpr GRHSs GhcTc (LHsExpr GhcTc)
GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
grhss
        ; TcType
new_ty    <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env XPatBind GhcTc GhcTc
TcType
ty
        ; HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBindLR GhcTc GhcTc
bind { pat_lhs :: LPat GhcTc
pat_lhs = LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat, pat_rhs :: GRHSs GhcTc (LHsExpr GhcTc)
pat_rhs = GRHSs GhcTc (LHsExpr GhcTc)
GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_grhss
                       , pat_ext :: XPatBind GhcTc GhcTc
pat_ext = XPatBind GhcTc GhcTc
TcType
new_ty }) }

zonk_bind ZonkEnv
env (VarBind { var_ext :: forall idL idR. HsBindLR idL idR -> XVarBind idL idR
var_ext = XVarBind GhcTc GhcTc
x
                       , var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id = IdP GhcTc
var, var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
var_rhs = LHsExpr GhcTc
expr })
  = do { TyCoVar
new_var  <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env IdP GhcTc
TyCoVar
var
       ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
       ; HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarBind :: forall idL idR.
XVarBind idL idR -> IdP idL -> LHsExpr idR -> HsBindLR idL idR
VarBind { var_ext :: XVarBind GhcTc GhcTc
var_ext = XVarBind GhcTc GhcTc
x
                         , var_id :: IdP GhcTc
var_id = IdP GhcTc
TyCoVar
new_var
                         , var_rhs :: LHsExpr GhcTc
var_rhs = LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr }) }

zonk_bind ZonkEnv
env bind :: HsBindLR GhcTc GhcTc
bind@(FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = L loc var
                            , fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
ms
                            , fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_ext = XFunBind GhcTc GhcTc
co_fn })
  = do { TyCoVar
new_var <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env TyCoVar
var
       ; (ZonkEnv
env1, HsWrapper
new_co_fn) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
XFunBind GhcTc GhcTc
co_fn
       ; MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_ms <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> TcM (MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env1 ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
ms
       ; HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBindLR GhcTc GhcTc
bind { fun_id :: LIdP GhcTc
fun_id = SrcSpanAnnN -> TyCoVar -> LocatedN TyCoVar
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc TyCoVar
new_var
                      , fun_matches :: MatchGroup GhcTc (LHsExpr GhcTc)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_ms
                      , fun_ext :: XFunBind GhcTc GhcTc
fun_ext = HsWrapper
XFunBind GhcTc GhcTc
new_co_fn }) }

zonk_bind ZonkEnv
env (XHsBindsLR (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
                                    , abs_ev_binds = ev_binds
                                    , abs_exports = exports
                                    , abs_binds = val_binds
                                    , abs_sig = has_sig }))
  = Bool -> TcM (HsBindLR GhcTc GhcTc) -> TcM (HsBindLR GhcTc GhcTc)
forall a. HasCallStack => Bool -> a -> a
assert ( (TyCoVar -> Bool) -> [TyCoVar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TyCoVar -> Bool
isImmutableTyVar [TyCoVar]
tyvars ) (TcM (HsBindLR GhcTc GhcTc) -> TcM (HsBindLR GhcTc GhcTc))
-> TcM (HsBindLR GhcTc GhcTc) -> TcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$
    do { (ZonkEnv
env0, [TyCoVar]
new_tyvars) <- ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
zonkTyBndrsX ZonkEnv
env [TyCoVar]
tyvars
       ; (ZonkEnv
env1, [TyCoVar]
new_evs) <- ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
zonkEvBndrsX ZonkEnv
env0 [TyCoVar]
evs
       ; (ZonkEnv
env2, [TcEvBinds]
new_ev_binds) <- ZonkEnv -> [TcEvBinds] -> TcM (ZonkEnv, [TcEvBinds])
zonkTcEvBinds_s ZonkEnv
env1 [TcEvBinds]
ev_binds
       ; (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_bind, [ABExport]
new_exports) <- ((Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM (((Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
  -> IOEnv
       (Env TcGblEnv TcLclEnv)
       (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
-> ((Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
     [ABExport])
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
forall a b. (a -> b) -> a -> b
$ \ ~(Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_binds, [ABExport]
_) ->
         do { let env3 :: ZonkEnv
env3 = ZonkEnv -> [TyCoVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env2 ([TyCoVar] -> ZonkEnv) -> [TyCoVar] -> ZonkEnv
forall a b. (a -> b) -> a -> b
$
                         CollectFlag GhcTc -> LHsBinds GhcTc -> [IdP GhcTc]
forall p idR.
CollectPass p =>
CollectFlag p -> LHsBindsLR p idR -> [IdP p]
collectHsBindsBinders CollectFlag GhcTc
forall p. CollectFlag p
CollNoDictBinders LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_binds
            ; Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_binds <- (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM (ZonkEnv
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
zonk_val_bind ZonkEnv
env3) LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
val_binds
            ; [ABExport]
new_exports   <- (ABExport -> IOEnv (Env TcGblEnv TcLclEnv) ABExport)
-> [ABExport] -> IOEnv (Env TcGblEnv TcLclEnv) [ABExport]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> ABExport -> IOEnv (Env TcGblEnv TcLclEnv) ABExport
zonk_export ZonkEnv
env3) [ABExport]
exports
            ; (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_binds, [ABExport]
new_exports) }
       ; HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc))
-> HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$ XXHsBindsLR GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall idL idR. XXHsBindsLR idL idR -> HsBindLR idL idR
XHsBindsLR (XXHsBindsLR GhcTc GhcTc -> HsBindLR GhcTc GhcTc)
-> XXHsBindsLR GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall a b. (a -> b) -> a -> b
$
                 AbsBinds :: [TyCoVar]
-> [TyCoVar]
-> [ABExport]
-> [TcEvBinds]
-> LHsBinds GhcTc
-> Bool
-> AbsBinds
AbsBinds { abs_tvs :: [TyCoVar]
abs_tvs = [TyCoVar]
new_tyvars, abs_ev_vars :: [TyCoVar]
abs_ev_vars = [TyCoVar]
new_evs
                          , abs_ev_binds :: [TcEvBinds]
abs_ev_binds = [TcEvBinds]
new_ev_binds
                          , abs_exports :: [ABExport]
abs_exports = [ABExport]
new_exports, abs_binds :: LHsBinds GhcTc
abs_binds = LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_bind
                          , abs_sig :: Bool
abs_sig = Bool
has_sig } }
  where
    zonk_val_bind :: ZonkEnv
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
zonk_val_bind ZonkEnv
env GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
lbind
      | Bool
has_sig
      , (L SrcSpanAnnA
loc bind :: HsBindLR GhcTc GhcTc
bind@(FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id      = (L mloc mono_id)
                             , fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
ms
                             , fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_ext     = XFunBind GhcTc GhcTc
co_fn })) <- GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
lbind
      = do { TyCoVar
new_mono_id <- (TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType)
-> TyCoVar -> TcM TyCoVar
forall (m :: * -> *).
Monad m =>
(TcType -> m TcType) -> TyCoVar -> m TyCoVar
updateIdTypeAndMultM (ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env) TyCoVar
mono_id
                            -- Specifically /not/ zonkIdBndr; we do not want to
                            -- complain about a representation-polymorphic binder
           ; (ZonkEnv
env', HsWrapper
new_co_fn) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
XFunBind GhcTc GhcTc
co_fn
           ; MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_ms            <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> TcM (MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env' ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
ms
           ; GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsBindLR GhcTc GhcTc
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsBindLR GhcTc GhcTc
 -> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> HsBindLR GhcTc GhcTc
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$
             HsBindLR GhcTc GhcTc
bind { fun_id :: LIdP GhcTc
fun_id      = SrcSpanAnnN -> TyCoVar -> LocatedN TyCoVar
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
mloc TyCoVar
new_mono_id
                  , fun_matches :: MatchGroup GhcTc (LHsExpr GhcTc)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_ms
                  , fun_ext :: XFunBind GhcTc GhcTc
fun_ext     = HsWrapper
XFunBind GhcTc GhcTc
new_co_fn } }
      | Bool
otherwise
      = ZonkEnv -> LHsBind GhcTc -> TcM (LHsBind GhcTc)
zonk_lbind ZonkEnv
env LHsBind GhcTc
GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
lbind   -- The normal case

    zonk_export :: ZonkEnv -> ABExport -> TcM ABExport
    zonk_export :: ZonkEnv -> ABExport -> IOEnv (Env TcGblEnv TcLclEnv) ABExport
zonk_export ZonkEnv
env (ABE{ abe_wrap :: ABExport -> HsWrapper
abe_wrap = HsWrapper
wrap
                        , abe_poly :: ABExport -> TyCoVar
abe_poly = TyCoVar
poly_id
                        , abe_mono :: ABExport -> TyCoVar
abe_mono = TyCoVar
mono_id
                        , abe_prags :: ABExport -> TcSpecPrags
abe_prags = TcSpecPrags
prags })
        = do TyCoVar
new_poly_id <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env TyCoVar
poly_id
             (ZonkEnv
_, HsWrapper
new_wrap) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
wrap
             TcSpecPrags
new_prags <- ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags
zonkSpecPrags ZonkEnv
env TcSpecPrags
prags
             ABExport -> IOEnv (Env TcGblEnv TcLclEnv) ABExport
forall (m :: * -> *) a. Monad m => a -> m a
return (ABE :: TyCoVar -> TyCoVar -> HsWrapper -> TcSpecPrags -> ABExport
ABE{ abe_wrap :: HsWrapper
abe_wrap = HsWrapper
new_wrap
                        , abe_poly :: TyCoVar
abe_poly = TyCoVar
new_poly_id
                        , abe_mono :: TyCoVar
abe_mono = ZonkEnv -> TyCoVar -> TyCoVar
zonkIdOcc ZonkEnv
env TyCoVar
mono_id
                        , abe_prags :: TcSpecPrags
abe_prags = TcSpecPrags
new_prags })

zonk_bind ZonkEnv
env (PatSynBind XPatSynBind GhcTc GhcTc
x bind :: PatSynBind GhcTc GhcTc
bind@(PSB { psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id = L loc id
                                      , psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_args = HsPatSynDetails GhcTc
details
                                      , psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_def = LPat GhcTc
lpat
                                      , psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir = HsPatSynDir GhcTc
dir }))
  = do { TyCoVar
id' <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env TyCoVar
id
       ; (ZonkEnv
env1, GenLocated SrcSpanAnnA (Pat GhcTc)
lpat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
lpat
       ; HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc]
details' <- ZonkEnv -> HsPatSynDetails GhcTc -> TcM (HsPatSynDetails GhcTc)
zonkPatSynDetails ZonkEnv
env1 HsPatSynDetails GhcTc
details
       ; (ZonkEnv
_env2, HsPatSynDir GhcTc
dir') <- ZonkEnv -> HsPatSynDir GhcTc -> TcM (ZonkEnv, HsPatSynDir GhcTc)
zonkPatSynDir ZonkEnv
env1 HsPatSynDir GhcTc
dir
       ; HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc))
-> HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$ XPatSynBind GhcTc GhcTc
-> PatSynBind GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall idL idR.
XPatSynBind idL idR -> PatSynBind idL idR -> HsBindLR idL idR
PatSynBind XPatSynBind GhcTc GhcTc
x (PatSynBind GhcTc GhcTc -> HsBindLR GhcTc GhcTc)
-> PatSynBind GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall a b. (a -> b) -> a -> b
$
                  PatSynBind GhcTc GhcTc
bind { psb_id :: LIdP GhcTc
psb_id = SrcSpanAnnN -> TyCoVar -> LocatedN TyCoVar
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc TyCoVar
id'
                       , psb_args :: HsPatSynDetails GhcTc
psb_args = HsPatSynDetails GhcTc
HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc]
details'
                       , psb_def :: LPat GhcTc
psb_def = LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
lpat'
                       , psb_dir :: HsPatSynDir GhcTc
psb_dir = HsPatSynDir GhcTc
dir' } }

zonkPatSynDetails :: ZonkEnv
                  -> HsPatSynDetails GhcTc
                  -> TcM (HsPatSynDetails GhcTc)
zonkPatSynDetails :: ZonkEnv -> HsPatSynDetails GhcTc -> TcM (HsPatSynDetails GhcTc)
zonkPatSynDetails ZonkEnv
env (PrefixCon [Void]
_ [LIdP GhcTc]
as)
  = HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc]
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc]))
-> HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc])
forall a b. (a -> b) -> a -> b
$ [Void]
-> [LocatedN TyCoVar]
-> HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc]
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [Void]
noTypeArgs ((LocatedN TyCoVar -> LocatedN TyCoVar)
-> [LocatedN TyCoVar] -> [LocatedN TyCoVar]
forall a b. (a -> b) -> [a] -> [b]
map (ZonkEnv -> LocatedN TyCoVar -> LocatedN TyCoVar
zonkLIdOcc ZonkEnv
env) [LIdP GhcTc]
[LocatedN TyCoVar]
as)
zonkPatSynDetails ZonkEnv
env (InfixCon LIdP GhcTc
a1 LIdP GhcTc
a2)
  = HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc]
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc]))
-> HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc])
forall a b. (a -> b) -> a -> b
$ LocatedN TyCoVar
-> LocatedN TyCoVar
-> HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc]
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon (ZonkEnv -> LocatedN TyCoVar -> LocatedN TyCoVar
zonkLIdOcc ZonkEnv
env LIdP GhcTc
LocatedN TyCoVar
a1) (ZonkEnv -> LocatedN TyCoVar -> LocatedN TyCoVar
zonkLIdOcc ZonkEnv
env LIdP GhcTc
LocatedN TyCoVar
a2)
zonkPatSynDetails ZonkEnv
env (RecCon [RecordPatSynField GhcTc]
flds)
  = [RecordPatSynField GhcTc]
-> HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc]
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon ([RecordPatSynField GhcTc]
 -> HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc])
-> IOEnv (Env TcGblEnv TcLclEnv) [RecordPatSynField GhcTc]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (HsConDetails Void (LocatedN TyCoVar) [RecordPatSynField GhcTc])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RecordPatSynField GhcTc
 -> IOEnv (Env TcGblEnv TcLclEnv) (RecordPatSynField GhcTc))
-> [RecordPatSynField GhcTc]
-> IOEnv (Env TcGblEnv TcLclEnv) [RecordPatSynField GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv
-> RecordPatSynField GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (RecordPatSynField GhcTc)
zonkPatSynField ZonkEnv
env) [RecordPatSynField GhcTc]
flds

zonkPatSynField :: ZonkEnv -> RecordPatSynField GhcTc -> TcM (RecordPatSynField GhcTc)
zonkPatSynField :: ZonkEnv
-> RecordPatSynField GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (RecordPatSynField GhcTc)
zonkPatSynField ZonkEnv
env (RecordPatSynField FieldOcc GhcTc
x LIdP GhcTc
y) =
    FieldOcc GhcTc -> LocatedN TyCoVar -> RecordPatSynField GhcTc
forall pass. FieldOcc pass -> LIdP pass -> RecordPatSynField pass
RecordPatSynField (FieldOcc GhcTc -> LocatedN TyCoVar -> RecordPatSynField GhcTc)
-> TcM (FieldOcc GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (LocatedN TyCoVar -> RecordPatSynField GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc ZonkEnv
env FieldOcc GhcTc
x IOEnv
  (Env TcGblEnv TcLclEnv)
  (LocatedN TyCoVar -> RecordPatSynField GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedN TyCoVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (RecordPatSynField GhcTc)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LocatedN TyCoVar
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedN TyCoVar)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ZonkEnv -> LocatedN TyCoVar -> LocatedN TyCoVar
zonkLIdOcc ZonkEnv
env LIdP GhcTc
LocatedN TyCoVar
y)

zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTc
              -> TcM (ZonkEnv, HsPatSynDir GhcTc)
zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTc -> TcM (ZonkEnv, HsPatSynDir GhcTc)
zonkPatSynDir ZonkEnv
env HsPatSynDir GhcTc
Unidirectional        = (ZonkEnv, HsPatSynDir GhcTc) -> TcM (ZonkEnv, HsPatSynDir GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, HsPatSynDir GhcTc
forall id. HsPatSynDir id
Unidirectional)
zonkPatSynDir ZonkEnv
env HsPatSynDir GhcTc
ImplicitBidirectional = (ZonkEnv, HsPatSynDir GhcTc) -> TcM (ZonkEnv, HsPatSynDir GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, HsPatSynDir GhcTc
forall id. HsPatSynDir id
ImplicitBidirectional)
zonkPatSynDir ZonkEnv
env (ExplicitBidirectional MatchGroup GhcTc (LHsExpr GhcTc)
mg) = do
    MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
mg' <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> TcM (MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
mg
    (ZonkEnv, HsPatSynDir GhcTc) -> TcM (ZonkEnv, HsPatSynDir GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, MatchGroup GhcTc (LHsExpr GhcTc) -> HsPatSynDir GhcTc
forall id. MatchGroup id (LHsExpr id) -> HsPatSynDir id
ExplicitBidirectional MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
mg')

zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags
zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags
zonkSpecPrags ZonkEnv
_   TcSpecPrags
IsDefaultMethod = TcSpecPrags -> TcM TcSpecPrags
forall (m :: * -> *) a. Monad m => a -> m a
return TcSpecPrags
IsDefaultMethod
zonkSpecPrags ZonkEnv
env (SpecPrags [LTcSpecPrag]
ps)  = do { [LTcSpecPrag]
ps' <- ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
zonkLTcSpecPrags ZonkEnv
env [LTcSpecPrag]
ps
                                       ; TcSpecPrags -> TcM TcSpecPrags
forall (m :: * -> *) a. Monad m => a -> m a
return ([LTcSpecPrag] -> TcSpecPrags
SpecPrags [LTcSpecPrag]
ps') }

zonkLTcSpecPrags :: ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
zonkLTcSpecPrags :: ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
zonkLTcSpecPrags ZonkEnv
env [LTcSpecPrag]
ps
  = (LTcSpecPrag -> IOEnv (Env TcGblEnv TcLclEnv) LTcSpecPrag)
-> [LTcSpecPrag] -> TcM [LTcSpecPrag]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LTcSpecPrag -> IOEnv (Env TcGblEnv TcLclEnv) LTcSpecPrag
zonk_prag [LTcSpecPrag]
ps
  where
    zonk_prag :: LTcSpecPrag -> IOEnv (Env TcGblEnv TcLclEnv) LTcSpecPrag
zonk_prag (L SrcSpan
loc (SpecPrag TyCoVar
id HsWrapper
co_fn InlinePragma
inl))
        = do { (ZonkEnv
_, HsWrapper
co_fn') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
co_fn
             ; LTcSpecPrag -> IOEnv (Env TcGblEnv TcLclEnv) LTcSpecPrag
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> TcSpecPrag -> LTcSpecPrag
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (TyCoVar -> HsWrapper -> InlinePragma -> TcSpecPrag
SpecPrag (ZonkEnv -> TyCoVar -> TyCoVar
zonkIdOcc ZonkEnv
env TyCoVar
id) HsWrapper
co_fn' InlinePragma
inl)) }

{-
************************************************************************
*                                                                      *
\subsection[BackSubst-Match-GRHSs]{Match and GRHSs}
*                                                                      *
************************************************************************
-}

zonkMatchGroup :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns
            => ZonkEnv
            -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
            -> MatchGroup GhcTc (LocatedA (body GhcTc))
            -> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup :: ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L l ms
                             , mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext = MatchGroupTc arg_tys res_ty
                             , mg_origin :: forall p body. MatchGroup p body -> Origin
mg_origin = Origin
origin })
  = do  { [GenLocated
   (Anno (Match GhcTc (LocatedA (body GhcTc))))
   (Match GhcTc (LocatedA (body GhcTc)))]
ms' <- (GenLocated
   (Anno (Match GhcTc (LocatedA (body GhcTc))))
   (Match GhcTc (LocatedA (body GhcTc)))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated
         (Anno (Match GhcTc (LocatedA (body GhcTc))))
         (Match GhcTc (LocatedA (body GhcTc)))))
-> [GenLocated
      (Anno (Match GhcTc (LocatedA (body GhcTc))))
      (Match GhcTc (LocatedA (body GhcTc)))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [GenLocated
        (Anno (Match GhcTc (LocatedA (body GhcTc))))
        (Match GhcTc (LocatedA (body GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> LMatch GhcTc (LocatedA (body GhcTc))
-> TcM (LMatch GhcTc (LocatedA (body GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> LMatch GhcTc (LocatedA (body GhcTc))
-> TcM (LMatch GhcTc (LocatedA (body GhcTc)))
zonkMatch ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody) [GenLocated
   (Anno (Match GhcTc (LocatedA (body GhcTc))))
   (Match GhcTc (LocatedA (body GhcTc)))]
ms
        ; [Scaled TcType]
arg_tys' <- ZonkEnv -> [Scaled TcType] -> TcM [Scaled TcType]
zonkScaledTcTypesToTypesX ZonkEnv
env [Scaled TcType]
arg_tys
        ; TcType
res_ty'  <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
res_ty
        ; MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (MG :: forall p body.
XMG p body -> XRec p [LMatch p body] -> Origin -> MatchGroup p body
MG { mg_alts :: XRec GhcTc [LMatch GhcTc (LocatedA (body GhcTc))]
mg_alts = Anno
  [GenLocated
     (Anno (Match GhcTc (LocatedA (body GhcTc))))
     (Match GhcTc (LocatedA (body GhcTc)))]
-> [GenLocated
      (Anno (Match GhcTc (LocatedA (body GhcTc))))
      (Match GhcTc (LocatedA (body GhcTc)))]
-> GenLocated
     (Anno
        [GenLocated
           (Anno (Match GhcTc (LocatedA (body GhcTc))))
           (Match GhcTc (LocatedA (body GhcTc)))])
     [GenLocated
        (Anno (Match GhcTc (LocatedA (body GhcTc))))
        (Match GhcTc (LocatedA (body GhcTc)))]
forall l e. l -> e -> GenLocated l e
L Anno
  [GenLocated
     (Anno (Match GhcTc (LocatedA (body GhcTc))))
     (Match GhcTc (LocatedA (body GhcTc)))]
l [GenLocated
   (Anno (Match GhcTc (LocatedA (body GhcTc))))
   (Match GhcTc (LocatedA (body GhcTc)))]
ms'
                     , mg_ext :: XMG GhcTc (LocatedA (body GhcTc))
mg_ext = [Scaled TcType] -> TcType -> MatchGroupTc
MatchGroupTc [Scaled TcType]
arg_tys' TcType
res_ty'
                     , mg_origin :: Origin
mg_origin = Origin
origin }) }

zonkMatch :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns
          => ZonkEnv
          -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
          -> LMatch GhcTc (LocatedA (body GhcTc))
          -> TcM (LMatch GhcTc (LocatedA (body GhcTc)))
zonkMatch :: ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> LMatch GhcTc (LocatedA (body GhcTc))
-> TcM (LMatch GhcTc (LocatedA (body GhcTc)))
zonkMatch ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (L loc match@(Match { m_pats = pats
                                        , m_grhss = grhss }))
  = do  { (ZonkEnv
env1, [GenLocated SrcSpanAnnA (Pat GhcTc)]
new_pats) <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env [LPat GhcTc]
pats
        ; GRHSs GhcTc (LocatedA (body GhcTc))
new_grhss <- ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> GRHSs GhcTc (LocatedA (body GhcTc))
-> TcM (GRHSs GhcTc (LocatedA (body GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> GRHSs GhcTc (LocatedA (body GhcTc))
-> TcM (GRHSs GhcTc (LocatedA (body GhcTc)))
zonkGRHSs ZonkEnv
env1 ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody GRHSs GhcTc (LocatedA (body GhcTc))
grhss
        ; GenLocated
  (Anno (Match GhcTc (LocatedA (body GhcTc))))
  (Match GhcTc (LocatedA (body GhcTc)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        (Anno (Match GhcTc (LocatedA (body GhcTc))))
        (Match GhcTc (LocatedA (body GhcTc))))
forall (m :: * -> *) a. Monad m => a -> m a
return (Anno (Match GhcTc (LocatedA (body GhcTc)))
-> Match GhcTc (LocatedA (body GhcTc))
-> GenLocated
     (Anno (Match GhcTc (LocatedA (body GhcTc))))
     (Match GhcTc (LocatedA (body GhcTc)))
forall l e. l -> e -> GenLocated l e
L Anno (Match GhcTc (LocatedA (body GhcTc)))
loc (Match GhcTc (LocatedA (body GhcTc))
match { m_pats :: [LPat GhcTc]
m_pats = [LPat GhcTc]
[GenLocated SrcSpanAnnA (Pat GhcTc)]
new_pats, m_grhss :: GRHSs GhcTc (LocatedA (body GhcTc))
m_grhss = GRHSs GhcTc (LocatedA (body GhcTc))
new_grhss })) }

-------------------------------------------------------------------------
zonkGRHSs :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns
          => ZonkEnv
          -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
          -> GRHSs GhcTc (LocatedA (body GhcTc))
          -> TcM (GRHSs GhcTc (LocatedA (body GhcTc)))

zonkGRHSs :: ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> GRHSs GhcTc (LocatedA (body GhcTc))
-> TcM (GRHSs GhcTc (LocatedA (body GhcTc)))
zonkGRHSs ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (GRHSs XCGRHSs GhcTc (LocatedA (body GhcTc))
x [LGRHS GhcTc (LocatedA (body GhcTc))]
grhss HsLocalBinds GhcTc
binds) = do
    (ZonkEnv
new_env, HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env HsLocalBinds GhcTc
binds
    let
        zonk_grhs :: GRHS GhcTc (LocatedA (body GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LocatedA (body GhcTc)))
zonk_grhs (GRHS XCGRHS GhcTc (LocatedA (body GhcTc))
xx [GuardLStmt GhcTc]
guarded LocatedA (body GhcTc)
rhs)
          = do (ZonkEnv
env2, [GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
new_guarded) <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
-> TcM
     (ZonkEnv, [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
new_env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
guarded
               LocatedA (body GhcTc)
new_rhs <- ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody ZonkEnv
env2 LocatedA (body GhcTc)
rhs
               GRHS GhcTc (LocatedA (body GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LocatedA (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (XCGRHS GhcTc (LocatedA (body GhcTc))
-> [GuardLStmt GhcTc]
-> LocatedA (body GhcTc)
-> GRHS GhcTc (LocatedA (body GhcTc))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcTc (LocatedA (body GhcTc))
xx [GuardLStmt GhcTc]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
new_guarded LocatedA (body GhcTc)
new_rhs)
    [GenLocated (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))]
new_grhss <- (GenLocated (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated
         (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))))
-> [GenLocated
      (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [GenLocated (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((GRHS GhcTc (LocatedA (body GhcTc))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LocatedA (body GhcTc))))
-> GenLocated
     (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc))))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA GRHS GhcTc (LocatedA (body GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LocatedA (body GhcTc)))
zonk_grhs) [LGRHS GhcTc (LocatedA (body GhcTc))]
[GenLocated (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))]
grhss
    GRHSs GhcTc (LocatedA (body GhcTc))
-> TcM (GRHSs GhcTc (LocatedA (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (XCGRHSs GhcTc (LocatedA (body GhcTc))
-> [LGRHS GhcTc (LocatedA (body GhcTc))]
-> HsLocalBinds GhcTc
-> GRHSs GhcTc (LocatedA (body GhcTc))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcTc (LocatedA (body GhcTc))
x [LGRHS GhcTc (LocatedA (body GhcTc))]
[GenLocated (SrcAnn NoEpAnns) (GRHS GhcTc (LocatedA (body GhcTc)))]
new_grhss HsLocalBinds GhcTc
new_binds)

{-
************************************************************************
*                                                                      *
\subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr}
*                                                                      *
************************************************************************
-}

zonkLExprs :: ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc]
zonkLExpr  :: ZonkEnv -> LHsExpr GhcTc   -> TcM (LHsExpr GhcTc)
zonkExpr   :: ZonkEnv -> HsExpr GhcTc    -> TcM (HsExpr GhcTc)

zonkLExprs :: ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc]
zonkLExprs ZonkEnv
env [LHsExpr GhcTc]
exprs = (GenLocated SrcSpanAnnA (HsExpr GhcTc)
 -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv) [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env) [LHsExpr GhcTc]
[GenLocated SrcSpanAnnA (HsExpr GhcTc)]
exprs
zonkLExpr :: ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr  ZonkEnv
env LHsExpr GhcTc
expr  = (HsExpr GhcTc -> TcM (HsExpr GhcTc))
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env) LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
expr

zonkExpr :: ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env (HsVar XVar GhcTc
x (L l id))
  = Bool -> SDoc -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Maybe DataCon -> Bool
forall a. Maybe a -> Bool
isNothing (TyCoVar -> Maybe DataCon
isDataConId_maybe TyCoVar
id)) (TyCoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCoVar
id) (TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc))
-> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$
    HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcTc -> LIdP GhcTc -> HsExpr GhcTc
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcTc
x (SrcSpanAnnN -> TyCoVar -> LocatedN TyCoVar
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l (ZonkEnv -> TyCoVar -> TyCoVar
zonkIdOcc ZonkEnv
env TyCoVar
id)))

zonkExpr ZonkEnv
env (HsUnboundVar XUnboundVar GhcTc
her OccName
occ)
  = do HoleExprRef
her' <- HoleExprRef -> TcM HoleExprRef
zonk_her HoleExprRef
XUnboundVar GhcTc
her
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XUnboundVar GhcTc -> OccName -> HsExpr GhcTc
forall p. XUnboundVar p -> OccName -> HsExpr p
HsUnboundVar HoleExprRef
XUnboundVar GhcTc
her' OccName
occ)
  where
    zonk_her :: HoleExprRef -> TcM HoleExprRef
    zonk_her :: HoleExprRef -> TcM HoleExprRef
zonk_her (HER IORef EvTerm
ref TcType
ty Unique
u)
      = do IORef EvTerm
-> (EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm)
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a env. IORef a -> (a -> IOEnv env a) -> IOEnv env ()
updMutVarM IORef EvTerm
ref (ZonkEnv -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
zonkEvTerm ZonkEnv
env)
           TcType
ty'  <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
ty
           HoleExprRef -> TcM HoleExprRef
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef EvTerm -> TcType -> Unique -> HoleExprRef
HER IORef EvTerm
ref TcType
ty' Unique
u)

zonkExpr ZonkEnv
env (HsRecSel XRecSel GhcTc
_ (FieldOcc XCFieldOcc GhcTc
v XRec GhcTc RdrName
occ))
  = HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XRecSel GhcTc -> FieldOcc GhcTc -> HsExpr GhcTc
forall p. XRecSel p -> FieldOcc p -> HsExpr p
HsRecSel NoExtField
XRecSel GhcTc
noExtField (XCFieldOcc GhcTc -> XRec GhcTc RdrName -> FieldOcc GhcTc
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc (ZonkEnv -> TyCoVar -> TyCoVar
zonkIdOcc ZonkEnv
env XCFieldOcc GhcTc
TyCoVar
v) XRec GhcTc RdrName
occ))

zonkExpr ZonkEnv
_ (HsIPVar XIPVar GhcTc
x HsIPName
_) = DataConCantHappen -> TcM (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen DataConCantHappen
XIPVar GhcTc
x

zonkExpr ZonkEnv
_ (HsOverLabel XOverLabel GhcTc
x FastString
_) = DataConCantHappen -> TcM (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen DataConCantHappen
XOverLabel GhcTc
x

zonkExpr ZonkEnv
env (HsLit XLitE GhcTc
x (HsRat XHsRat GhcTc
e FractionalLit
f TcType
ty))
  = do TcType
new_ty <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
ty
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
x (XHsRat GhcTc -> FractionalLit -> TcType -> HsLit GhcTc
forall x. XHsRat x -> FractionalLit -> TcType -> HsLit x
HsRat XHsRat GhcTc
e FractionalLit
f TcType
new_ty))

zonkExpr ZonkEnv
_ (HsLit XLitE GhcTc
x HsLit GhcTc
lit)
  = HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
x HsLit GhcTc
lit)

zonkExpr ZonkEnv
env (HsOverLit XOverLitE GhcTc
x HsOverLit GhcTc
lit)
  = do  { HsOverLit GhcTc
lit' <- ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
zonkOverLit ZonkEnv
env HsOverLit GhcTc
lit
        ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XOverLitE GhcTc -> HsOverLit GhcTc -> HsExpr GhcTc
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XOverLitE GhcTc
x HsOverLit GhcTc
lit') }

zonkExpr ZonkEnv
env (HsLam XLam GhcTc
x MatchGroup GhcTc (LHsExpr GhcTc)
matches)
  = do MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_matches <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> TcM (MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
matches
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLam GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam GhcTc
x MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_matches)

zonkExpr ZonkEnv
env (HsLamCase XLamCase GhcTc
x LamCaseVariant
lc_variant MatchGroup GhcTc (LHsExpr GhcTc)
matches)
  = do MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_matches <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> TcM (MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
matches
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLamCase GhcTc
-> LamCaseVariant
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> HsExpr GhcTc
forall p.
XLamCase p
-> LamCaseVariant -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase XLamCase GhcTc
x LamCaseVariant
lc_variant MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_matches)

zonkExpr ZonkEnv
env (HsApp XApp GhcTc
x LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
  = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
       GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XApp GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcTc
x LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e2)

zonkExpr ZonkEnv
env (HsAppType XAppTypeE GhcTc
ty LHsExpr GhcTc
e LHsWcType (NoGhcTc GhcTc)
t)
  = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
       TcType
new_ty <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env XAppTypeE GhcTc
TcType
ty
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XAppTypeE GhcTc
-> LHsExpr GhcTc -> LHsWcType (NoGhcTc GhcTc) -> HsExpr GhcTc
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcTc
TcType
new_ty LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e LHsWcType (NoGhcTc GhcTc)
t)
       -- NB: the type is an HsType; can't zonk that!

zonkExpr ZonkEnv
env (HsTypedBracket XTypedBracket GhcTc
hsb_tc LHsExpr GhcTc
body)
  = (\HsBracketTc
x -> XTypedBracket GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XTypedBracket p -> LHsExpr p -> HsExpr p
HsTypedBracket HsBracketTc
XTypedBracket GhcTc
x LHsExpr GhcTc
body) (HsBracketTc -> HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) HsBracketTc -> TcM (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> HsBracketTc -> IOEnv (Env TcGblEnv TcLclEnv) HsBracketTc
zonkBracket ZonkEnv
env HsBracketTc
XTypedBracket GhcTc
hsb_tc

zonkExpr ZonkEnv
env (HsUntypedBracket XUntypedBracket GhcTc
hsb_tc HsQuote GhcTc
body)
  = (\HsBracketTc
x -> XUntypedBracket GhcTc -> HsQuote GhcTc -> HsExpr GhcTc
forall p. XUntypedBracket p -> HsQuote p -> HsExpr p
HsUntypedBracket HsBracketTc
XUntypedBracket GhcTc
x HsQuote GhcTc
body) (HsBracketTc -> HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) HsBracketTc -> TcM (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> HsBracketTc -> IOEnv (Env TcGblEnv TcLclEnv) HsBracketTc
zonkBracket ZonkEnv
env HsBracketTc
XUntypedBracket GhcTc
hsb_tc

zonkExpr ZonkEnv
env (HsSpliceE XSpliceE GhcTc
_ (XSplice (HsSplicedT s))) =
  DelayedSplice -> TcM (HsExpr GhcTc)
runTopSplice DelayedSplice
s TcM (HsExpr GhcTc)
-> (HsExpr GhcTc -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env

zonkExpr ZonkEnv
_ e :: HsExpr GhcTc
e@(HsSpliceE XSpliceE GhcTc
_ HsSplice GhcTc
_) = String -> SDoc -> TcM (HsExpr GhcTc)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"zonkExpr: HsSpliceE" (HsExpr GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcTc
e)

zonkExpr ZonkEnv
_ (OpApp XOpApp GhcTc
x LHsExpr GhcTc
_ LHsExpr GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen -> TcM (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen DataConCantHappen
XOpApp GhcTc
x

zonkExpr ZonkEnv
env (NegApp XNegApp GhcTc
x LHsExpr GhcTc
expr SyntaxExpr GhcTc
op)
  = do (ZonkEnv
env', SyntaxExprTc
new_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
op
       GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env' LHsExpr GhcTc
expr
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XNegApp GhcTc -> LHsExpr GhcTc -> SyntaxExpr GhcTc -> HsExpr GhcTc
forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
NegApp XNegApp GhcTc
x LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr SyntaxExprTc
SyntaxExpr GhcTc
new_op)

zonkExpr ZonkEnv
env (HsPar XPar GhcTc
x LHsToken "(" GhcTc
lpar LHsExpr GhcTc
e LHsToken ")" GhcTc
rpar)
  = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XPar GhcTc
-> LHsToken "(" GhcTc
-> LHsExpr GhcTc
-> LHsToken ")" GhcTc
-> HsExpr GhcTc
forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar XPar GhcTc
x LHsToken "(" GhcTc
lpar LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e LHsToken ")" GhcTc
rpar)

zonkExpr ZonkEnv
_ (SectionL XSectionL GhcTc
x LHsExpr GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen -> TcM (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen DataConCantHappen
XSectionL GhcTc
x
zonkExpr ZonkEnv
_ (SectionR XSectionR GhcTc
x LHsExpr GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen -> TcM (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen DataConCantHappen
XSectionR GhcTc
x
zonkExpr ZonkEnv
env (ExplicitTuple XExplicitTuple GhcTc
x [HsTupArg GhcTc]
tup_args Boxity
boxed)
  = do { [HsTupArg GhcTc]
new_tup_args <- (HsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc))
-> [HsTupArg GhcTc]
-> IOEnv (Env TcGblEnv TcLclEnv) [HsTupArg GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
zonk_tup_arg [HsTupArg GhcTc]
tup_args
       ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitTuple GhcTc -> [HsTupArg GhcTc] -> Boxity -> HsExpr GhcTc
forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple GhcTc
x [HsTupArg GhcTc]
new_tup_args Boxity
boxed) }
  where
    zonk_tup_arg :: HsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
zonk_tup_arg (Present XPresent GhcTc
x LHsExpr GhcTc
e) = do { GenLocated SrcSpanAnnA (HsExpr GhcTc)
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
                                    ; HsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XPresent GhcTc -> LHsExpr GhcTc -> HsTupArg GhcTc
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcTc
x LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
e') }
    zonk_tup_arg (Missing XMissing GhcTc
t) = do { Scaled TcType
t' <- ZonkEnv -> Scaled TcType -> TcM (Scaled TcType)
zonkScaledTcTypeToTypeX ZonkEnv
env XMissing GhcTc
Scaled TcType
t
                                  ; HsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XMissing GhcTc -> HsTupArg GhcTc
forall id. XMissing id -> HsTupArg id
Missing XMissing GhcTc
Scaled TcType
t') }


zonkExpr ZonkEnv
env (ExplicitSum XExplicitSum GhcTc
args ConTag
alt ConTag
arity LHsExpr GhcTc
expr)
  = do [TcType]
new_args <- (TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType)
-> [TcType] -> IOEnv (Env TcGblEnv TcLclEnv) [TcType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env) [TcType]
XExplicitSum GhcTc
args
       GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitSum GhcTc
-> ConTag -> ConTag -> LHsExpr GhcTc -> HsExpr GhcTc
forall p.
XExplicitSum p -> ConTag -> ConTag -> LHsExpr p -> HsExpr p
ExplicitSum [TcType]
XExplicitSum GhcTc
new_args ConTag
alt ConTag
arity LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr)

zonkExpr ZonkEnv
env (HsCase XCase GhcTc
x LHsExpr GhcTc
expr MatchGroup GhcTc (LHsExpr GhcTc)
ms)
  = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
       MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_ms <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> TcM (MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
ms
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCase GhcTc
-> LHsExpr GhcTc
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> HsExpr GhcTc
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase XCase GhcTc
x LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_ms)

zonkExpr ZonkEnv
env (HsIf XIf GhcTc
x LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 LHsExpr GhcTc
e3)
  = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
       GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
       GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e3 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e3
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XIf GhcTc
-> LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XIf p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsIf XIf GhcTc
x LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e2 LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e3)

zonkExpr ZonkEnv
env (HsMultiIf XMultiIf GhcTc
ty [LGRHS GhcTc (LHsExpr GhcTc)]
alts)
  = do { [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
alts' <- (GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated
         (SrcAnn NoEpAnns)
         (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
-> [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
 -> TcM (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
-> GenLocated
     (SrcAnn NoEpAnns)
     (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        (SrcAnn NoEpAnns)
        (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> TcM (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
zonk_alt) [LGRHS GhcTc (LHsExpr GhcTc)]
[GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
alts
       ; TcType
ty'   <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env XMultiIf GhcTc
TcType
ty
       ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcTc -> TcM (HsExpr GhcTc))
-> HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ XMultiIf GhcTc -> [LGRHS GhcTc (LHsExpr GhcTc)] -> HsExpr GhcTc
forall p. XMultiIf p -> [LGRHS p (LHsExpr p)] -> HsExpr p
HsMultiIf XMultiIf GhcTc
TcType
ty' [LGRHS GhcTc (LHsExpr GhcTc)]
[GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
alts' }
  where zonk_alt :: GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> TcM (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
zonk_alt (GRHS XCGRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
x [GuardLStmt GhcTc]
guard GenLocated SrcSpanAnnA (HsExpr GhcTc)
expr)
          = do { (ZonkEnv
env', [GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
guard') <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
-> TcM
     (ZonkEnv, [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
guard
               ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
expr'          <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env' LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
expr
               ; GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> TcM (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
 -> TcM (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
-> GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> TcM (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
x [GuardLStmt GhcTc]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
guard' GenLocated SrcSpanAnnA (HsExpr GhcTc)
expr' }

zonkExpr ZonkEnv
env (HsLet XLet GhcTc
x LHsToken "let" GhcTc
tkLet HsLocalBinds GhcTc
binds LHsToken "in" GhcTc
tkIn LHsExpr GhcTc
expr)
  = do (ZonkEnv
new_env, HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env HsLocalBinds GhcTc
binds
       GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
new_env LHsExpr GhcTc
expr
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLet GhcTc
-> LHsToken "let" GhcTc
-> HsLocalBinds GhcTc
-> LHsToken "in" GhcTc
-> LHsExpr GhcTc
-> HsExpr GhcTc
forall p.
XLet p
-> LHsToken "let" p
-> HsLocalBinds p
-> LHsToken "in" p
-> LHsExpr p
-> HsExpr p
HsLet XLet GhcTc
x LHsToken "let" GhcTc
tkLet HsLocalBinds GhcTc
new_binds LHsToken "in" GhcTc
tkIn LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr)

zonkExpr ZonkEnv
env (HsDo XDo GhcTc
ty HsDoFlavour
do_or_lc (L l stmts))
  = do (ZonkEnv
_, [GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
new_stmts) <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
-> TcM
     (ZonkEnv, [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
zonkLExpr [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
stmts
       TcType
new_ty <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env XDo GhcTc
TcType
ty
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XDo GhcTc
-> HsDoFlavour -> XRec GhcTc [GuardLStmt GhcTc] -> HsExpr GhcTc
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo GhcTc
TcType
new_ty HsDoFlavour
do_or_lc (SrcSpanAnnL
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
new_stmts))

zonkExpr ZonkEnv
env (ExplicitList XExplicitList GhcTc
ty [LHsExpr GhcTc]
exprs)
  = do TcType
new_ty <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env XExplicitList GhcTc
TcType
ty
       [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
new_exprs <- ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc]
zonkLExprs ZonkEnv
env [LHsExpr GhcTc]
exprs
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitList GhcTc -> [LHsExpr GhcTc] -> HsExpr GhcTc
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcTc
TcType
new_ty [LHsExpr GhcTc]
[GenLocated SrcSpanAnnA (HsExpr GhcTc)]
new_exprs)

zonkExpr ZonkEnv
env expr :: HsExpr GhcTc
expr@(RecordCon { rcon_ext :: forall p. HsExpr p -> XRecordCon p
rcon_ext = XRecordCon GhcTc
con_expr, rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds = HsRecordBinds GhcTc
rbinds })
  = do  { HsExpr GhcTc
new_con_expr <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env HsExpr GhcTc
XRecordCon GhcTc
con_expr
        ; HsRecFields GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_rbinds   <- ZonkEnv -> HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc)
zonkRecFields ZonkEnv
env HsRecordBinds GhcTc
rbinds
        ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcTc
expr { rcon_ext :: XRecordCon GhcTc
rcon_ext  = HsExpr GhcTc
XRecordCon GhcTc
new_con_expr
                       , rcon_flds :: HsRecordBinds GhcTc
rcon_flds = HsRecordBinds GhcTc
HsRecFields GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
new_rbinds }) }

-- Record updates via dot syntax are replaced by desugared expressions
-- in the renamer. See Note [Rebindable syntax and HsExpansion]. This
-- is why we match on 'rupd_flds = Left rbinds' here and panic otherwise.
zonkExpr ZonkEnv
env (RecordUpd { rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
rupd_flds = Left [LHsRecUpdField GhcTc]
rbinds
                        , rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_expr = LHsExpr GhcTc
expr
                        , rupd_ext :: forall p. HsExpr p -> XRecordUpd p
rupd_ext = RecordUpdTc {
                                       rupd_cons = cons
                                     , rupd_in_tys = in_tys
                                     , rupd_out_tys = out_tys
                                     , rupd_wrap = req_wrap }})
  = do  { GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr    <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
        ; [TcType]
new_in_tys  <- (TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType)
-> [TcType] -> IOEnv (Env TcGblEnv TcLclEnv) [TcType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env) [TcType]
in_tys
        ; [TcType]
new_out_tys <- (TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType)
-> [TcType] -> IOEnv (Env TcGblEnv TcLclEnv) [TcType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env) [TcType]
out_tys
        ; [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
new_rbinds  <- ZonkEnv -> [LHsRecUpdField GhcTc] -> TcM [LHsRecUpdField GhcTc]
zonkRecUpdFields ZonkEnv
env [LHsRecUpdField GhcTc]
rbinds
        ; (ZonkEnv
_, HsWrapper
new_recwrap) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
req_wrap
        ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (
            RecordUpd :: forall p.
XRecordUpd p
-> LHsExpr p
-> Either [LHsRecUpdField p] [LHsRecUpdProj p]
-> HsExpr p
RecordUpd {
                  rupd_expr :: LHsExpr GhcTc
rupd_expr = LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr
                , rupd_flds :: Either [LHsRecUpdField GhcTc] [LHsRecUpdProj GhcTc]
rupd_flds = [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
-> Either
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
           (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcTc))
           (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
forall a b. a -> Either a b
Left [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
new_rbinds
                , rupd_ext :: XRecordUpd GhcTc
rupd_ext = RecordUpdTc :: [ConLike] -> [TcType] -> [TcType] -> HsWrapper -> RecordUpdTc
RecordUpdTc {
                               rupd_cons :: [ConLike]
rupd_cons = [ConLike]
cons
                             , rupd_in_tys :: [TcType]
rupd_in_tys = [TcType]
new_in_tys
                             , rupd_out_tys :: [TcType]
rupd_out_tys = [TcType]
new_out_tys
                             , rupd_wrap :: HsWrapper
rupd_wrap = HsWrapper
new_recwrap }}) }
zonkExpr ZonkEnv
_ (RecordUpd {}) = String -> TcM (HsExpr GhcTc)
forall a. String -> a
panic String
"GHC.Tc.Utils.Zonk: zonkExpr: The impossible happened!"

zonkExpr ZonkEnv
env (ExprWithTySig XExprWithTySig GhcTc
_ LHsExpr GhcTc
e LHsSigWcType (NoGhcTc GhcTc)
ty)
  = do { GenLocated SrcSpanAnnA (HsExpr GhcTc)
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
       ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExprWithTySig GhcTc
-> LHsExpr GhcTc -> LHsSigWcType (NoGhcTc GhcTc) -> HsExpr GhcTc
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig NoExtField
XExprWithTySig GhcTc
noExtField LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
e' LHsSigWcType (NoGhcTc GhcTc)
ty) }

zonkExpr ZonkEnv
env (ArithSeq XArithSeq GhcTc
expr Maybe (SyntaxExpr GhcTc)
wit ArithSeqInfo GhcTc
info)
  = do (ZonkEnv
env1, Maybe SyntaxExprTc
new_wit) <- ZonkEnv
-> Maybe SyntaxExprTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
zonkWit ZonkEnv
env Maybe SyntaxExprTc
Maybe (SyntaxExpr GhcTc)
wit
       HsExpr GhcTc
new_expr <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env HsExpr GhcTc
XArithSeq GhcTc
expr
       ArithSeqInfo GhcTc
new_info <- ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
zonkArithSeq ZonkEnv
env1 ArithSeqInfo GhcTc
info
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XArithSeq GhcTc
-> Maybe (SyntaxExpr GhcTc) -> ArithSeqInfo GhcTc -> HsExpr GhcTc
forall p.
XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
ArithSeq HsExpr GhcTc
XArithSeq GhcTc
new_expr Maybe SyntaxExprTc
Maybe (SyntaxExpr GhcTc)
new_wit ArithSeqInfo GhcTc
new_info)
   where zonkWit :: ZonkEnv
-> Maybe SyntaxExprTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
zonkWit ZonkEnv
env Maybe SyntaxExprTc
Nothing    = (ZonkEnv, Maybe SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Maybe SyntaxExprTc
forall a. Maybe a
Nothing)
         zonkWit ZonkEnv
env (Just SyntaxExprTc
fln) = (SyntaxExprTc -> Maybe SyntaxExprTc)
-> (ZonkEnv, SyntaxExprTc) -> (ZonkEnv, Maybe SyntaxExprTc)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second SyntaxExprTc -> Maybe SyntaxExprTc
forall a. a -> Maybe a
Just ((ZonkEnv, SyntaxExprTc) -> (ZonkEnv, Maybe SyntaxExprTc))
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExprTc
SyntaxExpr GhcTc
fln

zonkExpr ZonkEnv
env (HsPragE XPragE GhcTc
x HsPragE GhcTc
prag LHsExpr GhcTc
expr)
  = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XPragE GhcTc -> HsPragE GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XPragE p -> HsPragE p -> LHsExpr p -> HsExpr p
HsPragE XPragE GhcTc
x HsPragE GhcTc
prag LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr)

-- arrow notation extensions
zonkExpr ZonkEnv
env (HsProc XProc GhcTc
x LPat GhcTc
pat LHsCmdTop GhcTc
body)
  = do  { (ZonkEnv
env1, GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat) <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat
        ; GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)
new_body <- ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
zonkCmdTop ZonkEnv
env1 LHsCmdTop GhcTc
body
        ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XProc GhcTc -> LPat GhcTc -> LHsCmdTop GhcTc -> HsExpr GhcTc
forall p. XProc p -> LPat p -> LHsCmdTop p -> HsExpr p
HsProc XProc GhcTc
x LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat LHsCmdTop GhcTc
GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)
new_body) }

-- StaticPointers extension
zonkExpr ZonkEnv
env (HsStatic (fvs, ty) LHsExpr GhcTc
expr)
  = do TcType
new_ty <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
ty
       XStatic GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XStatic p -> LHsExpr p -> HsExpr p
HsStatic (NameSet
fvs, TcType
new_ty) (GenLocated SrcSpanAnnA (HsExpr GhcTc) -> HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> TcM (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr

zonkExpr ZonkEnv
env (XExpr (WrapExpr (HsWrap co_fn expr)))
  = do (ZonkEnv
env1, HsWrapper
new_co_fn) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
co_fn
       HsExpr GhcTc
new_expr <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env1 HsExpr GhcTc
expr
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XXExpr GhcTc -> HsExpr GhcTc
forall p. XXExpr p -> HsExpr p
XExpr (HsWrap HsExpr -> XXExprGhcTc
WrapExpr (HsWrapper -> HsExpr GhcTc -> HsWrap HsExpr
forall (hs_syn :: * -> *).
HsWrapper -> hs_syn GhcTc -> HsWrap hs_syn
HsWrap HsWrapper
new_co_fn HsExpr GhcTc
new_expr)))

zonkExpr ZonkEnv
env (XExpr (ExpansionExpr (HsExpanded a b)))
  = XXExprGhcTc -> HsExpr GhcTc
forall p. XXExpr p -> HsExpr p
XExpr (XXExprGhcTc -> HsExpr GhcTc)
-> (HsExpr GhcTc -> XXExprGhcTc) -> HsExpr GhcTc -> HsExpr GhcTc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpansion (HsExpr GhcRn) (HsExpr GhcTc) -> XXExprGhcTc
ExpansionExpr (HsExpansion (HsExpr GhcRn) (HsExpr GhcTc) -> XXExprGhcTc)
-> (HsExpr GhcTc -> HsExpansion (HsExpr GhcRn) (HsExpr GhcTc))
-> HsExpr GhcTc
-> XXExprGhcTc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcRn
-> HsExpr GhcTc -> HsExpansion (HsExpr GhcRn) (HsExpr GhcTc)
forall orig expanded. orig -> expanded -> HsExpansion orig expanded
HsExpanded HsExpr GhcRn
a (HsExpr GhcTc -> HsExpr GhcTc)
-> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env HsExpr GhcTc
b

zonkExpr ZonkEnv
env (XExpr (ConLikeTc con tvs tys))
  = XXExprGhcTc -> HsExpr GhcTc
forall p. XXExpr p -> HsExpr p
XExpr (XXExprGhcTc -> HsExpr GhcTc)
-> ([Scaled TcType] -> XXExprGhcTc)
-> [Scaled TcType]
-> HsExpr GhcTc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConLike -> [TyCoVar] -> [Scaled TcType] -> XXExprGhcTc
ConLikeTc ConLike
con [TyCoVar]
tvs ([Scaled TcType] -> HsExpr GhcTc)
-> TcM [Scaled TcType] -> TcM (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Scaled TcType -> TcM (Scaled TcType))
-> [Scaled TcType] -> TcM [Scaled TcType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Scaled TcType -> TcM (Scaled TcType)
zonk_scale [Scaled TcType]
tys
  where
    zonk_scale :: Scaled TcType -> TcM (Scaled TcType)
zonk_scale (Scaled TcType
m TcType
ty) = TcType -> TcType -> Scaled TcType
forall a. TcType -> a -> Scaled a
Scaled (TcType -> TcType -> Scaled TcType)
-> IOEnv (Env TcGblEnv TcLclEnv) TcType
-> IOEnv (Env TcGblEnv TcLclEnv) (TcType -> Scaled TcType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
m IOEnv (Env TcGblEnv TcLclEnv) (TcType -> Scaled TcType)
-> IOEnv (Env TcGblEnv TcLclEnv) TcType -> TcM (Scaled TcType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall (f :: * -> *) a. Applicative f => a -> f a
pure TcType
ty
    -- Only the multiplicity can contain unification variables
    -- The tvs come straight from the data-con, and so are strictly redundant
    -- See Wrinkles of Note [Typechecking data constructors] in GHC.Tc.Gen.Head

zonkExpr ZonkEnv
_ HsExpr GhcTc
expr = String -> SDoc -> TcM (HsExpr GhcTc)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"zonkExpr" (HsExpr GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcTc
expr)

-------------------------------------------------------------------------
{-
Note [Skolems in zonkSyntaxExpr]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider rebindable syntax with something like

  (>>=) :: (forall x. blah) -> (forall y. blah') -> blah''

The x and y become skolems that are in scope when type-checking the
arguments to the bind. This means that we must extend the ZonkEnv with
these skolems when zonking the arguments to the bind. But the skolems
are different between the two arguments, and so we should theoretically
carry around different environments to use for the different arguments.

However, this becomes a logistical nightmare, especially in dealing with
the more exotic Stmt forms. So, we simplify by making the critical
assumption that the uniques of the skolems are different. (This assumption
is justified by the use of newUnique in GHC.Tc.Utils.TcMType.instSkolTyCoVarX.)
Now, we can safely just extend one environment.
-}

-- See Note [Skolems in zonkSyntaxExpr]
zonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTc
               -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env (SyntaxExprTc { syn_expr      = expr
                               , syn_arg_wraps = arg_wraps
                               , syn_res_wrap  = res_wrap })
  = do { (ZonkEnv
env0, HsWrapper
res_wrap')  <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
res_wrap
       ; HsExpr GhcTc
expr'              <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env0 HsExpr GhcTc
expr
       ; (ZonkEnv
env1, [HsWrapper]
arg_wraps') <- (ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper))
-> ZonkEnv
-> [HsWrapper]
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [HsWrapper])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env0 [HsWrapper]
arg_wraps
       ; (ZonkEnv, SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, SyntaxExprTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, SyntaxExprTc :: HsExpr GhcTc -> [HsWrapper] -> HsWrapper -> SyntaxExprTc
SyntaxExprTc { syn_expr :: HsExpr GhcTc
syn_expr      = HsExpr GhcTc
expr'
                                    , syn_arg_wraps :: [HsWrapper]
syn_arg_wraps = [HsWrapper]
arg_wraps'
                                    , syn_res_wrap :: HsWrapper
syn_res_wrap  = HsWrapper
res_wrap' }) }
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
NoSyntaxExprTc = (ZonkEnv, SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, SyntaxExprTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, SyntaxExprTc
NoSyntaxExprTc)

-------------------------------------------------------------------------

zonkLCmd  :: ZonkEnv -> LHsCmd GhcTc   -> TcM (LHsCmd GhcTc)
zonkCmd   :: ZonkEnv -> HsCmd GhcTc    -> TcM (HsCmd GhcTc)

zonkLCmd :: ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd  ZonkEnv
env LHsCmd GhcTc
cmd  = (HsCmd GhcTc -> TcM (HsCmd GhcTc))
-> GenLocated SrcSpanAnnA (HsCmd GhcTc)
-> TcRn (GenLocated SrcSpanAnnA (HsCmd GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc)
zonkCmd ZonkEnv
env) LHsCmd GhcTc
GenLocated SrcSpanAnnA (HsCmd GhcTc)
cmd

zonkCmd :: ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc)
zonkCmd ZonkEnv
env (XCmd (HsWrap w cmd))
  = do { (ZonkEnv
env1, HsWrapper
w') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
w
       ; HsCmd GhcTc
cmd' <- ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc)
zonkCmd ZonkEnv
env1 HsCmd GhcTc
cmd
       ; HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XXCmd GhcTc -> HsCmd GhcTc
forall id. XXCmd id -> HsCmd id
XCmd (HsWrapper -> HsCmd GhcTc -> HsWrap HsCmd
forall (hs_syn :: * -> *).
HsWrapper -> hs_syn GhcTc -> HsWrap hs_syn
HsWrap HsWrapper
w' HsCmd GhcTc
cmd')) }
zonkCmd ZonkEnv
env (HsCmdArrApp XCmdArrApp GhcTc
ty LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 HsArrAppType
ho Bool
rl)
  = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
       GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
       TcType
new_ty <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env XCmdArrApp GhcTc
TcType
ty
       HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdArrApp GhcTc
-> LHsExpr GhcTc
-> LHsExpr GhcTc
-> HsArrAppType
-> Bool
-> HsCmd GhcTc
forall id.
XCmdArrApp id
-> LHsExpr id -> LHsExpr id -> HsArrAppType -> Bool -> HsCmd id
HsCmdArrApp XCmdArrApp GhcTc
TcType
new_ty LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e2 HsArrAppType
ho Bool
rl)

zonkCmd ZonkEnv
env (HsCmdArrForm XCmdArrForm GhcTc
x LHsExpr GhcTc
op LexicalFixity
f Maybe Fixity
fixity [LHsCmdTop GhcTc]
args)
  = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_op <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
op
       [GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)]
new_args <- (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)))
-> [GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
zonkCmdTop ZonkEnv
env) [LHsCmdTop GhcTc]
[GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)]
args
       HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdArrForm GhcTc
-> LHsExpr GhcTc
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop GhcTc]
-> HsCmd GhcTc
forall id.
XCmdArrForm id
-> LHsExpr id
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop id]
-> HsCmd id
HsCmdArrForm XCmdArrForm GhcTc
x LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_op LexicalFixity
f Maybe Fixity
fixity [LHsCmdTop GhcTc]
[GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)]
new_args)

zonkCmd ZonkEnv
env (HsCmdApp XCmdApp GhcTc
x LHsCmd GhcTc
c LHsExpr GhcTc
e)
  = do GenLocated SrcSpanAnnA (HsCmd GhcTc)
new_c <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env LHsCmd GhcTc
c
       GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
       HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdApp GhcTc -> LHsCmd GhcTc -> LHsExpr GhcTc -> HsCmd GhcTc
forall id. XCmdApp id -> LHsCmd id -> LHsExpr id -> HsCmd id
HsCmdApp XCmdApp GhcTc
x LHsCmd GhcTc
GenLocated SrcSpanAnnA (HsCmd GhcTc)
new_c LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e)

zonkCmd ZonkEnv
env (HsCmdLam XCmdLam GhcTc
x MatchGroup GhcTc (LHsCmd GhcTc)
matches)
  = do MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))
new_matches <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsCmd GhcTc)
    -> TcRn (GenLocated SrcSpanAnnA (HsCmd GhcTc)))
-> MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))
-> TcM (MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsCmd GhcTc)
-> TcRn (GenLocated SrcSpanAnnA (HsCmd GhcTc))
zonkLCmd MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))
matches
       HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLam GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
forall id. XCmdLam id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLam XCmdLam GhcTc
x MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))
new_matches)

zonkCmd ZonkEnv
env (HsCmdPar XCmdPar GhcTc
x LHsToken "(" GhcTc
lpar LHsCmd GhcTc
c LHsToken ")" GhcTc
rpar)
  = do GenLocated SrcSpanAnnA (HsCmd GhcTc)
new_c <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env LHsCmd GhcTc
c
       HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdPar GhcTc
-> LHsToken "(" GhcTc
-> LHsCmd GhcTc
-> LHsToken ")" GhcTc
-> HsCmd GhcTc
forall id.
XCmdPar id
-> LHsToken "(" id -> LHsCmd id -> LHsToken ")" id -> HsCmd id
HsCmdPar XCmdPar GhcTc
x LHsToken "(" GhcTc
lpar LHsCmd GhcTc
GenLocated SrcSpanAnnA (HsCmd GhcTc)
new_c LHsToken ")" GhcTc
rpar)

zonkCmd ZonkEnv
env (HsCmdCase XCmdCase GhcTc
x LHsExpr GhcTc
expr MatchGroup GhcTc (LHsCmd GhcTc)
ms)
  = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
       MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))
new_ms <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsCmd GhcTc)
    -> TcRn (GenLocated SrcSpanAnnA (HsCmd GhcTc)))
-> MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))
-> TcM (MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsCmd GhcTc)
-> TcRn (GenLocated SrcSpanAnnA (HsCmd GhcTc))
zonkLCmd MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))
ms
       HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdCase GhcTc
-> LHsExpr GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
forall id.
XCmdCase id -> LHsExpr id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdCase XCmdCase GhcTc
x LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))
new_ms)

zonkCmd ZonkEnv
env (HsCmdLamCase XCmdLamCase GhcTc
x LamCaseVariant
lc_variant MatchGroup GhcTc (LHsCmd GhcTc)
ms)
  = do MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))
new_ms <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsCmd GhcTc)
    -> TcRn (GenLocated SrcSpanAnnA (HsCmd GhcTc)))
-> MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))
-> TcM (MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsCmd GhcTc)
-> TcRn (GenLocated SrcSpanAnnA (HsCmd GhcTc))
zonkLCmd MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))
ms
       HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLamCase GhcTc
-> LamCaseVariant -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
forall id.
XCmdLamCase id
-> LamCaseVariant -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLamCase XCmdLamCase GhcTc
x LamCaseVariant
lc_variant MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))
new_ms)

zonkCmd ZonkEnv
env (HsCmdIf XCmdIf GhcTc
x SyntaxExpr GhcTc
eCond LHsExpr GhcTc
ePred LHsCmd GhcTc
cThen LHsCmd GhcTc
cElse)
  = do { (ZonkEnv
env1, SyntaxExprTc
new_eCond) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
eCond
       ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_ePred <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env1 LHsExpr GhcTc
ePred
       ; GenLocated SrcSpanAnnA (HsCmd GhcTc)
new_cThen <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env1 LHsCmd GhcTc
cThen
       ; GenLocated SrcSpanAnnA (HsCmd GhcTc)
new_cElse <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env1 LHsCmd GhcTc
cElse
       ; HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdIf GhcTc
-> SyntaxExpr GhcTc
-> LHsExpr GhcTc
-> LHsCmd GhcTc
-> LHsCmd GhcTc
-> HsCmd GhcTc
forall id.
XCmdIf id
-> SyntaxExpr id
-> LHsExpr id
-> LHsCmd id
-> LHsCmd id
-> HsCmd id
HsCmdIf XCmdIf GhcTc
x SyntaxExprTc
SyntaxExpr GhcTc
new_eCond LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_ePred LHsCmd GhcTc
GenLocated SrcSpanAnnA (HsCmd GhcTc)
new_cThen LHsCmd GhcTc
GenLocated SrcSpanAnnA (HsCmd GhcTc)
new_cElse) }

zonkCmd ZonkEnv
env (HsCmdLet XCmdLet GhcTc
x LHsToken "let" GhcTc
tkLet HsLocalBinds GhcTc
binds LHsToken "in" GhcTc
tkIn LHsCmd GhcTc
cmd)
  = do (ZonkEnv
new_env, HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env HsLocalBinds GhcTc
binds
       GenLocated SrcSpanAnnA (HsCmd GhcTc)
new_cmd <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
new_env LHsCmd GhcTc
cmd
       HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLet GhcTc
-> LHsToken "let" GhcTc
-> HsLocalBinds GhcTc
-> LHsToken "in" GhcTc
-> LHsCmd GhcTc
-> HsCmd GhcTc
forall id.
XCmdLet id
-> LHsToken "let" id
-> HsLocalBinds id
-> LHsToken "in" id
-> LHsCmd id
-> HsCmd id
HsCmdLet XCmdLet GhcTc
x LHsToken "let" GhcTc
tkLet HsLocalBinds GhcTc
new_binds LHsToken "in" GhcTc
tkIn LHsCmd GhcTc
GenLocated SrcSpanAnnA (HsCmd GhcTc)
new_cmd)

zonkCmd ZonkEnv
env (HsCmdDo XCmdDo GhcTc
ty (L l stmts))
  = do (ZonkEnv
_, [GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc)))]
new_stmts) <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsCmd GhcTc)
    -> TcRn (GenLocated SrcSpanAnnA (HsCmd GhcTc)))
-> [LStmt GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))]
-> TcM
     (ZonkEnv, [LStmt GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsCmd GhcTc)
-> TcRn (GenLocated SrcSpanAnnA (HsCmd GhcTc))
zonkLCmd [LStmt GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc))]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc)))]
stmts
       TcType
new_ty <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env XCmdDo GhcTc
TcType
ty
       HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdDo GhcTc -> XRec GhcTc [CmdLStmt GhcTc] -> HsCmd GhcTc
forall id. XCmdDo id -> XRec id [CmdLStmt id] -> HsCmd id
HsCmdDo XCmdDo GhcTc
TcType
new_ty (SrcSpanAnnL
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l [GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsCmd GhcTc)))]
new_stmts))



zonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
zonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
zonkCmdTop ZonkEnv
env LHsCmdTop GhcTc
cmd = (HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc))
-> GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc)
zonk_cmd_top ZonkEnv
env) LHsCmdTop GhcTc
GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcTc)
cmd

zonk_cmd_top :: ZonkEnv -> HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc)
zonk_cmd_top :: ZonkEnv -> HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc)
zonk_cmd_top ZonkEnv
env (HsCmdTop (CmdTopTc stack_tys ty ids) LHsCmd GhcTc
cmd)
  = do GenLocated SrcSpanAnnA (HsCmd GhcTc)
new_cmd <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env LHsCmd GhcTc
cmd
       TcType
new_stack_tys <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
stack_tys
       TcType
new_ty <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
ty
       [(Name, HsExpr GhcTc)]
new_ids <- (HsExpr GhcTc -> TcM (HsExpr GhcTc))
-> [(Name, HsExpr GhcTc)]
-> IOEnv (Env TcGblEnv TcLclEnv) [(Name, HsExpr GhcTc)]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> [(a, b)] -> m [(a, c)]
mapSndM (ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env) [(Name, HsExpr GhcTc)]
ids

       Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (TcType -> Bool
isLiftedTypeKind (HasDebugCallStack => TcType -> TcType
TcType -> TcType
tcTypeKind TcType
new_stack_tys))
         -- desugarer assumes that this is not representation-polymorphic...
         -- but indeed it should always be lifted due to the typing
         -- rules for arrows

       HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdTop GhcTc -> LHsCmd GhcTc -> HsCmdTop GhcTc
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
HsCmdTop (TcType -> TcType -> [(Name, HsExpr GhcTc)] -> CmdTopTc
CmdTopTc TcType
new_stack_tys TcType
new_ty [(Name, HsExpr GhcTc)]
new_ids) LHsCmd GhcTc
GenLocated SrcSpanAnnA (HsCmd GhcTc)
new_cmd)

-------------------------------------------------------------------------
zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
WpHole   = (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, HsWrapper
WpHole)
zonkCoFn ZonkEnv
env (WpCompose HsWrapper
c1 HsWrapper
c2) = do { (ZonkEnv
env1, HsWrapper
c1') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
c1
                                    ; (ZonkEnv
env2, HsWrapper
c2') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env1 HsWrapper
c2
                                    ; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, HsWrapper -> HsWrapper -> HsWrapper
WpCompose HsWrapper
c1' HsWrapper
c2') }
zonkCoFn ZonkEnv
env (WpFun HsWrapper
c1 HsWrapper
c2 Scaled TcType
t1)  = do { (ZonkEnv
env1, HsWrapper
c1') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
c1
                                    ; (ZonkEnv
env2, HsWrapper
c2') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env1 HsWrapper
c2
                                    ; Scaled TcType
t1'         <- ZonkEnv -> Scaled TcType -> TcM (Scaled TcType)
zonkScaledTcTypeToTypeX ZonkEnv
env2 Scaled TcType
t1
                                    ; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, HsWrapper -> HsWrapper -> Scaled TcType -> HsWrapper
WpFun HsWrapper
c1' HsWrapper
c2' Scaled TcType
t1') }
zonkCoFn ZonkEnv
env (WpCast TcCoercionR
co) = do { TcCoercionR
co' <- ZonkEnv -> TcCoercionR -> TcM TcCoercionR
zonkCoToCo ZonkEnv
env TcCoercionR
co
                              ; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, TcCoercionR -> HsWrapper
WpCast TcCoercionR
co') }
zonkCoFn ZonkEnv
env (WpEvLam TyCoVar
ev)   = do { (ZonkEnv
env', TyCoVar
ev') <- ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonkEvBndrX ZonkEnv
env TyCoVar
ev
                                 ; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', TyCoVar -> HsWrapper
WpEvLam TyCoVar
ev') }
zonkCoFn ZonkEnv
env (WpEvApp EvTerm
arg)  = do { EvTerm
arg' <- ZonkEnv -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
zonkEvTerm ZonkEnv
env EvTerm
arg
                                 ; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, EvTerm -> HsWrapper
WpEvApp EvTerm
arg') }
zonkCoFn ZonkEnv
env (WpTyLam TyCoVar
tv)   = Bool -> TcM (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall a. HasCallStack => Bool -> a -> a
assert (TyCoVar -> Bool
isImmutableTyVar TyCoVar
tv) (TcM (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper))
-> TcM (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall a b. (a -> b) -> a -> b
$
                              do { (ZonkEnv
env', TyCoVar
tv') <- ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonkTyBndrX ZonkEnv
env TyCoVar
tv
                                 ; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', TyCoVar -> HsWrapper
WpTyLam TyCoVar
tv') }
zonkCoFn ZonkEnv
env (WpTyApp TcType
ty)   = do { TcType
ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
ty
                                 ; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, TcType -> HsWrapper
WpTyApp TcType
ty') }
zonkCoFn ZonkEnv
env (WpLet TcEvBinds
bs)     = do { (ZonkEnv
env1, TcEvBinds
bs') <- ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds)
zonkTcEvBinds ZonkEnv
env TcEvBinds
bs
                                 ; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, TcEvBinds -> HsWrapper
WpLet TcEvBinds
bs') }
zonkCoFn ZonkEnv
env (WpMultCoercion TcCoercionR
co) = do { TcCoercionR
co' <- ZonkEnv -> TcCoercionR -> TcM TcCoercionR
zonkCoToCo ZonkEnv
env TcCoercionR
co
                                      ; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, TcCoercionR -> HsWrapper
WpMultCoercion TcCoercionR
co') }

-------------------------------------------------------------------------
zonkOverLit :: ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
zonkOverLit :: ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
zonkOverLit ZonkEnv
env lit :: HsOverLit GhcTc
lit@(OverLit {ol_ext :: forall p. HsOverLit p -> XOverLit p
ol_ext = x :: XOverLit GhcTc
x@OverLitTc { ol_witness = e, ol_type = ty } })
  = do  { TcType
ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
ty
        ; HsExpr GhcTc
e' <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env HsExpr GhcTc
e
        ; HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsOverLit GhcTc
lit { ol_ext :: XOverLit GhcTc
ol_ext = OverLitTc
XOverLit GhcTc
x { $sel:ol_witness:OverLitTc :: HsExpr GhcTc
ol_witness = HsExpr GhcTc
e'
                                   , $sel:ol_type:OverLitTc :: TcType
ol_type = TcType
ty' } }) }

-------------------------------------------------------------------------
zonkBracket :: ZonkEnv -> HsBracketTc -> TcM HsBracketTc
zonkBracket :: ZonkEnv -> HsBracketTc -> IOEnv (Env TcGblEnv TcLclEnv) HsBracketTc
zonkBracket ZonkEnv
env (HsBracketTc HsQuote GhcRn
hsb_thing TcType
ty Maybe QuoteWrapper
wrap [PendingTcSplice]
bs)
  = do Maybe QuoteWrapper
wrap' <- (QuoteWrapper -> IOEnv (Env TcGblEnv TcLclEnv) QuoteWrapper)
-> Maybe QuoteWrapper
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe QuoteWrapper)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse QuoteWrapper -> IOEnv (Env TcGblEnv TcLclEnv) QuoteWrapper
zonkQuoteWrap Maybe QuoteWrapper
wrap
       [PendingTcSplice]
bs' <- (PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice)
-> [PendingTcSplice]
-> IOEnv (Env TcGblEnv TcLclEnv) [PendingTcSplice]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv
-> PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice
zonk_b ZonkEnv
env) [PendingTcSplice]
bs
       TcType
new_ty <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
ty
       HsBracketTc -> IOEnv (Env TcGblEnv TcLclEnv) HsBracketTc
forall (m :: * -> *) a. Monad m => a -> m a
return (HsQuote GhcRn
-> TcType -> Maybe QuoteWrapper -> [PendingTcSplice] -> HsBracketTc
HsBracketTc HsQuote GhcRn
hsb_thing TcType
new_ty Maybe QuoteWrapper
wrap' [PendingTcSplice]
bs')
  where
    zonkQuoteWrap :: QuoteWrapper -> IOEnv (Env TcGblEnv TcLclEnv) QuoteWrapper
zonkQuoteWrap (QuoteWrapper TyCoVar
ev TcType
ty) = do
        let ev' :: TyCoVar
ev' = ZonkEnv -> TyCoVar -> TyCoVar
zonkIdOcc ZonkEnv
env TyCoVar
ev
        TcType
ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
ty
        QuoteWrapper -> IOEnv (Env TcGblEnv TcLclEnv) QuoteWrapper
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCoVar -> TcType -> QuoteWrapper
QuoteWrapper TyCoVar
ev' TcType
ty')

    zonk_b :: ZonkEnv
-> PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice
zonk_b ZonkEnv
env' (PendingTcSplice Name
n LHsExpr GhcTc
e) = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env' LHsExpr GhcTc
e
                                           PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> LHsExpr GhcTc -> PendingTcSplice
PendingTcSplice Name
n LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
e')

-------------------------------------------------------------------------
zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)

zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
zonkArithSeq ZonkEnv
env (From LHsExpr GhcTc
e)
  = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
       ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcTc -> ArithSeqInfo GhcTc
forall id. LHsExpr id -> ArithSeqInfo id
From LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e)

zonkArithSeq ZonkEnv
env (FromThen LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
  = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
       GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
       ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThen LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e2)

zonkArithSeq ZonkEnv
env (FromTo LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
  = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
       GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
       ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromTo LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e2)

zonkArithSeq ZonkEnv
env (FromThenTo LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 LHsExpr GhcTc
e3)
  = do GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
       GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
       GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e3 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e3
       ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcTc
-> LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
forall id.
LHsExpr id -> LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThenTo LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e2 LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_e3)

-------------------------------------------------------------------------
zonkStmts :: Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA
          => ZonkEnv
          -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
          -> [LStmt GhcTc (LocatedA (body GhcTc))]
          -> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts :: ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
_ []     = (ZonkEnv,
 [GenLocated
    SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv,
      [GenLocated
         SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, [])
zonkStmts ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (LStmt GhcTc (LocatedA (body GhcTc))
s:[LStmt GhcTc (LocatedA (body GhcTc))]
ss) = do { (ZonkEnv
env1, GenLocated SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
s')  <- (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
 -> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> GenLocated
     SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> TcM
     (ZonkEnv,
      GenLocated
        SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
forall a b c ann.
(a -> TcM (b, c))
-> GenLocated (SrcSpanAnn' ann) a
-> TcM (b, GenLocated (SrcSpanAnn' ann) c)
wrapLocSndMA (ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody) LStmt GhcTc (LocatedA (body GhcTc))
GenLocated SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
s
                                ; (ZonkEnv
env2, [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
ss') <- ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env1 ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody [LStmt GhcTc (LocatedA (body GhcTc))]
ss
                                ; (ZonkEnv,
 [GenLocated
    SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv,
      [GenLocated
         SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, GenLocated SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
s' GenLocated SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
-> [GenLocated
      SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
forall a. a -> [a] -> [a]
: [GenLocated
   SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
ss') }

zonkStmt :: Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA
         => ZonkEnv
         -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
         -> Stmt GhcTc (LocatedA (body GhcTc))
         -> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
zonkStmt :: ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> Stmt GhcTc (LocatedA (body GhcTc))
-> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
_ (ParStmt XParStmt GhcTc GhcTc (LocatedA (body GhcTc))
bind_ty [ParStmtBlock GhcTc GhcTc]
stmts_w_bndrs HsExpr GhcTc
mzip_op SyntaxExpr GhcTc
bind_op)
  = do { (ZonkEnv
env1, SyntaxExprTc
new_bind_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_op
       ; TcType
new_bind_ty <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env1 XParStmt GhcTc GhcTc (LocatedA (body GhcTc))
TcType
bind_ty
       ; [ParStmtBlock GhcTc GhcTc]
new_stmts_w_bndrs <- (ParStmtBlock GhcTc GhcTc
 -> IOEnv (Env TcGblEnv TcLclEnv) (ParStmtBlock GhcTc GhcTc))
-> [ParStmtBlock GhcTc GhcTc]
-> IOEnv (Env TcGblEnv TcLclEnv) [ParStmtBlock GhcTc GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv
-> ParStmtBlock GhcTc GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ParStmtBlock GhcTc GhcTc)
zonk_branch ZonkEnv
env1) [ParStmtBlock GhcTc GhcTc]
stmts_w_bndrs
       ; let new_binders :: [TyCoVar]
new_binders = [TyCoVar
b | ParStmtBlock XParStmtBlock GhcTc GhcTc
_ [GuardLStmt GhcTc]
_ [IdP GhcTc]
bs SyntaxExpr GhcTc
_ <- [ParStmtBlock GhcTc GhcTc]
new_stmts_w_bndrs
                              , TyCoVar
b <- [IdP GhcTc]
[TyCoVar]
bs]
             env2 :: ZonkEnv
env2 = ZonkEnv -> [TyCoVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env1 [TyCoVar]
new_binders
       ; HsExpr GhcTc
new_mzip <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env2 HsExpr GhcTc
mzip_op
       ; (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2
                , XParStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> [ParStmtBlock GhcTc GhcTc]
-> HsExpr GhcTc
-> SyntaxExpr GhcTc
-> Stmt GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XParStmt idL idR body
-> [ParStmtBlock idL idR]
-> HsExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
ParStmt XParStmt GhcTc GhcTc (LocatedA (body GhcTc))
TcType
new_bind_ty [ParStmtBlock GhcTc GhcTc]
new_stmts_w_bndrs HsExpr GhcTc
new_mzip SyntaxExprTc
SyntaxExpr GhcTc
new_bind_op)}
  where
    zonk_branch :: ZonkEnv -> ParStmtBlock GhcTc GhcTc
                -> TcM (ParStmtBlock GhcTc GhcTc)
    zonk_branch :: ZonkEnv
-> ParStmtBlock GhcTc GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ParStmtBlock GhcTc GhcTc)
zonk_branch ZonkEnv
env1 (ParStmtBlock XParStmtBlock GhcTc GhcTc
x [GuardLStmt GhcTc]
stmts [IdP GhcTc]
bndrs SyntaxExpr GhcTc
return_op)
       = do { (ZonkEnv
env2, [GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
new_stmts)  <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
-> TcM
     (ZonkEnv, [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env1 ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
stmts
            ; (ZonkEnv
env3, SyntaxExprTc
new_return) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env2 SyntaxExpr GhcTc
return_op
            ; ParStmtBlock GhcTc GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ParStmtBlock GhcTc GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XParStmtBlock GhcTc GhcTc
-> [GuardLStmt GhcTc]
-> [IdP GhcTc]
-> SyntaxExpr GhcTc
-> ParStmtBlock GhcTc GhcTc
forall idL idR.
XParStmtBlock idL idR
-> [ExprLStmt idL]
-> [IdP idR]
-> SyntaxExpr idR
-> ParStmtBlock idL idR
ParStmtBlock XParStmtBlock GhcTc GhcTc
x [GuardLStmt GhcTc]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
new_stmts (ZonkEnv -> [TyCoVar] -> [TyCoVar]
zonkIdOccs ZonkEnv
env3 [IdP GhcTc]
[TyCoVar]
bndrs)
                                                                   SyntaxExprTc
SyntaxExpr GhcTc
new_return) }

zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (RecStmt { recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_stmts = L _ segStmts, recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_later_ids = [IdP GhcTc]
lvs
                            , recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_rec_ids = [IdP GhcTc]
rvs
                            , recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_ret_fn = SyntaxExpr GhcTc
ret_id, recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_mfix_fn = SyntaxExpr GhcTc
mfix_id
                            , recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_bind_fn = SyntaxExpr GhcTc
bind_id
                            , recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
recS_ext =
                                       RecStmtTc { recS_bind_ty = bind_ty
                                                 , recS_later_rets = later_rets
                                                 , recS_rec_rets = rec_rets
                                                 , recS_ret_ty = ret_ty} })
  = do { (ZonkEnv
env1, SyntaxExprTc
new_bind_id) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_id
       ; (ZonkEnv
env2, SyntaxExprTc
new_mfix_id) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
mfix_id
       ; (ZonkEnv
env3, SyntaxExprTc
new_ret_id)  <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env2 SyntaxExpr GhcTc
ret_id
       ; TcType
new_bind_ty <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env3 TcType
bind_ty
       ; [TyCoVar]
new_rvs <- ZonkEnv -> [TyCoVar] -> TcM [TyCoVar]
zonkIdBndrs ZonkEnv
env3 [IdP GhcTc]
[TyCoVar]
rvs
       ; [TyCoVar]
new_lvs <- ZonkEnv -> [TyCoVar] -> TcM [TyCoVar]
zonkIdBndrs ZonkEnv
env3 [IdP GhcTc]
[TyCoVar]
lvs
       ; TcType
new_ret_ty  <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env3 TcType
ret_ty
       ; let env4 :: ZonkEnv
env4 = ZonkEnv -> [TyCoVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env3 [TyCoVar]
new_rvs
       ; (ZonkEnv
env5, [GenLocated SrcSpanAnnA (Stmt GhcTc (LocatedA (body GhcTc)))]
new_segStmts) <- ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmtLR GhcTc GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmtLR GhcTc GhcTc (LocatedA (body GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env4 ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody [LStmtLR GhcTc GhcTc (LocatedA (body GhcTc))]
[GenLocated SrcSpanAnnA (Stmt GhcTc (LocatedA (body GhcTc)))]
segStmts
        -- Zonk the ret-expressions in an envt that
        -- has the polymorphic bindings in the envt
       ; [HsExpr GhcTc]
new_later_rets <- (HsExpr GhcTc -> TcM (HsExpr GhcTc))
-> [HsExpr GhcTc] -> IOEnv (Env TcGblEnv TcLclEnv) [HsExpr GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env5) [HsExpr GhcTc]
later_rets
       ; [HsExpr GhcTc]
new_rec_rets <- (HsExpr GhcTc -> TcM (HsExpr GhcTc))
-> [HsExpr GhcTc] -> IOEnv (Env TcGblEnv TcLclEnv) [HsExpr GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env5) [HsExpr GhcTc]
rec_rets
       ; (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> [TyCoVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env3 [TyCoVar]
new_lvs,     -- Only the lvs are needed
                 RecStmt :: forall idL idR body.
XRecStmt idL idR body
-> XRec idR [LStmtLR idL idR body]
-> [IdP idR]
-> [IdP idR]
-> SyntaxExpr idR
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
RecStmt { recS_stmts :: XRec GhcTc [LStmtLR GhcTc GhcTc (LocatedA (body GhcTc))]
recS_stmts = [GenLocated SrcSpanAnnA (Stmt GhcTc (LocatedA (body GhcTc)))]
-> LocatedAn
     AnnList
     [GenLocated SrcSpanAnnA (Stmt GhcTc (LocatedA (body GhcTc)))]
forall a an. a -> LocatedAn an a
noLocA [GenLocated SrcSpanAnnA (Stmt GhcTc (LocatedA (body GhcTc)))]
new_segStmts
                         , recS_later_ids :: [IdP GhcTc]
recS_later_ids = [IdP GhcTc]
[TyCoVar]
new_lvs
                         , recS_rec_ids :: [IdP GhcTc]
recS_rec_ids = [IdP GhcTc]
[TyCoVar]
new_rvs, recS_ret_fn :: SyntaxExpr GhcTc
recS_ret_fn = SyntaxExprTc
SyntaxExpr GhcTc
new_ret_id
                         , recS_mfix_fn :: SyntaxExpr GhcTc
recS_mfix_fn = SyntaxExprTc
SyntaxExpr GhcTc
new_mfix_id, recS_bind_fn :: SyntaxExpr GhcTc
recS_bind_fn = SyntaxExprTc
SyntaxExpr GhcTc
new_bind_id
                         , recS_ext :: XRecStmt GhcTc GhcTc (LocatedA (body GhcTc))
recS_ext = RecStmtTc :: TcType -> [HsExpr GhcTc] -> [HsExpr GhcTc] -> TcType -> RecStmtTc
RecStmtTc
                             { recS_bind_ty :: TcType
recS_bind_ty = TcType
new_bind_ty
                             , recS_later_rets :: [HsExpr GhcTc]
recS_later_rets = [HsExpr GhcTc]
new_later_rets
                             , recS_rec_rets :: [HsExpr GhcTc]
recS_rec_rets = [HsExpr GhcTc]
new_rec_rets
                             , recS_ret_ty :: TcType
recS_ret_ty = TcType
new_ret_ty } }) }

zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (BodyStmt XBodyStmt GhcTc GhcTc (LocatedA (body GhcTc))
ty LocatedA (body GhcTc)
body SyntaxExpr GhcTc
then_op SyntaxExpr GhcTc
guard_op)
  = do (ZonkEnv
env1, SyntaxExprTc
new_then_op)  <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
then_op
       (ZonkEnv
env2, SyntaxExprTc
new_guard_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
guard_op
       LocatedA (body GhcTc)
new_body <- ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody ZonkEnv
env2 LocatedA (body GhcTc)
body
       TcType
new_ty   <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env2 XBodyStmt GhcTc GhcTc (LocatedA (body GhcTc))
TcType
ty
       (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, XBodyStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> LocatedA (body GhcTc)
-> SyntaxExpr GhcTc
-> SyntaxExpr GhcTc
-> Stmt GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcTc GhcTc (LocatedA (body GhcTc))
TcType
new_ty LocatedA (body GhcTc)
new_body SyntaxExprTc
SyntaxExpr GhcTc
new_then_op SyntaxExprTc
SyntaxExpr GhcTc
new_guard_op)

zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (LastStmt XLastStmt GhcTc GhcTc (LocatedA (body GhcTc))
x LocatedA (body GhcTc)
body Maybe Bool
noret SyntaxExpr GhcTc
ret_op)
  = do (ZonkEnv
env1, SyntaxExprTc
new_ret) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
ret_op
       LocatedA (body GhcTc)
new_body <- ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody ZonkEnv
env1 LocatedA (body GhcTc)
body
       (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, XLastStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> LocatedA (body GhcTc)
-> Maybe Bool
-> SyntaxExpr GhcTc
-> Stmt GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt GhcTc GhcTc (LocatedA (body GhcTc))
x LocatedA (body GhcTc)
new_body Maybe Bool
noret SyntaxExprTc
SyntaxExpr GhcTc
new_ret)

zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
_ (TransStmt { trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_stmts = [GuardLStmt GhcTc]
stmts, trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_bndrs = [(IdP GhcTc, IdP GhcTc)]
binderMap
                          , trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_by = Maybe (LHsExpr GhcTc)
by, trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_form = TransForm
form, trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_using = LHsExpr GhcTc
using
                          , trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_ret = SyntaxExpr GhcTc
return_op, trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind = SyntaxExpr GhcTc
bind_op
                          , trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_ext = XTransStmt GhcTc GhcTc (LocatedA (body GhcTc))
bind_arg_ty
                          , trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
trS_fmap = HsExpr GhcTc
liftM_op })
  = do {
    ; (ZonkEnv
env1, SyntaxExprTc
bind_op') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_op
    ; TcType
bind_arg_ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env1 XTransStmt GhcTc GhcTc (LocatedA (body GhcTc))
TcType
bind_arg_ty
    ; (ZonkEnv
env2, [GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
stmts') <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
-> TcM
     (ZonkEnv, [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env1 ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
stmts
    ; Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc))
by'        <- (GenLocated SrcSpanAnnA (HsExpr GhcTc)
 -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
fmapMaybeM (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env2) Maybe (LHsExpr GhcTc)
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc))
by
    ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
using'     <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env2 LHsExpr GhcTc
using

    ; (ZonkEnv
env3, SyntaxExprTc
return_op') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env2 SyntaxExpr GhcTc
return_op
    ; [(TyCoVar, TyCoVar)]
binderMap' <- ((TyCoVar, TyCoVar)
 -> IOEnv (Env TcGblEnv TcLclEnv) (TyCoVar, TyCoVar))
-> [(TyCoVar, TyCoVar)]
-> IOEnv (Env TcGblEnv TcLclEnv) [(TyCoVar, TyCoVar)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv
-> (TyCoVar, TyCoVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (TyCoVar, TyCoVar)
zonkBinderMapEntry ZonkEnv
env3) [(IdP GhcTc, IdP GhcTc)]
[(TyCoVar, TyCoVar)]
binderMap
    ; HsExpr GhcTc
liftM_op'  <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env3 HsExpr GhcTc
liftM_op
    ; let env3' :: ZonkEnv
env3' = ZonkEnv -> [TyCoVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env3 (((TyCoVar, TyCoVar) -> TyCoVar)
-> [(TyCoVar, TyCoVar)] -> [TyCoVar]
forall a b. (a -> b) -> [a] -> [b]
map (TyCoVar, TyCoVar) -> TyCoVar
forall a b. (a, b) -> b
snd [(TyCoVar, TyCoVar)]
binderMap')
    ; (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env3', TransStmt :: forall idL idR body.
XTransStmt idL idR body
-> TransForm
-> [ExprLStmt idL]
-> [(IdP idR, IdP idR)]
-> LHsExpr idR
-> Maybe (LHsExpr idR)
-> SyntaxExpr idR
-> SyntaxExpr idR
-> HsExpr idR
-> StmtLR idL idR body
TransStmt { trS_stmts :: [GuardLStmt GhcTc]
trS_stmts = [GuardLStmt GhcTc]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
stmts', trS_bndrs :: [(IdP GhcTc, IdP GhcTc)]
trS_bndrs = [(IdP GhcTc, IdP GhcTc)]
[(TyCoVar, TyCoVar)]
binderMap'
                               , trS_by :: Maybe (LHsExpr GhcTc)
trS_by = Maybe (LHsExpr GhcTc)
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc))
by', trS_form :: TransForm
trS_form = TransForm
form, trS_using :: LHsExpr GhcTc
trS_using = LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
using'
                               , trS_ret :: SyntaxExpr GhcTc
trS_ret = SyntaxExprTc
SyntaxExpr GhcTc
return_op', trS_bind :: SyntaxExpr GhcTc
trS_bind = SyntaxExprTc
SyntaxExpr GhcTc
bind_op'
                               , trS_ext :: XTransStmt GhcTc GhcTc (LocatedA (body GhcTc))
trS_ext = XTransStmt GhcTc GhcTc (LocatedA (body GhcTc))
TcType
bind_arg_ty'
                               , trS_fmap :: HsExpr GhcTc
trS_fmap = HsExpr GhcTc
liftM_op' }) }
  where
    zonkBinderMapEntry :: ZonkEnv
-> (TyCoVar, TyCoVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (TyCoVar, TyCoVar)
zonkBinderMapEntry ZonkEnv
env  (TyCoVar
oldBinder, TyCoVar
newBinder) = do
        let oldBinder' :: TyCoVar
oldBinder' = ZonkEnv -> TyCoVar -> TyCoVar
zonkIdOcc ZonkEnv
env TyCoVar
oldBinder
        TyCoVar
newBinder' <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env TyCoVar
newBinder
        (TyCoVar, TyCoVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (TyCoVar, TyCoVar)
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCoVar
oldBinder', TyCoVar
newBinder')

zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
_ (LetStmt XLetStmt GhcTc GhcTc (LocatedA (body GhcTc))
x HsLocalBinds GhcTc
binds)
  = do (ZonkEnv
env1, HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env HsLocalBinds GhcTc
binds
       (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, XLetStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> HsLocalBinds GhcTc -> Stmt GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcTc GhcTc (LocatedA (body GhcTc))
x HsLocalBinds GhcTc
new_binds)

zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (BindStmt XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
xbs LPat GhcTc
pat LocatedA (body GhcTc)
body)
  = do  { (ZonkEnv
env1, SyntaxExprTc
new_bind) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env (XBindStmtTc -> SyntaxExpr GhcTc
xbstc_bindOp XBindStmtTc
XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
xbs)
        ; TcType
new_w <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env1 (XBindStmtTc -> TcType
xbstc_boundResultMult XBindStmtTc
XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
xbs)
        ; TcType
new_bind_ty <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env1 (XBindStmtTc -> TcType
xbstc_boundResultType XBindStmtTc
XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
xbs)
        ; LocatedA (body GhcTc)
new_body <- ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody ZonkEnv
env1 LocatedA (body GhcTc)
body
        ; (ZonkEnv
env2, GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat) <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env1 LPat GhcTc
pat
        ; Maybe SyntaxExprTc
new_fail <- case XBindStmtTc -> Maybe (SyntaxExpr GhcTc)
xbstc_failOp XBindStmtTc
XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
xbs of
            Maybe (SyntaxExpr GhcTc)
Nothing -> Maybe SyntaxExprTc
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SyntaxExprTc
forall a. Maybe a
Nothing
            Just SyntaxExpr GhcTc
f -> ((ZonkEnv, SyntaxExprTc) -> Maybe SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SyntaxExprTc -> Maybe SyntaxExprTc
forall a. a -> Maybe a
Just (SyntaxExprTc -> Maybe SyntaxExprTc)
-> ((ZonkEnv, SyntaxExprTc) -> SyntaxExprTc)
-> (ZonkEnv, SyntaxExprTc)
-> Maybe SyntaxExprTc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZonkEnv, SyntaxExprTc) -> SyntaxExprTc
forall a b. (a, b) -> b
snd) (ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
f)
        ; (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ZonkEnv
env2
                 , XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> LPat GhcTc
-> LocatedA (body GhcTc)
-> Stmt GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt (XBindStmtTc :: SyntaxExpr GhcTc
-> TcType -> TcType -> Maybe (SyntaxExpr GhcTc) -> XBindStmtTc
XBindStmtTc
                              { xbstc_bindOp :: SyntaxExpr GhcTc
xbstc_bindOp = SyntaxExprTc
SyntaxExpr GhcTc
new_bind
                              , xbstc_boundResultType :: TcType
xbstc_boundResultType = TcType
new_bind_ty
                              , xbstc_boundResultMult :: TcType
xbstc_boundResultMult = TcType
new_w
                              , xbstc_failOp :: Maybe (SyntaxExpr GhcTc)
xbstc_failOp = Maybe SyntaxExprTc
Maybe (SyntaxExpr GhcTc)
new_fail
                              })
                            LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat LocatedA (body GhcTc)
new_body) }

-- Scopes: join > ops (in reverse order) > pats (in forward order)
--              > rest of stmts
zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
_zBody (ApplicativeStmt XApplicativeStmt GhcTc GhcTc (LocatedA (body GhcTc))
body_ty [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args Maybe (SyntaxExpr GhcTc)
mb_join)
  = do  { (ZonkEnv
env1, Maybe SyntaxExprTc
new_mb_join)   <- ZonkEnv
-> Maybe SyntaxExprTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
zonk_join ZonkEnv
env Maybe SyntaxExprTc
Maybe (SyntaxExpr GhcTc)
mb_join
        ; (ZonkEnv
env2, [(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args)      <- ZonkEnv
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
zonk_args ZonkEnv
env1 [(SyntaxExprTc, ApplicativeArg GhcTc)]
[(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args
        ; TcType
new_body_ty           <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env2 XApplicativeStmt GhcTc GhcTc (LocatedA (body GhcTc))
TcType
body_ty
        ; (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ZonkEnv
env2
                 , XApplicativeStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> Maybe (SyntaxExpr GhcTc)
-> Stmt GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XApplicativeStmt idL idR body
-> [(SyntaxExpr idR, ApplicativeArg idL)]
-> Maybe (SyntaxExpr idR)
-> StmtLR idL idR body
ApplicativeStmt XApplicativeStmt GhcTc GhcTc (LocatedA (body GhcTc))
TcType
new_body_ty [(SyntaxExprTc, ApplicativeArg GhcTc)]
[(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
new_args Maybe SyntaxExprTc
Maybe (SyntaxExpr GhcTc)
new_mb_join) }
  where
    zonk_join :: ZonkEnv
-> Maybe SyntaxExprTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
zonk_join ZonkEnv
env Maybe SyntaxExprTc
Nothing  = (ZonkEnv, Maybe SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Maybe SyntaxExprTc
forall a. Maybe a
Nothing)
    zonk_join ZonkEnv
env (Just SyntaxExprTc
j) = (SyntaxExprTc -> Maybe SyntaxExprTc)
-> (ZonkEnv, SyntaxExprTc) -> (ZonkEnv, Maybe SyntaxExprTc)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second SyntaxExprTc -> Maybe SyntaxExprTc
forall a. a -> Maybe a
Just ((ZonkEnv, SyntaxExprTc) -> (ZonkEnv, Maybe SyntaxExprTc))
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExprTc
SyntaxExpr GhcTc
j

    get_pat :: (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> LPat GhcTc
    get_pat :: (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> LPat GhcTc
get_pat (SyntaxExpr GhcTc
_, ApplicativeArgOne XApplicativeArgOne GhcTc
_ LPat GhcTc
pat LHsExpr GhcTc
_ Bool
_) = LPat GhcTc
pat
    get_pat (SyntaxExpr GhcTc
_, ApplicativeArgMany XApplicativeArgMany GhcTc
_ [GuardLStmt GhcTc]
_ HsExpr GhcTc
_ LPat GhcTc
pat HsDoFlavour
_) = LPat GhcTc
pat

    replace_pat :: LPat GhcTc
                -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
                -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
    replace_pat :: LPat GhcTc
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
replace_pat LPat GhcTc
pat (SyntaxExpr GhcTc
op, ApplicativeArgOne XApplicativeArgOne GhcTc
fail_op LPat GhcTc
_ LHsExpr GhcTc
a Bool
isBody)
      = (SyntaxExpr GhcTc
op, XApplicativeArgOne GhcTc
-> LPat GhcTc -> LHsExpr GhcTc -> Bool -> ApplicativeArg GhcTc
forall idL.
XApplicativeArgOne idL
-> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
ApplicativeArgOne XApplicativeArgOne GhcTc
fail_op LPat GhcTc
pat LHsExpr GhcTc
a Bool
isBody)
    replace_pat LPat GhcTc
pat (SyntaxExpr GhcTc
op, ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
a HsExpr GhcTc
b LPat GhcTc
_ HsDoFlavour
c)
      = (SyntaxExpr GhcTc
op, XApplicativeArgMany GhcTc
-> [GuardLStmt GhcTc]
-> HsExpr GhcTc
-> LPat GhcTc
-> HsDoFlavour
-> ApplicativeArg GhcTc
forall idL.
XApplicativeArgMany idL
-> [ExprLStmt idL]
-> HsExpr idL
-> LPat idL
-> HsDoFlavour
-> ApplicativeArg idL
ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
a HsExpr GhcTc
b LPat GhcTc
pat HsDoFlavour
c)

    zonk_args :: ZonkEnv
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
zonk_args ZonkEnv
env [(SyntaxExprTc, ApplicativeArg GhcTc)]
args
      = do { (ZonkEnv
env1, [(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args_rev) <- ZonkEnv
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
zonk_args_rev ZonkEnv
env ([(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a. [a] -> [a]
reverse [(SyntaxExprTc, ApplicativeArg GhcTc)]
args)
           ; (ZonkEnv
env2, [GenLocated SrcSpanAnnA (Pat GhcTc)]
new_pats)     <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env1 (((SyntaxExprTc, ApplicativeArg GhcTc)
 -> GenLocated SrcSpanAnnA (Pat GhcTc))
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
forall a b. (a -> b) -> [a] -> [b]
map (SyntaxExprTc, ApplicativeArg GhcTc)
-> GenLocated SrcSpanAnnA (Pat GhcTc)
(SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> LPat GhcTc
get_pat [(SyntaxExprTc, ApplicativeArg GhcTc)]
args)
           ; (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, String
-> (GenLocated SrcSpanAnnA (Pat GhcTc)
    -> (SyntaxExprTc, ApplicativeArg GhcTc)
    -> (SyntaxExprTc, ApplicativeArg GhcTc))
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithEqual String
"zonkStmt" LPat GhcTc
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
GenLocated SrcSpanAnnA (Pat GhcTc)
-> (SyntaxExprTc, ApplicativeArg GhcTc)
-> (SyntaxExprTc, ApplicativeArg GhcTc)
replace_pat
                                        [GenLocated SrcSpanAnnA (Pat GhcTc)]
new_pats ([(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a. [a] -> [a]
reverse [(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args_rev)) }

     -- these need to go backward, because if any operators are higher-rank,
     -- later operators may introduce skolems that are in scope for earlier
     -- arguments
    zonk_args_rev :: ZonkEnv
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
zonk_args_rev ZonkEnv
env ((SyntaxExprTc
op, ApplicativeArg GhcTc
arg) : [(SyntaxExprTc, ApplicativeArg GhcTc)]
args)
      = do { (ZonkEnv
env1, SyntaxExprTc
new_op)         <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExprTc
SyntaxExpr GhcTc
op
           ; ApplicativeArg GhcTc
new_arg                <- ZonkEnv
-> ApplicativeArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
zonk_arg ZonkEnv
env1 ApplicativeArg GhcTc
arg
           ; (ZonkEnv
env2, [(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args)       <- ZonkEnv
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
zonk_args_rev ZonkEnv
env1 [(SyntaxExprTc, ApplicativeArg GhcTc)]
args
           ; (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, (SyntaxExprTc
new_op, ApplicativeArg GhcTc
new_arg) (SyntaxExprTc, ApplicativeArg GhcTc)
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a. a -> [a] -> [a]
: [(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args) }
    zonk_args_rev ZonkEnv
env [] = (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, [])

    zonk_arg :: ZonkEnv
-> ApplicativeArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
zonk_arg ZonkEnv
env (ApplicativeArgOne XApplicativeArgOne GhcTc
fail_op LPat GhcTc
pat LHsExpr GhcTc
expr Bool
isBody)
      = do { GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
           ; Maybe SyntaxExprTc
new_fail <- Maybe SyntaxExprTc
-> (SyntaxExprTc -> IOEnv (Env TcGblEnv TcLclEnv) SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe SyntaxExprTc
XApplicativeArgOne GhcTc
fail_op ((SyntaxExprTc -> IOEnv (Env TcGblEnv TcLclEnv) SyntaxExprTc)
 -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
-> (SyntaxExprTc -> IOEnv (Env TcGblEnv TcLclEnv) SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
forall a b. (a -> b) -> a -> b
$ \SyntaxExprTc
old_fail ->
              do { (ZonkEnv
_, SyntaxExprTc
fail') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExprTc
SyntaxExpr GhcTc
old_fail
                 ; SyntaxExprTc -> IOEnv (Env TcGblEnv TcLclEnv) SyntaxExprTc
forall (m :: * -> *) a. Monad m => a -> m a
return SyntaxExprTc
fail'
                 }
           ; ApplicativeArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XApplicativeArgOne GhcTc
-> LPat GhcTc -> LHsExpr GhcTc -> Bool -> ApplicativeArg GhcTc
forall idL.
XApplicativeArgOne idL
-> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
ApplicativeArgOne Maybe SyntaxExprTc
XApplicativeArgOne GhcTc
new_fail LPat GhcTc
pat LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr Bool
isBody) }
    zonk_arg ZonkEnv
env (ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
stmts HsExpr GhcTc
ret LPat GhcTc
pat HsDoFlavour
ctxt)
      = do { (ZonkEnv
env1, [GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
new_stmts) <- ZonkEnv
-> (ZonkEnv
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
-> TcM
     (ZonkEnv, [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
 ~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
    -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
-> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
stmts
           ; HsExpr GhcTc
new_ret           <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env1 HsExpr GhcTc
ret
           ; ApplicativeArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XApplicativeArgMany GhcTc
-> [GuardLStmt GhcTc]
-> HsExpr GhcTc
-> LPat GhcTc
-> HsDoFlavour
-> ApplicativeArg GhcTc
forall idL.
XApplicativeArgMany idL
-> [ExprLStmt idL]
-> HsExpr idL
-> LPat idL
-> HsDoFlavour
-> ApplicativeArg idL
ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
new_stmts HsExpr GhcTc
new_ret LPat GhcTc
pat HsDoFlavour
ctxt) }

-------------------------------------------------------------------------
zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc)
zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc)
zonkRecFields ZonkEnv
env (HsRecFields [LHsRecField GhcTc (LHsExpr GhcTc)]
flds Maybe (Located ConTag)
dd)
  = do  { [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
flds' <- (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
            (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
           (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
           (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
zonk_rbind [LHsRecField GhcTc (LHsExpr GhcTc)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
flds
        ; HsRecFields GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (HsRecFields GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsRecField GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
-> Maybe (Located ConTag)
-> HsRecFields GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
forall p arg.
[LHsRecField p arg] -> Maybe (Located ConTag) -> HsRecFields p arg
HsRecFields [LHsRecField GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
flds' Maybe (Located ConTag)
dd) }
  where
    zonk_rbind :: GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
           (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
zonk_rbind (L SrcSpanAnnA
l HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (HsExpr GhcTc))
fld)
      = do { GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc)
new_id   <- (FieldOcc GhcTc -> TcM (FieldOcc GhcTc))
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc)
-> TcRn (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc ZonkEnv
env) (HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc)
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (HsExpr GhcTc))
fld)
           ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env (HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (HsExpr GhcTc))
fld)
           ; GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
           (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
        (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (HsExpr GhcTc))
fld { hfbLHS :: GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc)
hfbLHS = GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc)
new_id
                              , hfbRHS :: GenLocated SrcSpanAnnA (HsExpr GhcTc)
hfbRHS = GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr })) }

zonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTc]
                 -> TcM [LHsRecUpdField GhcTc]
zonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTc] -> TcM [LHsRecUpdField GhcTc]
zonkRecUpdFields ZonkEnv
env = (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
            (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
           (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
           (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
zonk_rbind
  where
    zonk_rbind :: GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
           (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
zonk_rbind (L SrcSpanAnnA
l HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (HsExpr GhcTc))
fld)
      = do { GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc)
new_id   <- (FieldOcc GhcTc -> TcM (FieldOcc GhcTc))
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc)
-> TcRn (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc ZonkEnv
env) (HsFieldBind
  (LAmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> LFieldOcc GhcTc
forall arg.
HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
hsRecUpdFieldOcc HsFieldBind
  (LAmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (HsExpr GhcTc))
fld)
           ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env (HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> GenLocated SrcSpanAnnA (HsExpr GhcTc)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (HsExpr GhcTc))
fld)
           ; GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
           (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (HsExpr GhcTc))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
        (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (HsExpr GhcTc))
fld { hfbLHS :: GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc)
hfbLHS = (FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc)
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc)
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc
ambiguousFieldOcc GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc)
new_id
                              , hfbRHS :: GenLocated SrcSpanAnnA (HsExpr GhcTc)
hfbRHS = GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_expr })) }

{-
************************************************************************
*                                                                      *
\subsection[BackSubst-Pats]{Patterns}
*                                                                      *
************************************************************************
-}

zonkPat :: ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
-- Extend the environment as we go, because it's possible for one
-- pattern to bind something that is used in another (inside or
-- to the right)
zonkPat :: ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat = (Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc))
-> GenLocated SrcSpanAnnA (Pat GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, GenLocated SrcSpanAnnA (Pat GhcTc))
forall a b c ann.
(a -> TcM (b, c))
-> GenLocated (SrcSpanAnn' ann) a
-> TcM (b, GenLocated (SrcSpanAnn' ann) c)
wrapLocSndMA (ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc)
zonk_pat ZonkEnv
env) LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat

zonk_pat :: ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc)
zonk_pat :: ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc)
zonk_pat ZonkEnv
env (ParPat XParPat GhcTc
x LHsToken "(" GhcTc
lpar LPat GhcTc
p LHsToken ")" GhcTc
rpar)
  = do  { (ZonkEnv
env', GenLocated SrcSpanAnnA (Pat GhcTc)
p') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
p
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XParPat GhcTc
-> LHsToken "(" GhcTc
-> LPat GhcTc
-> LHsToken ")" GhcTc
-> Pat GhcTc
forall p.
XParPat p -> LHsToken "(" p -> LPat p -> LHsToken ")" p -> Pat p
ParPat XParPat GhcTc
x LHsToken "(" GhcTc
lpar LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
p' LHsToken ")" GhcTc
rpar) }

zonk_pat ZonkEnv
env (WildPat XWildPat GhcTc
ty)
  = do  { TcType
ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env XWildPat GhcTc
TcType
ty
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, XWildPat GhcTc -> Pat GhcTc
forall p. XWildPat p -> Pat p
WildPat XWildPat GhcTc
TcType
ty') }

zonk_pat ZonkEnv
env (VarPat XVarPat GhcTc
x (L l v))
  = do  { TyCoVar
v' <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env TyCoVar
v
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> TyCoVar -> ZonkEnv
extendIdZonkEnv ZonkEnv
env TyCoVar
v', XVarPat GhcTc -> LIdP GhcTc -> Pat GhcTc
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcTc
x (SrcSpanAnnN -> TyCoVar -> LocatedN TyCoVar
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l TyCoVar
v')) }

zonk_pat ZonkEnv
env (LazyPat XLazyPat GhcTc
x LPat GhcTc
pat)
  = do  { (ZonkEnv
env', GenLocated SrcSpanAnnA (Pat GhcTc)
pat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env',  XLazyPat GhcTc -> LPat GhcTc -> Pat GhcTc
forall p. XLazyPat p -> LPat p -> Pat p
LazyPat XLazyPat GhcTc
x LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat') }

zonk_pat ZonkEnv
env (BangPat XBangPat GhcTc
x LPat GhcTc
pat)
  = do  { (ZonkEnv
env', GenLocated SrcSpanAnnA (Pat GhcTc)
pat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env',  XBangPat GhcTc -> LPat GhcTc -> Pat GhcTc
forall p. XBangPat p -> LPat p -> Pat p
BangPat XBangPat GhcTc
x LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat') }

zonk_pat ZonkEnv
env (AsPat XAsPat GhcTc
x (L loc v) LPat GhcTc
pat)
  = do  { TyCoVar
v' <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env TyCoVar
v
        ; (ZonkEnv
env', GenLocated SrcSpanAnnA (Pat GhcTc)
pat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat (ZonkEnv -> TyCoVar -> ZonkEnv
extendIdZonkEnv ZonkEnv
env TyCoVar
v') LPat GhcTc
pat
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XAsPat GhcTc -> LIdP GhcTc -> LPat GhcTc -> Pat GhcTc
forall p. XAsPat p -> LIdP p -> LPat p -> Pat p
AsPat XAsPat GhcTc
x (SrcSpanAnnN -> TyCoVar -> LocatedN TyCoVar
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc TyCoVar
v') LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat') }

zonk_pat ZonkEnv
env (ViewPat XViewPat GhcTc
ty LHsExpr GhcTc
expr LPat GhcTc
pat)
  = do  { GenLocated SrcSpanAnnA (HsExpr GhcTc)
expr' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
        ; (ZonkEnv
env', GenLocated SrcSpanAnnA (Pat GhcTc)
pat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat
        ; TcType
ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env XViewPat GhcTc
TcType
ty
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XViewPat GhcTc -> LHsExpr GhcTc -> LPat GhcTc -> Pat GhcTc
forall p. XViewPat p -> LHsExpr p -> LPat p -> Pat p
ViewPat XViewPat GhcTc
TcType
ty' LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
expr' LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat') }

zonk_pat ZonkEnv
env (ListPat XListPat GhcTc
ty [LPat GhcTc]
pats)
  = do  { TcType
ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env XListPat GhcTc
TcType
ty
        ; (ZonkEnv
env', [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats') <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env [LPat GhcTc]
pats
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XListPat GhcTc -> [LPat GhcTc] -> Pat GhcTc
forall p. XListPat p -> [LPat p] -> Pat p
ListPat XListPat GhcTc
TcType
ty' [LPat GhcTc]
[GenLocated SrcSpanAnnA (Pat GhcTc)]
pats') }

zonk_pat ZonkEnv
env (TuplePat XTuplePat GhcTc
tys [LPat GhcTc]
pats Boxity
boxed)
  = do  { [TcType]
tys' <- (TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType)
-> [TcType] -> IOEnv (Env TcGblEnv TcLclEnv) [TcType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env) [TcType]
XTuplePat GhcTc
tys
        ; (ZonkEnv
env', [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats') <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env [LPat GhcTc]
pats
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XTuplePat GhcTc -> [LPat GhcTc] -> Boxity -> Pat GhcTc
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat [TcType]
XTuplePat GhcTc
tys' [LPat GhcTc]
[GenLocated SrcSpanAnnA (Pat GhcTc)]
pats' Boxity
boxed) }

zonk_pat ZonkEnv
env (SumPat XSumPat GhcTc
tys LPat GhcTc
pat ConTag
alt ConTag
arity )
  = do  { [TcType]
tys' <- (TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType)
-> [TcType] -> IOEnv (Env TcGblEnv TcLclEnv) [TcType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env) [TcType]
XSumPat GhcTc
tys
        ; (ZonkEnv
env', GenLocated SrcSpanAnnA (Pat GhcTc)
pat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XSumPat GhcTc -> LPat GhcTc -> ConTag -> ConTag -> Pat GhcTc
forall p. XSumPat p -> LPat p -> ConTag -> ConTag -> Pat p
SumPat [TcType]
XSumPat GhcTc
tys' LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat' ConTag
alt ConTag
arity) }

zonk_pat ZonkEnv
env p :: Pat GhcTc
p@(ConPat { pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails GhcTc
args
                       , pat_con_ext :: forall p. Pat p -> XConPat p
pat_con_ext = p' :: XConPat GhcTc
p'@(ConPatTc
                         { cpt_tvs = tyvars
                         , cpt_dicts = evs
                         , cpt_binds = binds
                         , cpt_wrap = wrapper
                         , cpt_arg_tys = tys
                         })
                       })
  = Bool -> TcM (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall a. HasCallStack => Bool -> a -> a
assert ((TyCoVar -> Bool) -> [TyCoVar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TyCoVar -> Bool
isImmutableTyVar [TyCoVar]
tyvars) (TcM (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc))
-> TcM (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall a b. (a -> b) -> a -> b
$
    do  { [TcType]
new_tys <- (TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType)
-> [TcType] -> IOEnv (Env TcGblEnv TcLclEnv) [TcType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env) [TcType]
tys
        ; (ZonkEnv
env0, [TyCoVar]
new_tyvars) <- ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
zonkTyBndrsX ZonkEnv
env [TyCoVar]
tyvars
          -- Must zonk the existential variables, because their
          -- /kind/ need potential zonking.
          -- cf typecheck/should_compile/tc221.hs
        ; (ZonkEnv
env1, [TyCoVar]
new_evs) <- ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
zonkEvBndrsX ZonkEnv
env0 [TyCoVar]
evs
        ; (ZonkEnv
env2, TcEvBinds
new_binds) <- ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds)
zonkTcEvBinds ZonkEnv
env1 TcEvBinds
binds
        ; (ZonkEnv
env3, HsWrapper
new_wrapper) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env2 HsWrapper
wrapper
        ; (ZonkEnv
env', HsConDetails
  (HsPatSigType GhcRn)
  (GenLocated SrcSpanAnnA (Pat GhcTc))
  (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
new_args) <- ZonkEnv
-> HsConPatDetails GhcTc -> TcM (ZonkEnv, HsConPatDetails GhcTc)
zonkConStuff ZonkEnv
env3 HsConPatDetails GhcTc
args
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( ZonkEnv
env'
               , Pat GhcTc
p
                 { pat_args :: HsConPatDetails GhcTc
pat_args = HsConDetails
  (HsPatSigType GhcRn)
  (GenLocated SrcSpanAnnA (Pat GhcTc))
  (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
HsConPatDetails GhcTc
new_args
                 , pat_con_ext :: XConPat GhcTc
pat_con_ext = ConPatTc
XConPat GhcTc
p'
                   { cpt_arg_tys :: [TcType]
cpt_arg_tys = [TcType]
new_tys
                   , cpt_tvs :: [TyCoVar]
cpt_tvs = [TyCoVar]
new_tyvars
                   , cpt_dicts :: [TyCoVar]
cpt_dicts = [TyCoVar]
new_evs
                   , cpt_binds :: TcEvBinds
cpt_binds = TcEvBinds
new_binds
                   , cpt_wrap :: HsWrapper
cpt_wrap = HsWrapper
new_wrapper
                   }
                 }
               )
        }

zonk_pat ZonkEnv
env (LitPat XLitPat GhcTc
x HsLit GhcTc
lit) = (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, XLitPat GhcTc -> HsLit GhcTc -> Pat GhcTc
forall p. XLitPat p -> HsLit p -> Pat p
LitPat XLitPat GhcTc
x HsLit GhcTc
lit)

zonk_pat ZonkEnv
env (SigPat XSigPat GhcTc
ty LPat GhcTc
pat HsPatSigType (NoGhcTc GhcTc)
hs_ty)
  = do  { TcType
ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env XSigPat GhcTc
TcType
ty
        ; (ZonkEnv
env', GenLocated SrcSpanAnnA (Pat GhcTc)
pat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XSigPat GhcTc
-> LPat GhcTc -> HsPatSigType (NoGhcTc GhcTc) -> Pat GhcTc
forall p. XSigPat p -> LPat p -> HsPatSigType (NoGhcTc p) -> Pat p
SigPat XSigPat GhcTc
TcType
ty' LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat' HsPatSigType (NoGhcTc GhcTc)
hs_ty) }

zonk_pat ZonkEnv
env (NPat XNPat GhcTc
ty (L l lit) Maybe (SyntaxExpr GhcTc)
mb_neg SyntaxExpr GhcTc
eq_expr)
  = do  { (ZonkEnv
env1, SyntaxExprTc
eq_expr') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
eq_expr
        ; (ZonkEnv
env2, Maybe SyntaxExprTc
mb_neg') <- case Maybe (SyntaxExpr GhcTc)
mb_neg of
            Maybe (SyntaxExpr GhcTc)
Nothing -> (ZonkEnv, Maybe SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, Maybe SyntaxExprTc
forall a. Maybe a
Nothing)
            Just SyntaxExpr GhcTc
n  -> (SyntaxExprTc -> Maybe SyntaxExprTc)
-> (ZonkEnv, SyntaxExprTc) -> (ZonkEnv, Maybe SyntaxExprTc)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second SyntaxExprTc -> Maybe SyntaxExprTc
forall a. a -> Maybe a
Just ((ZonkEnv, SyntaxExprTc) -> (ZonkEnv, Maybe SyntaxExprTc))
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
n

        ; HsOverLit GhcTc
lit' <- ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
zonkOverLit ZonkEnv
env2 HsOverLit GhcTc
lit
        ; TcType
ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env2 XNPat GhcTc
TcType
ty
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, XNPat GhcTc
-> XRec GhcTc (HsOverLit GhcTc)
-> Maybe (SyntaxExpr GhcTc)
-> SyntaxExpr GhcTc
-> Pat GhcTc
forall p.
XNPat p
-> XRec p (HsOverLit p)
-> Maybe (SyntaxExpr p)
-> SyntaxExpr p
-> Pat p
NPat XNPat GhcTc
TcType
ty' (SrcAnn NoEpAnns
-> HsOverLit GhcTc
-> GenLocated (SrcAnn NoEpAnns) (HsOverLit GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
l HsOverLit GhcTc
lit') Maybe SyntaxExprTc
Maybe (SyntaxExpr GhcTc)
mb_neg' SyntaxExprTc
SyntaxExpr GhcTc
eq_expr') }

zonk_pat ZonkEnv
env (NPlusKPat XNPlusKPat GhcTc
ty (L loc n) (L l lit1) HsOverLit GhcTc
lit2 SyntaxExpr GhcTc
e1 SyntaxExpr GhcTc
e2)
  = do  { (ZonkEnv
env1, SyntaxExprTc
e1') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env  SyntaxExpr GhcTc
e1
        ; (ZonkEnv
env2, SyntaxExprTc
e2') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
e2
        ; TyCoVar
n' <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env2 TyCoVar
n
        ; HsOverLit GhcTc
lit1' <- ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
zonkOverLit ZonkEnv
env2 HsOverLit GhcTc
lit1
        ; HsOverLit GhcTc
lit2' <- ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
zonkOverLit ZonkEnv
env2 HsOverLit GhcTc
lit2
        ; TcType
ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env2 XNPlusKPat GhcTc
TcType
ty
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> TyCoVar -> ZonkEnv
extendIdZonkEnv ZonkEnv
env2 TyCoVar
n',
                  XNPlusKPat GhcTc
-> LIdP GhcTc
-> XRec GhcTc (HsOverLit GhcTc)
-> HsOverLit GhcTc
-> SyntaxExpr GhcTc
-> SyntaxExpr GhcTc
-> Pat GhcTc
forall p.
XNPlusKPat p
-> LIdP p
-> XRec p (HsOverLit p)
-> HsOverLit p
-> SyntaxExpr p
-> SyntaxExpr p
-> Pat p
NPlusKPat XNPlusKPat GhcTc
TcType
ty' (SrcSpanAnnN -> TyCoVar -> LocatedN TyCoVar
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc TyCoVar
n') (SrcAnn NoEpAnns
-> HsOverLit GhcTc
-> GenLocated (SrcAnn NoEpAnns) (HsOverLit GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
l HsOverLit GhcTc
lit1') HsOverLit GhcTc
lit2' SyntaxExprTc
SyntaxExpr GhcTc
e1' SyntaxExprTc
SyntaxExpr GhcTc
e2') }
zonk_pat ZonkEnv
env (XPat XXPat GhcTc
ext) = case XXPat GhcTc
ext of
  { ExpansionPat orig pat->
    do { (ZonkEnv
env, Pat GhcTc
pat') <- ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc)
zonk_pat ZonkEnv
env Pat GhcTc
pat
       ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc))
-> (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall a b. (a -> b) -> a -> b
$ (ZonkEnv
env, XXPat GhcTc -> Pat GhcTc
forall p. XXPat p -> Pat p
XPat (XXPat GhcTc -> Pat GhcTc) -> XXPat GhcTc -> Pat GhcTc
forall a b. (a -> b) -> a -> b
$ Pat GhcRn -> Pat GhcTc -> XXPatGhcTc
ExpansionPat Pat GhcRn
orig Pat GhcTc
pat') }
  ; CoPat co_fn pat ty ->
    do { (ZonkEnv
env', HsWrapper
co_fn') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
co_fn
       ; (ZonkEnv
env'', GenLocated SrcSpanAnnA (Pat GhcTc)
pat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env' (Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc)
forall a an. a -> LocatedAn an a
noLocA Pat GhcTc
pat)
       ; TcType
ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env'' TcType
ty
       ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env'', XXPat GhcTc -> Pat GhcTc
forall p. XXPat p -> Pat p
XPat (XXPat GhcTc -> Pat GhcTc) -> XXPat GhcTc -> Pat GhcTc
forall a b. (a -> b) -> a -> b
$ HsWrapper -> Pat GhcTc -> TcType -> XXPatGhcTc
CoPat HsWrapper
co_fn' (GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (Pat GhcTc)
pat') TcType
ty')
       }}

zonk_pat ZonkEnv
_ Pat GhcTc
pat = String -> SDoc -> TcM (ZonkEnv, Pat GhcTc)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"zonk_pat" (Pat GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcTc
pat)

---------------------------
zonkConStuff :: ZonkEnv -> HsConPatDetails GhcTc
             -> TcM (ZonkEnv, HsConPatDetails GhcTc)
zonkConStuff :: ZonkEnv
-> HsConPatDetails GhcTc -> TcM (ZonkEnv, HsConPatDetails GhcTc)
zonkConStuff ZonkEnv
env (PrefixCon [HsPatSigType (NoGhcTc GhcTc)]
tyargs [LPat GhcTc]
pats)
  = do  { (ZonkEnv
env', [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats') <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env [LPat GhcTc]
pats
        ; (ZonkEnv,
 HsConDetails
   (HsPatSigType GhcRn)
   (GenLocated SrcSpanAnnA (Pat GhcTc))
   (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv,
      HsConDetails
        (HsPatSigType GhcRn)
        (GenLocated SrcSpanAnnA (Pat GhcTc))
        (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', [HsPatSigType GhcRn]
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
-> HsConDetails
     (HsPatSigType GhcRn)
     (GenLocated SrcSpanAnnA (Pat GhcTc))
     (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [HsPatSigType GhcRn]
[HsPatSigType (NoGhcTc GhcTc)]
tyargs [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats') }

zonkConStuff ZonkEnv
env (InfixCon LPat GhcTc
p1 LPat GhcTc
p2)
  = do  { (ZonkEnv
env1, GenLocated SrcSpanAnnA (Pat GhcTc)
p1') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env  LPat GhcTc
p1
        ; (ZonkEnv
env', GenLocated SrcSpanAnnA (Pat GhcTc)
p2') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env1 LPat GhcTc
p2
        ; (ZonkEnv,
 HsConDetails
   (HsPatSigType GhcRn)
   (GenLocated SrcSpanAnnA (Pat GhcTc))
   (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv,
      HsConDetails
        (HsPatSigType GhcRn)
        (GenLocated SrcSpanAnnA (Pat GhcTc))
        (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', GenLocated SrcSpanAnnA (Pat GhcTc)
-> GenLocated SrcSpanAnnA (Pat GhcTc)
-> HsConDetails
     (HsPatSigType GhcRn)
     (GenLocated SrcSpanAnnA (Pat GhcTc))
     (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon GenLocated SrcSpanAnnA (Pat GhcTc)
p1' GenLocated SrcSpanAnnA (Pat GhcTc)
p2') }

zonkConStuff ZonkEnv
env (RecCon (HsRecFields [LHsRecField GhcTc (LPat GhcTc)]
rpats Maybe (Located ConTag)
dd))
  = do  { (ZonkEnv
env', [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats') <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env ((GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))
 -> GenLocated SrcSpanAnnA (Pat GhcTc))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))]
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
forall a b. (a -> b) -> [a] -> [b]
map (HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (Pat GhcTc))
-> GenLocated SrcSpanAnnA (Pat GhcTc)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS (HsFieldBind
   (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
   (GenLocated SrcSpanAnnA (Pat GhcTc))
 -> GenLocated SrcSpanAnnA (Pat GhcTc))
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))
    -> HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
        (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> GenLocated SrcSpanAnnA (Pat GhcTc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (Pat GhcTc)))
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (Pat GhcTc))
forall l e. GenLocated l e -> e
unLoc) [LHsRecField GhcTc (LPat GhcTc)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))]
rpats)
        ; let rpats' :: [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))]
rpats' = (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))
 -> GenLocated SrcSpanAnnA (Pat GhcTc)
 -> GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc))))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))]
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(L SrcSpanAnnA
l HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (Pat GhcTc))
rp) GenLocated SrcSpanAnnA (Pat GhcTc)
p' ->
                                  SrcSpanAnnA
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
     (GenLocated SrcSpanAnnA (Pat GhcTc))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
        (GenLocated SrcSpanAnnA (Pat GhcTc)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
  (GenLocated SrcSpanAnnA (Pat GhcTc))
rp { hfbRHS :: GenLocated SrcSpanAnnA (Pat GhcTc)
hfbRHS = GenLocated SrcSpanAnnA (Pat GhcTc)
p' }))
                               [LHsRecField GhcTc (LPat GhcTc)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))]
rpats [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats'
        ; (ZonkEnv,
 HsConDetails
   (HsPatSigType GhcRn)
   (GenLocated SrcSpanAnnA (Pat GhcTc))
   (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv,
      HsConDetails
        (HsPatSigType GhcRn)
        (GenLocated SrcSpanAnnA (Pat GhcTc))
        (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))
-> HsConDetails
     (HsPatSigType GhcRn)
     (GenLocated SrcSpanAnnA (Pat GhcTc))
     (HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc)))
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon ([LHsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))]
-> Maybe (Located ConTag)
-> HsRecFields GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))
forall p arg.
[LHsRecField p arg] -> Maybe (Located ConTag) -> HsRecFields p arg
HsRecFields [LHsRecField GhcTc (GenLocated SrcSpanAnnA (Pat GhcTc))]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcTc))
      (GenLocated SrcSpanAnnA (Pat GhcTc)))]
rpats' Maybe (Located ConTag)
dd)) }
        -- Field selectors have declared types; hence no zonking

---------------------------
zonkPats :: ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats :: ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env []         = (ZonkEnv, [GenLocated SrcSpanAnnA (Pat GhcTc)])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [GenLocated SrcSpanAnnA (Pat GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, [])
zonkPats ZonkEnv
env (LPat GhcTc
pat:[LPat GhcTc]
pats) = do { (ZonkEnv
env1, GenLocated SrcSpanAnnA (Pat GhcTc)
pat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat
                             ; (ZonkEnv
env', [GenLocated SrcSpanAnnA (Pat GhcTc)]
pats') <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env1 [LPat GhcTc]
pats
                             ; (ZonkEnv, [GenLocated SrcSpanAnnA (Pat GhcTc)])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [GenLocated SrcSpanAnnA (Pat GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', GenLocated SrcSpanAnnA (Pat GhcTc)
pat'GenLocated SrcSpanAnnA (Pat GhcTc)
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
forall a. a -> [a] -> [a]
:[GenLocated SrcSpanAnnA (Pat GhcTc)]
pats') }

{-
************************************************************************
*                                                                      *
\subsection[BackSubst-Foreign]{Foreign exports}
*                                                                      *
************************************************************************
-}

zonkForeignExports :: ZonkEnv -> [LForeignDecl GhcTc]
                   -> TcM [LForeignDecl GhcTc]
zonkForeignExports :: ZonkEnv -> [LForeignDecl GhcTc] -> TcM [LForeignDecl GhcTc]
zonkForeignExports ZonkEnv
env [LForeignDecl GhcTc]
ls = (GenLocated SrcSpanAnnA (ForeignDecl GhcTc)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated SrcSpanAnnA (ForeignDecl GhcTc)))
-> [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ForeignDecl GhcTc -> TcM (ForeignDecl GhcTc))
-> GenLocated SrcSpanAnnA (ForeignDecl GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (GenLocated SrcSpanAnnA (ForeignDecl GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> ForeignDecl GhcTc -> TcM (ForeignDecl GhcTc)
zonkForeignExport ZonkEnv
env)) [LForeignDecl GhcTc]
[GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
ls

zonkForeignExport :: ZonkEnv -> ForeignDecl GhcTc -> TcM (ForeignDecl GhcTc)
zonkForeignExport :: ZonkEnv -> ForeignDecl GhcTc -> TcM (ForeignDecl GhcTc)
zonkForeignExport ZonkEnv
env (ForeignExport { fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_name = LIdP GhcTc
i, fd_e_ext :: forall pass. ForeignDecl pass -> XForeignExport pass
fd_e_ext = XForeignExport GhcTc
co
                                     , fd_fe :: forall pass. ForeignDecl pass -> ForeignExport
fd_fe = ForeignExport
spec })
  = ForeignDecl GhcTc -> TcM (ForeignDecl GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignExport :: forall pass.
XForeignExport pass
-> LIdP pass
-> LHsSigType pass
-> ForeignExport
-> ForeignDecl pass
ForeignExport { fd_name :: LIdP GhcTc
fd_name = ZonkEnv -> LocatedN TyCoVar -> LocatedN TyCoVar
zonkLIdOcc ZonkEnv
env LIdP GhcTc
LocatedN TyCoVar
i
                          , fd_sig_ty :: LHsSigType GhcTc
fd_sig_ty = LHsSigType GhcTc
forall a. HasCallStack => a
undefined, fd_e_ext :: XForeignExport GhcTc
fd_e_ext = XForeignExport GhcTc
co
                          , fd_fe :: ForeignExport
fd_fe = ForeignExport
spec })
zonkForeignExport ZonkEnv
_ ForeignDecl GhcTc
for_imp
  = ForeignDecl GhcTc -> TcM (ForeignDecl GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignDecl GhcTc
for_imp     -- Foreign imports don't need zonking

zonkRules :: ZonkEnv -> [LRuleDecl GhcTc] -> TcM [LRuleDecl GhcTc]
zonkRules :: ZonkEnv -> [LRuleDecl GhcTc] -> TcM [LRuleDecl GhcTc]
zonkRules ZonkEnv
env [LRuleDecl GhcTc]
rs = (GenLocated SrcSpanAnnA (RuleDecl GhcTc)
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (RuleDecl GhcTc)))
-> [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv) [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((RuleDecl GhcTc -> TcM (RuleDecl GhcTc))
-> GenLocated SrcSpanAnnA (RuleDecl GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (RuleDecl GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> RuleDecl GhcTc -> TcM (RuleDecl GhcTc)
zonkRule ZonkEnv
env)) [LRuleDecl GhcTc]
[GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
rs

zonkRule :: ZonkEnv -> RuleDecl GhcTc -> TcM (RuleDecl GhcTc)
zonkRule :: ZonkEnv -> RuleDecl GhcTc -> TcM (RuleDecl GhcTc)
zonkRule ZonkEnv
env rule :: RuleDecl GhcTc
rule@(HsRule { rd_tmvs :: forall pass. RuleDecl pass -> [LRuleBndr pass]
rd_tmvs = [LRuleBndr GhcTc]
tm_bndrs{-::[RuleBndr TcId]-}
                          , rd_lhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
rd_lhs = LHsExpr GhcTc
lhs
                          , rd_rhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
rd_rhs = LHsExpr GhcTc
rhs })
  = do { (ZonkEnv
env_inside, [GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)]
new_tm_bndrs) <- (ZonkEnv
 -> GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (ZonkEnv, GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)))
-> ZonkEnv
-> [GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv -> LRuleBndr GhcTc -> TcM (ZonkEnv, LRuleBndr GhcTc)
ZonkEnv
-> GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc))
zonk_tm_bndr ZonkEnv
env [LRuleBndr GhcTc]
[GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)]
tm_bndrs

       ; let env_lhs :: ZonkEnv
env_lhs = ZonkEnv -> ZonkFlexi -> ZonkEnv
setZonkType ZonkEnv
env_inside ZonkFlexi
SkolemiseFlexi
              -- See Note [Zonking the LHS of a RULE]

       ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_lhs <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env_lhs    LHsExpr GhcTc
lhs
       ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_rhs <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env_inside LHsExpr GhcTc
rhs

       ; RuleDecl GhcTc -> TcM (RuleDecl GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (RuleDecl GhcTc -> TcM (RuleDecl GhcTc))
-> RuleDecl GhcTc -> TcM (RuleDecl GhcTc)
forall a b. (a -> b) -> a -> b
$ RuleDecl GhcTc
rule { rd_tmvs :: [LRuleBndr GhcTc]
rd_tmvs = [LRuleBndr GhcTc]
[GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)]
new_tm_bndrs
                       , rd_lhs :: LHsExpr GhcTc
rd_lhs  = LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_lhs
                       , rd_rhs :: LHsExpr GhcTc
rd_rhs  = LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
new_rhs } }
  where
   zonk_tm_bndr :: ZonkEnv -> LRuleBndr GhcTc -> TcM (ZonkEnv, LRuleBndr GhcTc)
   zonk_tm_bndr :: ZonkEnv -> LRuleBndr GhcTc -> TcM (ZonkEnv, LRuleBndr GhcTc)
zonk_tm_bndr ZonkEnv
env (L l (RuleBndr x (L loc v)))
      = do { (ZonkEnv
env', TyCoVar
v') <- ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonk_it ZonkEnv
env TyCoVar
v
           ; (ZonkEnv, GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', SrcAnn NoEpAnns
-> RuleBndr GhcTc -> GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
l (XCRuleBndr GhcTc -> LIdP GhcTc -> RuleBndr GhcTc
forall pass. XCRuleBndr pass -> LIdP pass -> RuleBndr pass
RuleBndr XCRuleBndr GhcTc
x (SrcSpanAnnN -> TyCoVar -> LocatedN TyCoVar
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc TyCoVar
v'))) }
   zonk_tm_bndr ZonkEnv
_ (L _ (RuleBndrSig {})) = String
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcTc))
forall a. String -> a
panic String
"zonk_tm_bndr RuleBndrSig"

   zonk_it :: ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonk_it ZonkEnv
env TyCoVar
v
     | TyCoVar -> Bool
isId TyCoVar
v     = do { TyCoVar
v' <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env TyCoVar
v
                       ; (ZonkEnv, TyCoVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> [TyCoVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env [TyCoVar
v'], TyCoVar
v') }
     | Bool
otherwise  = Bool
-> (ZonkEnv
    -> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar))
-> ZonkEnv
-> TyCoVar
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
forall a. HasCallStack => Bool -> a -> a
assert (TyCoVar -> Bool
isImmutableTyVar TyCoVar
v)
                    ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonkTyBndrX ZonkEnv
env TyCoVar
v
                    -- DV: used to be return (env,v) but that is plain
                    -- wrong because we may need to go inside the kind
                    -- of v and zonk there!

{-
************************************************************************
*                                                                      *
              Constraints and evidence
*                                                                      *
************************************************************************
-}

zonkEvTerm :: ZonkEnv -> EvTerm -> TcM EvTerm
zonkEvTerm :: ZonkEnv -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
zonkEvTerm ZonkEnv
env (EvExpr EvExpr
e)
  = EvExpr -> EvTerm
EvExpr (EvExpr -> EvTerm)
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
-> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env EvExpr
e
zonkEvTerm ZonkEnv
env (EvTypeable TcType
ty EvTypeable
ev)
  = TcType -> EvTypeable -> EvTerm
EvTypeable (TcType -> EvTypeable -> EvTerm)
-> IOEnv (Env TcGblEnv TcLclEnv) TcType
-> IOEnv (Env TcGblEnv TcLclEnv) (EvTypeable -> EvTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
ty IOEnv (Env TcGblEnv TcLclEnv) (EvTypeable -> EvTerm)
-> IOEnv (Env TcGblEnv TcLclEnv) EvTypeable
-> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ZonkEnv -> EvTypeable -> IOEnv (Env TcGblEnv TcLclEnv) EvTypeable
zonkEvTypeable ZonkEnv
env EvTypeable
ev
zonkEvTerm ZonkEnv
env (EvFun { et_tvs :: EvTerm -> [TyCoVar]
et_tvs = [TyCoVar]
tvs, et_given :: EvTerm -> [TyCoVar]
et_given = [TyCoVar]
evs
                      , et_binds :: EvTerm -> TcEvBinds
et_binds = TcEvBinds
ev_binds, et_body :: EvTerm -> TyCoVar
et_body = TyCoVar
body_id })
  = do { (ZonkEnv
env0, [TyCoVar]
new_tvs) <- ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
zonkTyBndrsX ZonkEnv
env [TyCoVar]
tvs
       ; (ZonkEnv
env1, [TyCoVar]
new_evs) <- ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
zonkEvBndrsX ZonkEnv
env0 [TyCoVar]
evs
       ; (ZonkEnv
env2, TcEvBinds
new_ev_binds) <- ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds)
zonkTcEvBinds ZonkEnv
env1 TcEvBinds
ev_binds
       ; let new_body_id :: TyCoVar
new_body_id = ZonkEnv -> TyCoVar -> TyCoVar
zonkIdOcc ZonkEnv
env2 TyCoVar
body_id
       ; EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (EvFun :: [TyCoVar] -> [TyCoVar] -> TcEvBinds -> TyCoVar -> EvTerm
EvFun { et_tvs :: [TyCoVar]
et_tvs = [TyCoVar]
new_tvs, et_given :: [TyCoVar]
et_given = [TyCoVar]
new_evs
                       , et_binds :: TcEvBinds
et_binds = TcEvBinds
new_ev_binds, et_body :: TyCoVar
et_body = TyCoVar
new_body_id }) }

zonkCoreExpr :: ZonkEnv -> CoreExpr -> TcM CoreExpr
zonkCoreExpr :: ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env (Var TyCoVar
v)
    | TyCoVar -> Bool
isCoVar TyCoVar
v
    = TcCoercionR -> EvExpr
forall b. TcCoercionR -> Expr b
Coercion (TcCoercionR -> EvExpr)
-> TcM TcCoercionR -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> TyCoVar -> TcM TcCoercionR
zonkCoVarOcc ZonkEnv
env TyCoVar
v
    | Bool
otherwise
    = EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCoVar -> EvExpr
forall b. TyCoVar -> Expr b
Var (TyCoVar -> EvExpr) -> TyCoVar -> EvExpr
forall a b. (a -> b) -> a -> b
$ ZonkEnv -> TyCoVar -> TyCoVar
zonkIdOcc ZonkEnv
env TyCoVar
v)
zonkCoreExpr ZonkEnv
_ (Lit Literal
l)
    = EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr)
-> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall a b. (a -> b) -> a -> b
$ Literal -> EvExpr
forall b. Literal -> Expr b
Lit Literal
l
zonkCoreExpr ZonkEnv
env (Coercion TcCoercionR
co)
    = TcCoercionR -> EvExpr
forall b. TcCoercionR -> Expr b
Coercion (TcCoercionR -> EvExpr)
-> TcM TcCoercionR -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> TcCoercionR -> TcM TcCoercionR
zonkCoToCo ZonkEnv
env TcCoercionR
co
zonkCoreExpr ZonkEnv
env (Type TcType
ty)
    = TcType -> EvExpr
forall b. TcType -> Expr b
Type (TcType -> EvExpr)
-> IOEnv (Env TcGblEnv TcLclEnv) TcType
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
ty

zonkCoreExpr ZonkEnv
env (Cast EvExpr
e TcCoercionR
co)
    = EvExpr -> TcCoercionR -> EvExpr
forall b. Expr b -> TcCoercionR -> Expr b
Cast (EvExpr -> TcCoercionR -> EvExpr)
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
-> IOEnv (Env TcGblEnv TcLclEnv) (TcCoercionR -> EvExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env EvExpr
e IOEnv (Env TcGblEnv TcLclEnv) (TcCoercionR -> EvExpr)
-> TcM TcCoercionR -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ZonkEnv -> TcCoercionR -> TcM TcCoercionR
zonkCoToCo ZonkEnv
env TcCoercionR
co
zonkCoreExpr ZonkEnv
env (Tick CoreTickish
t EvExpr
e)
    = CoreTickish -> EvExpr -> EvExpr
forall b. CoreTickish -> Expr b -> Expr b
Tick CoreTickish
t (EvExpr -> EvExpr)
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env EvExpr
e -- Do we need to zonk in ticks?

zonkCoreExpr ZonkEnv
env (App EvExpr
e1 EvExpr
e2)
    = EvExpr -> EvExpr -> EvExpr
forall b. Expr b -> Expr b -> Expr b
App (EvExpr -> EvExpr -> EvExpr)
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
-> IOEnv (Env TcGblEnv TcLclEnv) (EvExpr -> EvExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env EvExpr
e1 IOEnv (Env TcGblEnv TcLclEnv) (EvExpr -> EvExpr)
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env EvExpr
e2
zonkCoreExpr ZonkEnv
env (Lam TyCoVar
v EvExpr
e)
    = do { (ZonkEnv
env1, TyCoVar
v') <- ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonkCoreBndrX ZonkEnv
env TyCoVar
v
         ; TyCoVar -> EvExpr -> EvExpr
forall b. b -> Expr b -> Expr b
Lam TyCoVar
v' (EvExpr -> EvExpr)
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env1 EvExpr
e }
zonkCoreExpr ZonkEnv
env (Let Bind TyCoVar
bind EvExpr
e)
    = do (ZonkEnv
env1, Bind TyCoVar
bind') <- ZonkEnv -> Bind TyCoVar -> TcM (ZonkEnv, Bind TyCoVar)
zonkCoreBind ZonkEnv
env Bind TyCoVar
bind
         Bind TyCoVar -> EvExpr -> EvExpr
forall b. Bind b -> Expr b -> Expr b
Let Bind TyCoVar
bind'(EvExpr -> EvExpr)
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env1 EvExpr
e
zonkCoreExpr ZonkEnv
env (Case EvExpr
scrut TyCoVar
b TcType
ty [Alt TyCoVar]
alts)
    = do EvExpr
scrut' <- ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env EvExpr
scrut
         TcType
ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
ty
         TyCoVar
b' <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env TyCoVar
b
         let env1 :: ZonkEnv
env1 = ZonkEnv -> TyCoVar -> ZonkEnv
extendIdZonkEnv ZonkEnv
env TyCoVar
b'
         [Alt TyCoVar]
alts' <- (Alt TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (Alt TyCoVar))
-> [Alt TyCoVar] -> IOEnv (Env TcGblEnv TcLclEnv) [Alt TyCoVar]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv
-> Alt TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (Alt TyCoVar)
zonkCoreAlt ZonkEnv
env1) [Alt TyCoVar]
alts
         EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr)
-> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall a b. (a -> b) -> a -> b
$ EvExpr -> TyCoVar -> TcType -> [Alt TyCoVar] -> EvExpr
forall b. Expr b -> b -> TcType -> [Alt b] -> Expr b
Case EvExpr
scrut' TyCoVar
b' TcType
ty' [Alt TyCoVar]
alts'

zonkCoreAlt :: ZonkEnv -> CoreAlt -> TcM CoreAlt
zonkCoreAlt :: ZonkEnv
-> Alt TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (Alt TyCoVar)
zonkCoreAlt ZonkEnv
env (Alt AltCon
dc [TyCoVar]
bndrs EvExpr
rhs)
    = do (ZonkEnv
env1, [TyCoVar]
bndrs') <- ZonkEnv -> [TyCoVar] -> TcM (ZonkEnv, [TyCoVar])
zonkCoreBndrsX ZonkEnv
env [TyCoVar]
bndrs
         EvExpr
rhs' <- ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env1 EvExpr
rhs
         Alt TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (Alt TyCoVar)
forall (m :: * -> *) a. Monad m => a -> m a
return (Alt TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (Alt TyCoVar))
-> Alt TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (Alt TyCoVar)
forall a b. (a -> b) -> a -> b
$ AltCon -> [TyCoVar] -> EvExpr -> Alt TyCoVar
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
dc [TyCoVar]
bndrs' EvExpr
rhs'

zonkCoreBind :: ZonkEnv -> CoreBind -> TcM (ZonkEnv, CoreBind)
zonkCoreBind :: ZonkEnv -> Bind TyCoVar -> TcM (ZonkEnv, Bind TyCoVar)
zonkCoreBind ZonkEnv
env (NonRec TyCoVar
v EvExpr
e)
    = do TyCoVar
v' <- ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env TyCoVar
v
         EvExpr
e' <- ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env EvExpr
e
         let env1 :: ZonkEnv
env1 = ZonkEnv -> TyCoVar -> ZonkEnv
extendIdZonkEnv ZonkEnv
env TyCoVar
v'
         (ZonkEnv, Bind TyCoVar) -> TcM (ZonkEnv, Bind TyCoVar)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, TyCoVar -> EvExpr -> Bind TyCoVar
forall b. b -> Expr b -> Bind b
NonRec TyCoVar
v' EvExpr
e')
zonkCoreBind ZonkEnv
env (Rec [(TyCoVar, EvExpr)]
pairs)
    = do (ZonkEnv
env1, [(TyCoVar, EvExpr)]
pairs') <- ((ZonkEnv, [(TyCoVar, EvExpr)])
 -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(TyCoVar, EvExpr)]))
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(TyCoVar, EvExpr)])
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM (ZonkEnv, [(TyCoVar, EvExpr)])
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(TyCoVar, EvExpr)])
go
         (ZonkEnv, Bind TyCoVar) -> TcM (ZonkEnv, Bind TyCoVar)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, [(TyCoVar, EvExpr)] -> Bind TyCoVar
forall b. [(b, Expr b)] -> Bind b
Rec [(TyCoVar, EvExpr)]
pairs')
  where
    go :: (ZonkEnv, [(TyCoVar, EvExpr)])
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(TyCoVar, EvExpr)])
go ~(ZonkEnv
_, [(TyCoVar, EvExpr)]
new_pairs) = do
         let env1 :: ZonkEnv
env1 = ZonkEnv -> [TyCoVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env (((TyCoVar, EvExpr) -> TyCoVar) -> [(TyCoVar, EvExpr)] -> [TyCoVar]
forall a b. (a -> b) -> [a] -> [b]
map (TyCoVar, EvExpr) -> TyCoVar
forall a b. (a, b) -> a
fst [(TyCoVar, EvExpr)]
new_pairs)
         [(TyCoVar, EvExpr)]
pairs' <- ((TyCoVar, EvExpr)
 -> IOEnv (Env TcGblEnv TcLclEnv) (TyCoVar, EvExpr))
-> [(TyCoVar, EvExpr)]
-> IOEnv (Env TcGblEnv TcLclEnv) [(TyCoVar, EvExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv
-> (TyCoVar, EvExpr)
-> IOEnv (Env TcGblEnv TcLclEnv) (TyCoVar, EvExpr)
zonkCorePair ZonkEnv
env1) [(TyCoVar, EvExpr)]
pairs
         (ZonkEnv, [(TyCoVar, EvExpr)])
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(TyCoVar, EvExpr)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, [(TyCoVar, EvExpr)]
pairs')

zonkCorePair :: ZonkEnv -> (CoreBndr, CoreExpr) -> TcM (CoreBndr, CoreExpr)
zonkCorePair :: ZonkEnv
-> (TyCoVar, EvExpr)
-> IOEnv (Env TcGblEnv TcLclEnv) (TyCoVar, EvExpr)
zonkCorePair ZonkEnv
env (TyCoVar
v,EvExpr
e) = (,) (TyCoVar -> EvExpr -> (TyCoVar, EvExpr))
-> TcM TyCoVar
-> IOEnv (Env TcGblEnv TcLclEnv) (EvExpr -> (TyCoVar, EvExpr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkIdBndr ZonkEnv
env TyCoVar
v IOEnv (Env TcGblEnv TcLclEnv) (EvExpr -> (TyCoVar, EvExpr))
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
-> IOEnv (Env TcGblEnv TcLclEnv) (TyCoVar, EvExpr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env EvExpr
e

zonkEvTypeable :: ZonkEnv -> EvTypeable -> TcM EvTypeable
zonkEvTypeable :: ZonkEnv -> EvTypeable -> IOEnv (Env TcGblEnv TcLclEnv) EvTypeable
zonkEvTypeable ZonkEnv
env (EvTypeableTyCon TyCon
tycon [EvTerm]
e)
  = do { [EvTerm]
e'  <- (EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm)
-> [EvTerm] -> IOEnv (Env TcGblEnv TcLclEnv) [EvTerm]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
zonkEvTerm ZonkEnv
env) [EvTerm]
e
       ; EvTypeable -> IOEnv (Env TcGblEnv TcLclEnv) EvTypeable
forall (m :: * -> *) a. Monad m => a -> m a
return (EvTypeable -> IOEnv (Env TcGblEnv TcLclEnv) EvTypeable)
-> EvTypeable -> IOEnv (Env TcGblEnv TcLclEnv) EvTypeable
forall a b. (a -> b) -> a -> b
$ TyCon -> [EvTerm] -> EvTypeable
EvTypeableTyCon TyCon
tycon [EvTerm]
e' }
zonkEvTypeable ZonkEnv
env (EvTypeableTyApp EvTerm
t1 EvTerm
t2)
  = do { EvTerm
t1' <- ZonkEnv -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
zonkEvTerm ZonkEnv
env EvTerm
t1
       ; EvTerm
t2' <- ZonkEnv -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
zonkEvTerm ZonkEnv
env EvTerm
t2
       ; EvTypeable -> IOEnv (Env TcGblEnv TcLclEnv) EvTypeable
forall (m :: * -> *) a. Monad m => a -> m a
return (EvTerm -> EvTerm -> EvTypeable
EvTypeableTyApp EvTerm
t1' EvTerm
t2') }
zonkEvTypeable ZonkEnv
env (EvTypeableTrFun EvTerm
tm EvTerm
t1 EvTerm
t2)
  = do { EvTerm
tm' <- ZonkEnv -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
zonkEvTerm ZonkEnv
env EvTerm
tm
       ; EvTerm
t1' <- ZonkEnv -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
zonkEvTerm ZonkEnv
env EvTerm
t1
       ; EvTerm
t2' <- ZonkEnv -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
zonkEvTerm ZonkEnv
env EvTerm
t2
       ; EvTypeable -> IOEnv (Env TcGblEnv TcLclEnv) EvTypeable
forall (m :: * -> *) a. Monad m => a -> m a
return (EvTerm -> EvTerm -> EvTerm -> EvTypeable
EvTypeableTrFun EvTerm
tm' EvTerm
t1' EvTerm
t2') }
zonkEvTypeable ZonkEnv
env (EvTypeableTyLit EvTerm
t1)
  = do { EvTerm
t1' <- ZonkEnv -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
zonkEvTerm ZonkEnv
env EvTerm
t1
       ; EvTypeable -> IOEnv (Env TcGblEnv TcLclEnv) EvTypeable
forall (m :: * -> *) a. Monad m => a -> m a
return (EvTerm -> EvTypeable
EvTypeableTyLit EvTerm
t1') }

zonkTcEvBinds_s :: ZonkEnv -> [TcEvBinds] -> TcM (ZonkEnv, [TcEvBinds])
zonkTcEvBinds_s :: ZonkEnv -> [TcEvBinds] -> TcM (ZonkEnv, [TcEvBinds])
zonkTcEvBinds_s ZonkEnv
env [TcEvBinds]
bs = do { (ZonkEnv
env, [Bag EvBind]
bs') <- (ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, Bag EvBind))
-> ZonkEnv
-> [TcEvBinds]
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [Bag EvBind])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, Bag EvBind)
zonk_tc_ev_binds ZonkEnv
env [TcEvBinds]
bs
                            ; (ZonkEnv, [TcEvBinds]) -> TcM (ZonkEnv, [TcEvBinds])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, [Bag EvBind -> TcEvBinds
EvBinds ([Bag EvBind] -> Bag EvBind
forall a. [Bag a] -> Bag a
unionManyBags [Bag EvBind]
bs')]) }

zonkTcEvBinds :: ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds)
zonkTcEvBinds :: ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds)
zonkTcEvBinds ZonkEnv
env TcEvBinds
bs = do { (ZonkEnv
env', Bag EvBind
bs') <- ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, Bag EvBind)
zonk_tc_ev_binds ZonkEnv
env TcEvBinds
bs
                          ; (ZonkEnv, TcEvBinds) -> TcM (ZonkEnv, TcEvBinds)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', Bag EvBind -> TcEvBinds
EvBinds Bag EvBind
bs') }

zonk_tc_ev_binds :: ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, Bag EvBind)
zonk_tc_ev_binds :: ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, Bag EvBind)
zonk_tc_ev_binds ZonkEnv
env (TcEvBinds EvBindsVar
var) = ZonkEnv -> EvBindsVar -> TcM (ZonkEnv, Bag EvBind)
zonkEvBindsVar ZonkEnv
env EvBindsVar
var
zonk_tc_ev_binds ZonkEnv
env (EvBinds Bag EvBind
bs)    = ZonkEnv -> Bag EvBind -> TcM (ZonkEnv, Bag EvBind)
zonkEvBinds ZonkEnv
env Bag EvBind
bs

zonkEvBindsVar :: ZonkEnv -> EvBindsVar -> TcM (ZonkEnv, Bag EvBind)
zonkEvBindsVar :: ZonkEnv -> EvBindsVar -> TcM (ZonkEnv, Bag EvBind)
zonkEvBindsVar ZonkEnv
env (EvBindsVar { ebv_binds :: EvBindsVar -> IORef EvBindMap
ebv_binds = IORef EvBindMap
ref })
  = do { EvBindMap
bs <- IORef EvBindMap -> IOEnv (Env TcGblEnv TcLclEnv) EvBindMap
forall a env. IORef a -> IOEnv env a
readMutVar IORef EvBindMap
ref
       ; ZonkEnv -> Bag EvBind -> TcM (ZonkEnv, Bag EvBind)
zonkEvBinds ZonkEnv
env (EvBindMap -> Bag EvBind
evBindMapBinds EvBindMap
bs) }
zonkEvBindsVar ZonkEnv
env (CoEvBindsVar {}) = (ZonkEnv, Bag EvBind) -> TcM (ZonkEnv, Bag EvBind)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Bag EvBind
forall a. Bag a
emptyBag)

zonkEvBinds :: ZonkEnv -> Bag EvBind -> TcM (ZonkEnv, Bag EvBind)
zonkEvBinds :: ZonkEnv -> Bag EvBind -> TcM (ZonkEnv, Bag EvBind)
zonkEvBinds ZonkEnv
env Bag EvBind
binds
  = {-# SCC "zonkEvBinds" #-}
    ((ZonkEnv, Bag EvBind) -> TcM (ZonkEnv, Bag EvBind))
-> TcM (ZonkEnv, Bag EvBind)
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM (\ ~( ZonkEnv
_, Bag EvBind
new_binds) -> do
         { let env1 :: ZonkEnv
env1 = ZonkEnv -> [TyCoVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env (Bag EvBind -> [TyCoVar]
collect_ev_bndrs Bag EvBind
new_binds)
         ; Bag EvBind
binds' <- (EvBind -> IOEnv (Env TcGblEnv TcLclEnv) EvBind)
-> Bag EvBind -> IOEnv (Env TcGblEnv TcLclEnv) (Bag EvBind)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM (ZonkEnv -> EvBind -> IOEnv (Env TcGblEnv TcLclEnv) EvBind
zonkEvBind ZonkEnv
env1) Bag EvBind
binds
         ; (ZonkEnv, Bag EvBind) -> TcM (ZonkEnv, Bag EvBind)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, Bag EvBind
binds') })
  where
    collect_ev_bndrs :: Bag EvBind -> [EvVar]
    collect_ev_bndrs :: Bag EvBind -> [TyCoVar]
collect_ev_bndrs = (EvBind -> [TyCoVar] -> [TyCoVar])
-> [TyCoVar] -> Bag EvBind -> [TyCoVar]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr EvBind -> [TyCoVar] -> [TyCoVar]
add []
    add :: EvBind -> [TyCoVar] -> [TyCoVar]
add (EvBind { eb_lhs :: EvBind -> TyCoVar
eb_lhs = TyCoVar
var }) [TyCoVar]
vars = TyCoVar
var TyCoVar -> [TyCoVar] -> [TyCoVar]
forall a. a -> [a] -> [a]
: [TyCoVar]
vars

zonkEvBind :: ZonkEnv -> EvBind -> TcM EvBind
zonkEvBind :: ZonkEnv -> EvBind -> IOEnv (Env TcGblEnv TcLclEnv) EvBind
zonkEvBind ZonkEnv
env bind :: EvBind
bind@(EvBind { eb_lhs :: EvBind -> TyCoVar
eb_lhs = TyCoVar
var, eb_rhs :: EvBind -> EvTerm
eb_rhs = EvTerm
term })
  = do { TyCoVar
var'  <- {-# SCC "zonkEvBndr" #-} ZonkEnv -> TyCoVar -> TcM TyCoVar
zonkEvBndr ZonkEnv
env TyCoVar
var

         -- Optimise the common case of Refl coercions
         -- See Note [Optimise coercion zonking]
         -- This has a very big effect on some programs (eg #5030)

       ; EvTerm
term' <- case TcType -> Maybe (Role, TcType, TcType)
getEqPredTys_maybe (TyCoVar -> TcType
idType TyCoVar
var') of
           Just (Role
r, TcType
ty1, TcType
ty2) | TcType
ty1 TcType -> TcType -> Bool
`eqType` TcType
ty2
                  -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (TcCoercionR -> EvTerm
evCoercion (Role -> TcType -> TcCoercionR
mkTcReflCo Role
r TcType
ty1))
           Maybe (Role, TcType, TcType)
_other -> ZonkEnv -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
zonkEvTerm ZonkEnv
env EvTerm
term

       ; EvBind -> IOEnv (Env TcGblEnv TcLclEnv) EvBind
forall (m :: * -> *) a. Monad m => a -> m a
return (EvBind
bind { eb_lhs :: TyCoVar
eb_lhs = TyCoVar
var', eb_rhs :: EvTerm
eb_rhs = EvTerm
term' }) }

{- Note [Optimise coercion zonking]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When optimising evidence binds we may come across situations where
a coercion looks like
      cv = ReflCo ty
or    cv1 = cv2
where the type 'ty' is big.  In such cases it is a waste of time to zonk both
  * The variable on the LHS
  * The coercion on the RHS
Rather, we can zonk the variable, and if its type is (ty ~ ty), we can just
use Refl on the right, ignoring the actual coercion on the RHS.

This can have a very big effect, because the constraint solver sometimes does go
to a lot of effort to prove Refl!  (Eg when solving  10+3 = 10+3; cf #5030)


************************************************************************
*                                                                      *
                         Zonking types
*                                                                      *
************************************************************************
-}

{- Note [Sharing when zonking to Type]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Problem:

    In GHC.Tc.Utils.TcMType.zonkTcTyVar, we short-circuit (Indirect ty) to
    (Indirect zty), see Note [Sharing in zonking] in GHC.Tc.Utils.TcMType. But we
    /can't/ do this when zonking a TcType to a Type (#15552, esp
    comment:3).  Suppose we have

       alpha -> alpha
         where
            alpha is already unified:
             alpha := T{tc-tycon} Int -> Int
         and T is knot-tied

    By "knot-tied" I mean that the occurrence of T is currently a TcTyCon,
    but the global env contains a mapping "T" :-> T{knot-tied-tc}. See
    Note [Type checking recursive type and class declarations] in
    GHC.Tc.TyCl.

    Now we call zonkTcTypeToType on that (alpha -> alpha). If we follow
    the same path as Note [Sharing in zonking] in GHC.Tc.Utils.TcMType, we'll
    update alpha to
       alpha := T{knot-tied-tc} Int -> Int

    But alas, if we encounter alpha for a /second/ time, we end up
    looking at T{knot-tied-tc} and fall into a black hole. The whole
    point of zonkTcTypeToType is that it produces a type full of
    knot-tied tycons, and you must not look at the result!!

    To put it another way (zonkTcTypeToType . zonkTcTypeToType) is not
    the same as zonkTcTypeToType. (If we distinguished TcType from
    Type, this issue would have been a type error!)

Solutions: (see #15552 for other variants)

One possible solution is simply not to do the short-circuiting.
That has less sharing, but maybe sharing is rare. And indeed,
that usually turns out to be viable from a perf point of view

But zonkTyVarOcc implements something a bit better

* ZonkEnv contains ze_meta_tv_env, which maps
      from a MetaTyVar (unification variable)
      to a Type (not a TcType)

* In zonkTyVarOcc, we check this map to see if we have zonked
  this variable before. If so, use the previous answer; if not
  zonk it, and extend the map.

* The map is of course stateful, held in a TcRef. (That is unlike
  the treatment of lexically-scoped variables in ze_tv_env and
  ze_id_env.)

* In zonkTyVarOcc we read the TcRef to look up the unification
  variable:
    - if we get a hit we use the zonked result;
    - if not, in zonk_meta we see if the variable is `Indirect ty`,
      zonk that, and update the map (in finish_meta)
  But Nota Bene that the "update map" step must re-read the TcRef
  (or, more precisely, use updTcRef) because the zonking of the
  `Indirect ty` may have added lots of stuff to the map.  See
  #19668 for an example where this made an asymptotic difference!

Is it worth the extra work of carrying ze_meta_tv_env? Some
non-systematic perf measurements suggest that compiler allocation is
reduced overall (by 0.5% or so) but compile time really doesn't
change.  But in some cases it makes a HUGE difference: see test
T9198 and #19668.  So yes, it seems worth it.
-}

zonkTyVarOcc :: ZonkEnv -> TcTyVar -> TcM Type
zonkTyVarOcc :: ZonkEnv -> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTyVarOcc env :: ZonkEnv
env@(ZonkEnv { ze_flexi :: ZonkEnv -> ZonkFlexi
ze_flexi = ZonkFlexi
flexi
                          , ze_tv_env :: ZonkEnv -> TyCoVarEnv TyCoVar
ze_tv_env = TyCoVarEnv TyCoVar
tv_env
                          , ze_meta_tv_env :: ZonkEnv -> TcRef (TyVarEnv TcType)
ze_meta_tv_env = TcRef (TyVarEnv TcType)
mtv_env_ref }) TyCoVar
tv
  | TyCoVar -> Bool
isTcTyVar TyCoVar
tv
  = case TyCoVar -> TcTyVarDetails
tcTyVarDetails TyCoVar
tv of
      SkolemTv {}    -> IOEnv (Env TcGblEnv TcLclEnv) TcType
lookup_in_tv_env
      RuntimeUnk {}  -> IOEnv (Env TcGblEnv TcLclEnv) TcType
lookup_in_tv_env
      MetaTv { mtv_ref :: TcTyVarDetails -> IORef MetaDetails
mtv_ref = IORef MetaDetails
ref }
        -> do { TyVarEnv TcType
mtv_env <- TcRef (TyVarEnv TcType)
-> TcRnIf TcGblEnv TcLclEnv (TyVarEnv TcType)
forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
readTcRef TcRef (TyVarEnv TcType)
mtv_env_ref
                -- See Note [Sharing when zonking to Type]
              ; case TyVarEnv TcType -> TyCoVar -> Maybe TcType
forall a. VarEnv a -> TyCoVar -> Maybe a
lookupVarEnv TyVarEnv TcType
mtv_env TyCoVar
tv of
                  Just TcType
ty -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall (m :: * -> *) a. Monad m => a -> m a
return TcType
ty
                  Maybe TcType
Nothing -> do { MetaDetails
mtv_details <- IORef MetaDetails -> TcRnIf TcGblEnv TcLclEnv MetaDetails
forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
readTcRef IORef MetaDetails
ref
                                ; IORef MetaDetails
-> MetaDetails -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonk_meta IORef MetaDetails
ref MetaDetails
mtv_details } }
  | Bool
otherwise  -- This should never really happen;
               -- TyVars should not occur in the typechecker
  = IOEnv (Env TcGblEnv TcLclEnv) TcType
lookup_in_tv_env

  where
    lookup_in_tv_env :: IOEnv (Env TcGblEnv TcLclEnv) TcType
lookup_in_tv_env    -- Look up in the env just as we do for Ids
      = case TyCoVarEnv TyCoVar -> TyCoVar -> Maybe TyCoVar
forall a. VarEnv a -> TyCoVar -> Maybe a
lookupVarEnv TyCoVarEnv TyCoVar
tv_env TyCoVar
tv of
          Maybe TyCoVar
Nothing  -> -- TyVar/SkolemTv/RuntimeUnk that isn't in the ZonkEnv
                      -- This can happen for RuntimeUnk variables (which
                      -- should stay as RuntimeUnk), but I think it should
                      -- not happen for SkolemTv.
                      TyCoVar -> TcType
mkTyVarTy (TyCoVar -> TcType)
-> TcM TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType)
-> TyCoVar -> TcM TyCoVar
forall (m :: * -> *).
Monad m =>
(TcType -> m TcType) -> TyCoVar -> m TyCoVar
updateTyVarKindM (ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env) TyCoVar
tv

          Just TyCoVar
tv' -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCoVar -> TcType
mkTyVarTy TyCoVar
tv')

    zonk_meta :: IORef MetaDetails
-> MetaDetails -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonk_meta IORef MetaDetails
ref MetaDetails
Flexi
      = do { TcType
kind <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env (TyCoVar -> TcType
tyVarKind TyCoVar
tv)
           ; TcType
ty <- ZonkFlexi
-> TyCoVar -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
commitFlexi ZonkFlexi
flexi TyCoVar
tv TcType
kind
           ; TyCoVar
-> IORef MetaDetails -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) ()
writeMetaTyVarRef TyCoVar
tv IORef MetaDetails
ref TcType
ty  -- Belt and braces
           ; TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
finish_meta TcType
ty }

    zonk_meta IORef MetaDetails
_ (Indirect TcType
ty)
      = do { TcType
zty <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
ty
           ; TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
finish_meta TcType
zty }

    finish_meta :: TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
finish_meta TcType
ty
      = do { TcRef (TyVarEnv TcType)
-> (TyVarEnv TcType -> TyVarEnv TcType)
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a gbl lcl. TcRef a -> (a -> a) -> TcRnIf gbl lcl ()
updTcRef TcRef (TyVarEnv TcType)
mtv_env_ref (\TyVarEnv TcType
env -> TyVarEnv TcType -> TyCoVar -> TcType -> TyVarEnv TcType
forall a. VarEnv a -> TyCoVar -> a -> VarEnv a
extendVarEnv TyVarEnv TcType
env TyCoVar
tv TcType
ty)
           ; TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall (m :: * -> *) a. Monad m => a -> m a
return TcType
ty }

lookupTyVarX :: ZonkEnv -> TcTyVar -> TyVar
lookupTyVarX :: ZonkEnv -> TyCoVar -> TyCoVar
lookupTyVarX (ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv TyCoVar
ze_tv_env = TyCoVarEnv TyCoVar
tv_env }) TyCoVar
tv
  = case TyCoVarEnv TyCoVar -> TyCoVar -> Maybe TyCoVar
forall a. VarEnv a -> TyCoVar -> Maybe a
lookupVarEnv TyCoVarEnv TyCoVar
tv_env TyCoVar
tv of
       Just TyCoVar
tv -> TyCoVar
tv
       Maybe TyCoVar
Nothing -> String -> SDoc -> TyCoVar
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"lookupTyVarOcc" (TyCoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCoVar
tv SDoc -> SDoc -> SDoc
$$ TyCoVarEnv TyCoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCoVarEnv TyCoVar
tv_env)

commitFlexi :: ZonkFlexi -> TcTyVar -> Kind -> TcM Type
-- Only monadic so we can do tc-tracing
commitFlexi :: ZonkFlexi
-> TyCoVar -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
commitFlexi ZonkFlexi
flexi TyCoVar
tv TcType
zonked_kind
  = case ZonkFlexi
flexi of
      ZonkFlexi
SkolemiseFlexi  -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCoVar -> TcType
mkTyVarTy (Name -> TcType -> TyCoVar
mkTyVar Name
name TcType
zonked_kind))

      ZonkFlexi
DefaultFlexi
          -- Normally, RuntimeRep variables are defaulted in TcMType.defaultTyVar
          -- But that sees only type variables that appear in, say, an inferred type
          -- Defaulting here in the zonker is needed to catch e.g.
          --    y :: Bool
          --    y = (\x -> True) undefined
          -- We need *some* known RuntimeRep for the x and undefined, but no one
          -- will choose it until we get here, in the zonker.
        | TcType -> Bool
isRuntimeRepTy TcType
zonked_kind
        -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"Defaulting flexi tyvar to LiftedRep:" (TyCoVar -> SDoc
pprTyVar TyCoVar
tv)
              ; TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall (m :: * -> *) a. Monad m => a -> m a
return TcType
liftedRepTy }
        | TcType -> Bool
isLevityTy TcType
zonked_kind
        -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"Defaulting flexi tyvar to Lifted:" (TyCoVar -> SDoc
pprTyVar TyCoVar
tv)
              ; TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall (m :: * -> *) a. Monad m => a -> m a
return TcType
liftedDataConTy }
        | TcType -> Bool
isMultiplicityTy TcType
zonked_kind
        -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"Defaulting flexi tyvar to Many:" (TyCoVar -> SDoc
pprTyVar TyCoVar
tv)
              ; TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall (m :: * -> *) a. Monad m => a -> m a
return TcType
manyDataConTy }
        | Bool
otherwise
        -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"Defaulting flexi tyvar to Any:" (TyCoVar -> SDoc
pprTyVar TyCoVar
tv)
              ; TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall (m :: * -> *) a. Monad m => a -> m a
return (TcType -> TcType
anyTypeOfKind TcType
zonked_kind) }

      ZonkFlexi
RuntimeUnkFlexi
        -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"Defaulting flexi tyvar to RuntimeUnk:" (TyCoVar -> SDoc
pprTyVar TyCoVar
tv)
              ; TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCoVar -> TcType
mkTyVarTy (Name -> TcType -> TcTyVarDetails -> TyCoVar
mkTcTyVar Name
name TcType
zonked_kind TcTyVarDetails
RuntimeUnk)) }
                        -- This is where RuntimeUnks are born:
                        -- otherwise-unconstrained unification variables are
                        -- turned into RuntimeUnks as they leave the
                        -- typechecker's monad

      ZonkFlexi
NoFlexi -> String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"NoFlexi" (TyCoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCoVar
tv SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
zonked_kind)

  where
     name :: Name
name = TyCoVar -> Name
tyVarName TyCoVar
tv

zonkCoVarOcc :: ZonkEnv -> CoVar -> TcM Coercion
zonkCoVarOcc :: ZonkEnv -> TyCoVar -> TcM TcCoercionR
zonkCoVarOcc (ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv TyCoVar
ze_tv_env = TyCoVarEnv TyCoVar
tyco_env }) TyCoVar
cv
  | Just TyCoVar
cv' <- TyCoVarEnv TyCoVar -> TyCoVar -> Maybe TyCoVar
forall a. VarEnv a -> TyCoVar -> Maybe a
lookupVarEnv TyCoVarEnv TyCoVar
tyco_env TyCoVar
cv  -- don't look in the knot-tied env
  = TcCoercionR -> TcM TcCoercionR
forall (m :: * -> *) a. Monad m => a -> m a
return (TcCoercionR -> TcM TcCoercionR) -> TcCoercionR -> TcM TcCoercionR
forall a b. (a -> b) -> a -> b
$ TyCoVar -> TcCoercionR
mkCoVarCo TyCoVar
cv'
  | Bool
otherwise
  = do { TyCoVar
cv' <- TyCoVar -> TcM TyCoVar
zonkCoVar TyCoVar
cv; TcCoercionR -> TcM TcCoercionR
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCoVar -> TcCoercionR
mkCoVarCo TyCoVar
cv') }

zonkCoHole :: ZonkEnv -> CoercionHole -> TcM Coercion
zonkCoHole :: ZonkEnv -> CoercionHole -> TcM TcCoercionR
zonkCoHole ZonkEnv
env hole :: CoercionHole
hole@(CoercionHole { ch_ref :: CoercionHole -> IORef (Maybe TcCoercionR)
ch_ref = IORef (Maybe TcCoercionR)
ref, ch_co_var :: CoercionHole -> TyCoVar
ch_co_var = TyCoVar
cv })
  = do { Maybe TcCoercionR
contents <- IORef (Maybe TcCoercionR)
-> TcRnIf TcGblEnv TcLclEnv (Maybe TcCoercionR)
forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
readTcRef IORef (Maybe TcCoercionR)
ref
       ; case Maybe TcCoercionR
contents of
           Just TcCoercionR
co -> do { TcCoercionR
co' <- ZonkEnv -> TcCoercionR -> TcM TcCoercionR
zonkCoToCo ZonkEnv
env TcCoercionR
co
                         ; TyCoVar -> TcCoercionR -> TcM TcCoercionR
checkCoercionHole TyCoVar
cv TcCoercionR
co' }

              -- This next case should happen only in the presence of
              -- (undeferred) type errors. Originally, I put in a panic
              -- here, but that caused too many uses of `failIfErrsM`.
           Maybe TcCoercionR
Nothing -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc String
"Zonking unfilled coercion hole" (CoercionHole -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoercionHole
hole)
                         ; TyCoVar
cv' <- TyCoVar -> TcM TyCoVar
zonkCoVar TyCoVar
cv
                         ; TcCoercionR -> TcM TcCoercionR
forall (m :: * -> *) a. Monad m => a -> m a
return (TcCoercionR -> TcM TcCoercionR) -> TcCoercionR -> TcM TcCoercionR
forall a b. (a -> b) -> a -> b
$ TyCoVar -> TcCoercionR
mkCoVarCo TyCoVar
cv' } }
                             -- This will be an out-of-scope variable, but keeping
                             -- this as a coercion hole led to #15787

zonk_tycomapper :: TyCoMapper ZonkEnv TcM
zonk_tycomapper :: TyCoMapper ZonkEnv TcM
zonk_tycomapper = TyCoMapper :: forall env (m :: * -> *).
(env -> TyCoVar -> m TcType)
-> (env -> TyCoVar -> m TcCoercionR)
-> (env -> CoercionHole -> m TcCoercionR)
-> (env -> TyCoVar -> ArgFlag -> m (env, TyCoVar))
-> (TyCon -> m TyCon)
-> TyCoMapper env m
TyCoMapper
  { tcm_tyvar :: ZonkEnv -> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) TcType
tcm_tyvar      = ZonkEnv -> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTyVarOcc
  , tcm_covar :: ZonkEnv -> TyCoVar -> TcM TcCoercionR
tcm_covar      = ZonkEnv -> TyCoVar -> TcM TcCoercionR
zonkCoVarOcc
  , tcm_hole :: ZonkEnv -> CoercionHole -> TcM TcCoercionR
tcm_hole       = ZonkEnv -> CoercionHole -> TcM TcCoercionR
zonkCoHole
  , tcm_tycobinder :: ZonkEnv
-> TyCoVar
-> ArgFlag
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
tcm_tycobinder = \ZonkEnv
env TyCoVar
tv ArgFlag
_vis -> ZonkEnv
-> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TyCoVar)
zonkTyBndrX ZonkEnv
env TyCoVar
tv
  , tcm_tycon :: TyCon -> TcM TyCon
tcm_tycon      = TyCon -> TcM TyCon
zonkTcTyConToTyCon }

-- Zonk a TyCon by changing a TcTyCon to a regular TyCon
zonkTcTyConToTyCon :: TcTyCon -> TcM TyCon
zonkTcTyConToTyCon :: TyCon -> TcM TyCon
zonkTcTyConToTyCon TyCon
tc
  | TyCon -> Bool
isTcTyCon TyCon
tc = do { TyThing
thing <- Name -> TcM TyThing
tcLookupGlobalOnly (TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tc)
                      ; case TyThing
thing of
                          ATyCon TyCon
real_tc -> TyCon -> TcM TyCon
forall (m :: * -> *) a. Monad m => a -> m a
return TyCon
real_tc
                          TyThing
_              -> String -> SDoc -> TcM TyCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"zonkTcTyCon" (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc SDoc -> SDoc -> SDoc
$$ TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
thing) }
  | Bool
otherwise    = TyCon -> TcM TyCon
forall (m :: * -> *) a. Monad m => a -> m a
return TyCon
tc -- it's already zonked

-- Confused by zonking? See Note [What is zonking?] in GHC.Tc.Utils.TcMType.
zonkTcTypeToType :: TcType -> TcM Type
zonkTcTypeToType :: TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToType TcType
ty = (ZonkEnv -> IOEnv (Env TcGblEnv TcLclEnv) TcType)
-> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> IOEnv (Env TcGblEnv TcLclEnv) TcType)
 -> IOEnv (Env TcGblEnv TcLclEnv) TcType)
-> (ZonkEnv -> IOEnv (Env TcGblEnv TcLclEnv) TcType)
-> IOEnv (Env TcGblEnv TcLclEnv) TcType
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze -> ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
ze TcType
ty

zonkScaledTcTypeToTypeX :: ZonkEnv -> Scaled TcType -> TcM (Scaled TcType)
zonkScaledTcTypeToTypeX :: ZonkEnv -> Scaled TcType -> TcM (Scaled TcType)
zonkScaledTcTypeToTypeX ZonkEnv
env (Scaled TcType
m TcType
ty) = TcType -> TcType -> Scaled TcType
forall a. TcType -> a -> Scaled a
Scaled (TcType -> TcType -> Scaled TcType)
-> IOEnv (Env TcGblEnv TcLclEnv) TcType
-> IOEnv (Env TcGblEnv TcLclEnv) (TcType -> Scaled TcType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
m
                                                   IOEnv (Env TcGblEnv TcLclEnv) (TcType -> Scaled TcType)
-> IOEnv (Env TcGblEnv TcLclEnv) TcType -> TcM (Scaled TcType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
env TcType
ty

zonkTcTypeToTypeX   :: ZonkEnv -> TcType   -> TcM Type
zonkTcTypesToTypesX :: ZonkEnv -> [TcType] -> TcM [Type]
zonkCoToCo          :: ZonkEnv -> Coercion -> TcM Coercion
(ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX, ZonkEnv -> [TcType] -> IOEnv (Env TcGblEnv TcLclEnv) [TcType]
zonkTcTypesToTypesX, ZonkEnv -> TcCoercionR -> TcM TcCoercionR
zonkCoToCo, ZonkEnv -> [TcCoercionR] -> TcM [TcCoercionR]
_)
  = TyCoMapper ZonkEnv TcM
-> (ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType,
    ZonkEnv -> [TcType] -> IOEnv (Env TcGblEnv TcLclEnv) [TcType],
    ZonkEnv -> TcCoercionR -> TcM TcCoercionR,
    ZonkEnv -> [TcCoercionR] -> TcM [TcCoercionR])
forall (m :: * -> *) env.
Monad m =>
TyCoMapper env m
-> (env -> TcType -> m TcType, env -> [TcType] -> m [TcType],
    env -> TcCoercionR -> m TcCoercionR,
    env -> [TcCoercionR] -> m [TcCoercionR])
mapTyCoX TyCoMapper ZonkEnv TcM
zonk_tycomapper

zonkScaledTcTypesToTypesX :: ZonkEnv -> [Scaled TcType] -> TcM [Scaled Type]
zonkScaledTcTypesToTypesX :: ZonkEnv -> [Scaled TcType] -> TcM [Scaled TcType]
zonkScaledTcTypesToTypesX ZonkEnv
env [Scaled TcType]
scaled_tys =
   (Scaled TcType -> TcM (Scaled TcType))
-> [Scaled TcType] -> TcM [Scaled TcType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Scaled TcType -> TcM (Scaled TcType)
zonkScaledTcTypeToTypeX ZonkEnv
env) [Scaled TcType]
scaled_tys

zonkTcMethInfoToMethInfoX :: ZonkEnv -> TcMethInfo -> TcM MethInfo
zonkTcMethInfoToMethInfoX :: ZonkEnv -> TcMethInfo -> TcM TcMethInfo
zonkTcMethInfoToMethInfoX ZonkEnv
ze (Name
name, TcType
ty, Maybe (DefMethSpec (SrcSpan, TcType))
gdm_spec)
  = do { TcType
ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
ze TcType
ty
       ; Maybe (DefMethSpec (SrcSpan, TcType))
gdm_spec' <- Maybe (DefMethSpec (SrcSpan, TcType))
-> TcM (Maybe (DefMethSpec (SrcSpan, TcType)))
zonk_gdm Maybe (DefMethSpec (SrcSpan, TcType))
gdm_spec
       ; TcMethInfo -> TcM TcMethInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
name, TcType
ty', Maybe (DefMethSpec (SrcSpan, TcType))
gdm_spec') }
  where
    zonk_gdm :: Maybe (DefMethSpec (SrcSpan, TcType))
             -> TcM (Maybe (DefMethSpec (SrcSpan, Type)))
    zonk_gdm :: Maybe (DefMethSpec (SrcSpan, TcType))
-> TcM (Maybe (DefMethSpec (SrcSpan, TcType)))
zonk_gdm Maybe (DefMethSpec (SrcSpan, TcType))
Nothing = Maybe (DefMethSpec (SrcSpan, TcType))
-> TcM (Maybe (DefMethSpec (SrcSpan, TcType)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DefMethSpec (SrcSpan, TcType))
forall a. Maybe a
Nothing
    zonk_gdm (Just DefMethSpec (SrcSpan, TcType)
VanillaDM) = Maybe (DefMethSpec (SrcSpan, TcType))
-> TcM (Maybe (DefMethSpec (SrcSpan, TcType)))
forall (m :: * -> *) a. Monad m => a -> m a
return (DefMethSpec (SrcSpan, TcType)
-> Maybe (DefMethSpec (SrcSpan, TcType))
forall a. a -> Maybe a
Just DefMethSpec (SrcSpan, TcType)
forall ty. DefMethSpec ty
VanillaDM)
    zonk_gdm (Just (GenericDM (SrcSpan
loc, TcType
ty)))
      = do { TcType
ty' <- ZonkEnv -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) TcType
zonkTcTypeToTypeX ZonkEnv
ze TcType
ty
           ; Maybe (DefMethSpec (SrcSpan, TcType))
-> TcM (Maybe (DefMethSpec (SrcSpan, TcType)))
forall (m :: * -> *) a. Monad m => a -> m a
return (DefMethSpec (SrcSpan, TcType)
-> Maybe (DefMethSpec (SrcSpan, TcType))
forall a. a -> Maybe a
Just ((SrcSpan, TcType) -> DefMethSpec (SrcSpan, TcType)
forall ty. ty -> DefMethSpec ty
GenericDM (SrcSpan
loc, TcType
ty'))) }

---------------------------------------
{- Note [Zonking the LHS of a RULE]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See also GHC.HsToCore.Binds Note [Free tyvars on rule LHS]

We need to gather the type variables mentioned on the LHS so we can
quantify over them.  Example:
  data T a = C

  foo :: T a -> Int
  foo C = 1

  {-# RULES "myrule"  foo C = 1 #-}

After type checking the LHS becomes (foo alpha (C alpha)) and we do
not want to zap the unbound meta-tyvar 'alpha' to Any, because that
limits the applicability of the rule.  Instead, we want to quantify
over it!

We do this in two stages.

* During zonking, we skolemise the TcTyVar 'alpha' to TyVar 'a'.  We
  do this by using zonkTvSkolemising as the UnboundTyVarZonker in the
  ZonkEnv.  (This is in fact the whole reason that the ZonkEnv has a
  UnboundTyVarZonker.)

* In GHC.HsToCore.Binds, we quantify over it.  See GHC.HsToCore.Binds
  Note [Free tyvars on rule LHS]

Quantifying here is awkward because (a) the data type is big and (b)
finding the free type vars of an expression is necessarily monadic
operation. (consider /\a -> f @ b, where b is side-effected to a)
-}