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


TcHsSyn: Specialisations of the @HsSyn@ syntax for the typechecker

This module is an extension of @HsSyn@ syntax, for use in the type
checker.
-}

{-# LANGUAGE CPP, TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}

module TcHsSyn (
        -- * Extracting types from HsSyn
        hsLitType, hsPatType, hsLPatType,

        -- * Other HsSyn functions
        mkHsDictLet, mkHsApp,
        mkHsAppTy, mkHsCaseAlt,
        shortCutLit, hsOverLitName,
        conLikeResTy,

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

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

#include "HsVersions.h"

import GhcPrelude

import GHC.Hs
import Id
import IdInfo
import Predicate
import TcRnMonad
import PrelNames
import BuildTyCl ( TcMethInfo, MethInfo )
import TcType
import TcMType
import TcEnv   ( tcLookupGlobalOnly )
import TcEvidence
import TyCoPpr ( pprTyVar )
import TysPrim
import TyCon
import TysWiredIn
import Type
import Coercion
import ConLike
import DataCon
import HscTypes
import Name
import NameEnv
import Var
import VarEnv
import DynFlags
import Literal
import BasicTypes
import Maybes
import SrcLoc
import Bag
import Outputable
import Util
import UniqFM
import CoreSyn

import {-# SOURCE #-} TcSplice (runTopSplice)

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

{-
************************************************************************
*                                                                      *
       Extracting the type from HsSyn
*                                                                      *
************************************************************************

-}

hsLPatType :: LPat GhcTc -> Type
hsLPatType :: LPat GhcTc -> Type
hsLPatType (LPat GhcTc -> Located (SrcSpanLess (Located (Pat GhcTc)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located (Pat GhcTc))
p) = Pat GhcTc -> Type
hsPatType SrcSpanLess (Located (Pat GhcTc))
Pat GhcTc
p

hsPatType :: Pat GhcTc -> Type
hsPatType :: Pat GhcTc -> Type
hsPatType (ParPat XParPat GhcTc
_ LPat GhcTc
pat)                = LPat GhcTc -> Type
hsLPatType LPat GhcTc
pat
hsPatType (WildPat XWildPat GhcTc
ty)                  = Type
XWildPat GhcTc
ty
hsPatType (VarPat XVarPat GhcTc
_ Located (IdP GhcTc)
lvar)               = Id -> Type
idType (Located Id -> SrcSpanLess (Located Id)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Id
Located (IdP GhcTc)
lvar)
hsPatType (BangPat XBangPat GhcTc
_ LPat GhcTc
pat)               = LPat GhcTc -> Type
hsLPatType LPat GhcTc
pat
hsPatType (LazyPat XLazyPat GhcTc
_ LPat GhcTc
pat)               = LPat GhcTc -> Type
hsLPatType LPat GhcTc
pat
hsPatType (LitPat XLitPat GhcTc
_ HsLit GhcTc
lit)                = HsLit GhcTc -> Type
forall (p :: Pass). HsLit (GhcPass p) -> Type
hsLitType HsLit GhcTc
lit
hsPatType (AsPat XAsPat GhcTc
_ Located (IdP GhcTc)
var LPat GhcTc
_)               = Id -> Type
idType (Located Id -> SrcSpanLess (Located Id)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Id
Located (IdP GhcTc)
var)
hsPatType (ViewPat XViewPat GhcTc
ty LHsExpr GhcTc
_ LPat GhcTc
_)              = Type
XViewPat GhcTc
ty
hsPatType (ListPat (ListPatTc ty Nothing) [LPat GhcTc]
_)      = Type -> Type
mkListTy Type
ty
hsPatType (ListPat (ListPatTc _ (Just (ty,_))) [LPat GhcTc]
_) = Type
ty
hsPatType (TuplePat XTuplePat GhcTc
tys [LPat GhcTc]
_ Boxity
bx)           = Boxity -> [Type] -> Type
mkTupleTy1 Boxity
bx [Type]
XTuplePat GhcTc
tys
                  -- See Note [Don't flatten tuples from HsSyn] in MkCore
hsPatType (SumPat XSumPat GhcTc
tys LPat GhcTc
_ ConTag
_ ConTag
_ )           = [Type] -> Type
mkSumTy [Type]
XSumPat GhcTc
tys
hsPatType (ConPatOut { pat_con :: forall p. Pat p -> Located ConLike
pat_con = Located ConLike
lcon
                     , pat_arg_tys :: forall p. Pat p -> [Type]
pat_arg_tys = [Type]
tys })
                                        = ConLike -> [Type] -> Type
conLikeResTy (Located ConLike -> SrcSpanLess (Located ConLike)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ConLike
lcon) [Type]
tys
hsPatType (SigPat XSigPat GhcTc
ty LPat GhcTc
_ LHsSigWcType (NoGhcTc GhcTc)
_)               = Type
XSigPat GhcTc
ty
hsPatType (NPat XNPat GhcTc
ty Located (HsOverLit GhcTc)
_ Maybe (SyntaxExpr GhcTc)
_ SyntaxExpr GhcTc
_)               = Type
XNPat GhcTc
ty
hsPatType (NPlusKPat XNPlusKPat GhcTc
ty Located (IdP GhcTc)
_ Located (HsOverLit GhcTc)
_ HsOverLit GhcTc
_ SyntaxExpr GhcTc
_ SyntaxExpr GhcTc
_)      = Type
XNPlusKPat GhcTc
ty
hsPatType (CoPat XCoPat GhcTc
_ HsWrapper
_ Pat GhcTc
_ Type
ty)              = Type
ty
hsPatType (XPat XXPat GhcTc
n)                      = NoExtCon -> Type
forall a. NoExtCon -> a
noExtCon XXPat GhcTc
NoExtCon
n
hsPatType ConPatIn{}                    = String -> Type
forall a. String -> a
panic String
"hsPatType: ConPatIn"
hsPatType SplicePat{}                   = String -> Type
forall a. String -> a
panic String
"hsPatType: SplicePat"

hsLitType :: HsLit (GhcPass p) -> TcType
hsLitType :: HsLit (GhcPass p) -> Type
hsLitType (HsChar XHsChar (GhcPass p)
_ Char
_)       = Type
charTy
hsLitType (HsCharPrim XHsCharPrim (GhcPass p)
_ Char
_)   = Type
charPrimTy
hsLitType (HsString XHsString (GhcPass p)
_ FastString
_)     = Type
stringTy
hsLitType (HsStringPrim XHsStringPrim (GhcPass p)
_ ByteString
_) = Type
addrPrimTy
hsLitType (HsInt XHsInt (GhcPass p)
_ IntegralLit
_)        = Type
intTy
hsLitType (HsIntPrim XHsIntPrim (GhcPass p)
_ Integer
_)    = Type
intPrimTy
hsLitType (HsWordPrim XHsWordPrim (GhcPass p)
_ Integer
_)   = Type
wordPrimTy
hsLitType (HsInt64Prim XHsInt64Prim (GhcPass p)
_ Integer
_)  = Type
int64PrimTy
hsLitType (HsWord64Prim XHsWord64Prim (GhcPass p)
_ Integer
_) = Type
word64PrimTy
hsLitType (HsInteger XHsInteger (GhcPass p)
_ Integer
_ Type
ty) = Type
ty
hsLitType (HsRat XHsRat (GhcPass p)
_ FractionalLit
_ Type
ty)     = Type
ty
hsLitType (HsFloatPrim XHsFloatPrim (GhcPass p)
_ FractionalLit
_)  = Type
floatPrimTy
hsLitType (HsDoublePrim XHsDoublePrim (GhcPass p)
_ FractionalLit
_) = Type
doublePrimTy
hsLitType (XLit XXLit (GhcPass p)
nec)         = NoExtCon -> Type
forall a. NoExtCon -> a
noExtCon XXLit (GhcPass p)
NoExtCon
nec

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

shortCutLit :: DynFlags -> OverLitVal -> TcType -> Maybe (HsExpr GhcTcId)
shortCutLit :: DynFlags -> OverLitVal -> Type -> Maybe (HsExpr GhcTc)
shortCutLit DynFlags
dflags (HsIntegral int :: IntegralLit
int@(IL SourceText
src Bool
neg Integer
i)) Type
ty
  | Type -> Bool
isIntTy Type
ty  Bool -> Bool -> Bool
&& DynFlags -> Integer -> Bool
inIntRange  DynFlags
dflags 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
NoExtField
noExtField (XHsInt GhcTc -> IntegralLit -> HsLit GhcTc
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt XHsInt GhcTc
NoExtField
noExtField IntegralLit
int))
  | Type -> Bool
isWordTy Type
ty Bool -> Bool -> Bool
&& DynFlags -> Integer -> Bool
inWordRange DynFlags
dflags 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 SourceText
XHsWordPrim GhcTc
src Integer
i))
  | Type -> Bool
isIntegerTy Type
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
NoExtField
noExtField (XHsInteger GhcTc -> Integer -> Type -> HsLit GhcTc
forall x. XHsInteger x -> Integer -> Type -> HsLit x
HsInteger SourceText
XHsInteger GhcTc
src Integer
i Type
ty))
  | Bool
otherwise = DynFlags -> OverLitVal -> Type -> Maybe (HsExpr GhcTc)
shortCutLit DynFlags
dflags (FractionalLit -> OverLitVal
HsFractional (Bool -> Integer -> FractionalLit
integralFractionalLit Bool
neg Integer
i)) Type
ty
        -- 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

shortCutLit DynFlags
_ (HsFractional FractionalLit
f) Type
ty
  | Type -> Bool
isFloatTy Type
ty  = 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 XHsFloatPrim GhcTc
NoExtField
noExtField FractionalLit
f))
  | Type -> Bool
isDoubleTy Type
ty = 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 XHsDoublePrim GhcTc
NoExtField
noExtField FractionalLit
f))
  | Bool
otherwise     = Maybe (HsExpr GhcTc)
forall a. Maybe a
Nothing

shortCutLit DynFlags
_ (HsIsString SourceText
src FastString
s) Type
ty
  | Type -> Bool
isStringTy Type
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
NoExtField
noExtField (XHsString GhcTc -> FastString -> HsLit GhcTc
forall x. XHsString x -> FastString -> HsLit x
HsString SourceText
XHsString GhcTc
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
NoExtField
noExtField (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 TcMType.

-- | See Note [The ZonkEnv]
-- Confused by zonking? See Note [What is zonking?] in TcMType.
data ZonkEnv  -- See Note [The ZonkEnv]
  = ZonkEnv { ZonkEnv -> ZonkFlexi
ze_flexi  :: ZonkFlexi
            , ZonkEnv -> TyCoVarEnv Id
ze_tv_env :: TyCoVarEnv TyCoVar
            , ZonkEnv -> TyCoVarEnv Id
ze_id_env :: IdEnv      Id
            , ZonkEnv -> TcRef (TyVarEnv Type)
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 recusive 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 leae mutable unification
  variables floating around: after typecheck is complete, every
  type variable occurrence must have a bindign 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 thign).

* 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 mutuable
  unification variable, but doesn't have a binding site
  either.
-}

data ZonkFlexi   -- See Note [Un-unified unification variables]
  = DefaultFlexi    -- Default unbound unificaiton variables to Any
  | SkolemiseFlexi  -- Skolemise unbound unification variables
                    -- See Note [Zonking the LHS of a RULE]
  | RuntimeUnkFlexi -- Used in the GHCi debugger

instance Outputable ZonkEnv where
  ppr :: ZonkEnv -> SDoc
ppr (ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id
tv_env
               , ze_id_env :: ZonkEnv -> TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
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 Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCoVarEnv Id
tv_env
         , String -> SDoc
text String
"ze_id_env =" SDoc -> SDoc -> SDoc
<+> TyCoVarEnv Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCoVarEnv Id
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 Type)
mtv_env_ref <- TyVarEnv Type -> TcRnIf TcGblEnv TcLclEnv (TcRef (TyVarEnv Type))
forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
newTcRef TyVarEnv Type
forall a. VarEnv a
emptyVarEnv
       ; ZonkEnv -> TcM ZonkEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv :: ZonkFlexi
-> TyCoVarEnv Id
-> TyCoVarEnv Id
-> TcRef (TyVarEnv Type)
-> ZonkEnv
ZonkEnv { ze_flexi :: ZonkFlexi
ze_flexi = ZonkFlexi
flexi
                         , ze_tv_env :: TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id
forall a. VarEnv a
emptyVarEnv
                         , ze_id_env :: TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
forall a. VarEnv a
emptyVarEnv
                         , ze_meta_tv_env :: TcRef (TyVarEnv Type)
ze_meta_tv_env = TcRef (TyVarEnv Type)
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 -> [Id] -> ZonkEnv
extendIdZonkEnvRec ze :: ZonkEnv
ze@(ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
id_env }) [Id]
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 Id
ze_id_env = TyCoVarEnv Id -> [(Id, Id)] -> TyCoVarEnv Id
forall a. VarEnv a -> [(Id, a)] -> VarEnv a
extendVarEnvList TyCoVarEnv Id
id_env [(Id
id,Id
id) | Id
id <- [Id]
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 -> [Id] -> ZonkEnv
extendZonkEnv ze :: ZonkEnv
ze@(ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id
tyco_env, ze_id_env :: ZonkEnv -> TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
id_env }) [Id]
vars
  = ZonkEnv
ze { ze_tv_env :: TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id -> [(Id, Id)] -> TyCoVarEnv Id
forall a. VarEnv a -> [(Id, a)] -> VarEnv a
extendVarEnvList TyCoVarEnv Id
tyco_env [(Id
tv,Id
tv) | Id
tv <- [Id]
tycovars]
       , ze_id_env :: TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id -> [(Id, Id)] -> TyCoVarEnv Id
forall a. VarEnv a -> [(Id, a)] -> VarEnv a
extendVarEnvList TyCoVarEnv Id
id_env   [(Id
id,Id
id) | Id
id <- [Id]
ids] }
  where
    ([Id]
tycovars, [Id]
ids) = (Id -> Bool) -> [Id] -> ([Id], [Id])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Id -> Bool
isTyCoVar [Id]
vars

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

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

extendTyZonkEnvN :: ZonkEnv -> [(Name,TyVar)] -> ZonkEnv
extendTyZonkEnvN :: ZonkEnv -> [(Name, Id)] -> ZonkEnv
extendTyZonkEnvN ze :: ZonkEnv
ze@(ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id
ty_env }) [(Name, Id)]
pairs
  = ZonkEnv
ze { ze_tv_env :: TyCoVarEnv Id
ze_tv_env = (TyCoVarEnv Id -> (Name, Id) -> TyCoVarEnv Id)
-> TyCoVarEnv Id -> [(Name, Id)] -> TyCoVarEnv Id
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl TyCoVarEnv Id -> (Name, Id) -> TyCoVarEnv Id
forall a a. Uniquable a => VarEnv a -> (a, a) -> VarEnv a
add TyCoVarEnv Id
ty_env [(Name, Id)]
pairs }
  where
    add :: VarEnv a -> (a, a) -> VarEnv a
add VarEnv a
env (a
name, a
tv) = VarEnv a -> Unique -> a -> VarEnv a
forall a. VarEnv a -> Unique -> a -> VarEnv a
extendVarEnv_Directly VarEnv a
env (a -> Unique
forall a. Uniquable a => a -> Unique
getUnique a
name) a
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 Id
ze_id_env = TyCoVarEnv Id
id_env})
  = [(Name, TyThing)] -> TypeEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Id -> Name
forall a. NamedThing a => a -> Name
getName Id
id, Id -> TyThing
AnId Id
id) | Id
id <- TyCoVarEnv Id -> [Id]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM TyCoVarEnv Id
id_env]
  -- It's OK to use nonDetEltsUFM here because we forget the ordering
  -- immediately by creating a TypeEnv

zonkLIdOcc :: ZonkEnv -> Located TcId -> Located Id
zonkLIdOcc :: ZonkEnv -> Located Id -> Located Id
zonkLIdOcc ZonkEnv
env = (SrcSpanLess (Located Id) -> SrcSpanLess (Located Id))
-> Located Id -> Located Id
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> SrcSpanLess b) -> a -> b
onHasSrcSpan (ZonkEnv -> Id -> Id
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 -> Id -> Id
zonkIdOcc (ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
id_env}) Id
id
  | Id -> Bool
isLocalVar Id
id = TyCoVarEnv Id -> Id -> Maybe Id
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv TyCoVarEnv Id
id_env Id
id Maybe Id -> Id -> Id
forall a. Maybe a -> a -> a
`orElse`
                    Id
id
  | Bool
otherwise     = Id
id

zonkIdOccs :: ZonkEnv -> [TcId] -> [Id]
zonkIdOccs :: ZonkEnv -> [Id] -> [Id]
zonkIdOccs ZonkEnv
env [Id]
ids = (Id -> Id) -> [Id] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (ZonkEnv -> Id -> Id
zonkIdOcc ZonkEnv
env) [Id]
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 -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
v
  = do Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env (Id -> Type
idType Id
v)
       Type -> SDoc -> TcM ()
ensureNotLevPoly Type
ty'
         (String -> SDoc
text String
"In the type of binder" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
v))

       Id -> TcM Id
forall (m :: * -> *) a. Monad m => a -> m a
return (HasDebugCallStack => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> Type -> IdInfo
`setLevityInfoWithType` Type
ty') (Id -> Type -> Id
setIdType Id
v Type
ty'))

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

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

zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTcId -> TcM (FieldOcc GhcTc)
zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc ZonkEnv
env (FieldOcc XCFieldOcc GhcTc
sel Located RdrName
lbl)
  = (Id -> FieldOcc GhcTc) -> TcM Id -> TcM (FieldOcc GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Id -> Located RdrName -> FieldOcc GhcTc)
-> Located RdrName -> Id -> FieldOcc GhcTc
forall a b c. (a -> b -> c) -> b -> a -> c
flip Id -> Located RdrName -> FieldOcc GhcTc
forall pass. XCFieldOcc pass -> Located RdrName -> FieldOcc pass
FieldOcc) Located RdrName
lbl) (TcM Id -> TcM (FieldOcc GhcTc)) -> TcM Id -> TcM (FieldOcc GhcTc)
forall a b. (a -> b) -> a -> b
$ ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
XCFieldOcc GhcTc
sel
zonkFieldOcc ZonkEnv
_ (XFieldOcc XXFieldOcc GhcTc
nec) = NoExtCon -> TcM (FieldOcc GhcTc)
forall a. NoExtCon -> a
noExtCon XXFieldOcc GhcTc
NoExtCon
nec

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

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

zonkEvBndr :: ZonkEnv -> EvVar -> TcM EvVar
-- Works for dictionaries and coercions
-- Does not extend the ZonkEnv
zonkEvBndr :: ZonkEnv -> Id -> TcM Id
zonkEvBndr ZonkEnv
env Id
var
  = do { let var_ty :: Type
var_ty = Id -> Type
varType Id
var
       ; Type
ty <-
           {-# SCC "zonkEvBndr_zonkTcTypeToType" #-}
           ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
var_ty
       ; Id -> TcM Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Type -> Id
setVarType Id
var Type
ty) }

{-
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 -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkCoreBndrX ZonkEnv
env Id
v
  | Id -> Bool
isId Id
v = do { Id
v' <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
v
                ; (ZonkEnv, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> Id -> ZonkEnv
extendIdZonkEnv1 ZonkEnv
env Id
v', Id
v') }
  | Bool
otherwise = ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkTyBndrX ZonkEnv
env Id
v

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

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

zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])
zonkTyBndrsX :: ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
zonkTyBndrsX = (ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id))
-> ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
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
zonkTyBndrX :: ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkTyBndrX ZonkEnv
env Id
tv
  = ASSERT2( isImmutableTyVar tv, ppr tv <+> dcolon <+> ppr (tyVarKind tv) )
    do { Type
ki <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env (Id -> Type
tyVarKind Id
tv)
               -- Internal names tidy up better, for iface files.
       ; let tv' :: Id
tv' = Name -> Type -> Id
mkTyVar (Id -> Name
tyVarName Id
tv) Type
ki
       ; (ZonkEnv, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> Id -> ZonkEnv
extendTyZonkEnv1 ZonkEnv
env Id
tv', Id
tv') }

zonkTyVarBinders ::  [VarBndr TcTyVar vis]
                 -> TcM (ZonkEnv, [VarBndr TyVar vis])
zonkTyVarBinders :: [VarBndr Id vis] -> TcM (ZonkEnv, [VarBndr Id vis])
zonkTyVarBinders [VarBndr Id vis]
tvbs = (ZonkEnv -> TcM (ZonkEnv, [VarBndr Id vis]))
-> TcM (ZonkEnv, [VarBndr Id vis])
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM (ZonkEnv, [VarBndr Id vis]))
 -> TcM (ZonkEnv, [VarBndr Id vis]))
-> (ZonkEnv -> TcM (ZonkEnv, [VarBndr Id vis]))
-> TcM (ZonkEnv, [VarBndr Id vis])
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze -> ZonkEnv -> [VarBndr Id vis] -> TcM (ZonkEnv, [VarBndr Id vis])
forall vis.
ZonkEnv -> [VarBndr Id vis] -> TcM (ZonkEnv, [VarBndr Id vis])
zonkTyVarBindersX ZonkEnv
ze [VarBndr Id vis]
tvbs

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

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

zonkRecTyVarBndrs :: [Name] -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])
-- This rather specialised function is used in exactly one place.
-- See Note [Tricky scoping in generaliseTcTyCon] in TcTyClsDecls.
zonkRecTyVarBndrs :: [Name] -> [Id] -> TcM (ZonkEnv, [Id])
zonkRecTyVarBndrs [Name]
names [Id]
tc_tvs
  = (ZonkEnv -> TcM (ZonkEnv, [Id])) -> TcM (ZonkEnv, [Id])
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM (ZonkEnv, [Id])) -> TcM (ZonkEnv, [Id]))
-> (ZonkEnv -> TcM (ZonkEnv, [Id])) -> TcM (ZonkEnv, [Id])
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze ->
    ((ZonkEnv, [Id]) -> TcM (ZonkEnv, [Id])) -> TcM (ZonkEnv, [Id])
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM (((ZonkEnv, [Id]) -> TcM (ZonkEnv, [Id])) -> TcM (ZonkEnv, [Id]))
-> ((ZonkEnv, [Id]) -> TcM (ZonkEnv, [Id])) -> TcM (ZonkEnv, [Id])
forall a b. (a -> b) -> a -> b
$ \ ~(ZonkEnv
_, [Id]
rec_new_tvs) ->
    do { let ze' :: ZonkEnv
ze' = ZonkEnv -> [(Name, Id)] -> ZonkEnv
extendTyZonkEnvN ZonkEnv
ze ([(Name, Id)] -> ZonkEnv) -> [(Name, Id)] -> ZonkEnv
forall a b. (a -> b) -> a -> b
$
                   (Id -> Id -> (Name, Id)) -> [Id] -> [Id] -> [(Name, Id)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWithLazy (\ Id
tc_tv Id
new_tv -> (Id -> Name
forall a. NamedThing a => a -> Name
getName Id
tc_tv, Id
new_tv))
                               [Id]
tc_tvs [Id]
rec_new_tvs
       ; [Id]
new_tvs <- (Name -> Id -> TcM Id) -> [Name] -> [Id] -> TcM [Id]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (ZonkEnv -> Name -> Id -> TcM Id
zonk_one ZonkEnv
ze') [Name]
names [Id]
tc_tvs
       ; (ZonkEnv, [Id]) -> TcM (ZonkEnv, [Id])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
ze', [Id]
new_tvs) }
  where
    zonk_one :: ZonkEnv -> Name -> Id -> TcM Id
zonk_one ZonkEnv
ze Name
name Id
tc_tv
      = do { Type
ki <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
ze (Id -> Type
tyVarKind Id
tc_tv)
           ; Id -> TcM Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type -> Id
mkTyVar Name
name Type
ki) }

zonkTopExpr :: HsExpr GhcTcId -> 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 GhcTcId -> TcM (LHsExpr GhcTc)
zonkTopLExpr :: LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkTopLExpr LHsExpr GhcTc
e = (ZonkEnv -> TcM (LHsExpr GhcTc)) -> TcM (LHsExpr GhcTc)
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM (LHsExpr GhcTc)) -> TcM (LHsExpr GhcTc))
-> (ZonkEnv -> TcM (LHsExpr GhcTc)) -> TcM (LHsExpr 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 GhcTcId
             -> [LRuleDecl GhcTcId] -> [LTcSpecPrag]
             -> [LForeignDecl GhcTcId]
             -> 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, LHsBinds GhcTc
binds')    <- ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds ZonkEnv
env1 LHsBinds GhcTc
binds
                        -- Top level is implicitly recursive
        ; [LRuleDecl 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
        ; [LForeignDecl GhcTc]
fords' <- ZonkEnv -> [LForeignDecl GhcTc] -> TcM [LForeignDecl GhcTc]
zonkForeignExports ZonkEnv
env2 [LForeignDecl GhcTc]
fords
        ; (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
 [LTcSpecPrag], [LRuleDecl GhcTc])
-> TcM
     (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
      [LTcSpecPrag], [LRuleDecl GhcTc])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> TypeEnv
zonkEnvIds ZonkEnv
env2, Bag EvBind
ev_binds', LHsBinds GhcTc
binds', [LForeignDecl GhcTc]
fords', [LTcSpecPrag]
specs', [LRuleDecl GhcTc]
rules') }

---------------------------------------------
zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTcId
               -> 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, LHsBinds GhcTc)]
new_binds) <- ZonkEnv
-> [(RecFlag, LHsBinds GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv) (ZonkEnv, [(RecFlag, LHsBinds GhcTc)])
forall a.
ZonkEnv
-> [(a, LHsBinds GhcTc)]
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(a, LHsBinds GhcTc)])
go ZonkEnv
env [(RecFlag, LHsBinds 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)]
new_binds [LSig GhcRn]
sigs))) }
  where
    go :: ZonkEnv
-> [(a, LHsBinds GhcTc)]
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(a, LHsBinds GhcTc)])
go ZonkEnv
env []
      = (ZonkEnv, [(a, LHsBinds GhcTc)])
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(a, LHsBinds GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, [])
    go ZonkEnv
env ((a
r,LHsBinds GhcTc
b):[(a, LHsBinds GhcTc)]
bs)
      = do { (ZonkEnv
env1, LHsBinds GhcTc
b')  <- ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds ZonkEnv
env LHsBinds GhcTc
b
           ; (ZonkEnv
env2, [(a, LHsBinds GhcTc)]
bs') <- ZonkEnv
-> [(a, LHsBinds GhcTc)]
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(a, LHsBinds GhcTc)])
go ZonkEnv
env1 [(a, LHsBinds GhcTc)]
bs
           ; (ZonkEnv, [(a, LHsBinds GhcTc)])
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(a, LHsBinds GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, (a
r,LHsBinds GhcTc
b')(a, LHsBinds GhcTc)
-> [(a, LHsBinds GhcTc)] -> [(a, LHsBinds GhcTc)]
forall a. a -> [a] -> [a]
:[(a, LHsBinds GhcTc)]
bs') }

zonkLocalBinds ZonkEnv
env (HsIPBinds XHsIPBinds GhcTc GhcTc
x (IPBinds XIPBinds GhcTc
dict_binds [LIPBind GhcTc]
binds )) = do
    [LIPBind GhcTc]
new_binds <- (LIPBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LIPBind GhcTc))
-> [LIPBind GhcTc] -> IOEnv (Env TcGblEnv TcLclEnv) [LIPBind GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((SrcSpanLess (LIPBind GhcTc) -> TcM (SrcSpanLess (LIPBind GhcTc)))
-> LIPBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LIPBind GhcTc)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM SrcSpanLess (LIPBind GhcTc) -> TcM (SrcSpanLess (LIPBind GhcTc))
IPBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (IPBind GhcTc)
zonk_ip_bind) [LIPBind GhcTc]
binds
    let
        env1 :: ZonkEnv
env1 = ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env
                 [ Id
IdP GhcTc
n | (LIPBind GhcTc -> Located (SrcSpanLess (LIPBind GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (IPBind _ (Right n) _)) <- [LIPBind GhcTc]
new_binds]
    (ZonkEnv
env2, TcEvBinds
new_dict_binds) <- ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds)
zonkTcEvBinds ZonkEnv
env1 XIPBinds GhcTc
TcEvBinds
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 XIPBinds GhcTc
TcEvBinds
new_dict_binds [LIPBind GhcTc]
new_binds))
  where
    zonk_ip_bind :: IPBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (IPBind GhcTc)
zonk_ip_bind (IPBind XCIPBind GhcTc
x Either (Located HsIPName) (IdP GhcTc)
n LHsExpr GhcTc
e)
        = do Either (Located HsIPName) Id
n' <- (Id -> TcM Id)
-> Either (Located HsIPName) Id
-> TcM (Either (Located HsIPName) Id)
forall a b.
(a -> TcM b)
-> Either (Located HsIPName) a -> TcM (Either (Located HsIPName) b)
mapIPNameTc (ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env) Either (Located HsIPName) Id
Either (Located HsIPName) (IdP GhcTc)
n
             LHsExpr GhcTc
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
             IPBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (IPBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCIPBind GhcTc
-> Either (Located HsIPName) (IdP GhcTc)
-> LHsExpr GhcTc
-> IPBind GhcTc
forall id.
XCIPBind id
-> Either (Located HsIPName) (IdP id) -> LHsExpr id -> IPBind id
IPBind XCIPBind GhcTc
x Either (Located HsIPName) Id
Either (Located HsIPName) (IdP GhcTc)
n' LHsExpr GhcTc
e')
    zonk_ip_bind (XIPBind XXIPBind GhcTc
nec) = NoExtCon -> IOEnv (Env TcGblEnv TcLclEnv) (IPBind GhcTc)
forall a. NoExtCon -> a
noExtCon XXIPBind GhcTc
NoExtCon
nec

zonkLocalBinds ZonkEnv
_ (HsIPBinds XHsIPBinds GhcTc GhcTc
_ (XHsIPBinds XXHsIPBinds GhcTc
nec))
  = NoExtCon -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall a. NoExtCon -> a
noExtCon XXHsIPBinds GhcTc
NoExtCon
nec
zonkLocalBinds ZonkEnv
_ (XHsLocalBindsLR XXHsLocalBindsLR GhcTc GhcTc
nec)
  = NoExtCon -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall a. NoExtCon -> a
noExtCon XXHsLocalBindsLR GhcTc GhcTc
NoExtCon
nec

---------------------------------------------
zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTcId -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds ZonkEnv
env LHsBinds GhcTc
binds
 = ((ZonkEnv, LHsBinds GhcTc) -> TcM (ZonkEnv, LHsBinds GhcTc))
-> TcM (ZonkEnv, LHsBinds GhcTc)
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM (\ ~(ZonkEnv
_, LHsBinds GhcTc
new_binds) -> do
        { let env1 :: ZonkEnv
env1 = ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env (LHsBinds GhcTc -> [IdP GhcTc]
forall (p :: Pass) idR.
LHsBindsLR (GhcPass p) idR -> [IdP (GhcPass p)]
collectHsBindsBinders LHsBinds GhcTc
new_binds)
        ; LHsBinds GhcTc
binds' <- ZonkEnv -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
zonkMonoBinds ZonkEnv
env1 LHsBinds GhcTc
binds
        ; (ZonkEnv, LHsBinds GhcTc) -> TcM (ZonkEnv, LHsBinds GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, LHsBinds GhcTc
binds') })

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

zonk_lbind :: ZonkEnv -> LHsBind GhcTcId -> TcM (LHsBind GhcTc)
zonk_lbind :: ZonkEnv
-> LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
zonk_lbind ZonkEnv
env = (SrcSpanLess (LHsBind GhcTc) -> TcM (SrcSpanLess (LHsBind GhcTc)))
-> LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> HsBind GhcTc -> TcM (HsBind GhcTc)
zonk_bind ZonkEnv
env)

zonk_bind :: ZonkEnv -> HsBind GhcTcId -> TcM (HsBind GhcTc)
zonk_bind :: ZonkEnv -> HsBind GhcTc -> TcM (HsBind GhcTc)
zonk_bind ZonkEnv
env bind :: HsBind 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 = NPatBindTc fvs ty})
  = do  { (ZonkEnv
_env, Located (Pat GhcTc)
new_pat) <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat            -- Env already extended
        ; GRHSs GhcTc (LHsExpr GhcTc)
new_grhss <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> GRHSs GhcTc (LHsExpr GhcTc)
-> TcM (GRHSs GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> GRHSs GhcTc (Located (body GhcTc))
-> TcM (GRHSs GhcTc (Located (body GhcTc)))
zonkGRHSs ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr GRHSs GhcTc (LHsExpr GhcTc)
grhss
        ; Type
new_ty    <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
ty
        ; HsBind GhcTc -> TcM (HsBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBind GhcTc
bind { pat_lhs :: LPat GhcTc
pat_lhs = Located (Pat GhcTc)
LPat GhcTc
new_pat, pat_rhs :: GRHSs GhcTc (LHsExpr GhcTc)
pat_rhs = GRHSs GhcTc (LHsExpr GhcTc)
new_grhss
                       , pat_ext :: XPatBind GhcTc GhcTc
pat_ext = NameSet -> Type -> NPatBindTc
NPatBindTc NameSet
fvs Type
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, var_inline :: forall idL idR. HsBindLR idL idR -> Bool
var_inline = Bool
inl })
  = do { Id
new_var  <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
IdP GhcTc
var
       ; LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
       ; HsBind GhcTc -> TcM (HsBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarBind :: forall idL idR.
XVarBind idL idR
-> IdP idL -> LHsExpr idR -> Bool -> HsBindLR idL idR
VarBind { var_ext :: XVarBind GhcTc GhcTc
var_ext = XVarBind GhcTc GhcTc
x
                         , var_id :: IdP GhcTc
var_id = Id
IdP GhcTc
new_var
                         , var_rhs :: LHsExpr GhcTc
var_rhs = LHsExpr GhcTc
new_expr
                         , var_inline :: Bool
var_inline = Bool
inl }) }

zonk_bind ZonkEnv
env bind :: HsBind GhcTc
bind@(FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id = (Located (IdP GhcTc) -> Located (SrcSpanLess (Located Id))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (Located Id)
var)
                            , fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
ms
                            , fun_co_fn :: forall idL idR. HsBindLR idL idR -> HsWrapper
fun_co_fn = HsWrapper
co_fn })
  = do { Id
new_var <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env SrcSpanLess (Located Id)
Id
var
       ; (ZonkEnv
env1, HsWrapper
new_co_fn) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
co_fn
       ; MatchGroup GhcTc (LHsExpr GhcTc)
new_ms <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env1 ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
ms
       ; HsBind GhcTc -> TcM (HsBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBind GhcTc
bind { fun_id :: Located (IdP GhcTc)
fun_id = SrcSpan -> SrcSpanLess (Located Id) -> Located Id
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located Id)
Id
new_var
                      , fun_matches :: MatchGroup GhcTc (LHsExpr GhcTc)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
new_ms
                      , fun_co_fn :: HsWrapper
fun_co_fn = HsWrapper
new_co_fn }) }

zonk_bind ZonkEnv
env (AbsBinds { abs_tvs :: forall idL idR. HsBindLR idL idR -> [Id]
abs_tvs = [Id]
tyvars, abs_ev_vars :: forall idL idR. HsBindLR idL idR -> [Id]
abs_ev_vars = [Id]
evs
                        , abs_ev_binds :: forall idL idR. HsBindLR idL idR -> [TcEvBinds]
abs_ev_binds = [TcEvBinds]
ev_binds
                        , abs_exports :: forall idL idR. HsBindLR idL idR -> [ABExport idL]
abs_exports = [ABExport GhcTc]
exports
                        , abs_binds :: forall idL idR. HsBindLR idL idR -> LHsBinds idL
abs_binds = LHsBinds GhcTc
val_binds
                        , abs_sig :: forall idL idR. HsBindLR idL idR -> Bool
abs_sig = Bool
has_sig })
  = ASSERT( all isImmutableTyVar tyvars )
    do { (ZonkEnv
env0, [Id]
new_tyvars) <- ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
zonkTyBndrsX ZonkEnv
env [Id]
tyvars
       ; (ZonkEnv
env1, [Id]
new_evs) <- ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
zonkEvBndrsX ZonkEnv
env0 [Id]
evs
       ; (ZonkEnv
env2, [TcEvBinds]
new_ev_binds) <- ZonkEnv -> [TcEvBinds] -> TcM (ZonkEnv, [TcEvBinds])
zonkTcEvBinds_s ZonkEnv
env1 [TcEvBinds]
ev_binds
       ; (LHsBinds GhcTc
new_val_bind, [ABExport GhcTc]
new_exports) <- ((LHsBinds GhcTc, [ABExport GhcTc])
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc]))
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc])
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM (((LHsBinds GhcTc, [ABExport GhcTc])
  -> IOEnv
       (Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc]))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc]))
-> ((LHsBinds GhcTc, [ABExport GhcTc])
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc]))
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc])
forall a b. (a -> b) -> a -> b
$ \ ~(LHsBinds GhcTc
new_val_binds, [ABExport GhcTc]
_) ->
         do { let env3 :: ZonkEnv
env3 = ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env2 ([Id] -> ZonkEnv) -> [Id] -> ZonkEnv
forall a b. (a -> b) -> a -> b
$
                         LHsBinds GhcTc -> [IdP GhcTc]
forall (p :: Pass) idR.
LHsBindsLR (GhcPass p) idR -> [IdP (GhcPass p)]
collectHsBindsBinders LHsBinds GhcTc
new_val_binds
            ; LHsBinds GhcTc
new_val_binds <- (LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc))
-> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM (ZonkEnv
-> LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
zonk_val_bind ZonkEnv
env3) LHsBinds GhcTc
val_binds
            ; [ABExport GhcTc]
new_exports   <- (ABExport GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport GhcTc))
-> [ABExport GhcTc]
-> IOEnv (Env TcGblEnv TcLclEnv) [ABExport GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv
-> ABExport GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport GhcTc)
forall p p.
(XABE p ~ XABE p, IdP p ~ Id, IdP p ~ Id,
 XXABExport p ~ NoExtCon) =>
ZonkEnv -> ABExport p -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport p)
zonk_export ZonkEnv
env3) [ABExport GhcTc]
exports
            ; (LHsBinds GhcTc, [ABExport GhcTc])
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc])
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsBinds GhcTc
new_val_binds, [ABExport GhcTc]
new_exports) }
       ; HsBind GhcTc -> TcM (HsBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (AbsBinds :: forall idL idR.
XAbsBinds idL idR
-> [Id]
-> [Id]
-> [ABExport idL]
-> [TcEvBinds]
-> LHsBinds idL
-> Bool
-> HsBindLR idL idR
AbsBinds { abs_ext :: XAbsBinds GhcTc GhcTc
abs_ext = XAbsBinds GhcTc GhcTc
NoExtField
noExtField
                          , abs_tvs :: [Id]
abs_tvs = [Id]
new_tyvars, abs_ev_vars :: [Id]
abs_ev_vars = [Id]
new_evs
                          , abs_ev_binds :: [TcEvBinds]
abs_ev_binds = [TcEvBinds]
new_ev_binds
                          , abs_exports :: [ABExport GhcTc]
abs_exports = [ABExport GhcTc]
new_exports, abs_binds :: LHsBinds GhcTc
abs_binds = LHsBinds GhcTc
new_val_bind
                          , abs_sig :: Bool
abs_sig = Bool
has_sig }) }
  where
    zonk_val_bind :: ZonkEnv
-> LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
zonk_val_bind ZonkEnv
env LHsBind GhcTc
lbind
      | Bool
has_sig
      , (LHsBind GhcTc -> Located (SrcSpanLess (LHsBind GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc bind :: SrcSpanLess (LHsBind GhcTc)
bind@(FunBind { fun_id      = (dL->L mloc mono_id)
                                 , fun_matches = ms
                                 , fun_co_fn   = co_fn })) <- LHsBind GhcTc
lbind
      = do { Id
new_mono_id <- (Type -> TcM Type) -> Id -> TcM Id
forall (m :: * -> *). Monad m => (Type -> m Type) -> Id -> m Id
updateVarTypeM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) SrcSpanLess (Located Id)
Id
mono_id
                            -- Specifically /not/ zonkIdBndr; we do not
                            -- want to complain about a levity-polymorphic binder
           ; (ZonkEnv
env', HsWrapper
new_co_fn) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
co_fn
           ; MatchGroup GhcTc (LHsExpr GhcTc)
new_ms            <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env' ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
ms
           ; LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc))
-> LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> SrcSpanLess (LHsBind GhcTc) -> LHsBind GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (SrcSpanLess (LHsBind GhcTc) -> LHsBind GhcTc)
-> SrcSpanLess (LHsBind GhcTc) -> LHsBind GhcTc
forall a b. (a -> b) -> a -> b
$
             SrcSpanLess (LHsBind GhcTc)
HsBind GhcTc
bind { fun_id :: Located (IdP GhcTc)
fun_id      = SrcSpan -> SrcSpanLess (Located Id) -> Located Id
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
mloc SrcSpanLess (Located Id)
Id
new_mono_id
                  , fun_matches :: MatchGroup GhcTc (LHsExpr GhcTc)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
new_ms
                  , fun_co_fn :: HsWrapper
fun_co_fn   = HsWrapper
new_co_fn } }
      | Bool
otherwise
      = ZonkEnv
-> LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
zonk_lbind ZonkEnv
env LHsBind GhcTc
lbind   -- The normal case

    zonk_export :: ZonkEnv -> ABExport p -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport p)
zonk_export ZonkEnv
env (ABE{ abe_ext :: forall p. ABExport p -> XABE p
abe_ext = XABE p
x
                        , abe_wrap :: forall p. ABExport p -> HsWrapper
abe_wrap = HsWrapper
wrap
                        , abe_poly :: forall p. ABExport p -> IdP p
abe_poly = IdP p
poly_id
                        , abe_mono :: forall p. ABExport p -> IdP p
abe_mono = IdP p
mono_id
                        , abe_prags :: forall p. ABExport p -> TcSpecPrags
abe_prags = TcSpecPrags
prags })
        = do Id
new_poly_id <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
IdP p
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 p -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport p)
forall (m :: * -> *) a. Monad m => a -> m a
return (ABE :: forall p.
XABE p -> IdP p -> IdP p -> HsWrapper -> TcSpecPrags -> ABExport p
ABE{ abe_ext :: XABE p
abe_ext = XABE p
XABE p
x
                        , abe_wrap :: HsWrapper
abe_wrap = HsWrapper
new_wrap
                        , abe_poly :: IdP p
abe_poly = Id
IdP p
new_poly_id
                        , abe_mono :: IdP p
abe_mono = ZonkEnv -> Id -> Id
zonkIdOcc ZonkEnv
env Id
IdP p
mono_id
                        , abe_prags :: TcSpecPrags
abe_prags = TcSpecPrags
new_prags })
    zonk_export ZonkEnv
_ (XABExport XXABExport p
nec) = NoExtCon -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport p)
forall a. NoExtCon -> a
noExtCon XXABExport p
NoExtCon
nec

zonk_bind ZonkEnv
env (PatSynBind XPatSynBind GhcTc GhcTc
x bind :: PatSynBind GhcTc GhcTc
bind@(PSB { psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
psb_id = (Located (IdP GhcTc) -> Located (SrcSpanLess (Located Id))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (Located Id)
id)
                                      , psb_args :: forall idL idR.
PatSynBind idL idR -> HsPatSynDetails (Located (IdP idR))
psb_args = HsPatSynDetails (Located (IdP 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 { Id
id' <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env SrcSpanLess (Located Id)
Id
id
       ; (ZonkEnv
env1, Located (Pat GhcTc)
lpat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
lpat
       ; let details' :: HsPatSynDetails (Located Id)
details' = ZonkEnv
-> HsPatSynDetails (Located Id) -> HsPatSynDetails (Located Id)
zonkPatSynDetails ZonkEnv
env1 HsPatSynDetails (Located Id)
HsPatSynDetails (Located (IdP GhcTc))
details
       ; (ZonkEnv
_env2, HsPatSynDir GhcTc
dir') <- ZonkEnv -> HsPatSynDir GhcTc -> TcM (ZonkEnv, HsPatSynDir GhcTc)
zonkPatSynDir ZonkEnv
env1 HsPatSynDir GhcTc
dir
       ; HsBind GhcTc -> TcM (HsBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBind GhcTc -> TcM (HsBind GhcTc))
-> HsBind GhcTc -> TcM (HsBind GhcTc)
forall a b. (a -> b) -> a -> b
$ XPatSynBind GhcTc GhcTc -> PatSynBind GhcTc GhcTc -> HsBind GhcTc
forall idL idR.
XPatSynBind idL idR -> PatSynBind idL idR -> HsBindLR idL idR
PatSynBind XPatSynBind GhcTc GhcTc
x (PatSynBind GhcTc GhcTc -> HsBind GhcTc)
-> PatSynBind GhcTc GhcTc -> HsBind GhcTc
forall a b. (a -> b) -> a -> b
$
                  PatSynBind GhcTc GhcTc
bind { psb_id :: Located (IdP GhcTc)
psb_id = SrcSpan -> SrcSpanLess (Located Id) -> Located Id
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located Id)
Id
id'
                       , psb_args :: HsPatSynDetails (Located (IdP GhcTc))
psb_args = HsPatSynDetails (Located Id)
HsPatSynDetails (Located (IdP GhcTc))
details'
                       , psb_def :: LPat GhcTc
psb_def = Located (Pat GhcTc)
LPat GhcTc
lpat'
                       , psb_dir :: HsPatSynDir GhcTc
psb_dir = HsPatSynDir GhcTc
dir' } }

zonk_bind ZonkEnv
_ (PatSynBind XPatSynBind GhcTc GhcTc
_ (XPatSynBind XXPatSynBind GhcTc GhcTc
nec)) = NoExtCon -> TcM (HsBind GhcTc)
forall a. NoExtCon -> a
noExtCon XXPatSynBind GhcTc GhcTc
NoExtCon
nec
zonk_bind ZonkEnv
_ (XHsBindsLR XXHsBindsLR GhcTc GhcTc
nec)                 = NoExtCon -> TcM (HsBind GhcTc)
forall a. NoExtCon -> a
noExtCon XXHsBindsLR GhcTc GhcTc
NoExtCon
nec

zonkPatSynDetails :: ZonkEnv
                  -> HsPatSynDetails (Located TcId)
                  -> HsPatSynDetails (Located Id)
zonkPatSynDetails :: ZonkEnv
-> HsPatSynDetails (Located Id) -> HsPatSynDetails (Located Id)
zonkPatSynDetails ZonkEnv
env (PrefixCon [Located Id]
as)
  = [Located Id] -> HsPatSynDetails (Located Id)
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon ((Located Id -> Located Id) -> [Located Id] -> [Located Id]
forall a b. (a -> b) -> [a] -> [b]
map (ZonkEnv -> Located Id -> Located Id
zonkLIdOcc ZonkEnv
env) [Located Id]
as)
zonkPatSynDetails ZonkEnv
env (InfixCon Located Id
a1 Located Id
a2)
  = Located Id -> Located Id -> HsPatSynDetails (Located Id)
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon (ZonkEnv -> Located Id -> Located Id
zonkLIdOcc ZonkEnv
env Located Id
a1) (ZonkEnv -> Located Id -> Located Id
zonkLIdOcc ZonkEnv
env Located Id
a2)
zonkPatSynDetails ZonkEnv
env (RecCon [RecordPatSynField (Located Id)]
flds)
  = [RecordPatSynField (Located Id)] -> HsPatSynDetails (Located Id)
forall arg rec. rec -> HsConDetails arg rec
RecCon ((RecordPatSynField (Located Id) -> RecordPatSynField (Located Id))
-> [RecordPatSynField (Located Id)]
-> [RecordPatSynField (Located Id)]
forall a b. (a -> b) -> [a] -> [b]
map ((Located Id -> Located Id)
-> RecordPatSynField (Located Id) -> RecordPatSynField (Located Id)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ZonkEnv -> Located Id -> Located Id
zonkLIdOcc ZonkEnv
env)) [RecordPatSynField (Located Id)]
flds)

zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTcId
              -> 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 (LHsExpr GhcTc)
mg' <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr MatchGroup GhcTc (LHsExpr 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)
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 (LTcSpecPrag -> Located (SrcSpanLess LTcSpecPrag)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc (SpecPrag id co_fn 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 -> SrcSpanLess LTcSpecPrag -> LTcSpecPrag
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (Id -> HsWrapper -> InlinePragma -> TcSpecPrag
SpecPrag (ZonkEnv -> Id -> Id
zonkIdOcc ZonkEnv
env Id
id) HsWrapper
co_fn' InlinePragma
inl)) }

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

zonkMatchGroup :: ZonkEnv
            -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
            -> MatchGroup GhcTcId (Located (body GhcTcId))
            -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = (Located [LMatch GhcTc (Located (body GhcTc))]
-> Located
     (SrcSpanLess (Located [LMatch GhcTc (Located (body GhcTc))]))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (Located [LMatch GhcTc (Located (body GhcTc))])
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  { [LMatch GhcTc (Located (body GhcTc))]
ms' <- (LMatch GhcTc (Located (body GhcTc))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LMatch GhcTc (Located (body GhcTc))))
-> [LMatch GhcTc (Located (body GhcTc))]
-> IOEnv
     (Env TcGblEnv TcLclEnv) [LMatch GhcTc (Located (body GhcTc))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> LMatch GhcTc (Located (body GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LMatch GhcTc (Located (body GhcTc)))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> LMatch GhcTc (Located (body GhcTc))
-> TcM (LMatch GhcTc (Located (body GhcTc)))
zonkMatch ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody) [LMatch GhcTc (Located (body GhcTc))]
SrcSpanLess (Located [LMatch GhcTc (Located (body GhcTc))])
ms
        ; [Type]
arg_tys' <- ZonkEnv -> [Type] -> TcM [Type]
zonkTcTypesToTypesX ZonkEnv
env [Type]
arg_tys
        ; Type
res_ty'  <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
res_ty
        ; MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (MG :: forall p body.
XMG p body
-> Located [LMatch p body] -> Origin -> MatchGroup p body
MG { mg_alts :: Located [LMatch GhcTc (Located (body GhcTc))]
mg_alts = SrcSpan
-> SrcSpanLess (Located [LMatch GhcTc (Located (body GhcTc))])
-> Located [LMatch GhcTc (Located (body GhcTc))]
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l [LMatch GhcTc (Located (body GhcTc))]
SrcSpanLess (Located [LMatch GhcTc (Located (body GhcTc))])
ms'
                     , mg_ext :: XMG GhcTc (Located (body GhcTc))
mg_ext = [Type] -> Type -> MatchGroupTc
MatchGroupTc [Type]
arg_tys' Type
res_ty'
                     , mg_origin :: Origin
mg_origin = Origin
origin }) }
zonkMatchGroup ZonkEnv
_ ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
_ (XMatchGroup XXMatchGroup GhcTc (Located (body GhcTc))
nec) = NoExtCon -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
forall a. NoExtCon -> a
noExtCon XXMatchGroup GhcTc (Located (body GhcTc))
NoExtCon
nec

zonkMatch :: ZonkEnv
          -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
          -> LMatch GhcTcId (Located (body GhcTcId))
          -> TcM (LMatch GhcTc (Located (body GhcTc)))
zonkMatch :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> LMatch GhcTc (Located (body GhcTc))
-> TcM (LMatch GhcTc (Located (body GhcTc)))
zonkMatch ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (LMatch GhcTc (Located (body GhcTc))
-> Located (SrcSpanLess (LMatch GhcTc (Located (body GhcTc))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc match :: SrcSpanLess (LMatch GhcTc (Located (body GhcTc)))
match@(Match { m_pats = pats
                                            , m_grhss = grhss }))
  = do  { (ZonkEnv
env1, [Located (Pat GhcTc)]
new_pats) <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env [LPat GhcTc]
pats
        ; GRHSs GhcTc (Located (body GhcTc))
new_grhss <- ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> GRHSs GhcTc (Located (body GhcTc))
-> TcM (GRHSs GhcTc (Located (body GhcTc)))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> GRHSs GhcTc (Located (body GhcTc))
-> TcM (GRHSs GhcTc (Located (body GhcTc)))
zonkGRHSs ZonkEnv
env1 ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody GRHSs GhcTc (Located (body GhcTc))
grhss
        ; LMatch GhcTc (Located (body GhcTc))
-> TcM (LMatch GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> SrcSpanLess (LMatch GhcTc (Located (body GhcTc)))
-> LMatch GhcTc (Located (body GhcTc))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (SrcSpanLess (LMatch GhcTc (Located (body GhcTc)))
Match GhcTc (Located (body GhcTc))
match { m_pats :: [LPat GhcTc]
m_pats = [Located (Pat GhcTc)]
[LPat GhcTc]
new_pats, m_grhss :: GRHSs GhcTc (Located (body GhcTc))
m_grhss = GRHSs GhcTc (Located (body GhcTc))
new_grhss })) }
zonkMatch ZonkEnv
_ ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
_ (LMatch GhcTc (Located (body GhcTc))
-> Located (SrcSpanLess (LMatch GhcTc (Located (body GhcTc))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L  SrcSpan
_ (XMatch nec)) = NoExtCon -> TcM (LMatch GhcTc (Located (body GhcTc)))
forall a. NoExtCon -> a
noExtCon XXMatch GhcTc (Located (body GhcTc))
NoExtCon
nec
zonkMatch ZonkEnv
_ ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
_ LMatch GhcTc (Located (body GhcTc))
_ = String -> TcM (LMatch GhcTc (Located (body GhcTc)))
forall a. String -> a
panic String
"zonkMatch: Impossible Match"
                             -- due to #15884

-------------------------------------------------------------------------
zonkGRHSs :: ZonkEnv
          -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
          -> GRHSs GhcTcId (Located (body GhcTcId))
          -> TcM (GRHSs GhcTc (Located (body GhcTc)))

zonkGRHSs :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> GRHSs GhcTc (Located (body GhcTc))
-> TcM (GRHSs GhcTc (Located (body GhcTc)))
zonkGRHSs ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (GRHSs XCGRHSs GhcTc (Located (body GhcTc))
x [LGRHS GhcTc (Located (body GhcTc))]
grhss (LHsLocalBinds GhcTc -> Located (SrcSpanLess (LHsLocalBinds GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (LHsLocalBinds GhcTc)
binds)) = do
    (ZonkEnv
new_env, HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
binds
    let
        zonk_grhs :: GRHS GhcTc (Located (body GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (GRHS GhcTc (Located (body GhcTc)))
zonk_grhs (GRHS XCGRHS GhcTc (Located (body GhcTc))
xx [GuardLStmt GhcTc]
guarded Located (body GhcTc)
rhs)
          = do (ZonkEnv
env2, [GuardLStmt GhcTc]
new_guarded) <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> TcM (ZonkEnv, [GuardLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
new_env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr [GuardLStmt GhcTc]
guarded
               Located (body GhcTc)
new_rhs <- ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody ZonkEnv
env2 Located (body GhcTc)
rhs
               GRHS GhcTc (Located (body GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (GRHS GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (XCGRHS GhcTc (Located (body GhcTc))
-> [GuardLStmt GhcTc]
-> Located (body GhcTc)
-> GRHS GhcTc (Located (body GhcTc))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcTc (Located (body GhcTc))
xx [GuardLStmt GhcTc]
new_guarded Located (body GhcTc)
new_rhs)
        zonk_grhs (XGRHS XXGRHS GhcTc (Located (body GhcTc))
nec) = NoExtCon
-> IOEnv
     (Env TcGblEnv TcLclEnv) (GRHS GhcTc (Located (body GhcTc)))
forall a. NoExtCon -> a
noExtCon XXGRHS GhcTc (Located (body GhcTc))
NoExtCon
nec
    [LGRHS GhcTc (Located (body GhcTc))]
new_grhss <- (LGRHS GhcTc (Located (body GhcTc))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LGRHS GhcTc (Located (body GhcTc))))
-> [LGRHS GhcTc (Located (body GhcTc))]
-> IOEnv
     (Env TcGblEnv TcLclEnv) [LGRHS GhcTc (Located (body GhcTc))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((SrcSpanLess (LGRHS GhcTc (Located (body GhcTc)))
 -> TcM (SrcSpanLess (LGRHS GhcTc (Located (body GhcTc)))))
-> LGRHS GhcTc (Located (body GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LGRHS GhcTc (Located (body GhcTc)))
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM SrcSpanLess (LGRHS GhcTc (Located (body GhcTc)))
-> TcM (SrcSpanLess (LGRHS GhcTc (Located (body GhcTc))))
GRHS GhcTc (Located (body GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (GRHS GhcTc (Located (body GhcTc)))
zonk_grhs) [LGRHS GhcTc (Located (body GhcTc))]
grhss
    GRHSs GhcTc (Located (body GhcTc))
-> TcM (GRHSs GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (XCGRHSs GhcTc (Located (body GhcTc))
-> [LGRHS GhcTc (Located (body GhcTc))]
-> LHsLocalBinds GhcTc
-> GRHSs GhcTc (Located (body GhcTc))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcTc (Located (body GhcTc))
x [LGRHS GhcTc (Located (body GhcTc))]
new_grhss (SrcSpan -> SrcSpanLess (LHsLocalBinds GhcTc) -> LHsLocalBinds GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
new_binds))
zonkGRHSs ZonkEnv
_ ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
_ (XGRHSs XXGRHSs GhcTc (Located (body GhcTc))
nec) = NoExtCon -> TcM (GRHSs GhcTc (Located (body GhcTc)))
forall a. NoExtCon -> a
noExtCon XXGRHSs GhcTc (Located (body GhcTc))
NoExtCon
nec

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

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

zonkLExprs :: ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc]
zonkLExprs ZonkEnv
env [LHsExpr GhcTc]
exprs = (LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [LHsExpr GhcTc] -> TcM [LHsExpr 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]
exprs
zonkLExpr :: ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr  ZonkEnv
env LHsExpr GhcTc
expr  = (SrcSpanLess (LHsExpr GhcTc) -> TcM (SrcSpanLess (LHsExpr GhcTc)))
-> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env) LHsExpr GhcTc
expr

zonkExpr :: ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env (HsVar XVar GhcTc
x (Located (IdP GhcTc) -> Located (SrcSpanLess (Located Id))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (Located Id)
id))
  = ASSERT2( isNothing (isDataConId_maybe id), ppr id )
    HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcTc -> Located (IdP GhcTc) -> HsExpr GhcTc
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar GhcTc
x (SrcSpan -> SrcSpanLess (Located Id) -> Located Id
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (ZonkEnv -> Id -> Id
zonkIdOcc ZonkEnv
env SrcSpanLess (Located Id)
Id
id)))

zonkExpr ZonkEnv
_ e :: HsExpr GhcTc
e@(HsConLikeOut {}) = HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return HsExpr GhcTc
e

zonkExpr ZonkEnv
_ (HsIPVar XIPVar GhcTc
x HsIPName
id)
  = HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XIPVar GhcTc -> HsIPName -> HsExpr GhcTc
forall p. XIPVar p -> HsIPName -> HsExpr p
HsIPVar XIPVar GhcTc
x HsIPName
id)

zonkExpr ZonkEnv
_ e :: HsExpr GhcTc
e@HsOverLabel{} = HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return HsExpr GhcTc
e

zonkExpr ZonkEnv
env (HsLit XLitE GhcTc
x (HsRat XHsRat GhcTc
e FractionalLit
f Type
ty))
  = do Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
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 -> Type -> HsLit GhcTc
forall x. XHsRat x -> FractionalLit -> Type -> HsLit x
HsRat XHsRat GhcTc
e FractionalLit
f Type
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 (LHsExpr GhcTc)
new_matches <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr MatchGroup GhcTc (LHsExpr 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)
new_matches)

zonkExpr ZonkEnv
env (HsLamCase XLamCase GhcTc
x MatchGroup GhcTc (LHsExpr GhcTc)
matches)
  = do MatchGroup GhcTc (LHsExpr GhcTc)
new_matches <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
matches
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLamCase GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
forall p. XLamCase p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase XLamCase GhcTc
x MatchGroup GhcTc (LHsExpr GhcTc)
new_matches)

zonkExpr ZonkEnv
env (HsApp XApp GhcTc
x LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
  = do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
       LHsExpr 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
new_e1 LHsExpr GhcTc
new_e2)

zonkExpr ZonkEnv
env (HsAppType XAppTypeE GhcTc
x LHsExpr GhcTc
e LHsWcType (NoGhcTc GhcTc)
t)
  = do LHsExpr 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 (XAppTypeE GhcTc
-> LHsExpr GhcTc -> LHsWcType (NoGhcTc GhcTc) -> HsExpr GhcTc
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcTc
x LHsExpr GhcTc
new_e LHsWcType (NoGhcTc GhcTc)
t)
       -- NB: the type is an HsType; can't zonk that!

zonkExpr ZonkEnv
_ e :: HsExpr GhcTc
e@(HsRnBracketOut XRnBracketOut GhcTc
_ HsBracket GhcRn
_ [PendingRnSplice]
_)
  = String -> SDoc -> TcM (HsExpr GhcTc)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"zonkExpr: HsRnBracketOut" (HsExpr GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcTc
e)

zonkExpr ZonkEnv
env (HsTcBracketOut XTcBracketOut GhcTc
x HsBracket GhcRn
body [PendingTcSplice]
bs)
  = do [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 PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice
zonk_b [PendingTcSplice]
bs
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XTcBracketOut GhcTc
-> HsBracket GhcRn -> [PendingTcSplice] -> HsExpr GhcTc
forall p.
XTcBracketOut p -> HsBracket GhcRn -> [PendingTcSplice] -> HsExpr p
HsTcBracketOut XTcBracketOut GhcTc
x HsBracket GhcRn
body [PendingTcSplice]
bs')
  where
    zonk_b :: PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice
zonk_b (PendingTcSplice Name
n LHsExpr GhcTc
e) = do LHsExpr 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
e')

zonkExpr ZonkEnv
env (HsSpliceE XSpliceE GhcTc
_ (HsSplicedT DelayedSplice
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
_ (HsSpliceE XSpliceE GhcTc
x HsSplice GhcTc
s) = WARN( True, ppr s ) -- Should not happen
                           HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XSpliceE GhcTc -> HsSplice GhcTc -> HsExpr GhcTc
forall p. XSpliceE p -> HsSplice p -> HsExpr p
HsSpliceE XSpliceE GhcTc
x HsSplice GhcTc
s)

zonkExpr ZonkEnv
env (OpApp XOpApp GhcTc
fixity LHsExpr GhcTc
e1 LHsExpr GhcTc
op LHsExpr GhcTc
e2)
  = do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
       LHsExpr GhcTc
new_op <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
op
       LHsExpr 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 (XOpApp GhcTc
-> LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcTc
fixity LHsExpr GhcTc
new_e1 LHsExpr GhcTc
new_op LHsExpr GhcTc
new_e2)

zonkExpr ZonkEnv
env (NegApp XNegApp GhcTc
x LHsExpr GhcTc
expr SyntaxExpr GhcTc
op)
  = do (ZonkEnv
env', SyntaxExpr GhcTc
new_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
op
       LHsExpr 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
new_expr SyntaxExpr GhcTc
new_op)

zonkExpr ZonkEnv
env (HsPar XPar GhcTc
x LHsExpr GhcTc
e)
  = do LHsExpr 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 -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar GhcTc
x LHsExpr GhcTc
new_e)

zonkExpr ZonkEnv
env (SectionL XSectionL GhcTc
x LHsExpr GhcTc
expr LHsExpr GhcTc
op)
  = do LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
       LHsExpr GhcTc
new_op   <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
op
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XSectionL GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XSectionL p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionL XSectionL GhcTc
x LHsExpr GhcTc
new_expr LHsExpr GhcTc
new_op)

zonkExpr ZonkEnv
env (SectionR XSectionR GhcTc
x LHsExpr GhcTc
op LHsExpr GhcTc
expr)
  = do LHsExpr GhcTc
new_op   <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
op
       LHsExpr 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 (XSectionR GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionR XSectionR GhcTc
x LHsExpr GhcTc
new_op LHsExpr GhcTc
new_expr)

zonkExpr ZonkEnv
env (ExplicitTuple XExplicitTuple GhcTc
x [LHsTupArg GhcTc]
tup_args Boxity
boxed)
  = do { [LHsTupArg GhcTc]
new_tup_args <- (LHsTupArg GhcTc
 -> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc))
-> [LHsTupArg GhcTc]
-> IOEnv (Env TcGblEnv TcLclEnv) [LHsTupArg GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc)
zonk_tup_arg [LHsTupArg GhcTc]
tup_args
       ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitTuple GhcTc -> [LHsTupArg GhcTc] -> Boxity -> HsExpr GhcTc
forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple GhcTc
x [LHsTupArg GhcTc]
new_tup_args Boxity
boxed) }
  where
    zonk_tup_arg :: LHsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc)
zonk_tup_arg (LHsTupArg GhcTc -> Located (SrcSpanLess (LHsTupArg GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l (Present x e)) = do { LHsExpr GhcTc
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
                                              ; LHsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> SrcSpanLess (LHsTupArg GhcTc) -> LHsTupArg GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (XPresent GhcTc -> LHsExpr GhcTc -> HsTupArg GhcTc
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcTc
x LHsExpr GhcTc
e')) }
    zonk_tup_arg (LHsTupArg GhcTc -> Located (SrcSpanLess (LHsTupArg GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l (Missing t)) = do { Type
t' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XMissing GhcTc
t
                                            ; LHsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> SrcSpanLess (LHsTupArg GhcTc) -> LHsTupArg GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (XMissing GhcTc -> HsTupArg GhcTc
forall id. XMissing id -> HsTupArg id
Missing Type
XMissing GhcTc
t')) }
    zonk_tup_arg (LHsTupArg GhcTc -> Located (SrcSpanLess (LHsTupArg GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (XTupArg nec)) = NoExtCon -> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc)
forall a. NoExtCon -> a
noExtCon XXTupArg GhcTc
NoExtCon
nec
    zonk_tup_arg LHsTupArg GhcTc
_ = String -> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc)
forall a. String -> a
panic String
"zonk_tup_arg: Impossible Match"
                             -- due to #15884


zonkExpr ZonkEnv
env (ExplicitSum XExplicitSum GhcTc
args ConTag
alt ConTag
arity LHsExpr GhcTc
expr)
  = do [Type]
new_args <- (Type -> TcM Type) -> [Type] -> TcM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) [Type]
XExplicitSum GhcTc
args
       LHsExpr 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 [Type]
XExplicitSum GhcTc
new_args ConTag
alt ConTag
arity LHsExpr GhcTc
new_expr)

zonkExpr ZonkEnv
env (HsCase XCase GhcTc
x LHsExpr GhcTc
expr MatchGroup GhcTc (LHsExpr GhcTc)
ms)
  = do LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
       MatchGroup GhcTc (LHsExpr GhcTc)
new_ms <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr MatchGroup GhcTc (LHsExpr 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
new_expr MatchGroup GhcTc (LHsExpr GhcTc)
new_ms)

zonkExpr ZonkEnv
env (HsIf XIf GhcTc
x Maybe (SyntaxExpr GhcTc)
Nothing LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 LHsExpr GhcTc
e3)
  = do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
       LHsExpr GhcTc
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
       LHsExpr 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
-> Maybe (SyntaxExpr GhcTc)
-> LHsExpr GhcTc
-> LHsExpr GhcTc
-> LHsExpr GhcTc
-> HsExpr GhcTc
forall p.
XIf p
-> Maybe (SyntaxExpr p)
-> LHsExpr p
-> LHsExpr p
-> LHsExpr p
-> HsExpr p
HsIf XIf GhcTc
x Maybe (SyntaxExpr GhcTc)
forall a. Maybe a
Nothing LHsExpr GhcTc
new_e1 LHsExpr GhcTc
new_e2 LHsExpr GhcTc
new_e3)

zonkExpr ZonkEnv
env (HsIf XIf GhcTc
x (Just SyntaxExpr GhcTc
fun) LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 LHsExpr GhcTc
e3)
  = do (ZonkEnv
env1, SyntaxExpr GhcTc
new_fun) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
fun
       LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env1 LHsExpr GhcTc
e1
       LHsExpr GhcTc
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env1 LHsExpr GhcTc
e2
       LHsExpr GhcTc
new_e3 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env1 LHsExpr GhcTc
e3
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XIf GhcTc
-> Maybe (SyntaxExpr GhcTc)
-> LHsExpr GhcTc
-> LHsExpr GhcTc
-> LHsExpr GhcTc
-> HsExpr GhcTc
forall p.
XIf p
-> Maybe (SyntaxExpr p)
-> LHsExpr p
-> LHsExpr p
-> LHsExpr p
-> HsExpr p
HsIf XIf GhcTc
x (SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc)
forall a. a -> Maybe a
Just SyntaxExpr GhcTc
new_fun) LHsExpr GhcTc
new_e1 LHsExpr GhcTc
new_e2 LHsExpr GhcTc
new_e3)

zonkExpr ZonkEnv
env (HsMultiIf XMultiIf GhcTc
ty [LGRHS GhcTc (LHsExpr GhcTc)]
alts)
  = do { [LGRHS GhcTc (LHsExpr GhcTc)]
alts' <- (LGRHS GhcTc (LHsExpr GhcTc)
 -> IOEnv (Env TcGblEnv TcLclEnv) (LGRHS GhcTc (LHsExpr GhcTc)))
-> [LGRHS GhcTc (LHsExpr GhcTc)]
-> IOEnv (Env TcGblEnv TcLclEnv) [LGRHS GhcTc (LHsExpr GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((SrcSpanLess (LGRHS GhcTc (LHsExpr GhcTc))
 -> TcM (SrcSpanLess (LGRHS GhcTc (LHsExpr GhcTc))))
-> LGRHS GhcTc (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LGRHS GhcTc (LHsExpr GhcTc))
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM SrcSpanLess (LGRHS GhcTc (LHsExpr GhcTc))
-> TcM (SrcSpanLess (LGRHS GhcTc (LHsExpr GhcTc)))
GRHS GhcTc (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LHsExpr GhcTc))
zonk_alt) [LGRHS GhcTc (LHsExpr GhcTc)]
alts
       ; Type
ty'   <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XMultiIf GhcTc
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 Type
XMultiIf GhcTc
ty' [LGRHS GhcTc (LHsExpr GhcTc)]
alts' }
  where zonk_alt :: GRHS GhcTc (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LHsExpr GhcTc))
zonk_alt (GRHS XCGRHS GhcTc (LHsExpr GhcTc)
x [GuardLStmt GhcTc]
guard LHsExpr GhcTc
expr)
          = do { (ZonkEnv
env', [GuardLStmt GhcTc]
guard') <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> TcM (ZonkEnv, [GuardLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr [GuardLStmt GhcTc]
guard
               ; LHsExpr GhcTc
expr'          <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env' LHsExpr GhcTc
expr
               ; GRHS GhcTc (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LHsExpr GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (GRHS GhcTc (LHsExpr GhcTc)
 -> IOEnv (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LHsExpr GhcTc)))
-> GRHS GhcTc (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LHsExpr GhcTc))
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcTc (LHsExpr GhcTc)
-> [GuardLStmt GhcTc]
-> LHsExpr GhcTc
-> GRHS GhcTc (LHsExpr GhcTc)
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcTc (LHsExpr GhcTc)
x [GuardLStmt GhcTc]
guard' LHsExpr GhcTc
expr' }
        zonk_alt (XGRHS XXGRHS GhcTc (LHsExpr GhcTc)
nec) = NoExtCon
-> IOEnv (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LHsExpr GhcTc))
forall a. NoExtCon -> a
noExtCon XXGRHS GhcTc (LHsExpr GhcTc)
NoExtCon
nec

zonkExpr ZonkEnv
env (HsLet XLet GhcTc
x (LHsLocalBinds GhcTc -> Located (SrcSpanLess (LHsLocalBinds GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (LHsLocalBinds GhcTc)
binds) LHsExpr GhcTc
expr)
  = do (ZonkEnv
new_env, HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
binds
       LHsExpr 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 -> LHsLocalBinds GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XLet p -> LHsLocalBinds p -> LHsExpr p -> HsExpr p
HsLet XLet GhcTc
x (SrcSpan -> SrcSpanLess (LHsLocalBinds GhcTc) -> LHsLocalBinds GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
new_binds) LHsExpr GhcTc
new_expr)

zonkExpr ZonkEnv
env (HsDo XDo GhcTc
ty HsStmtContext Name
do_or_lc (Located [GuardLStmt GhcTc]
-> Located (SrcSpanLess (Located [GuardLStmt GhcTc]))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (Located [GuardLStmt GhcTc])
stmts))
  = do (ZonkEnv
_, [GuardLStmt GhcTc]
new_stmts) <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> TcM (ZonkEnv, [GuardLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr [GuardLStmt GhcTc]
SrcSpanLess (Located [GuardLStmt GhcTc])
stmts
       Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XDo GhcTc
ty
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XDo GhcTc
-> HsStmtContext Name -> Located [GuardLStmt GhcTc] -> HsExpr GhcTc
forall p.
XDo p -> HsStmtContext Name -> Located [ExprLStmt p] -> HsExpr p
HsDo Type
XDo GhcTc
new_ty HsStmtContext Name
do_or_lc (SrcSpan
-> SrcSpanLess (Located [GuardLStmt GhcTc])
-> Located [GuardLStmt GhcTc]
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l [GuardLStmt GhcTc]
SrcSpanLess (Located [GuardLStmt GhcTc])
new_stmts))

zonkExpr ZonkEnv
env (ExplicitList XExplicitList GhcTc
ty Maybe (SyntaxExpr GhcTc)
wit [LHsExpr GhcTc]
exprs)
  = do (ZonkEnv
env1, Maybe (SyntaxExpr GhcTc)
new_wit) <- ZonkEnv
-> Maybe (SyntaxExpr GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
zonkWit ZonkEnv
env Maybe (SyntaxExpr GhcTc)
wit
       Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env1 Type
XExplicitList GhcTc
ty
       [LHsExpr GhcTc]
new_exprs <- ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc]
zonkLExprs ZonkEnv
env1 [LHsExpr GhcTc]
exprs
       HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitList GhcTc
-> Maybe (SyntaxExpr GhcTc) -> [LHsExpr GhcTc] -> HsExpr GhcTc
forall p.
XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
ExplicitList Type
XExplicitList GhcTc
new_ty Maybe (SyntaxExpr GhcTc)
new_wit [LHsExpr GhcTc]
new_exprs)
   where zonkWit :: ZonkEnv
-> Maybe (SyntaxExpr GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
zonkWit ZonkEnv
env Maybe (SyntaxExpr GhcTc)
Nothing    = (ZonkEnv, Maybe (SyntaxExpr GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Maybe (SyntaxExpr GhcTc)
forall a. Maybe a
Nothing)
         zonkWit ZonkEnv
env (Just SyntaxExpr GhcTc
fln) = (SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc))
-> (ZonkEnv, SyntaxExpr GhcTc)
-> (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc)
forall a. a -> Maybe a
Just ((ZonkEnv, SyntaxExpr GhcTc)
 -> (ZonkEnv, Maybe (SyntaxExpr GhcTc)))
-> TcM (ZonkEnv, SyntaxExpr GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
fln

zonkExpr ZonkEnv
env expr :: HsExpr GhcTc
expr@(RecordCon { rcon_ext :: forall p. HsExpr p -> XRecordCon p
rcon_ext = XRecordCon GhcTc
ext, 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 (RecordConTc -> HsExpr GhcTc
rcon_con_expr XRecordCon GhcTc
RecordConTc
ext)
        ; HsRecordBinds 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  = XRecordCon GhcTc
RecordConTc
ext { rcon_con_expr :: HsExpr GhcTc
rcon_con_expr = HsExpr GhcTc
new_con_expr }
                       , rcon_flds :: HsRecordBinds GhcTc
rcon_flds = HsRecordBinds GhcTc
new_rbinds }) }

zonkExpr ZonkEnv
env (RecordUpd { rupd_flds :: forall p. HsExpr p -> [LHsRecUpdField p]
rupd_flds = [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  { LHsExpr GhcTc
new_expr    <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
        ; [Type]
new_in_tys  <- (Type -> TcM Type) -> [Type] -> TcM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) [Type]
in_tys
        ; [Type]
new_out_tys <- (Type -> TcM Type) -> [Type] -> TcM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) [Type]
out_tys
        ; [LHsRecUpdField 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 -> [LHsRecUpdField p] -> HsExpr p
RecordUpd { rupd_expr :: LHsExpr GhcTc
rupd_expr = LHsExpr GhcTc
new_expr, rupd_flds :: [LHsRecUpdField GhcTc]
rupd_flds =  [LHsRecUpdField GhcTc]
new_rbinds
                            , rupd_ext :: XRecordUpd GhcTc
rupd_ext = RecordUpdTc :: [ConLike] -> [Type] -> [Type] -> HsWrapper -> RecordUpdTc
RecordUpdTc
                                { rupd_cons :: [ConLike]
rupd_cons = [ConLike]
cons, rupd_in_tys :: [Type]
rupd_in_tys = [Type]
new_in_tys
                                , rupd_out_tys :: [Type]
rupd_out_tys = [Type]
new_out_tys
                                , rupd_wrap :: HsWrapper
rupd_wrap = HsWrapper
new_recwrap }}) }

zonkExpr ZonkEnv
env (ExprWithTySig XExprWithTySig GhcTc
_ LHsExpr GhcTc
e LHsSigWcType (NoGhcTc GhcTc)
ty)
  = do { LHsExpr 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 XExprWithTySig GhcTc
NoExtField
noExtField LHsExpr GhcTc
e' LHsSigWcType (NoGhcTc GhcTc)
ty) }

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

zonkExpr ZonkEnv
env (HsSCC XSCC GhcTc
x SourceText
src StringLiteral
lbl LHsExpr GhcTc
expr)
  = do LHsExpr 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 (XSCC GhcTc
-> SourceText -> StringLiteral -> LHsExpr GhcTc -> HsExpr GhcTc
forall p.
XSCC p -> SourceText -> StringLiteral -> LHsExpr p -> HsExpr p
HsSCC XSCC GhcTc
x SourceText
src StringLiteral
lbl LHsExpr GhcTc
new_expr)

zonkExpr ZonkEnv
env (HsTickPragma XTickPragma GhcTc
x SourceText
src (StringLiteral, (ConTag, ConTag), (ConTag, ConTag))
info ((SourceText, SourceText), (SourceText, SourceText))
srcInfo LHsExpr GhcTc
expr)
  = do LHsExpr 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 (XTickPragma GhcTc
-> SourceText
-> (StringLiteral, (ConTag, ConTag), (ConTag, ConTag))
-> ((SourceText, SourceText), (SourceText, SourceText))
-> LHsExpr GhcTc
-> HsExpr GhcTc
forall p.
XTickPragma p
-> SourceText
-> (StringLiteral, (ConTag, ConTag), (ConTag, ConTag))
-> ((SourceText, SourceText), (SourceText, SourceText))
-> LHsExpr p
-> HsExpr p
HsTickPragma XTickPragma GhcTc
x SourceText
src (StringLiteral, (ConTag, ConTag), (ConTag, ConTag))
info ((SourceText, SourceText), (SourceText, SourceText))
srcInfo LHsExpr GhcTc
new_expr)

-- hdaume: core annotations
zonkExpr ZonkEnv
env (HsCoreAnn XCoreAnn GhcTc
x SourceText
src StringLiteral
lbl LHsExpr GhcTc
expr)
  = do LHsExpr 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 (XCoreAnn GhcTc
-> SourceText -> StringLiteral -> LHsExpr GhcTc -> HsExpr GhcTc
forall p.
XCoreAnn p -> SourceText -> StringLiteral -> LHsExpr p -> HsExpr p
HsCoreAnn XCoreAnn GhcTc
x SourceText
src StringLiteral
lbl LHsExpr GhcTc
new_expr)

-- arrow notation extensions
zonkExpr ZonkEnv
env (HsProc XProc GhcTc
x LPat GhcTc
pat LHsCmdTop GhcTc
body)
  = do  { (ZonkEnv
env1, Located (Pat GhcTc)
new_pat) <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat
        ; LHsCmdTop 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 Located (Pat GhcTc)
LPat GhcTc
new_pat LHsCmdTop GhcTc
new_body) }

-- StaticPointers extension
zonkExpr ZonkEnv
env (HsStatic XStatic GhcTc
fvs LHsExpr GhcTc
expr)
  = XStatic GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XStatic p -> LHsExpr p -> HsExpr p
HsStatic XStatic GhcTc
fvs (LHsExpr GhcTc -> HsExpr GhcTc)
-> TcM (LHsExpr 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 (HsWrap XWrap GhcTc
x HsWrapper
co_fn HsExpr GhcTc
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 (XWrap GhcTc -> HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
forall p. XWrap p -> HsWrapper -> HsExpr p -> HsExpr p
HsWrap XWrap GhcTc
x HsWrapper
new_co_fn HsExpr GhcTc
new_expr)

zonkExpr ZonkEnv
_ e :: HsExpr GhcTc
e@(HsUnboundVar {}) = HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return HsExpr GhcTc
e

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 TcMType.instSkolTyCoVarX.)
Now, we can safely just extend one environment.
-}

-- See Note [Skolems in zonkSyntaxExpr]
zonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTcId
               -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env (SyntaxExpr { syn_expr :: forall p. SyntaxExpr p -> HsExpr p
syn_expr      = HsExpr GhcTc
expr
                               , syn_arg_wraps :: forall p. SyntaxExpr p -> [HsWrapper]
syn_arg_wraps = [HsWrapper]
arg_wraps
                               , syn_res_wrap :: forall p. SyntaxExpr p -> HsWrapper
syn_res_wrap  = HsWrapper
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, SyntaxExpr GhcTc) -> TcM (ZonkEnv, SyntaxExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, SyntaxExpr :: forall p. HsExpr p -> [HsWrapper] -> HsWrapper -> SyntaxExpr p
SyntaxExpr { 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' }) }

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

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

zonkLCmd :: ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd  ZonkEnv
env LHsCmd GhcTc
cmd  = (SrcSpanLess (LHsCmd GhcTc) -> TcM (SrcSpanLess (LHsCmd GhcTc)))
-> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc)
zonkCmd ZonkEnv
env) LHsCmd GhcTc
cmd

zonkCmd :: ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc)
zonkCmd ZonkEnv
env (HsCmdWrap XCmdWrap GhcTc
x HsWrapper
w HsCmd GhcTc
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 (XCmdWrap GhcTc -> HsWrapper -> HsCmd GhcTc -> HsCmd GhcTc
forall id. XCmdWrap id -> HsWrapper -> HsCmd id -> HsCmd id
HsCmdWrap XCmdWrap GhcTc
x HsWrapper
w' HsCmd GhcTc
cmd') }
zonkCmd ZonkEnv
env (HsCmdArrApp XCmdArrApp GhcTc
ty LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 HsArrAppType
ho Bool
rl)
  = do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
       LHsExpr GhcTc
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
       Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XCmdArrApp GhcTc
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 Type
XCmdArrApp GhcTc
new_ty LHsExpr GhcTc
new_e1 LHsExpr 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 LHsExpr GhcTc
new_op <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
op
       [LHsCmdTop GhcTc]
new_args <- (LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc))
-> [LHsCmdTop GhcTc]
-> IOEnv (Env TcGblEnv TcLclEnv) [LHsCmdTop 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]
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
new_op LexicalFixity
f Maybe Fixity
fixity [LHsCmdTop GhcTc]
new_args)

zonkCmd ZonkEnv
env (HsCmdApp XCmdApp GhcTc
x LHsCmd GhcTc
c LHsExpr GhcTc
e)
  = do LHsCmd GhcTc
new_c <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env LHsCmd GhcTc
c
       LHsExpr 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
new_c LHsExpr GhcTc
new_e)

zonkCmd ZonkEnv
env (HsCmdLam XCmdLam GhcTc
x MatchGroup GhcTc (LHsCmd GhcTc)
matches)
  = do MatchGroup GhcTc (LHsCmd GhcTc)
new_matches <- ZonkEnv
-> (ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc))
-> MatchGroup GhcTc (LHsCmd GhcTc)
-> TcM (MatchGroup GhcTc (LHsCmd GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd MatchGroup GhcTc (LHsCmd 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)
new_matches)

zonkCmd ZonkEnv
env (HsCmdPar XCmdPar GhcTc
x LHsCmd GhcTc
c)
  = do LHsCmd 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 -> LHsCmd GhcTc -> HsCmd GhcTc
forall id. XCmdPar id -> LHsCmd id -> HsCmd id
HsCmdPar XCmdPar GhcTc
x LHsCmd GhcTc
new_c)

zonkCmd ZonkEnv
env (HsCmdCase XCmdCase GhcTc
x LHsExpr GhcTc
expr MatchGroup GhcTc (LHsCmd GhcTc)
ms)
  = do LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
       MatchGroup GhcTc (LHsCmd GhcTc)
new_ms <- ZonkEnv
-> (ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc))
-> MatchGroup GhcTc (LHsCmd GhcTc)
-> TcM (MatchGroup GhcTc (LHsCmd GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd MatchGroup GhcTc (LHsCmd 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
new_expr MatchGroup GhcTc (LHsCmd GhcTc)
new_ms)

zonkCmd ZonkEnv
env (HsCmdIf XCmdIf GhcTc
x Maybe (SyntaxExpr GhcTc)
eCond LHsExpr GhcTc
ePred LHsCmd GhcTc
cThen LHsCmd GhcTc
cElse)
  = do { (ZonkEnv
env1, Maybe (SyntaxExpr GhcTc)
new_eCond) <- ZonkEnv
-> Maybe (SyntaxExpr GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
zonkWit ZonkEnv
env Maybe (SyntaxExpr GhcTc)
eCond
       ; LHsExpr GhcTc
new_ePred <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env1 LHsExpr GhcTc
ePred
       ; LHsCmd GhcTc
new_cThen <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env1 LHsCmd GhcTc
cThen
       ; LHsCmd 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
-> Maybe (SyntaxExpr GhcTc)
-> LHsExpr GhcTc
-> LHsCmd GhcTc
-> LHsCmd GhcTc
-> HsCmd GhcTc
forall id.
XCmdIf id
-> Maybe (SyntaxExpr id)
-> LHsExpr id
-> LHsCmd id
-> LHsCmd id
-> HsCmd id
HsCmdIf XCmdIf GhcTc
x Maybe (SyntaxExpr GhcTc)
new_eCond LHsExpr GhcTc
new_ePred LHsCmd GhcTc
new_cThen LHsCmd GhcTc
new_cElse) }
  where
    zonkWit :: ZonkEnv
-> Maybe (SyntaxExpr GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
zonkWit ZonkEnv
env Maybe (SyntaxExpr GhcTc)
Nothing  = (ZonkEnv, Maybe (SyntaxExpr GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Maybe (SyntaxExpr GhcTc)
forall a. Maybe a
Nothing)
    zonkWit ZonkEnv
env (Just SyntaxExpr GhcTc
w) = (SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc))
-> (ZonkEnv, SyntaxExpr GhcTc)
-> (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc)
forall a. a -> Maybe a
Just ((ZonkEnv, SyntaxExpr GhcTc)
 -> (ZonkEnv, Maybe (SyntaxExpr GhcTc)))
-> TcM (ZonkEnv, SyntaxExpr GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
w

zonkCmd ZonkEnv
env (HsCmdLet XCmdLet GhcTc
x (LHsLocalBinds GhcTc -> Located (SrcSpanLess (LHsLocalBinds GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (LHsLocalBinds GhcTc)
binds) LHsCmd GhcTc
cmd)
  = do (ZonkEnv
new_env, HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
binds
       LHsCmd 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 -> LHsLocalBinds GhcTc -> LHsCmd GhcTc -> HsCmd GhcTc
forall id. XCmdLet id -> LHsLocalBinds id -> LHsCmd id -> HsCmd id
HsCmdLet XCmdLet GhcTc
x (SrcSpan -> SrcSpanLess (LHsLocalBinds GhcTc) -> LHsLocalBinds GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
new_binds) LHsCmd GhcTc
new_cmd)

zonkCmd ZonkEnv
env (HsCmdDo XCmdDo GhcTc
ty (Located [CmdLStmt GhcTc]
-> Located (SrcSpanLess (Located [CmdLStmt GhcTc]))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (Located [CmdLStmt GhcTc])
stmts))
  = do (ZonkEnv
_, [CmdLStmt GhcTc]
new_stmts) <- ZonkEnv
-> (ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc))
-> [CmdLStmt GhcTc]
-> TcM (ZonkEnv, [CmdLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd [CmdLStmt GhcTc]
SrcSpanLess (Located [CmdLStmt GhcTc])
stmts
       Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XCmdDo GhcTc
ty
       HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdDo GhcTc -> Located [CmdLStmt GhcTc] -> HsCmd GhcTc
forall id. XCmdDo id -> Located [CmdLStmt id] -> HsCmd id
HsCmdDo Type
XCmdDo GhcTc
new_ty (SrcSpan
-> SrcSpanLess (Located [CmdLStmt GhcTc])
-> Located [CmdLStmt GhcTc]
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l [CmdLStmt GhcTc]
SrcSpanLess (Located [CmdLStmt GhcTc])
new_stmts))

zonkCmd ZonkEnv
_ (XCmd XXCmd GhcTc
nec) = NoExtCon -> TcM (HsCmd GhcTc)
forall a. NoExtCon -> a
noExtCon XXCmd GhcTc
NoExtCon
nec



zonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTcId -> TcM (LHsCmdTop GhcTc)
zonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
zonkCmdTop ZonkEnv
env LHsCmdTop GhcTc
cmd = (SrcSpanLess (LHsCmdTop GhcTc)
 -> TcM (SrcSpanLess (LHsCmdTop GhcTc)))
-> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc)
zonk_cmd_top ZonkEnv
env) LHsCmdTop GhcTc
cmd

zonk_cmd_top :: ZonkEnv -> HsCmdTop GhcTcId -> 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 LHsCmd GhcTc
new_cmd <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env LHsCmd GhcTc
cmd
       Type
new_stack_tys <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
stack_tys
       Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
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

       MASSERT( isLiftedTypeKind (tcTypeKind new_stack_tys) )
         -- desugarer assumes that this is not levity 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 (Type -> Type -> [(Name, HsExpr GhcTc)] -> CmdTopTc
CmdTopTc Type
new_stack_tys Type
new_ty [(Name, HsExpr GhcTc)]
new_ids) LHsCmd GhcTc
new_cmd)
zonk_cmd_top ZonkEnv
_ (XCmdTop XXCmdTop GhcTc
nec) = NoExtCon -> TcM (HsCmdTop GhcTc)
forall a. NoExtCon -> a
noExtCon XXCmdTop GhcTc
NoExtCon
nec

-------------------------------------------------------------------------
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 Type
t1 SDoc
d) = 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
                                     ; Type
t1'         <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env2 Type
t1
                                     ; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, HsWrapper -> HsWrapper -> Type -> SDoc -> HsWrapper
WpFun HsWrapper
c1' HsWrapper
c2' Type
t1' SDoc
d) }
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 Id
ev)   = do { (ZonkEnv
env', Id
ev') <- ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkEvBndrX ZonkEnv
env Id
ev
                                 ; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', Id -> HsWrapper
WpEvLam Id
ev') }
zonkCoFn ZonkEnv
env (WpEvApp EvTerm
arg)  = do { EvTerm
arg' <- ZonkEnv -> EvTerm -> TcM 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 Id
tv)   = ASSERT( isImmutableTyVar tv )
                              do { (ZonkEnv
env', Id
tv') <- ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkTyBndrX ZonkEnv
env Id
tv
                                 ; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', Id -> HsWrapper
WpTyLam Id
tv') }
zonkCoFn ZonkEnv
env (WpTyApp Type
ty)   = do { Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
ty
                                 ; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Type -> HsWrapper
WpTyApp Type
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') }

-------------------------------------------------------------------------
zonkOverLit :: ZonkEnv -> HsOverLit GhcTcId -> 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 = OverLitTc r ty, ol_witness :: forall p. HsOverLit p -> HsExpr p
ol_witness = HsExpr GhcTc
e })
  = do  { Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
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_witness :: HsExpr GhcTc
ol_witness = HsExpr GhcTc
e', ol_ext :: XOverLit GhcTc
ol_ext = Bool -> Type -> OverLitTc
OverLitTc Bool
r Type
ty' }) }

zonkOverLit ZonkEnv
_ (XOverLit XXOverLit GhcTc
nec) = NoExtCon -> TcM (HsOverLit GhcTc)
forall a. NoExtCon -> a
noExtCon XXOverLit GhcTc
NoExtCon
nec

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

zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
zonkArithSeq ZonkEnv
env (From LHsExpr GhcTc
e)
  = do LHsExpr 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
new_e)

zonkArithSeq ZonkEnv
env (FromThen LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
  = do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
       LHsExpr 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
new_e1 LHsExpr GhcTc
new_e2)

zonkArithSeq ZonkEnv
env (FromTo LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
  = do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
       LHsExpr 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
new_e1 LHsExpr GhcTc
new_e2)

zonkArithSeq ZonkEnv
env (FromThenTo LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 LHsExpr GhcTc
e3)
  = do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
       LHsExpr GhcTc
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
       LHsExpr 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
new_e1 LHsExpr GhcTc
new_e2 LHsExpr GhcTc
new_e3)


-------------------------------------------------------------------------
zonkStmts :: ZonkEnv
          -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
          -> [LStmt GhcTcId (Located (body GhcTcId))]
          -> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
_ []     = (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, [])
zonkStmts ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (LStmt GhcTc (Located (body GhcTc))
s:[LStmt GhcTc (Located (body GhcTc))]
ss) = do { (ZonkEnv
env1, LStmt GhcTc (Located (body GhcTc))
s')  <- (SrcSpanLess (LStmt GhcTc (Located (body GhcTc)))
 -> TcM (ZonkEnv, SrcSpanLess (LStmt GhcTc (Located (body GhcTc)))))
-> LStmt GhcTc (Located (body GhcTc))
-> TcM (ZonkEnv, LStmt GhcTc (Located (body GhcTc)))
forall a c b.
(HasSrcSpan a, HasSrcSpan c) =>
(SrcSpanLess a -> TcM (b, SrcSpanLess c)) -> a -> TcM (b, c)
wrapLocSndM (ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> Stmt GhcTc (Located (body GhcTc))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> Stmt GhcTc (Located (body GhcTc))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
zonkStmt ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody) LStmt GhcTc (Located (body GhcTc))
s
                                ; (ZonkEnv
env2, [LStmt GhcTc (Located (body GhcTc))]
ss') <- ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env1 ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody [LStmt GhcTc (Located (body GhcTc))]
ss
                                ; (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, LStmt GhcTc (Located (body GhcTc))
s' LStmt GhcTc (Located (body GhcTc))
-> [LStmt GhcTc (Located (body GhcTc))]
-> [LStmt GhcTc (Located (body GhcTc))]
forall a. a -> [a] -> [a]
: [LStmt GhcTc (Located (body GhcTc))]
ss') }

zonkStmt :: ZonkEnv
         -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
         -> Stmt GhcTcId (Located (body GhcTcId))
         -> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
zonkStmt :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> Stmt GhcTc (Located (body GhcTc))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
zonkStmt ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
_ (ParStmt XParStmt GhcTc GhcTc (Located (body GhcTc))
bind_ty [ParStmtBlock GhcTc GhcTc]
stmts_w_bndrs HsExpr GhcTc
mzip_op SyntaxExpr GhcTc
bind_op)
  = do { (ZonkEnv
env1, SyntaxExpr GhcTc
new_bind_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_op
       ; Type
new_bind_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env1 Type
XParStmt GhcTc GhcTc (Located (body GhcTc))
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 :: [Id]
new_binders = [Id
b | ParStmtBlock XParStmtBlock GhcTc GhcTc
_ [GuardLStmt GhcTc]
_ [IdP GhcTc]
bs SyntaxExpr GhcTc
_ <- [ParStmtBlock GhcTc GhcTc]
new_stmts_w_bndrs
                              , Id
b <- [Id]
[IdP GhcTc]
bs]
             env2 :: ZonkEnv
env2 = ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env1 [Id]
new_binders
       ; HsExpr GhcTc
new_mzip <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env2 HsExpr GhcTc
mzip_op
       ; (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2
                , XParStmt GhcTc GhcTc (Located (body GhcTc))
-> [ParStmtBlock GhcTc GhcTc]
-> HsExpr GhcTc
-> SyntaxExpr GhcTc
-> Stmt GhcTc (Located (body GhcTc))
forall idL idR body.
XParStmt idL idR body
-> [ParStmtBlock idL idR]
-> HsExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
ParStmt Type
XParStmt GhcTc GhcTc (Located (body GhcTc))
new_bind_ty [ParStmtBlock GhcTc GhcTc]
new_stmts_w_bndrs HsExpr GhcTc
new_mzip SyntaxExpr GhcTc
new_bind_op)}
  where
    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, [GuardLStmt GhcTc]
new_stmts)  <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> TcM (ZonkEnv, [GuardLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env1 ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr [GuardLStmt GhcTc]
stmts
            ; (ZonkEnv
env3, SyntaxExpr GhcTc
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]
new_stmts (ZonkEnv -> [Id] -> [Id]
zonkIdOccs ZonkEnv
env3 [Id]
[IdP GhcTc]
bndrs)
                                                                   SyntaxExpr GhcTc
new_return) }
    zonk_branch ZonkEnv
_ (XParStmtBlock XXParStmtBlock GhcTc GhcTc
nec) = NoExtCon
-> IOEnv (Env TcGblEnv TcLclEnv) (ParStmtBlock GhcTc GhcTc)
forall a. NoExtCon -> a
noExtCon XXParStmtBlock GhcTc GhcTc
NoExtCon
nec

zonkStmt ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (RecStmt { recS_stmts :: forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
recS_stmts = [LStmtLR GhcTc GhcTc (Located (body GhcTc))]
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, SyntaxExpr GhcTc
new_bind_id) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_id
       ; (ZonkEnv
env2, SyntaxExpr GhcTc
new_mfix_id) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
mfix_id
       ; (ZonkEnv
env3, SyntaxExpr GhcTc
new_ret_id)  <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env2 SyntaxExpr GhcTc
ret_id
       ; Type
new_bind_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env3 Type
bind_ty
       ; [Id]
new_rvs <- ZonkEnv -> [Id] -> TcM [Id]
zonkIdBndrs ZonkEnv
env3 [Id]
[IdP GhcTc]
rvs
       ; [Id]
new_lvs <- ZonkEnv -> [Id] -> TcM [Id]
zonkIdBndrs ZonkEnv
env3 [Id]
[IdP GhcTc]
lvs
       ; Type
new_ret_ty  <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env3 Type
ret_ty
       ; let env4 :: ZonkEnv
env4 = ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env3 [Id]
new_rvs
       ; (ZonkEnv
env5, [LStmtLR GhcTc GhcTc (Located (body GhcTc))]
new_segStmts) <- ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmtLR GhcTc GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmtLR GhcTc GhcTc (Located (body GhcTc))])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env4 ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody [LStmtLR GhcTc GhcTc (Located (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 (Located (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env3 [Id]
new_lvs,     -- Only the lvs are needed
                 RecStmt :: forall idL idR body.
XRecStmt idL idR body
-> [LStmtLR idL idR body]
-> [IdP idR]
-> [IdP idR]
-> SyntaxExpr idR
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
RecStmt { recS_stmts :: [LStmtLR GhcTc GhcTc (Located (body GhcTc))]
recS_stmts = [LStmtLR GhcTc GhcTc (Located (body GhcTc))]
new_segStmts, recS_later_ids :: [IdP GhcTc]
recS_later_ids = [Id]
[IdP GhcTc]
new_lvs
                         , recS_rec_ids :: [IdP GhcTc]
recS_rec_ids = [Id]
[IdP GhcTc]
new_rvs, recS_ret_fn :: SyntaxExpr GhcTc
recS_ret_fn = SyntaxExpr GhcTc
new_ret_id
                         , recS_mfix_fn :: SyntaxExpr GhcTc
recS_mfix_fn = SyntaxExpr GhcTc
new_mfix_id, recS_bind_fn :: SyntaxExpr GhcTc
recS_bind_fn = SyntaxExpr GhcTc
new_bind_id
                         , recS_ext :: XRecStmt GhcTc GhcTc (Located (body GhcTc))
recS_ext = RecStmtTc :: Type -> [HsExpr GhcTc] -> [HsExpr GhcTc] -> Type -> RecStmtTc
RecStmtTc
                             { recS_bind_ty :: Type
recS_bind_ty = Type
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 :: Type
recS_ret_ty = Type
new_ret_ty } }) }

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

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

zonkStmt ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (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 (Located (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, SyntaxExpr GhcTc
bind_op') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_op
    ; Type
bind_arg_ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env1 Type
XTransStmt GhcTc GhcTc (Located (body GhcTc))
bind_arg_ty
    ; (ZonkEnv
env2, [GuardLStmt GhcTc]
stmts') <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> TcM (ZonkEnv, [GuardLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env1 ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr [GuardLStmt GhcTc]
stmts
    ; Maybe (LHsExpr GhcTc)
by'        <- (LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> Maybe (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (LHsExpr 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)
by
    ; LHsExpr GhcTc
using'     <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env2 LHsExpr GhcTc
using

    ; (ZonkEnv
env3, SyntaxExpr GhcTc
return_op') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env2 SyntaxExpr GhcTc
return_op
    ; [(Id, Id)]
binderMap' <- ((Id, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (Id, Id))
-> [(Id, Id)] -> IOEnv (Env TcGblEnv TcLclEnv) [(Id, Id)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> (Id, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (Id, Id)
zonkBinderMapEntry ZonkEnv
env3) [(Id, Id)]
[(IdP GhcTc, IdP GhcTc)]
binderMap
    ; HsExpr GhcTc
liftM_op'  <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env3 HsExpr GhcTc
liftM_op
    ; let env3' :: ZonkEnv
env3' = ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env3 (((Id, Id) -> Id) -> [(Id, Id)] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (Id, Id) -> Id
forall a b. (a, b) -> b
snd [(Id, Id)]
binderMap')
    ; (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (Located (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]
stmts', trS_bndrs :: [(IdP GhcTc, IdP GhcTc)]
trS_bndrs = [(Id, Id)]
[(IdP GhcTc, IdP GhcTc)]
binderMap'
                               , trS_by :: Maybe (LHsExpr GhcTc)
trS_by = Maybe (LHsExpr GhcTc)
by', trS_form :: TransForm
trS_form = TransForm
form, trS_using :: LHsExpr GhcTc
trS_using = LHsExpr GhcTc
using'
                               , trS_ret :: SyntaxExpr GhcTc
trS_ret = SyntaxExpr GhcTc
return_op', trS_bind :: SyntaxExpr GhcTc
trS_bind = SyntaxExpr GhcTc
bind_op'
                               , trS_ext :: XTransStmt GhcTc GhcTc (Located (body GhcTc))
trS_ext = Type
XTransStmt GhcTc GhcTc (Located (body GhcTc))
bind_arg_ty'
                               , trS_fmap :: HsExpr GhcTc
trS_fmap = HsExpr GhcTc
liftM_op' }) }
  where
    zonkBinderMapEntry :: ZonkEnv -> (Id, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (Id, Id)
zonkBinderMapEntry ZonkEnv
env  (Id
oldBinder, Id
newBinder) = do
        let oldBinder' :: Id
oldBinder' = ZonkEnv -> Id -> Id
zonkIdOcc ZonkEnv
env Id
oldBinder
        Id
newBinder' <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
newBinder
        (Id, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (Id, Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (Id
oldBinder', Id
newBinder')

zonkStmt ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
_ (LetStmt XLetStmt GhcTc GhcTc (Located (body GhcTc))
x (LHsLocalBinds GhcTc -> Located (SrcSpanLess (LHsLocalBinds GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (LHsLocalBinds GhcTc)
binds))
  = do (ZonkEnv
env1, HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
binds
       (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, XLetStmt GhcTc GhcTc (Located (body GhcTc))
-> LHsLocalBinds GhcTc -> Stmt GhcTc (Located (body GhcTc))
forall idL idR body.
XLetStmt idL idR body
-> LHsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcTc GhcTc (Located (body GhcTc))
x (SrcSpan -> SrcSpanLess (LHsLocalBinds GhcTc) -> LHsLocalBinds GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
new_binds))

zonkStmt ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (BindStmt XBindStmt GhcTc GhcTc (Located (body GhcTc))
bind_ty LPat GhcTc
pat Located (body GhcTc)
body SyntaxExpr GhcTc
bind_op SyntaxExpr GhcTc
fail_op)
  = do  { (ZonkEnv
env1, SyntaxExpr GhcTc
new_bind) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_op
        ; Type
new_bind_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env1 Type
XBindStmt GhcTc GhcTc (Located (body GhcTc))
bind_ty
        ; Located (body GhcTc)
new_body <- ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody ZonkEnv
env1 Located (body GhcTc)
body
        ; (ZonkEnv
env2, Located (Pat GhcTc)
new_pat) <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env1 LPat GhcTc
pat
        ; (ZonkEnv
_, SyntaxExpr GhcTc
new_fail) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
fail_op
        ; (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ZonkEnv
env2
                 , XBindStmt GhcTc GhcTc (Located (body GhcTc))
-> LPat GhcTc
-> Located (body GhcTc)
-> SyntaxExpr GhcTc
-> SyntaxExpr GhcTc
-> Stmt GhcTc (Located (body GhcTc))
forall idL idR body.
XBindStmt idL idR body
-> LPat idL
-> body
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
BindStmt Type
XBindStmt GhcTc GhcTc (Located (body GhcTc))
new_bind_ty Located (Pat GhcTc)
LPat GhcTc
new_pat Located (body GhcTc)
new_body SyntaxExpr GhcTc
new_bind SyntaxExpr GhcTc
new_fail) }

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

    get_pat :: (a, ApplicativeArg idL) -> XRec idL Pat
get_pat (a
_, ApplicativeArgOne XApplicativeArgOne idL
_ XRec idL Pat
pat LHsExpr idL
_ Bool
_ SyntaxExpr idL
_) = XRec idL Pat
pat
    get_pat (a
_, ApplicativeArgMany XApplicativeArgMany idL
_ [ExprLStmt idL]
_ HsExpr idL
_ XRec idL Pat
pat) = XRec idL Pat
pat
    get_pat (a
_, XApplicativeArg XXApplicativeArg idL
nec) = NoExtCon -> XRec idL Pat
forall a. NoExtCon -> a
noExtCon XXApplicativeArg idL
NoExtCon
nec

    replace_pat :: XRec idL Pat -> (a, ApplicativeArg idL) -> (a, ApplicativeArg idL)
replace_pat XRec idL Pat
pat (a
op, ApplicativeArgOne XApplicativeArgOne idL
x XRec idL Pat
_ LHsExpr idL
a Bool
isBody SyntaxExpr idL
fail_op)
      = (a
op, XApplicativeArgOne idL
-> XRec idL Pat
-> LHsExpr idL
-> Bool
-> SyntaxExpr idL
-> ApplicativeArg idL
forall idL.
XApplicativeArgOne idL
-> LPat idL
-> LHsExpr idL
-> Bool
-> SyntaxExpr idL
-> ApplicativeArg idL
ApplicativeArgOne XApplicativeArgOne idL
x XRec idL Pat
pat LHsExpr idL
a Bool
isBody SyntaxExpr idL
fail_op)
    replace_pat XRec idL Pat
pat (a
op, ApplicativeArgMany XApplicativeArgMany idL
x [ExprLStmt idL]
a HsExpr idL
b XRec idL Pat
_)
      = (a
op, XApplicativeArgMany idL
-> [ExprLStmt idL]
-> HsExpr idL
-> XRec idL Pat
-> ApplicativeArg idL
forall idL.
XApplicativeArgMany idL
-> [ExprLStmt idL] -> HsExpr idL -> LPat idL -> ApplicativeArg idL
ApplicativeArgMany XApplicativeArgMany idL
x [ExprLStmt idL]
a HsExpr idL
b XRec idL Pat
pat)
    replace_pat XRec idL Pat
_ (a
_, XApplicativeArg XXApplicativeArg idL
nec) = NoExtCon -> (a, ApplicativeArg idL)
forall a. NoExtCon -> a
noExtCon XXApplicativeArg idL
NoExtCon
nec

    zonk_args :: ZonkEnv
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
zonk_args ZonkEnv
env [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args
      = do { (ZonkEnv
env1, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
new_args_rev) <- ZonkEnv
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
zonk_args_rev ZonkEnv
env ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
forall a. [a] -> [a]
reverse [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args)
           ; (ZonkEnv
env2, [Located (Pat GhcTc)]
new_pats)     <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env1 (((SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> Located (Pat GhcTc))
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> [Located (Pat GhcTc)]
forall a b. (a -> b) -> [a] -> [b]
map (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> Located (Pat GhcTc)
forall idL a.
(XXApplicativeArg idL ~ NoExtCon) =>
(a, ApplicativeArg idL) -> XRec idL Pat
get_pat [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args)
           ; (ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, (Located (Pat GhcTc)
 -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
 -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc))
-> [Located (Pat GhcTc)]
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Located (Pat GhcTc)
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
forall idL a.
(XXApplicativeArg idL ~ NoExtCon) =>
XRec idL Pat -> (a, ApplicativeArg idL) -> (a, ApplicativeArg idL)
replace_pat [Located (Pat GhcTc)]
new_pats ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
forall a. [a] -> [a]
reverse [(SyntaxExpr GhcTc, 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
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
zonk_args_rev ZonkEnv
env ((SyntaxExpr GhcTc
op, ApplicativeArg GhcTc
arg) : [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args)
      = do { (ZonkEnv
env1, SyntaxExpr GhcTc
new_op)         <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env 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, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
new_args)       <- ZonkEnv
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
zonk_args_rev ZonkEnv
env1 [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args
           ; (ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, (SyntaxExpr GhcTc
new_op, ApplicativeArg GhcTc
new_arg) (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
forall a. a -> [a] -> [a]
: [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
new_args) }
    zonk_args_rev ZonkEnv
env [] = (ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv, [(SyntaxExpr GhcTc, 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
x LPat GhcTc
pat LHsExpr GhcTc
expr Bool
isBody SyntaxExpr GhcTc
fail_op)
      = do { LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
           ; (ZonkEnv
_, SyntaxExpr GhcTc
new_fail) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
fail_op
           ; ApplicativeArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XApplicativeArgOne GhcTc
-> LPat GhcTc
-> LHsExpr GhcTc
-> Bool
-> SyntaxExpr GhcTc
-> ApplicativeArg GhcTc
forall idL.
XApplicativeArgOne idL
-> LPat idL
-> LHsExpr idL
-> Bool
-> SyntaxExpr idL
-> ApplicativeArg idL
ApplicativeArgOne XApplicativeArgOne GhcTc
x LPat GhcTc
pat LHsExpr GhcTc
new_expr Bool
isBody SyntaxExpr GhcTc
new_fail) }
    zonk_arg ZonkEnv
env (ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
stmts HsExpr GhcTc
ret LPat GhcTc
pat)
      = do { (ZonkEnv
env1, [GuardLStmt GhcTc]
new_stmts) <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> TcM (ZonkEnv, [GuardLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr [GuardLStmt 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
-> ApplicativeArg GhcTc
forall idL.
XApplicativeArgMany idL
-> [ExprLStmt idL] -> HsExpr idL -> LPat idL -> ApplicativeArg idL
ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
new_stmts HsExpr GhcTc
new_ret LPat GhcTc
pat) }
    zonk_arg ZonkEnv
_ (XApplicativeArg XXApplicativeArg GhcTc
nec) = NoExtCon -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
forall a. NoExtCon -> a
noExtCon XXApplicativeArg GhcTc
NoExtCon
nec

zonkStmt ZonkEnv
_ ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
_ (XStmtLR XXStmtLR GhcTc GhcTc (Located (body GhcTc))
nec) = NoExtCon -> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall a. NoExtCon -> a
noExtCon XXStmtLR GhcTc GhcTc (Located (body GhcTc))
NoExtCon
nec

-------------------------------------------------------------------------
zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTcId -> TcM (HsRecordBinds GhcTcId)
zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc)
zonkRecFields ZonkEnv
env (HsRecFields [LHsRecField GhcTc (LHsExpr GhcTc)]
flds Maybe (Located ConTag)
dd)
  = do  { [LHsRecField GhcTc (LHsExpr GhcTc)]
flds' <- (LHsRecField GhcTc (LHsExpr GhcTc)
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsRecField GhcTc (LHsExpr GhcTc)))
-> [LHsRecField GhcTc (LHsExpr GhcTc)]
-> IOEnv
     (Env TcGblEnv TcLclEnv) [LHsRecField GhcTc (LHsExpr GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsRecField GhcTc (LHsExpr GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsRecField GhcTc (LHsExpr GhcTc))
zonk_rbind [LHsRecField GhcTc (LHsExpr GhcTc)]
flds
        ; HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsRecField GhcTc (LHsExpr GhcTc)]
-> Maybe (Located ConTag) -> HsRecordBinds GhcTc
forall p arg.
[LHsRecField p arg] -> Maybe (Located ConTag) -> HsRecFields p arg
HsRecFields [LHsRecField GhcTc (LHsExpr GhcTc)]
flds' Maybe (Located ConTag)
dd) }
  where
    zonk_rbind :: LHsRecField GhcTc (LHsExpr GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsRecField GhcTc (LHsExpr GhcTc))
zonk_rbind (LHsRecField GhcTc (LHsExpr GhcTc)
-> Located (SrcSpanLess (LHsRecField GhcTc (LHsExpr GhcTc)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (LHsRecField GhcTc (LHsExpr GhcTc))
fld)
      = do { Located (FieldOcc GhcTc)
new_id   <- (SrcSpanLess (Located (FieldOcc GhcTc))
 -> TcM (SrcSpanLess (Located (FieldOcc GhcTc))))
-> Located (FieldOcc GhcTc) -> TcM (Located (FieldOcc GhcTc))
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc ZonkEnv
env) (HsRecField' (FieldOcc GhcTc) (LHsExpr GhcTc)
-> Located (FieldOcc GhcTc)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl SrcSpanLess (LHsRecField GhcTc (LHsExpr GhcTc))
HsRecField' (FieldOcc GhcTc) (LHsExpr GhcTc)
fld)
           ; LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env (HsRecField' (FieldOcc GhcTc) (LHsExpr GhcTc) -> LHsExpr GhcTc
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg SrcSpanLess (LHsRecField GhcTc (LHsExpr GhcTc))
HsRecField' (FieldOcc GhcTc) (LHsExpr GhcTc)
fld)
           ; LHsRecField GhcTc (LHsExpr GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsRecField GhcTc (LHsExpr GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> SrcSpanLess (LHsRecField GhcTc (LHsExpr GhcTc))
-> LHsRecField GhcTc (LHsExpr GhcTc)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (SrcSpanLess (LHsRecField GhcTc (LHsExpr GhcTc))
HsRecField' (FieldOcc GhcTc) (LHsExpr GhcTc)
fld { hsRecFieldLbl :: Located (FieldOcc GhcTc)
hsRecFieldLbl = Located (FieldOcc GhcTc)
new_id
                              , hsRecFieldArg :: LHsExpr GhcTc
hsRecFieldArg = LHsExpr GhcTc
new_expr })) }

zonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTcId]
                 -> TcM [LHsRecUpdField GhcTcId]
zonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTc] -> TcM [LHsRecUpdField GhcTc]
zonkRecUpdFields ZonkEnv
env = (LHsRecUpdField GhcTc
 -> IOEnv (Env TcGblEnv TcLclEnv) (LHsRecUpdField GhcTc))
-> [LHsRecUpdField GhcTc] -> TcM [LHsRecUpdField GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsRecUpdField GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsRecUpdField GhcTc)
zonk_rbind
  where
    zonk_rbind :: LHsRecUpdField GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsRecUpdField GhcTc)
zonk_rbind (LHsRecUpdField GhcTc
-> Located (SrcSpanLess (LHsRecUpdField GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (LHsRecUpdField GhcTc)
fld)
      = do { Located (FieldOcc GhcTc)
new_id   <- (SrcSpanLess (Located (FieldOcc GhcTc))
 -> TcM (SrcSpanLess (Located (FieldOcc GhcTc))))
-> Located (FieldOcc GhcTc) -> TcM (Located (FieldOcc GhcTc))
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc ZonkEnv
env) (HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcTc)
-> Located (FieldOcc GhcTc)
forall arg.
HsRecField' (AmbiguousFieldOcc GhcTc) arg
-> Located (FieldOcc GhcTc)
hsRecUpdFieldOcc SrcSpanLess (LHsRecUpdField GhcTc)
HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcTc)
fld)
           ; LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env (HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcTc)
-> LHsExpr GhcTc
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg SrcSpanLess (LHsRecUpdField GhcTc)
HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcTc)
fld)
           ; LHsRecUpdField GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsRecUpdField GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> SrcSpanLess (LHsRecUpdField GhcTc) -> LHsRecUpdField GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (SrcSpanLess (LHsRecUpdField GhcTc)
HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcTc)
fld { hsRecFieldLbl :: Located (AmbiguousFieldOcc GhcTc)
hsRecFieldLbl = (FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc)
-> Located (FieldOcc GhcTc) -> Located (AmbiguousFieldOcc GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc
ambiguousFieldOcc Located (FieldOcc GhcTc)
new_id
                               , hsRecFieldArg :: LHsExpr GhcTc
hsRecFieldArg = LHsExpr GhcTc
new_expr })) }

-------------------------------------------------------------------------
mapIPNameTc :: (a -> TcM b) -> Either (Located HsIPName) a
            -> TcM (Either (Located HsIPName) b)
mapIPNameTc :: (a -> TcM b)
-> Either (Located HsIPName) a -> TcM (Either (Located HsIPName) b)
mapIPNameTc a -> TcM b
_ (Left Located HsIPName
x)  = Either (Located HsIPName) b -> TcM (Either (Located HsIPName) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located HsIPName -> Either (Located HsIPName) b
forall a b. a -> Either a b
Left Located HsIPName
x)
mapIPNameTc a -> TcM b
f (Right a
x) = do b
r <- a -> TcM b
f a
x
                             Either (Located HsIPName) b -> TcM (Either (Located HsIPName) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either (Located HsIPName) b
forall a b. b -> Either a b
Right b
r)

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

zonkPat :: ZonkEnv -> OutPat GhcTcId -> TcM (ZonkEnv, OutPat 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 = (SrcSpanLess (Located (Pat GhcTc))
 -> TcM (ZonkEnv, SrcSpanLess (Located (Pat GhcTc))))
-> Located (Pat GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Located (Pat GhcTc))
forall a c b.
(HasSrcSpan a, HasSrcSpan c) =>
(SrcSpanLess a -> TcM (b, SrcSpanLess c)) -> a -> TcM (b, c)
wrapLocSndM (ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc)
zonk_pat ZonkEnv
env) Located (Pat GhcTc)
LPat GhcTc
pat

zonk_pat :: ZonkEnv -> Pat GhcTcId -> TcM (ZonkEnv, Pat GhcTc)
zonk_pat :: ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc)
zonk_pat ZonkEnv
env (ParPat XParPat GhcTc
x LPat GhcTc
p)
  = do  { (ZonkEnv
env', Located (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 -> LPat GhcTc -> Pat GhcTc
forall p. XParPat p -> LPat p -> Pat p
ParPat XParPat GhcTc
x Located (Pat GhcTc)
LPat GhcTc
p') }

zonk_pat ZonkEnv
env (WildPat XWildPat GhcTc
ty)
  = do  { Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XWildPat GhcTc
ty
        ; Type -> SDoc -> TcM ()
ensureNotLevPoly Type
ty'
            (String -> SDoc
text String
"In a wildcard pattern")
        ; (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 Type
XWildPat GhcTc
ty') }

zonk_pat ZonkEnv
env (VarPat XVarPat GhcTc
x (Located (IdP GhcTc) -> Located (SrcSpanLess (Located Id))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (Located Id)
v))
  = do  { Id
v' <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env SrcSpanLess (Located Id)
Id
v
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> Id -> ZonkEnv
extendIdZonkEnv1 ZonkEnv
env Id
v', XVarPat GhcTc -> Located (IdP GhcTc) -> Pat GhcTc
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat XVarPat GhcTc
x (SrcSpan -> SrcSpanLess (Located Id) -> Located Id
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (Located Id)
Id
v')) }

zonk_pat ZonkEnv
env (LazyPat XLazyPat GhcTc
x LPat GhcTc
pat)
  = do  { (ZonkEnv
env', Located (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 Located (Pat GhcTc)
LPat GhcTc
pat') }

zonk_pat ZonkEnv
env (BangPat XBangPat GhcTc
x LPat GhcTc
pat)
  = do  { (ZonkEnv
env', Located (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 Located (Pat GhcTc)
LPat GhcTc
pat') }

zonk_pat ZonkEnv
env (AsPat XAsPat GhcTc
x (Located (IdP GhcTc) -> Located (SrcSpanLess (Located Id))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (Located Id)
v) LPat GhcTc
pat)
  = do  { Id
v' <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env SrcSpanLess (Located Id)
Id
v
        ; (ZonkEnv
env', Located (Pat GhcTc)
pat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat (ZonkEnv -> Id -> ZonkEnv
extendIdZonkEnv1 ZonkEnv
env Id
v') LPat GhcTc
pat
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XAsPat GhcTc -> Located (IdP GhcTc) -> LPat GhcTc -> Pat GhcTc
forall p. XAsPat p -> Located (IdP p) -> LPat p -> Pat p
AsPat XAsPat GhcTc
x (SrcSpan -> SrcSpanLess (Located Id) -> Located Id
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located Id)
Id
v') Located (Pat GhcTc)
LPat GhcTc
pat') }

zonk_pat ZonkEnv
env (ViewPat XViewPat GhcTc
ty LHsExpr GhcTc
expr LPat GhcTc
pat)
  = do  { LHsExpr GhcTc
expr' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
        ; (ZonkEnv
env', Located (Pat GhcTc)
pat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat
        ; Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XViewPat GhcTc
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 Type
XViewPat GhcTc
ty' LHsExpr GhcTc
expr' Located (Pat GhcTc)
LPat GhcTc
pat') }

zonk_pat ZonkEnv
env (ListPat (ListPatTc ty Nothing) [LPat GhcTc]
pats)
  = do  { Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
ty
        ; (ZonkEnv
env', [Located (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 (Type -> Maybe (Type, SyntaxExpr GhcTc) -> ListPatTc
ListPatTc Type
ty' Maybe (Type, SyntaxExpr GhcTc)
forall a. Maybe a
Nothing) [Located (Pat GhcTc)]
[LPat GhcTc]
pats') }

zonk_pat ZonkEnv
env (ListPat (ListPatTc ty (Just (ty2,wit))) [LPat GhcTc]
pats)
  = do  { (ZonkEnv
env', SyntaxExpr GhcTc
wit') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
wit
        ; Type
ty2' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env' Type
ty2
        ; Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env' Type
ty
        ; (ZonkEnv
env'', [Located (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 (Type -> Maybe (Type, SyntaxExpr GhcTc) -> ListPatTc
ListPatTc Type
ty' ((Type, SyntaxExpr GhcTc) -> Maybe (Type, SyntaxExpr GhcTc)
forall a. a -> Maybe a
Just (Type
ty2',SyntaxExpr GhcTc
wit'))) [Located (Pat GhcTc)]
[LPat GhcTc]
pats') }

zonk_pat ZonkEnv
env (TuplePat XTuplePat GhcTc
tys [LPat GhcTc]
pats Boxity
boxed)
  = do  { [Type]
tys' <- (Type -> TcM Type) -> [Type] -> TcM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) [Type]
XTuplePat GhcTc
tys
        ; (ZonkEnv
env', [Located (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 [Type]
XTuplePat GhcTc
tys' [Located (Pat GhcTc)]
[LPat GhcTc]
pats' Boxity
boxed) }

zonk_pat ZonkEnv
env (SumPat XSumPat GhcTc
tys LPat GhcTc
pat ConTag
alt ConTag
arity )
  = do  { [Type]
tys' <- (Type -> TcM Type) -> [Type] -> TcM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) [Type]
XSumPat GhcTc
tys
        ; (ZonkEnv
env', Located (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 [Type]
XSumPat GhcTc
tys' Located (Pat GhcTc)
LPat GhcTc
pat' ConTag
alt ConTag
arity) }

zonk_pat ZonkEnv
env p :: Pat GhcTc
p@(ConPatOut { pat_arg_tys :: forall p. Pat p -> [Type]
pat_arg_tys = [Type]
tys
                          , pat_tvs :: forall p. Pat p -> [Id]
pat_tvs = [Id]
tyvars
                          , pat_dicts :: forall p. Pat p -> [Id]
pat_dicts = [Id]
evs
                          , pat_binds :: forall p. Pat p -> TcEvBinds
pat_binds = TcEvBinds
binds
                          , pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails GhcTc
args
                          , pat_wrap :: forall p. Pat p -> HsWrapper
pat_wrap = HsWrapper
wrapper
                          , pat_con :: forall p. Pat p -> Located ConLike
pat_con = (Located ConLike -> Located (SrcSpanLess (Located ConLike))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ SrcSpanLess (Located ConLike)
con) })
  = ASSERT( all isImmutableTyVar tyvars )
    do  { [Type]
new_tys <- (Type -> TcM Type) -> [Type] -> TcM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) [Type]
tys

          -- an unboxed tuple pattern (but only an unboxed tuple pattern)
          -- might have levity-polymorphic arguments. Check for this badness.
        ; case SrcSpanLess (Located ConLike)
con of
            RealDataCon dc
              | TyCon -> Bool
isUnboxedTupleTyCon (DataCon -> TyCon
dataConTyCon DataCon
dc)
              -> (Type -> TcM ()) -> [Type] -> TcM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SDoc -> Type -> TcM ()
checkForLevPoly SDoc
doc) ([Type] -> [Type]
dropRuntimeRepArgs [Type]
new_tys)
            SrcSpanLess (Located ConLike)
_ -> () -> TcM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        ; (ZonkEnv
env0, [Id]
new_tyvars) <- ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
zonkTyBndrsX ZonkEnv
env [Id]
tyvars
          -- Must zonk the existential variables, because their
          -- /kind/ need potential zonking.
          -- cf typecheck/should_compile/tc221.hs
        ; (ZonkEnv
env1, [Id]
new_evs) <- ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
zonkEvBndrsX ZonkEnv
env0 [Id]
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
  (Located (Pat GhcTc)) (HsRecFields GhcTc (Located (Pat GhcTc)))
new_args) <- ZonkEnv
-> HsConPatDetails GhcTc -> TcM (ZonkEnv, HsConPatDetails GhcTc)
forall id.
ZonkEnv
-> HsConDetails (LPat GhcTc) (HsRecFields id (LPat GhcTc))
-> TcM
     (ZonkEnv, HsConDetails (LPat GhcTc) (HsRecFields id (LPat GhcTc)))
zonkConStuff ZonkEnv
env3 HsConPatDetails GhcTc
args
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', Pat GhcTc
p { pat_arg_tys :: [Type]
pat_arg_tys = [Type]
new_tys,
                            pat_tvs :: [Id]
pat_tvs = [Id]
new_tyvars,
                            pat_dicts :: [Id]
pat_dicts = [Id]
new_evs,
                            pat_binds :: TcEvBinds
pat_binds = TcEvBinds
new_binds,
                            pat_args :: HsConPatDetails GhcTc
pat_args = HsConDetails
  (Located (Pat GhcTc)) (HsRecFields GhcTc (Located (Pat GhcTc)))
HsConPatDetails GhcTc
new_args,
                            pat_wrap :: HsWrapper
pat_wrap = HsWrapper
new_wrapper}) }
  where
    doc :: SDoc
doc = String -> SDoc
text String
"In the type of an element of an unboxed tuple pattern:" SDoc -> SDoc -> SDoc
$$ Pat GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcTc
p

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 LHsSigWcType (NoGhcTc GhcTc)
hs_ty)
  = do  { Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XSigPat GhcTc
ty
        ; (ZonkEnv
env', Located (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 -> LHsSigWcType (NoGhcTc GhcTc) -> Pat GhcTc
forall p. XSigPat p -> LPat p -> LHsSigWcType (NoGhcTc p) -> Pat p
SigPat Type
XSigPat GhcTc
ty' Located (Pat GhcTc)
LPat GhcTc
pat' LHsSigWcType (NoGhcTc GhcTc)
hs_ty) }

zonk_pat ZonkEnv
env (NPat XNPat GhcTc
ty (Located (HsOverLit GhcTc)
-> Located (SrcSpanLess (Located (HsOverLit GhcTc)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (Located (HsOverLit GhcTc))
lit) Maybe (SyntaxExpr GhcTc)
mb_neg SyntaxExpr GhcTc
eq_expr)
  = do  { (ZonkEnv
env1, SyntaxExpr GhcTc
eq_expr') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
eq_expr
        ; (ZonkEnv
env2, Maybe (SyntaxExpr GhcTc)
mb_neg') <- case Maybe (SyntaxExpr GhcTc)
mb_neg of
            Maybe (SyntaxExpr GhcTc)
Nothing -> (ZonkEnv, Maybe (SyntaxExpr GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, Maybe (SyntaxExpr GhcTc)
forall a. Maybe a
Nothing)
            Just SyntaxExpr GhcTc
n  -> (SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc))
-> (ZonkEnv, SyntaxExpr GhcTc)
-> (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc)
forall a. a -> Maybe a
Just ((ZonkEnv, SyntaxExpr GhcTc)
 -> (ZonkEnv, Maybe (SyntaxExpr GhcTc)))
-> TcM (ZonkEnv, SyntaxExpr GhcTc)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
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 SrcSpanLess (Located (HsOverLit GhcTc))
HsOverLit GhcTc
lit
        ; Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env2 Type
XNPat GhcTc
ty
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, XNPat GhcTc
-> Located (HsOverLit GhcTc)
-> Maybe (SyntaxExpr GhcTc)
-> SyntaxExpr GhcTc
-> Pat GhcTc
forall p.
XNPat p
-> Located (HsOverLit p)
-> Maybe (SyntaxExpr p)
-> SyntaxExpr p
-> Pat p
NPat Type
XNPat GhcTc
ty' (SrcSpan
-> SrcSpanLess (Located (HsOverLit GhcTc))
-> Located (HsOverLit GhcTc)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (Located (HsOverLit GhcTc))
HsOverLit GhcTc
lit') Maybe (SyntaxExpr GhcTc)
mb_neg' SyntaxExpr GhcTc
eq_expr') }

zonk_pat ZonkEnv
env (NPlusKPat XNPlusKPat GhcTc
ty (Located (IdP GhcTc) -> Located (SrcSpanLess (Located Id))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (Located Id)
n) (Located (HsOverLit GhcTc)
-> Located (SrcSpanLess (Located (HsOverLit GhcTc)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (Located (HsOverLit GhcTc))
lit1) HsOverLit GhcTc
lit2 SyntaxExpr GhcTc
e1 SyntaxExpr GhcTc
e2)
  = do  { (ZonkEnv
env1, SyntaxExpr GhcTc
e1') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env  SyntaxExpr GhcTc
e1
        ; (ZonkEnv
env2, SyntaxExpr GhcTc
e2') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
e2
        ; Id
n' <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env2 SrcSpanLess (Located Id)
Id
n
        ; HsOverLit GhcTc
lit1' <- ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
zonkOverLit ZonkEnv
env2 SrcSpanLess (Located (HsOverLit GhcTc))
HsOverLit GhcTc
lit1
        ; HsOverLit GhcTc
lit2' <- ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
zonkOverLit ZonkEnv
env2 HsOverLit GhcTc
lit2
        ; Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env2 Type
XNPlusKPat GhcTc
ty
        ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> Id -> ZonkEnv
extendIdZonkEnv1 ZonkEnv
env2 Id
n',
                  XNPlusKPat GhcTc
-> Located (IdP GhcTc)
-> Located (HsOverLit GhcTc)
-> HsOverLit GhcTc
-> SyntaxExpr GhcTc
-> SyntaxExpr GhcTc
-> Pat GhcTc
forall p.
XNPlusKPat p
-> Located (IdP p)
-> Located (HsOverLit p)
-> HsOverLit p
-> SyntaxExpr p
-> SyntaxExpr p
-> Pat p
NPlusKPat Type
XNPlusKPat GhcTc
ty' (SrcSpan -> SrcSpanLess (Located Id) -> Located Id
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located Id)
Id
n') (SrcSpan
-> SrcSpanLess (Located (HsOverLit GhcTc))
-> Located (HsOverLit GhcTc)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (Located (HsOverLit GhcTc))
HsOverLit GhcTc
lit1') HsOverLit GhcTc
lit2' SyntaxExpr GhcTc
e1' SyntaxExpr GhcTc
e2') }

zonk_pat ZonkEnv
env (CoPat XCoPat GhcTc
x HsWrapper
co_fn Pat GhcTc
pat Type
ty)
  = do { (ZonkEnv
env', HsWrapper
co_fn') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
co_fn
       ; (ZonkEnv
env'', Located (Pat GhcTc)
pat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env' (SrcSpanLess (Located (Pat GhcTc)) -> Located (Pat GhcTc)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located (Pat GhcTc))
Pat GhcTc
pat)
       ; Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env'' Type
ty
       ; (ZonkEnv, Pat GhcTc) -> TcM (ZonkEnv, Pat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env'', XCoPat GhcTc -> HsWrapper -> Pat GhcTc -> Type -> Pat GhcTc
forall p. XCoPat p -> HsWrapper -> Pat p -> Type -> Pat p
CoPat XCoPat GhcTc
x HsWrapper
co_fn' (Located (Pat GhcTc) -> SrcSpanLess (Located (Pat GhcTc))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (Pat GhcTc)
pat') Type
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
             -> HsConDetails (OutPat GhcTcId) (HsRecFields id (OutPat GhcTcId))
             -> TcM (ZonkEnv,
                    HsConDetails (OutPat GhcTc) (HsRecFields id (OutPat GhcTc)))
zonkConStuff :: ZonkEnv
-> HsConDetails (LPat GhcTc) (HsRecFields id (LPat GhcTc))
-> TcM
     (ZonkEnv, HsConDetails (LPat GhcTc) (HsRecFields id (LPat GhcTc)))
zonkConStuff ZonkEnv
env (PrefixCon [LPat GhcTc]
pats)
  = do  { (ZonkEnv
env', [Located (Pat GhcTc)]
pats') <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env [LPat GhcTc]
pats
        ; (ZonkEnv,
 HsConDetails
   (Located (Pat GhcTc)) (HsRecFields id (Located (Pat GhcTc))))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv,
      HsConDetails
        (Located (Pat GhcTc)) (HsRecFields id (Located (Pat GhcTc))))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', [Located (Pat GhcTc)]
-> HsConDetails
     (Located (Pat GhcTc)) (HsRecFields id (Located (Pat GhcTc)))
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon [Located (Pat GhcTc)]
pats') }

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

zonkConStuff ZonkEnv
env (RecCon (HsRecFields [LHsRecField id (LPat GhcTc)]
rpats Maybe (Located ConTag)
dd))
  = do  { (ZonkEnv
env', [Located (Pat GhcTc)]
pats') <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env ((LHsRecField id (Located (Pat GhcTc)) -> Located (Pat GhcTc))
-> [LHsRecField id (Located (Pat GhcTc))] -> [Located (Pat GhcTc)]
forall a b. (a -> b) -> [a] -> [b]
map (HsRecField' (FieldOcc id) (Located (Pat GhcTc))
-> Located (Pat GhcTc)
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg (HsRecField' (FieldOcc id) (Located (Pat GhcTc))
 -> Located (Pat GhcTc))
-> (LHsRecField id (Located (Pat GhcTc))
    -> HsRecField' (FieldOcc id) (Located (Pat GhcTc)))
-> LHsRecField id (Located (Pat GhcTc))
-> Located (Pat GhcTc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsRecField id (Located (Pat GhcTc))
-> HsRecField' (FieldOcc id) (Located (Pat GhcTc))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LHsRecField id (Located (Pat GhcTc))]
[LHsRecField id (LPat GhcTc)]
rpats)
        ; let rpats' :: [LHsRecField id (Located (Pat GhcTc))]
rpats' = (LHsRecField id (Located (Pat GhcTc))
 -> Located (Pat GhcTc) -> LHsRecField id (Located (Pat GhcTc)))
-> [LHsRecField id (Located (Pat GhcTc))]
-> [Located (Pat GhcTc)]
-> [LHsRecField id (Located (Pat GhcTc))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(LHsRecField id (Located (Pat GhcTc))
-> Located (SrcSpanLess (LHsRecField id (Located (Pat GhcTc))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l SrcSpanLess (LHsRecField id (Located (Pat GhcTc)))
rp) Located (Pat GhcTc)
p' ->
                                  SrcSpan
-> SrcSpanLess (LHsRecField id (Located (Pat GhcTc)))
-> LHsRecField id (Located (Pat GhcTc))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (SrcSpanLess (LHsRecField id (Located (Pat GhcTc)))
HsRecField' (FieldOcc id) (Located (Pat GhcTc))
rp { hsRecFieldArg :: Located (Pat GhcTc)
hsRecFieldArg = Located (Pat GhcTc)
p' }))
                               [LHsRecField id (Located (Pat GhcTc))]
[LHsRecField id (LPat GhcTc)]
rpats [Located (Pat GhcTc)]
pats'
        ; (ZonkEnv,
 HsConDetails
   (Located (Pat GhcTc)) (HsRecFields id (Located (Pat GhcTc))))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (ZonkEnv,
      HsConDetails
        (Located (Pat GhcTc)) (HsRecFields id (Located (Pat GhcTc))))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', HsRecFields id (Located (Pat GhcTc))
-> HsConDetails
     (Located (Pat GhcTc)) (HsRecFields id (Located (Pat GhcTc)))
forall arg rec. rec -> HsConDetails arg rec
RecCon ([LHsRecField id (Located (Pat GhcTc))]
-> Maybe (Located ConTag) -> HsRecFields id (Located (Pat GhcTc))
forall p arg.
[LHsRecField p arg] -> Maybe (Located ConTag) -> HsRecFields p arg
HsRecFields [LHsRecField id (Located (Pat GhcTc))]
rpats' Maybe (Located ConTag)
dd)) }
        -- Field selectors have declared types; hence no zonking

---------------------------
zonkPats :: ZonkEnv -> [OutPat GhcTcId] -> TcM (ZonkEnv, [OutPat GhcTc])
zonkPats :: ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env []         = (ZonkEnv, [Located (Pat GhcTc)])
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [Located (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, Located (Pat GhcTc)
pat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat
                             ; (ZonkEnv
env', [Located (Pat GhcTc)]
pats') <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env1 [LPat GhcTc]
pats
                             ; (ZonkEnv, [Located (Pat GhcTc)])
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [Located (Pat GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', Located (Pat GhcTc)
pat'Located (Pat GhcTc)
-> [Located (Pat GhcTc)] -> [Located (Pat GhcTc)]
forall a. a -> [a] -> [a]
:[Located (Pat GhcTc)]
pats') }

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

zonkForeignExports :: ZonkEnv -> [LForeignDecl GhcTcId]
                   -> TcM [LForeignDecl GhcTc]
zonkForeignExports :: ZonkEnv -> [LForeignDecl GhcTc] -> TcM [LForeignDecl GhcTc]
zonkForeignExports ZonkEnv
env [LForeignDecl GhcTc]
ls = (LForeignDecl GhcTc
 -> IOEnv (Env TcGblEnv TcLclEnv) (LForeignDecl GhcTc))
-> [LForeignDecl GhcTc] -> TcM [LForeignDecl GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((SrcSpanLess (LForeignDecl GhcTc)
 -> TcM (SrcSpanLess (LForeignDecl GhcTc)))
-> LForeignDecl GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (LForeignDecl GhcTc)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> ForeignDecl GhcTc -> TcM (ForeignDecl GhcTc)
zonkForeignExport ZonkEnv
env)) [LForeignDecl GhcTc]
ls

zonkForeignExport :: ZonkEnv -> ForeignDecl GhcTcId -> TcM (ForeignDecl GhcTc)
zonkForeignExport :: ZonkEnv -> ForeignDecl GhcTc -> TcM (ForeignDecl GhcTc)
zonkForeignExport ZonkEnv
env (ForeignExport { fd_name :: forall pass. ForeignDecl pass -> Located (IdP pass)
fd_name = Located (IdP 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
-> Located (IdP pass)
-> LHsSigType pass
-> ForeignExport
-> ForeignDecl pass
ForeignExport { fd_name :: Located (IdP GhcTc)
fd_name = ZonkEnv -> Located Id -> Located Id
zonkLIdOcc ZonkEnv
env Located Id
Located (IdP GhcTc)
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 GhcTcId] -> TcM [LRuleDecl GhcTc]
zonkRules :: ZonkEnv -> [LRuleDecl GhcTc] -> TcM [LRuleDecl GhcTc]
zonkRules ZonkEnv
env [LRuleDecl GhcTc]
rs = (LRuleDecl GhcTc
 -> IOEnv (Env TcGblEnv TcLclEnv) (LRuleDecl GhcTc))
-> [LRuleDecl GhcTc] -> TcM [LRuleDecl GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((SrcSpanLess (LRuleDecl GhcTc)
 -> TcM (SrcSpanLess (LRuleDecl GhcTc)))
-> LRuleDecl GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (LRuleDecl GhcTc)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> RuleDecl GhcTc -> TcM (RuleDecl GhcTc)
zonkRule ZonkEnv
env)) [LRuleDecl GhcTc]
rs

zonkRule :: ZonkEnv -> RuleDecl GhcTcId -> 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 -> Located (HsExpr pass)
rd_lhs = LHsExpr GhcTc
lhs
                          , rd_rhs :: forall pass. RuleDecl pass -> Located (HsExpr pass)
rd_rhs = LHsExpr GhcTc
rhs })
  = do { (ZonkEnv
env_inside, [LRuleBndr GhcTc]
new_tm_bndrs) <- (ZonkEnv
 -> LRuleBndr GhcTc
 -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, LRuleBndr GhcTc))
-> ZonkEnv
-> [LRuleBndr GhcTc]
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [LRuleBndr GhcTc])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv
-> LRuleBndr GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, LRuleBndr GhcTc)
forall a b pass pass.
(HasSrcSpan a, HasSrcSpan b, XCRuleBndr pass ~ XCRuleBndr pass,
 IdP pass ~ Id, SrcSpanLess b ~ RuleBndr pass,
 SrcSpanLess a ~ RuleBndr pass, IdP pass ~ Id,
 XXRuleBndr pass ~ NoExtCon) =>
ZonkEnv -> a -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, b)
zonk_tm_bndr ZonkEnv
env [LRuleBndr 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]

       ; LHsExpr GhcTc
new_lhs <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env_lhs    LHsExpr GhcTc
lhs
       ; LHsExpr 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]
new_tm_bndrs
                       , rd_lhs :: LHsExpr GhcTc
rd_lhs  = LHsExpr GhcTc
new_lhs
                       , rd_rhs :: LHsExpr GhcTc
rd_rhs  = LHsExpr GhcTc
new_rhs } }
  where
   zonk_tm_bndr :: ZonkEnv -> a -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, b)
zonk_tm_bndr ZonkEnv
env (a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
l (RuleBndr x (dL->L loc v)))
      = do { (ZonkEnv
env', Id
v') <- ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonk_it ZonkEnv
env SrcSpanLess (Located (IdP pass))
Id
v
           ; (ZonkEnv, b) -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', SrcSpan -> SrcSpanLess b -> b
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (XCRuleBndr pass -> Located (IdP pass) -> RuleBndr pass
forall pass. XCRuleBndr pass -> Located (IdP pass) -> RuleBndr pass
RuleBndr XCRuleBndr pass
XCRuleBndr pass
x (SrcSpan -> SrcSpanLess (Located (IdP pass)) -> Located (IdP pass)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located (IdP pass))
Id
v'))) }
   zonk_tm_bndr ZonkEnv
_ (a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (RuleBndrSig {})) = String -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, b)
forall a. String -> a
panic String
"zonk_tm_bndr RuleBndrSig"
   zonk_tm_bndr ZonkEnv
_ (a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
_ (XRuleBndr nec)) = NoExtCon -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, b)
forall a. NoExtCon -> a
noExtCon XXRuleBndr pass
NoExtCon
nec
   zonk_tm_bndr ZonkEnv
_ a
_ = String -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, b)
forall a. String -> a
panic String
"zonk_tm_bndr: Impossible Match"
                            -- due to #15884

   zonk_it :: ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonk_it ZonkEnv
env Id
v
     | Id -> Bool
isId Id
v     = do { Id
v' <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
v
                       ; (ZonkEnv, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env [Id
v'], Id
v') }
     | Bool
otherwise  = ASSERT( isImmutableTyVar v)
                    ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkTyBndrX ZonkEnv
env Id
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!
zonkRule ZonkEnv
_ (XRuleDecl XXRuleDecl GhcTc
nec) = NoExtCon -> TcM (RuleDecl GhcTc)
forall a. NoExtCon -> a
noExtCon XXRuleDecl GhcTc
NoExtCon
nec

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

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

zonkCoreExpr :: ZonkEnv -> CoreExpr -> TcM CoreExpr
zonkCoreExpr :: ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env (Var Id
v)
    | Id -> Bool
isCoVar Id
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 -> Id -> TcM TcCoercionR
zonkCoVarOcc ZonkEnv
env Id
v
    | Bool
otherwise
    = EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> EvExpr
forall b. Id -> Expr b
Var (Id -> EvExpr) -> Id -> EvExpr
forall a b. (a -> b) -> a -> b
$ ZonkEnv -> Id -> Id
zonkIdOcc ZonkEnv
env Id
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 Type
ty)
    = Type -> EvExpr
forall b. Type -> Expr b
Type (Type -> EvExpr)
-> TcM Type -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
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 Tickish Id
t EvExpr
e)
    = Tickish Id -> EvExpr -> EvExpr
forall b. Tickish Id -> Expr b -> Expr b
Tick Tickish Id
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 Id
v EvExpr
e)
    = do { (ZonkEnv
env1, Id
v') <- ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkCoreBndrX ZonkEnv
env Id
v
         ; Id -> EvExpr -> EvExpr
forall b. b -> Expr b -> Expr b
Lam Id
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 Id
bind EvExpr
e)
    = do (ZonkEnv
env1, Bind Id
bind') <- ZonkEnv -> Bind Id -> TcM (ZonkEnv, Bind Id)
zonkCoreBind ZonkEnv
env Bind Id
bind
         Bind Id -> EvExpr -> EvExpr
forall b. Bind b -> Expr b -> Expr b
Let Bind Id
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 Id
b Type
ty [Alt Id]
alts)
    = do EvExpr
scrut' <- ZonkEnv -> EvExpr -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
zonkCoreExpr ZonkEnv
env EvExpr
scrut
         Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
ty
         Id
b' <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
b
         let env1 :: ZonkEnv
env1 = ZonkEnv -> Id -> ZonkEnv
extendIdZonkEnv1 ZonkEnv
env Id
b'
         [Alt Id]
alts' <- (Alt Id -> IOEnv (Env TcGblEnv TcLclEnv) (Alt Id))
-> [Alt Id] -> IOEnv (Env TcGblEnv TcLclEnv) [Alt Id]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Alt Id -> IOEnv (Env TcGblEnv TcLclEnv) (Alt Id)
zonkCoreAlt ZonkEnv
env1) [Alt Id]
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 -> Id -> Type -> [Alt Id] -> EvExpr
forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case EvExpr
scrut' Id
b' Type
ty' [Alt Id]
alts'

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

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

zonkCorePair :: ZonkEnv -> (CoreBndr, CoreExpr) -> TcM (CoreBndr, CoreExpr)
zonkCorePair :: ZonkEnv
-> (Id, EvExpr) -> IOEnv (Env TcGblEnv TcLclEnv) (Id, EvExpr)
zonkCorePair ZonkEnv
env (Id
v,EvExpr
e) = (,) (Id -> EvExpr -> (Id, EvExpr))
-> TcM Id -> IOEnv (Env TcGblEnv TcLclEnv) (EvExpr -> (Id, EvExpr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
v IOEnv (Env TcGblEnv TcLclEnv) (EvExpr -> (Id, EvExpr))
-> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
-> IOEnv (Env TcGblEnv TcLclEnv) (Id, 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 -> TcM 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 -> TcM 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 -> TcM EvTerm
zonkEvTerm ZonkEnv
env EvTerm
t1
       ; EvTerm
t2' <- ZonkEnv -> EvTerm -> TcM 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
t1 EvTerm
t2)
  = do { EvTerm
t1' <- ZonkEnv -> EvTerm -> TcM EvTerm
zonkEvTerm ZonkEnv
env EvTerm
t1
       ; EvTerm
t2' <- ZonkEnv -> EvTerm -> TcM EvTerm
zonkEvTerm ZonkEnv
env EvTerm
t2
       ; EvTypeable -> IOEnv (Env TcGblEnv TcLclEnv) EvTypeable
forall (m :: * -> *) a. Monad m => a -> m a
return (EvTerm -> EvTerm -> EvTypeable
EvTypeableTrFun EvTerm
t1' EvTerm
t2') }
zonkEvTypeable ZonkEnv
env (EvTypeableTyLit EvTerm
t1)
  = do { EvTerm
t1' <- ZonkEnv -> EvTerm -> TcM 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 -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env (Bag EvBind -> [Id]
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 -> [Id]
collect_ev_bndrs = (EvBind -> [Id] -> [Id]) -> [Id] -> Bag EvBind -> [Id]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr EvBind -> [Id] -> [Id]
add []
    add :: EvBind -> [Id] -> [Id]
add (EvBind { eb_lhs :: EvBind -> Id
eb_lhs = Id
var }) [Id]
vars = Id
var Id -> [Id] -> [Id]
forall a. a -> [a] -> [a]
: [Id]
vars

zonkEvBind :: ZonkEnv -> EvBind -> TcM EvBind
zonkEvBind :: ZonkEnv -> EvBind -> IOEnv (Env TcGblEnv TcLclEnv) EvBind
zonkEvBind ZonkEnv
env bind :: EvBind
bind@(EvBind { eb_lhs :: EvBind -> Id
eb_lhs = Id
var, eb_rhs :: EvBind -> EvTerm
eb_rhs = EvTerm
term })
  = do { Id
var'  <- {-# SCC "zonkEvBndr" #-} ZonkEnv -> Id -> TcM Id
zonkEvBndr ZonkEnv
env Id
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 Type -> Maybe (Role, Type, Type)
getEqPredTys_maybe (Id -> Type
idType Id
var') of
           Just (Role
r, Type
ty1, Type
ty2) | Type
ty1 Type -> Type -> Bool
`eqType` Type
ty2
                  -> EvTerm -> TcM EvTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (TcCoercionR -> EvTerm
evCoercion (Role -> Type -> TcCoercionR
mkTcReflCo Role
r Type
ty1))
           Maybe (Role, Type, Type)
_other -> ZonkEnv -> EvTerm -> TcM 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 :: Id
eb_lhs = Id
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 TcMType.zonkTcTyVar, we short-circuit (Indirect ty) to
    (Indirect zty), see Note [Sharing in zonking] in 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
    TcTyClsDecls.

    Now we call zonkTcTypeToType on that (alpha -> alpha). If we follow
    the same path as Note [Sharing in zonking] in 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!)

Solution: (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 turns out to be viable from a perf point of view

    But the code implements something a bit better

    * ZonkEnv contains ze_meta_tv_env, which maps
          from a MetaTyVar (unificaion 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.)

    Is the extra work worth it?  Some non-sytematic perf measurements
    suggest that compiler allocation is reduced overall (by 0.5% or so)
    but compile time really doesn't change.
-}

zonkTyVarOcc :: ZonkEnv -> TyVar -> TcM TcType
zonkTyVarOcc :: ZonkEnv -> Id -> TcM Type
zonkTyVarOcc env :: ZonkEnv
env@(ZonkEnv { ze_flexi :: ZonkEnv -> ZonkFlexi
ze_flexi = ZonkFlexi
flexi
                          , ze_tv_env :: ZonkEnv -> TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id
tv_env
                          , ze_meta_tv_env :: ZonkEnv -> TcRef (TyVarEnv Type)
ze_meta_tv_env = TcRef (TyVarEnv Type)
mtv_env_ref }) Id
tv
  | Id -> Bool
isTcTyVar Id
tv
  = case Id -> TcTyVarDetails
tcTyVarDetails Id
tv of
      SkolemTv {}    -> TcM Type
lookup_in_tv_env
      RuntimeUnk {}  -> TcM Type
lookup_in_tv_env
      MetaTv { mtv_ref :: TcTyVarDetails -> IORef MetaDetails
mtv_ref = IORef MetaDetails
ref }
        -> do { TyVarEnv Type
mtv_env <- TcRef (TyVarEnv Type) -> TcRnIf TcGblEnv TcLclEnv (TyVarEnv Type)
forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
readTcRef TcRef (TyVarEnv Type)
mtv_env_ref
                -- See Note [Sharing when zonking to Type]
              ; case TyVarEnv Type -> Id -> Maybe Type
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv TyVarEnv Type
mtv_env Id
tv of
                  Just Type
ty -> Type -> TcM Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
ty
                  Maybe Type
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
                                ; TyVarEnv Type -> IORef MetaDetails -> MetaDetails -> TcM Type
zonk_meta TyVarEnv Type
mtv_env IORef MetaDetails
ref MetaDetails
mtv_details } }
  | Bool
otherwise
  = TcM Type
lookup_in_tv_env

  where
    lookup_in_tv_env :: TcM Type
lookup_in_tv_env    -- Look up in the env just as we do for Ids
      = case TyCoVarEnv Id -> Id -> Maybe Id
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv TyCoVarEnv Id
tv_env Id
tv of
          Maybe Id
Nothing  -> Id -> Type
mkTyVarTy (Id -> Type) -> TcM Id -> TcM Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> TcM Type) -> Id -> TcM Id
forall (m :: * -> *). Monad m => (Type -> m Type) -> Id -> m Id
updateTyVarKindM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) Id
tv
          Just Id
tv' -> Type -> TcM Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Type
mkTyVarTy Id
tv')

    zonk_meta :: TyVarEnv Type -> IORef MetaDetails -> MetaDetails -> TcM Type
zonk_meta TyVarEnv Type
mtv_env IORef MetaDetails
ref MetaDetails
Flexi
      = do { Type
kind <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env (Id -> Type
tyVarKind Id
tv)
           ; Type
ty <- ZonkFlexi -> Id -> Type -> TcM Type
commitFlexi ZonkFlexi
flexi Id
tv Type
kind
           ; Id -> IORef MetaDetails -> Type -> TcM ()
writeMetaTyVarRef Id
tv IORef MetaDetails
ref Type
ty  -- Belt and braces
           ; TyVarEnv Type -> Type -> TcM Type
finish_meta TyVarEnv Type
mtv_env Type
ty }

    zonk_meta TyVarEnv Type
mtv_env IORef MetaDetails
_ (Indirect Type
ty)
      = do { Type
zty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
ty
           ; TyVarEnv Type -> Type -> TcM Type
finish_meta TyVarEnv Type
mtv_env Type
zty }

    finish_meta :: TyVarEnv Type -> Type -> TcM Type
finish_meta TyVarEnv Type
mtv_env Type
ty
      = do { let mtv_env' :: TyVarEnv Type
mtv_env' = TyVarEnv Type -> Id -> Type -> TyVarEnv Type
forall a. VarEnv a -> Id -> a -> VarEnv a
extendVarEnv TyVarEnv Type
mtv_env Id
tv Type
ty
           ; TcRef (TyVarEnv Type) -> TyVarEnv Type -> TcM ()
forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
writeTcRef TcRef (TyVarEnv Type)
mtv_env_ref TyVarEnv Type
mtv_env'
           ; Type -> TcM Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
ty }

lookupTyVarOcc :: ZonkEnv -> TcTyVar -> Maybe TyVar
lookupTyVarOcc :: ZonkEnv -> Id -> Maybe Id
lookupTyVarOcc (ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id
tv_env }) Id
tv
  = TyCoVarEnv Id -> Id -> Maybe Id
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv TyCoVarEnv Id
tv_env Id
tv

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

      ZonkFlexi
DefaultFlexi
        | Type -> Bool
isRuntimeRepTy Type
zonked_kind
        -> do { String -> SDoc -> TcM ()
traceTc String
"Defaulting flexi tyvar to LiftedRep:" (Id -> SDoc
pprTyVar Id
tv)
              ; Type -> TcM Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
liftedRepTy }
        | Bool
otherwise
        -> do { String -> SDoc -> TcM ()
traceTc String
"Defaulting flexi tyvar to Any:" (Id -> SDoc
pprTyVar Id
tv)
              ; Type -> TcM Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Type
anyTypeOfKind Type
zonked_kind) }

      ZonkFlexi
RuntimeUnkFlexi
        -> do { String -> SDoc -> TcM ()
traceTc String
"Defaulting flexi tyvar to RuntimeUnk:" (Id -> SDoc
pprTyVar Id
tv)
              ; Type -> TcM Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Type
mkTyVarTy (Name -> Type -> TcTyVarDetails -> Id
mkTcTyVar Name
name Type
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
  where
     name :: Name
name = Id -> Name
tyVarName Id
tv

zonkCoVarOcc :: ZonkEnv -> CoVar -> TcM Coercion
zonkCoVarOcc :: ZonkEnv -> Id -> TcM TcCoercionR
zonkCoVarOcc (ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id
tyco_env }) Id
cv
  | Just Id
cv' <- TyCoVarEnv Id -> Id -> Maybe Id
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv TyCoVarEnv Id
tyco_env Id
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
$ Id -> TcCoercionR
mkCoVarCo Id
cv'
  | Bool
otherwise
  = do { Id
cv' <- Id -> TcM Id
zonkCoVar Id
cv; TcCoercionR -> TcM TcCoercionR
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> TcCoercionR
mkCoVarCo Id
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 -> Id
ch_co_var = Id
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
                         ; Id -> TcCoercionR -> TcM TcCoercionR
checkCoercionHole Id
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 -> TcM ()
traceTc String
"Zonking unfilled coercion hole" (CoercionHole -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoercionHole
hole)
                         ; Bool -> TcM () -> TcM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugIsOn (TcM () -> TcM ()) -> TcM () -> TcM ()
forall a b. (a -> b) -> a -> b
$
                           TcM () -> TcM ()
whenNoErrs (TcM () -> TcM ()) -> TcM () -> TcM ()
forall a b. (a -> b) -> a -> b
$
                           MASSERT2( False
                                   , text "Type-correct unfilled coercion hole"
                                     <+> ppr hole )
                         ; Id
cv' <- Id -> TcM Id
zonkCoVar Id
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
$ Id -> TcCoercionR
mkCoVarCo Id
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 -> Id -> m Type)
-> (env -> Id -> m TcCoercionR)
-> (env -> CoercionHole -> m TcCoercionR)
-> (env -> Id -> ArgFlag -> m (env, Id))
-> (TyCon -> m TyCon)
-> TyCoMapper env m
TyCoMapper
  { tcm_tyvar :: ZonkEnv -> Id -> TcM Type
tcm_tyvar      = ZonkEnv -> Id -> TcM Type
zonkTyVarOcc
  , tcm_covar :: ZonkEnv -> Id -> TcM TcCoercionR
tcm_covar      = ZonkEnv -> Id -> TcM TcCoercionR
zonkCoVarOcc
  , tcm_hole :: ZonkEnv -> CoercionHole -> TcM TcCoercionR
tcm_hole       = ZonkEnv -> CoercionHole -> TcM TcCoercionR
zonkCoHole
  , tcm_tycobinder :: ZonkEnv
-> Id -> ArgFlag -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
tcm_tycobinder = \ZonkEnv
env Id
tv ArgFlag
_vis -> ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkTyBndrX ZonkEnv
env Id
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 TcMType.
zonkTcTypeToType :: TcType -> TcM Type
zonkTcTypeToType :: Type -> TcM Type
zonkTcTypeToType Type
ty = (ZonkEnv -> TcM Type) -> TcM Type
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM Type) -> TcM Type)
-> (ZonkEnv -> TcM Type) -> TcM Type
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze -> ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
ze Type
ty

zonkTcTypeToTypeX :: ZonkEnv -> TcType -> TcM Type
zonkTcTypeToTypeX :: ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX = TyCoMapper ZonkEnv TcM -> ZonkEnv -> Type -> TcM Type
forall (m :: * -> *) env.
Monad m =>
TyCoMapper env m -> env -> Type -> m Type
mapType TyCoMapper ZonkEnv TcM
zonk_tycomapper

zonkTcTypesToTypes :: [TcType] -> TcM [Type]
zonkTcTypesToTypes :: [Type] -> TcM [Type]
zonkTcTypesToTypes [Type]
tys = (ZonkEnv -> TcM [Type]) -> TcM [Type]
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM [Type]) -> TcM [Type])
-> (ZonkEnv -> TcM [Type]) -> TcM [Type]
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze -> ZonkEnv -> [Type] -> TcM [Type]
zonkTcTypesToTypesX ZonkEnv
ze [Type]
tys

zonkTcTypesToTypesX :: ZonkEnv -> [TcType] -> TcM [Type]
zonkTcTypesToTypesX :: ZonkEnv -> [Type] -> TcM [Type]
zonkTcTypesToTypesX ZonkEnv
env [Type]
tys = (Type -> TcM Type) -> [Type] -> TcM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) [Type]
tys

zonkCoToCo :: ZonkEnv -> Coercion -> TcM Coercion
zonkCoToCo :: ZonkEnv -> TcCoercionR -> TcM TcCoercionR
zonkCoToCo = TyCoMapper ZonkEnv TcM -> ZonkEnv -> TcCoercionR -> TcM TcCoercionR
forall (m :: * -> *) env.
Monad m =>
TyCoMapper env m -> env -> TcCoercionR -> m TcCoercionR
mapCoercion TyCoMapper ZonkEnv TcM
zonk_tycomapper

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

---------------------------------------
{- Note [Zonking the LHS of a RULE]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See also DsBinds 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 DsBinds, we quantify over it.  See DsBinds
  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)
-}