{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Tc.Utils.Zonk (
mkHsDictLet, mkHsApp,
mkHsAppTy, mkHsCaseAlt,
tcShortCutLit, shortCutLit, hsOverLitName,
conLikeResTy,
TcId, TcIdSet,
zonkTopDecls, zonkTopExpr, zonkTopLExpr,
zonkTopBndrs,
ZonkEnv, ZonkFlexi(..), emptyZonkEnv, mkEmptyZonkEnv, initZonkEnv,
zonkTyVarBindersX, zonkTyVarBinderX,
zonkTyBndrs, zonkTyBndrsX,
zonkTcTypeToType, zonkTcTypeToTypeX,
zonkTcTypesToTypesX, zonkScaledTcTypesToTypesX,
zonkTyVarOcc,
zonkCoToCo,
zonkEvBinds, zonkTcEvBinds,
zonkTcMethInfoToMethInfoX,
lookupTyVarX
) where
import GHC.Prelude
import GHC.Platform
import GHC.Builtin.Types
import GHC.Builtin.Names
import GHC.Hs
import {-# SOURCE #-} GHC.Tc.Gen.Splice (runTopSplice)
import GHC.Tc.Utils.Monad
import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo )
import GHC.Tc.Utils.TcType
import GHC.Tc.Utils.TcMType
import GHC.Tc.Utils.Env ( tcLookupGlobalOnly )
import GHC.Tc.Types.Evidence
import GHC.Core.TyCo.Ppr ( pprTyVar )
import GHC.Core.TyCon
import GHC.Core.Type
import GHC.Core.Coercion
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Core.Multiplicity
import GHC.Core
import GHC.Core.Predicate
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.TypeEnv
import GHC.Types.SourceText
import GHC.Types.Basic
import GHC.Types.SrcLoc
import GHC.Types.Unique.FM
import GHC.Types.TyThing
import GHC.Driver.Session( getDynFlags, targetPlatform )
import GHC.Data.Maybe
import GHC.Data.Bag
import Control.Monad
import Data.List ( partition )
import Control.Arrow ( second )
tcShortCutLit :: HsOverLit GhcRn -> ExpRhoType -> TcM (Maybe (HsOverLit GhcTc))
tcShortCutLit :: HsOverLit GhcRn -> ExpRhoType -> TcM (Maybe (HsOverLit GhcTc))
tcShortCutLit lit :: HsOverLit GhcRn
lit@(OverLit { ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = OverLitVal
val, ol_ext :: forall p. HsOverLit p -> XOverLit p
ol_ext = OverLitRn Bool
rebindable LIdP GhcRn
_}) ExpRhoType
exp_res_ty
| Bool -> Bool
not Bool
rebindable
, Just Kind
res_ty <- ExpRhoType -> Maybe Kind
checkingExpType_maybe ExpRhoType
exp_res_ty
= do { DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
; case Platform -> OverLitVal -> Kind -> Maybe (HsExpr GhcTc)
shortCutLit Platform
platform OverLitVal
val Kind
res_ty of
Just HsExpr GhcTc
expr -> Maybe (HsOverLit GhcTc) -> TcM (Maybe (HsOverLit GhcTc))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (HsOverLit GhcTc) -> TcM (Maybe (HsOverLit GhcTc)))
-> Maybe (HsOverLit GhcTc) -> TcM (Maybe (HsOverLit GhcTc))
forall a b. (a -> b) -> a -> b
$ HsOverLit GhcTc -> Maybe (HsOverLit GhcTc)
forall a. a -> Maybe a
Just (HsOverLit GhcTc -> Maybe (HsOverLit GhcTc))
-> HsOverLit GhcTc -> Maybe (HsOverLit GhcTc)
forall a b. (a -> b) -> a -> b
$
HsOverLit GhcRn
lit { ol_ext :: XOverLit GhcTc
ol_ext = Bool -> HsExpr GhcTc -> Kind -> OverLitTc
OverLitTc Bool
False HsExpr GhcTc
expr Kind
res_ty }
Maybe (HsExpr GhcTc)
Nothing -> Maybe (HsOverLit GhcTc) -> TcM (Maybe (HsOverLit GhcTc))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (HsOverLit GhcTc)
forall a. Maybe a
Nothing }
| Bool
otherwise
= Maybe (HsOverLit GhcTc) -> TcM (Maybe (HsOverLit GhcTc))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (HsOverLit GhcTc)
forall a. Maybe a
Nothing
shortCutLit :: Platform -> OverLitVal -> TcType -> Maybe (HsExpr GhcTc)
shortCutLit :: Platform -> OverLitVal -> Kind -> Maybe (HsExpr GhcTc)
shortCutLit Platform
platform OverLitVal
val Kind
res_ty
= case OverLitVal
val of
HsIntegral IntegralLit
int_lit -> IntegralLit -> Maybe (HsExpr GhcTc)
go_integral IntegralLit
int_lit
HsFractional FractionalLit
frac_lit -> FractionalLit -> Maybe (HsExpr GhcTc)
go_fractional FractionalLit
frac_lit
HsIsString SourceText
s FastString
src -> SourceText -> FastString -> Maybe (HsExpr GhcTc)
go_string SourceText
s FastString
src
where
go_integral :: IntegralLit -> Maybe (HsExpr GhcTc)
go_integral int :: IntegralLit
int@(IL SourceText
src Bool
neg Integer
i)
| Kind -> Bool
isIntTy Kind
res_ty Bool -> Bool -> Bool
&& Platform -> Integer -> Bool
platformInIntRange Platform
platform Integer
i
= HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
EpAnn NoEpAnns
forall a. EpAnn a
noAnn (XHsInt GhcTc -> IntegralLit -> HsLit GhcTc
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt XHsInt GhcTc
NoExtField
noExtField IntegralLit
int))
| Kind -> Bool
isWordTy Kind
res_ty Bool -> Bool -> Bool
&& Platform -> Integer -> Bool
platformInWordRange Platform
platform Integer
i
= HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit DataCon
wordDataCon (XHsWordPrim GhcTc -> Integer -> HsLit GhcTc
forall x. XHsWordPrim x -> Integer -> HsLit x
HsWordPrim XHsWordPrim GhcTc
SourceText
src Integer
i))
| Kind -> Bool
isIntegerTy Kind
res_ty
= HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
EpAnn NoEpAnns
forall a. EpAnn a
noAnn (XHsInteger GhcTc -> Integer -> Kind -> HsLit GhcTc
forall x. XHsInteger x -> Integer -> Kind -> HsLit x
HsInteger XHsInteger GhcTc
SourceText
src Integer
i Kind
res_ty))
| Bool
otherwise
= FractionalLit -> Maybe (HsExpr GhcTc)
go_fractional (Bool -> Integer -> FractionalLit
integralFractionalLit Bool
neg Integer
i)
go_fractional :: FractionalLit -> Maybe (HsExpr GhcTc)
go_fractional FractionalLit
f
| Kind -> Bool
isFloatTy Kind
res_ty Bool -> Bool -> Bool
&& Bool
valueInRange = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit DataCon
floatDataCon (XHsFloatPrim GhcTc -> FractionalLit -> HsLit GhcTc
forall x. XHsFloatPrim x -> FractionalLit -> HsLit x
HsFloatPrim XHsFloatPrim GhcTc
NoExtField
noExtField FractionalLit
f))
| Kind -> Bool
isDoubleTy Kind
res_ty Bool -> Bool -> Bool
&& Bool
valueInRange = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit DataCon
doubleDataCon (XHsDoublePrim GhcTc -> FractionalLit -> HsLit GhcTc
forall x. XHsDoublePrim x -> FractionalLit -> HsLit x
HsDoublePrim XHsDoublePrim GhcTc
NoExtField
noExtField FractionalLit
f))
| Bool
otherwise = Maybe (HsExpr GhcTc)
forall a. Maybe a
Nothing
where
valueInRange :: Bool
valueInRange =
case FractionalLit
f of
FL { fl_exp :: FractionalLit -> Integer
fl_exp = Integer
e } -> (-Integer
100) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
e Bool -> Bool -> Bool
&& Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
100
go_string :: SourceText -> FastString -> Maybe (HsExpr GhcTc)
go_string SourceText
src FastString
s
| Kind -> Bool
isStringTy Kind
res_ty = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
EpAnn NoEpAnns
forall a. EpAnn a
noAnn (XHsString GhcTc -> FastString -> HsLit GhcTc
forall x. XHsString x -> FastString -> HsLit x
HsString XHsString GhcTc
SourceText
src FastString
s))
| Bool
otherwise = Maybe (HsExpr GhcTc)
forall a. Maybe a
Nothing
mkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit DataCon
con HsLit GhcTc
lit = XApp GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcTc
EpAnn NoEpAnns
noComments (DataCon -> LHsExpr GhcTc
nlHsDataCon DataCon
con) (HsLit GhcTc -> LHsExpr GhcTc
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
nlHsLit HsLit GhcTc
lit)
hsOverLitName :: OverLitVal -> Name
hsOverLitName :: OverLitVal -> Name
hsOverLitName (HsIntegral {}) = Name
fromIntegerName
hsOverLitName (HsFractional {}) = Name
fromRationalName
hsOverLitName (HsIsString {}) = Name
fromStringName
data ZonkEnv
= ZonkEnv { ZonkEnv -> ZonkFlexi
ze_flexi :: ZonkFlexi
, ZonkEnv -> TyCoVarEnv TcTyVar
ze_tv_env :: TyCoVarEnv TyCoVar
, ZonkEnv -> TyCoVarEnv TcTyVar
ze_id_env :: IdEnv Id
, ZonkEnv -> TcRef (TyVarEnv Kind)
ze_meta_tv_env :: TcRef (TyVarEnv Type) }
data ZonkFlexi
= DefaultFlexi
| SkolemiseFlexi
| RuntimeUnkFlexi
| NoFlexi
instance Outputable ZonkEnv where
ppr :: ZonkEnv -> SDoc
ppr (ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv TcTyVar
ze_tv_env = TyCoVarEnv TcTyVar
tv_env
, ze_id_env :: ZonkEnv -> TyCoVarEnv TcTyVar
ze_id_env = TyCoVarEnv TcTyVar
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 TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCoVarEnv TcTyVar
tv_env
, String -> SDoc
text String
"ze_id_env =" SDoc -> SDoc -> SDoc
<+> TyCoVarEnv TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCoVarEnv TcTyVar
id_env ])
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 Kind)
mtv_env_ref <- TyVarEnv Kind -> TcRnIf TcGblEnv TcLclEnv (TcRef (TyVarEnv Kind))
forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
newTcRef TyVarEnv Kind
forall a. VarEnv a
emptyVarEnv
; ZonkEnv -> TcM ZonkEnv
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv { ze_flexi :: ZonkFlexi
ze_flexi = ZonkFlexi
flexi
, ze_tv_env :: TyCoVarEnv TcTyVar
ze_tv_env = TyCoVarEnv TcTyVar
forall a. VarEnv a
emptyVarEnv
, ze_id_env :: TyCoVarEnv TcTyVar
ze_id_env = TyCoVarEnv TcTyVar
forall a. VarEnv a
emptyVarEnv
, ze_meta_tv_env :: TcRef (TyVarEnv Kind)
ze_meta_tv_env = TcRef (TyVarEnv Kind)
mtv_env_ref }) }
initZonkEnv :: (ZonkEnv -> TcM b) -> TcM b
initZonkEnv :: forall b. (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 }
extendIdZonkEnvRec :: ZonkEnv -> [Var] -> ZonkEnv
extendIdZonkEnvRec :: ZonkEnv -> [TcTyVar] -> ZonkEnv
extendIdZonkEnvRec ze :: ZonkEnv
ze@(ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv TcTyVar
ze_id_env = TyCoVarEnv TcTyVar
id_env }) [TcTyVar]
ids
= ZonkEnv
ze { ze_id_env :: TyCoVarEnv TcTyVar
ze_id_env = TyCoVarEnv TcTyVar -> [(TcTyVar, TcTyVar)] -> TyCoVarEnv TcTyVar
forall a. VarEnv a -> [(TcTyVar, a)] -> VarEnv a
extendVarEnvList TyCoVarEnv TcTyVar
id_env [(TcTyVar
id,TcTyVar
id) | TcTyVar
id <- [TcTyVar]
ids] }
extendZonkEnv :: ZonkEnv -> [Var] -> ZonkEnv
extendZonkEnv :: ZonkEnv -> [TcTyVar] -> ZonkEnv
extendZonkEnv ze :: ZonkEnv
ze@(ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv TcTyVar
ze_tv_env = TyCoVarEnv TcTyVar
tyco_env, ze_id_env :: ZonkEnv -> TyCoVarEnv TcTyVar
ze_id_env = TyCoVarEnv TcTyVar
id_env }) [TcTyVar]
vars
= ZonkEnv
ze { ze_tv_env :: TyCoVarEnv TcTyVar
ze_tv_env = TyCoVarEnv TcTyVar -> [(TcTyVar, TcTyVar)] -> TyCoVarEnv TcTyVar
forall a. VarEnv a -> [(TcTyVar, a)] -> VarEnv a
extendVarEnvList TyCoVarEnv TcTyVar
tyco_env [(TcTyVar
tv,TcTyVar
tv) | TcTyVar
tv <- [TcTyVar]
tycovars]
, ze_id_env :: TyCoVarEnv TcTyVar
ze_id_env = TyCoVarEnv TcTyVar -> [(TcTyVar, TcTyVar)] -> TyCoVarEnv TcTyVar
forall a. VarEnv a -> [(TcTyVar, a)] -> VarEnv a
extendVarEnvList TyCoVarEnv TcTyVar
id_env [(TcTyVar
id,TcTyVar
id) | TcTyVar
id <- [TcTyVar]
ids] }
where
([TcTyVar]
tycovars, [TcTyVar]
ids) = (TcTyVar -> Bool) -> [TcTyVar] -> ([TcTyVar], [TcTyVar])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition TcTyVar -> Bool
isTyCoVar [TcTyVar]
vars
extendIdZonkEnv :: ZonkEnv -> Var -> ZonkEnv
extendIdZonkEnv :: ZonkEnv -> TcTyVar -> ZonkEnv
extendIdZonkEnv ze :: ZonkEnv
ze@(ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv TcTyVar
ze_id_env = TyCoVarEnv TcTyVar
id_env }) TcTyVar
id
= ZonkEnv
ze { ze_id_env :: TyCoVarEnv TcTyVar
ze_id_env = TyCoVarEnv TcTyVar -> TcTyVar -> TcTyVar -> TyCoVarEnv TcTyVar
forall a. VarEnv a -> TcTyVar -> a -> VarEnv a
extendVarEnv TyCoVarEnv TcTyVar
id_env TcTyVar
id TcTyVar
id }
extendTyZonkEnv :: ZonkEnv -> TyVar -> ZonkEnv
extendTyZonkEnv :: ZonkEnv -> TcTyVar -> ZonkEnv
extendTyZonkEnv ze :: ZonkEnv
ze@(ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv TcTyVar
ze_tv_env = TyCoVarEnv TcTyVar
ty_env }) TcTyVar
tv
= ZonkEnv
ze { ze_tv_env :: TyCoVarEnv TcTyVar
ze_tv_env = TyCoVarEnv TcTyVar -> TcTyVar -> TcTyVar -> TyCoVarEnv TcTyVar
forall a. VarEnv a -> TcTyVar -> a -> VarEnv a
extendVarEnv TyCoVarEnv TcTyVar
ty_env TcTyVar
tv TcTyVar
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 TcTyVar
ze_id_env = TyCoVarEnv TcTyVar
id_env})
= [(Name, TyThing)] -> TypeEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(TcTyVar -> Name
forall a. NamedThing a => a -> Name
getName TcTyVar
id, TcTyVar -> TyThing
AnId TcTyVar
id) | TcTyVar
id <- TyCoVarEnv TcTyVar -> [TcTyVar]
forall key elt. UniqFM key elt -> [elt]
nonDetEltsUFM TyCoVarEnv TcTyVar
id_env]
zonkLIdOcc :: ZonkEnv -> LocatedN TcId -> LocatedN Id
zonkLIdOcc :: ZonkEnv
-> GenLocated SrcSpanAnnN TcTyVar -> GenLocated SrcSpanAnnN TcTyVar
zonkLIdOcc ZonkEnv
env = (TcTyVar -> TcTyVar)
-> GenLocated SrcSpanAnnN TcTyVar -> GenLocated SrcSpanAnnN TcTyVar
forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc (ZonkEnv -> TcTyVar -> TcTyVar
zonkIdOcc ZonkEnv
env)
zonkIdOcc :: ZonkEnv -> TcId -> Id
zonkIdOcc :: ZonkEnv -> TcTyVar -> TcTyVar
zonkIdOcc (ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv TcTyVar
ze_id_env = TyCoVarEnv TcTyVar
id_env}) TcTyVar
id
| TcTyVar -> Bool
isLocalVar TcTyVar
id = TyCoVarEnv TcTyVar -> TcTyVar -> Maybe TcTyVar
forall a. VarEnv a -> TcTyVar -> Maybe a
lookupVarEnv TyCoVarEnv TcTyVar
id_env TcTyVar
id Maybe TcTyVar -> TcTyVar -> TcTyVar
forall a. Maybe a -> a -> a
`orElse`
TcTyVar
id
| Bool
otherwise = TcTyVar
id
zonkIdOccs :: ZonkEnv -> [TcId] -> [Id]
zonkIdOccs :: ZonkEnv -> [TcTyVar] -> [TcTyVar]
zonkIdOccs ZonkEnv
env [TcTyVar]
ids = (TcTyVar -> TcTyVar) -> [TcTyVar] -> [TcTyVar]
forall a b. (a -> b) -> [a] -> [b]
map (ZonkEnv -> TcTyVar -> TcTyVar
zonkIdOcc ZonkEnv
env) [TcTyVar]
ids
zonkIdBndr :: ZonkEnv -> TcId -> TcM Id
zonkIdBndr :: ZonkEnv -> TcTyVar -> TcM TcTyVar
zonkIdBndr ZonkEnv
env TcTyVar
v
= do Scaled Kind
w' Kind
ty' <- ZonkEnv -> Scaled Kind -> TcM (Scaled Kind)
zonkScaledTcTypeToTypeX ZonkEnv
env (TcTyVar -> Scaled Kind
idScaledType TcTyVar
v)
TcTyVar -> TcM TcTyVar
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((() :: Constraint) => (IdInfo -> IdInfo) -> TcTyVar -> TcTyVar
(IdInfo -> IdInfo) -> TcTyVar -> TcTyVar
modifyIdInfo (IdInfo -> Kind -> IdInfo
`setLevityInfoWithType` Kind
ty') (TcTyVar -> Kind -> TcTyVar
setIdMult (TcTyVar -> Kind -> TcTyVar
setIdType TcTyVar
v Kind
ty') Kind
w'))
zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id]
zonkIdBndrs :: ZonkEnv -> [TcTyVar] -> TcM [TcTyVar]
zonkIdBndrs ZonkEnv
env [TcTyVar]
ids = (TcTyVar -> TcM TcTyVar) -> [TcTyVar] -> TcM [TcTyVar]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ZonkEnv -> TcTyVar -> TcM TcTyVar
zonkIdBndr ZonkEnv
env) [TcTyVar]
ids
zonkTopBndrs :: [TcId] -> TcM [Id]
zonkTopBndrs :: [TcTyVar] -> TcM [TcTyVar]
zonkTopBndrs [TcTyVar]
ids = (ZonkEnv -> TcM [TcTyVar]) -> TcM [TcTyVar]
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM [TcTyVar]) -> TcM [TcTyVar])
-> (ZonkEnv -> TcM [TcTyVar]) -> TcM [TcTyVar]
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze -> ZonkEnv -> [TcTyVar] -> TcM [TcTyVar]
zonkIdBndrs ZonkEnv
ze [TcTyVar]
ids
zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc ZonkEnv
env (FieldOcc XCFieldOcc GhcTc
sel XRec GhcTc RdrName
lbl)
= (TcTyVar -> FieldOcc GhcTc) -> TcM TcTyVar -> TcM (FieldOcc GhcTc)
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((TcTyVar -> GenLocated SrcSpanAnnN RdrName -> FieldOcc GhcTc)
-> GenLocated SrcSpanAnnN RdrName -> TcTyVar -> FieldOcc GhcTc
forall a b c. (a -> b -> c) -> b -> a -> c
flip XCFieldOcc GhcTc -> XRec GhcTc RdrName -> FieldOcc GhcTc
TcTyVar -> GenLocated SrcSpanAnnN RdrName -> FieldOcc GhcTc
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc) XRec GhcTc RdrName
GenLocated SrcSpanAnnN RdrName
lbl) (TcM TcTyVar -> TcM (FieldOcc GhcTc))
-> TcM TcTyVar -> TcM (FieldOcc GhcTc)
forall a b. (a -> b) -> a -> b
$ ZonkEnv -> TcTyVar -> TcM TcTyVar
zonkIdBndr ZonkEnv
env XCFieldOcc GhcTc
TcTyVar
sel
zonkEvBndrsX :: ZonkEnv -> [EvVar] -> TcM (ZonkEnv, [Var])
zonkEvBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TcTyVar])
zonkEvBndrsX = (ZonkEnv
-> TcTyVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar))
-> ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TcTyVar])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv
-> TcTyVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
zonkEvBndrX
zonkEvBndrX :: ZonkEnv -> EvVar -> TcM (ZonkEnv, EvVar)
zonkEvBndrX :: ZonkEnv
-> TcTyVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
zonkEvBndrX ZonkEnv
env TcTyVar
var
= do { TcTyVar
var' <- ZonkEnv -> TcTyVar -> TcM TcTyVar
zonkEvBndr ZonkEnv
env TcTyVar
var
; (ZonkEnv, TcTyVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> [TcTyVar] -> ZonkEnv
extendZonkEnv ZonkEnv
env [TcTyVar
var'], TcTyVar
var') }
zonkEvBndr :: ZonkEnv -> EvVar -> TcM EvVar
zonkEvBndr :: ZonkEnv -> TcTyVar -> TcM TcTyVar
zonkEvBndr ZonkEnv
env TcTyVar
var
= (Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind)
-> TcTyVar -> TcM TcTyVar
forall (m :: * -> *).
Monad m =>
(Kind -> m Kind) -> TcTyVar -> m TcTyVar
updateIdTypeAndMultM ({-# SCC "zonkEvBndr_zonkTcTypeToType" #-} ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env) TcTyVar
var
zonkCoreBndrX :: ZonkEnv -> Var -> TcM (ZonkEnv, Var)
zonkCoreBndrX :: ZonkEnv
-> TcTyVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
zonkCoreBndrX ZonkEnv
env TcTyVar
v
| TcTyVar -> Bool
isId TcTyVar
v = do { TcTyVar
v' <- ZonkEnv -> TcTyVar -> TcM TcTyVar
zonkIdBndr ZonkEnv
env TcTyVar
v
; (ZonkEnv, TcTyVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> TcTyVar -> ZonkEnv
extendIdZonkEnv ZonkEnv
env TcTyVar
v', TcTyVar
v') }
| Bool
otherwise = ZonkEnv
-> TcTyVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
zonkTyBndrX ZonkEnv
env TcTyVar
v
zonkCoreBndrsX :: ZonkEnv -> [Var] -> TcM (ZonkEnv, [Var])
zonkCoreBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TcTyVar])
zonkCoreBndrsX = (ZonkEnv
-> TcTyVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar))
-> ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TcTyVar])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv
-> TcTyVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
zonkCoreBndrX
zonkTyBndrs :: [TcTyVar] -> TcM (ZonkEnv, [TyVar])
zonkTyBndrs :: [TcTyVar] -> TcM (ZonkEnv, [TcTyVar])
zonkTyBndrs [TcTyVar]
tvs = (ZonkEnv -> TcM (ZonkEnv, [TcTyVar])) -> TcM (ZonkEnv, [TcTyVar])
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM (ZonkEnv, [TcTyVar])) -> TcM (ZonkEnv, [TcTyVar]))
-> (ZonkEnv -> TcM (ZonkEnv, [TcTyVar]))
-> TcM (ZonkEnv, [TcTyVar])
forall a b. (a -> b) -> a -> b
$ \ZonkEnv
ze -> ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TcTyVar])
zonkTyBndrsX ZonkEnv
ze [TcTyVar]
tvs
zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])
zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TcTyVar])
zonkTyBndrsX = (ZonkEnv
-> TcTyVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar))
-> ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TcTyVar])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv
-> TcTyVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
zonkTyBndrX
zonkTyBndrX :: ZonkEnv -> TcTyVar -> TcM (ZonkEnv, TyVar)
zonkTyBndrX :: ZonkEnv
-> TcTyVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
zonkTyBndrX ZonkEnv
env TcTyVar
tv
= Bool
-> SDoc
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (TcTyVar -> Bool
isImmutableTyVar TcTyVar
tv) (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> Kind -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcTyVar -> Kind
tyVarKind TcTyVar
tv)) (IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar))
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
forall a b. (a -> b) -> a -> b
$
do { Kind
ki <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env (TcTyVar -> Kind
tyVarKind TcTyVar
tv)
; let tv' :: TcTyVar
tv' = Name -> Kind -> TcTyVar
mkTyVar (TcTyVar -> Name
tyVarName TcTyVar
tv) Kind
ki
; (ZonkEnv, TcTyVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> TcTyVar -> ZonkEnv
extendTyZonkEnv ZonkEnv
env TcTyVar
tv', TcTyVar
tv') }
zonkTyVarBindersX :: ZonkEnv -> [VarBndr TcTyVar vis]
-> TcM (ZonkEnv, [VarBndr TyVar vis])
zonkTyVarBindersX :: forall vis.
ZonkEnv
-> [VarBndr TcTyVar vis] -> TcM (ZonkEnv, [VarBndr TcTyVar vis])
zonkTyVarBindersX = (ZonkEnv
-> VarBndr TcTyVar vis
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, VarBndr TcTyVar vis))
-> ZonkEnv
-> [VarBndr TcTyVar vis]
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [VarBndr TcTyVar vis])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv
-> VarBndr TcTyVar vis
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, VarBndr TcTyVar vis)
forall vis.
ZonkEnv
-> VarBndr TcTyVar vis -> TcM (ZonkEnv, VarBndr TcTyVar vis)
zonkTyVarBinderX
zonkTyVarBinderX :: ZonkEnv -> VarBndr TcTyVar vis
-> TcM (ZonkEnv, VarBndr TyVar vis)
zonkTyVarBinderX :: forall vis.
ZonkEnv
-> VarBndr TcTyVar vis -> TcM (ZonkEnv, VarBndr TcTyVar vis)
zonkTyVarBinderX ZonkEnv
env (Bndr TcTyVar
tv vis
vis)
= do { (ZonkEnv
env', TcTyVar
tv') <- ZonkEnv
-> TcTyVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
zonkTyBndrX ZonkEnv
env TcTyVar
tv
; (ZonkEnv, VarBndr TcTyVar vis)
-> TcM (ZonkEnv, VarBndr TcTyVar vis)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', TcTyVar -> vis -> VarBndr TcTyVar vis
forall var argf. var -> argf -> VarBndr var argf
Bndr TcTyVar
tv' vis
vis) }
zonkTopExpr :: HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkTopExpr :: HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkTopExpr HsExpr GhcTc
e = (ZonkEnv -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc)
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc))
-> (ZonkEnv -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze -> ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
ze HsExpr GhcTc
e
zonkTopLExpr :: LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkTopLExpr :: LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkTopLExpr LHsExpr GhcTc
e = (ZonkEnv -> TcM (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 GhcTc
-> [LRuleDecl GhcTc] -> [LTcSpecPrag]
-> [LForeignDecl GhcTc]
-> TcM (TypeEnv,
Bag EvBind,
LHsBinds GhcTc,
[LForeignDecl GhcTc],
[LTcSpecPrag],
[LRuleDecl GhcTc])
zonkTopDecls :: Bag EvBind
-> LHsBinds GhcTc
-> [LRuleDecl GhcTc]
-> [LTcSpecPrag]
-> [LForeignDecl GhcTc]
-> TcM
(TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
[LTcSpecPrag], [LRuleDecl GhcTc])
zonkTopDecls Bag EvBind
ev_binds LHsBinds GhcTc
binds [LRuleDecl GhcTc]
rules [LTcSpecPrag]
imp_specs [LForeignDecl GhcTc]
fords
= do { (ZonkEnv
env1, Bag EvBind
ev_binds') <- (ZonkEnv -> TcM (ZonkEnv, Bag EvBind)) -> TcM (ZonkEnv, Bag EvBind)
forall b. (ZonkEnv -> TcM b) -> TcM b
initZonkEnv ((ZonkEnv -> TcM (ZonkEnv, Bag EvBind))
-> TcM (ZonkEnv, Bag EvBind))
-> (ZonkEnv -> TcM (ZonkEnv, Bag EvBind))
-> TcM (ZonkEnv, Bag EvBind)
forall a b. (a -> b) -> a -> b
$ \ ZonkEnv
ze -> ZonkEnv -> Bag EvBind -> TcM (ZonkEnv, Bag EvBind)
zonkEvBinds ZonkEnv
ze Bag EvBind
ev_binds
; (ZonkEnv
env2, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
binds') <- ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds ZonkEnv
env1 LHsBinds GhcTc
binds
; [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
rules' <- ZonkEnv -> [LRuleDecl GhcTc] -> TcM [LRuleDecl GhcTc]
zonkRules ZonkEnv
env2 [LRuleDecl GhcTc]
rules
; [LTcSpecPrag]
specs' <- ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
zonkLTcSpecPrags ZonkEnv
env2 [LTcSpecPrag]
imp_specs
; [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
fords' <- ZonkEnv -> [LForeignDecl GhcTc] -> TcM [LForeignDecl GhcTc]
zonkForeignExports ZonkEnv
env2 [LForeignDecl GhcTc]
fords
; (TypeEnv, Bag EvBind,
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
[GenLocated SrcSpanAnnA (ForeignDecl GhcTc)], [LTcSpecPrag],
[GenLocated SrcSpanAnnA (RuleDecl GhcTc)])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(TypeEnv, Bag EvBind,
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
[GenLocated SrcSpanAnnA (ForeignDecl GhcTc)], [LTcSpecPrag],
[GenLocated SrcSpanAnnA (RuleDecl GhcTc)])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> TypeEnv
zonkEnvIds ZonkEnv
env2, Bag EvBind
ev_binds', Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
binds', [GenLocated SrcSpanAnnA (ForeignDecl GhcTc)]
fords', [LTcSpecPrag]
specs', [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
rules') }
zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTc
-> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env (EmptyLocalBinds XEmptyLocalBinds GhcTc GhcTc
x)
= (ZonkEnv, HsLocalBinds GhcTc) -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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"
zonkLocalBinds ZonkEnv
env (HsValBinds XHsValBinds GhcTc GhcTc
x (XValBindsLR (NValBinds [(RecFlag, LHsBinds GhcTc)]
binds [LSig GhcRn]
sigs)))
= do { (ZonkEnv
env1, [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
new_binds) <- ZonkEnv
-> [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv,
[(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
forall {a}.
ZonkEnv
-> [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv,
[(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
go ZonkEnv
env [(RecFlag, LHsBinds GhcTc)]
[(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
binds
; (ZonkEnv, HsLocalBinds GhcTc) -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, XHsValBinds GhcTc GhcTc
-> HsValBindsLR GhcTc GhcTc -> HsLocalBinds GhcTc
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcTc GhcTc
x (XXValBindsLR GhcTc GhcTc -> HsValBindsLR GhcTc GhcTc
forall idL idR. XXValBindsLR idL idR -> HsValBindsLR idL idR
XValBindsLR ([(RecFlag, LHsBinds GhcTc)] -> [LSig GhcRn] -> NHsValBindsLR GhcTc
forall idL.
[(RecFlag, LHsBinds idL)] -> [LSig GhcRn] -> NHsValBindsLR idL
NValBinds [(RecFlag, LHsBinds GhcTc)]
[(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
new_binds [LSig GhcRn]
sigs))) }
where
go :: ZonkEnv
-> [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv,
[(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
go ZonkEnv
env []
= (ZonkEnv,
[(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv,
[(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, [])
go ZonkEnv
env ((a
r,Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
b):[(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
bs)
= do { (ZonkEnv
env1, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
b') <- ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds ZonkEnv
env LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
b
; (ZonkEnv
env2, [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
bs') <- ZonkEnv
-> [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv,
[(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
go ZonkEnv
env1 [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
bs
; (ZonkEnv,
[(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv,
[(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, (a
r,Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
b')(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
-> [(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
forall a. a -> [a] -> [a]
:[(a, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))]
bs') }
zonkLocalBinds ZonkEnv
env (HsIPBinds XHsIPBinds GhcTc GhcTc
x (IPBinds XIPBinds GhcTc
dict_binds [LIPBind GhcTc]
binds )) = do
[GenLocated SrcSpanAnnA (IPBind GhcTc)]
new_binds <- (GenLocated SrcSpanAnnA (IPBind GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (IPBind GhcTc)))
-> [GenLocated SrcSpanAnnA (IPBind GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv) [GenLocated SrcSpanAnnA (IPBind GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((IPBind GhcTc -> TcM (IPBind GhcTc))
-> GenLocated SrcSpanAnnA (IPBind GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (IPBind GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA IPBind GhcTc -> TcM (IPBind GhcTc)
zonk_ip_bind) [LIPBind GhcTc]
[GenLocated SrcSpanAnnA (IPBind GhcTc)]
binds
let
env1 :: ZonkEnv
env1 = ZonkEnv -> [TcTyVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env
[ XCIPBind GhcTc
TcTyVar
n | (L SrcSpanAnnA
_ (IPBind XCIPBind GhcTc
n XRec GhcTc HsIPName
_ LHsExpr GhcTc
_)) <- [GenLocated SrcSpanAnnA (IPBind GhcTc)]
new_binds]
(ZonkEnv
env2, TcEvBinds
new_dict_binds) <- ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds)
zonkTcEvBinds ZonkEnv
env1 XIPBinds GhcTc
TcEvBinds
dict_binds
(ZonkEnv, HsLocalBinds GhcTc) -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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]
[GenLocated SrcSpanAnnA (IPBind GhcTc)]
new_binds))
where
zonk_ip_bind :: IPBind GhcTc -> TcM (IPBind GhcTc)
zonk_ip_bind (IPBind XCIPBind GhcTc
dict_id XRec GhcTc HsIPName
n LHsExpr GhcTc
e)
= do TcTyVar
dict_id' <- ZonkEnv -> TcTyVar -> TcM TcTyVar
zonkIdBndr ZonkEnv
env XCIPBind GhcTc
TcTyVar
dict_id
LocatedA (HsExpr GhcTc)
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
IPBind GhcTc -> TcM (IPBind GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCIPBind GhcTc
-> XRec GhcTc HsIPName -> LHsExpr GhcTc -> IPBind GhcTc
forall id.
XCIPBind id -> XRec id HsIPName -> LHsExpr id -> IPBind id
IPBind XCIPBind GhcTc
TcTyVar
dict_id' XRec GhcTc HsIPName
n LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
e')
zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds ZonkEnv
env LHsBinds GhcTc
binds
= ((ZonkEnv, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM (\ ~(ZonkEnv
_, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_binds) -> do
{ let env1 :: ZonkEnv
env1 = ZonkEnv -> [TcTyVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env (CollectFlag GhcTc -> LHsBinds GhcTc -> [IdP GhcTc]
forall p idR.
CollectPass p =>
CollectFlag p -> LHsBindsLR p idR -> [IdP p]
collectHsBindsBinders CollectFlag GhcTc
forall p. CollectFlag p
CollNoDictBinders LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_binds)
; Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
binds' <- ZonkEnv -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
zonkMonoBinds ZonkEnv
env1 LHsBinds GhcTc
binds
; (ZonkEnv, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
binds') })
zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
zonkMonoBinds ZonkEnv
env LHsBinds GhcTc
binds = (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM (ZonkEnv -> LHsBind GhcTc -> TcM (LHsBind GhcTc)
zonk_lbind ZonkEnv
env) LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
binds
zonk_lbind :: ZonkEnv -> LHsBind GhcTc -> TcM (LHsBind GhcTc)
zonk_lbind :: ZonkEnv -> LHsBind GhcTc -> TcM (LHsBind GhcTc)
zonk_lbind ZonkEnv
env = (HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc))
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
zonk_bind ZonkEnv
env)
zonk_bind :: ZonkEnv -> HsBind GhcTc -> TcM (HsBind GhcTc)
zonk_bind :: ZonkEnv -> HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
zonk_bind ZonkEnv
env bind :: HsBindLR GhcTc GhcTc
bind@(PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat GhcTc
pat, pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_rhs = GRHSs GhcTc (LHsExpr GhcTc)
grhss
, pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
pat_ext = XPatBind GhcTc GhcTc
ty})
= do { (ZonkEnv
_env, GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat) <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat
; GRHSs GhcTc (LocatedA (HsExpr GhcTc))
new_grhss <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> GRHSs GhcTc (LocatedA (HsExpr GhcTc))
-> TcM (GRHSs GhcTc (LocatedA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> GRHSs GhcTc (LocatedA (body GhcTc))
-> TcM (GRHSs GhcTc (LocatedA (body GhcTc)))
zonkGRHSs ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
zonkLExpr GRHSs GhcTc (LHsExpr GhcTc)
GRHSs GhcTc (LocatedA (HsExpr GhcTc))
grhss
; Kind
new_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env XPatBind GhcTc GhcTc
Kind
ty
; HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBindLR GhcTc GhcTc
bind { pat_lhs :: LPat GhcTc
pat_lhs = LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat, pat_rhs :: GRHSs GhcTc (LHsExpr GhcTc)
pat_rhs = GRHSs GhcTc (LHsExpr GhcTc)
GRHSs GhcTc (LocatedA (HsExpr GhcTc))
new_grhss
, pat_ext :: XPatBind GhcTc GhcTc
pat_ext = XPatBind GhcTc GhcTc
Kind
new_ty }) }
zonk_bind ZonkEnv
env (VarBind { var_ext :: forall idL idR. HsBindLR idL idR -> XVarBind idL idR
var_ext = XVarBind GhcTc GhcTc
x
, var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id = IdP GhcTc
var, var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
var_rhs = LHsExpr GhcTc
expr })
= do { TcTyVar
new_var <- ZonkEnv -> TcTyVar -> TcM TcTyVar
zonkIdBndr ZonkEnv
env IdP GhcTc
TcTyVar
var
; LocatedA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
; HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (VarBind { var_ext :: XVarBind GhcTc GhcTc
var_ext = XVarBind GhcTc GhcTc
x
, var_id :: IdP GhcTc
var_id = IdP GhcTc
TcTyVar
new_var
, var_rhs :: LHsExpr GhcTc
var_rhs = LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_expr }) }
zonk_bind ZonkEnv
env bind :: HsBindLR GhcTc GhcTc
bind@(FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = L SrcSpanAnnN
loc TcTyVar
var
, fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
ms
, fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_ext = XFunBind GhcTc GhcTc
co_fn })
= do { TcTyVar
new_var <- ZonkEnv -> TcTyVar -> TcM TcTyVar
zonkIdBndr ZonkEnv
env TcTyVar
var
; (ZonkEnv
env1, HsWrapper
new_co_fn) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env XFunBind GhcTc GhcTc
HsWrapper
co_fn
; MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
new_ms <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env1 ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
ms
; HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBindLR GhcTc GhcTc
bind { fun_id :: LIdP GhcTc
fun_id = SrcSpanAnnN -> TcTyVar -> GenLocated SrcSpanAnnN TcTyVar
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc TcTyVar
new_var
, fun_matches :: MatchGroup GhcTc (LHsExpr GhcTc)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
new_ms
, fun_ext :: XFunBind GhcTc GhcTc
fun_ext = XFunBind GhcTc GhcTc
HsWrapper
new_co_fn }) }
zonk_bind ZonkEnv
env (XHsBindsLR (AbsBinds { abs_tvs :: AbsBinds -> [TcTyVar]
abs_tvs = [TcTyVar]
tyvars, abs_ev_vars :: AbsBinds -> [TcTyVar]
abs_ev_vars = [TcTyVar]
evs
, abs_ev_binds :: AbsBinds -> [TcEvBinds]
abs_ev_binds = [TcEvBinds]
ev_binds
, abs_exports :: AbsBinds -> [ABExport]
abs_exports = [ABExport]
exports
, abs_binds :: AbsBinds -> LHsBinds GhcTc
abs_binds = LHsBinds GhcTc
val_binds
, abs_sig :: AbsBinds -> Bool
abs_sig = Bool
has_sig }))
= Bool -> TcM (HsBindLR GhcTc GhcTc) -> TcM (HsBindLR GhcTc GhcTc)
forall a. HasCallStack => Bool -> a -> a
assert ( (TcTyVar -> Bool) -> [TcTyVar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TcTyVar -> Bool
isImmutableTyVar [TcTyVar]
tyvars ) (TcM (HsBindLR GhcTc GhcTc) -> TcM (HsBindLR GhcTc GhcTc))
-> TcM (HsBindLR GhcTc GhcTc) -> TcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$
do { (ZonkEnv
env0, [TcTyVar]
new_tyvars) <- ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TcTyVar])
zonkTyBndrsX ZonkEnv
env [TcTyVar]
tyvars
; (ZonkEnv
env1, [TcTyVar]
new_evs) <- ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TcTyVar])
zonkEvBndrsX ZonkEnv
env0 [TcTyVar]
evs
; (ZonkEnv
env2, [TcEvBinds]
new_ev_binds) <- ZonkEnv -> [TcEvBinds] -> TcM (ZonkEnv, [TcEvBinds])
zonkTcEvBinds_s ZonkEnv
env1 [TcEvBinds]
ev_binds
; (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_bind, [ABExport]
new_exports) <- ((Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM (((Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
-> ((Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)),
[ABExport])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport]))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
forall a b. (a -> b) -> a -> b
$ \ ~(Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_binds, [ABExport]
_) ->
do { let env3 :: ZonkEnv
env3 = ZonkEnv -> [TcTyVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env2 ([TcTyVar] -> ZonkEnv) -> [TcTyVar] -> ZonkEnv
forall a b. (a -> b) -> a -> b
$
CollectFlag GhcTc -> LHsBinds GhcTc -> [IdP GhcTc]
forall p idR.
CollectPass p =>
CollectFlag p -> LHsBindsLR p idR -> [IdP p]
collectHsBindsBinders CollectFlag GhcTc
forall p. CollectFlag p
CollNoDictBinders LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_binds
; Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_binds <- (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM (ZonkEnv
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
zonk_val_bind ZonkEnv
env3) LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
val_binds
; [ABExport]
new_exports <- (ABExport -> IOEnv (Env TcGblEnv TcLclEnv) ABExport)
-> [ABExport] -> IOEnv (Env TcGblEnv TcLclEnv) [ABExport]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ZonkEnv -> ABExport -> IOEnv (Env TcGblEnv TcLclEnv) ABExport
zonk_export ZonkEnv
env3) [ABExport]
exports
; (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), [ABExport])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_binds, [ABExport]
new_exports) }
; HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc))
-> HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$ XXHsBindsLR GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall idL idR. XXHsBindsLR idL idR -> HsBindLR idL idR
XHsBindsLR (XXHsBindsLR GhcTc GhcTc -> HsBindLR GhcTc GhcTc)
-> XXHsBindsLR GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall a b. (a -> b) -> a -> b
$
AbsBinds { abs_tvs :: [TcTyVar]
abs_tvs = [TcTyVar]
new_tyvars, abs_ev_vars :: [TcTyVar]
abs_ev_vars = [TcTyVar]
new_evs
, abs_ev_binds :: [TcEvBinds]
abs_ev_binds = [TcEvBinds]
new_ev_binds
, abs_exports :: [ABExport]
abs_exports = [ABExport]
new_exports, abs_binds :: LHsBinds GhcTc
abs_binds = LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
new_val_bind
, abs_sig :: Bool
abs_sig = Bool
has_sig } }
where
zonk_val_bind :: ZonkEnv
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
zonk_val_bind ZonkEnv
env GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
lbind
| Bool
has_sig
, (L SrcSpanAnnA
loc bind :: HsBindLR GhcTc GhcTc
bind@(FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = (L SrcSpanAnnN
mloc TcTyVar
mono_id)
, fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
ms
, fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_ext = XFunBind GhcTc GhcTc
co_fn })) <- GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
lbind
= do { TcTyVar
new_mono_id <- (Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind)
-> TcTyVar -> TcM TcTyVar
forall (m :: * -> *).
Monad m =>
(Kind -> m Kind) -> TcTyVar -> m TcTyVar
updateIdTypeAndMultM (ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env) TcTyVar
mono_id
; (ZonkEnv
env', HsWrapper
new_co_fn) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env XFunBind GhcTc GhcTc
HsWrapper
co_fn
; MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
new_ms <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env' ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
ms
; GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsBindLR GhcTc GhcTc
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsBindLR GhcTc GhcTc
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> HsBindLR GhcTc GhcTc
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$
HsBindLR GhcTc GhcTc
bind { fun_id :: LIdP GhcTc
fun_id = SrcSpanAnnN -> TcTyVar -> GenLocated SrcSpanAnnN TcTyVar
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
mloc TcTyVar
new_mono_id
, fun_matches :: MatchGroup GhcTc (LHsExpr GhcTc)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
new_ms
, fun_ext :: XFunBind GhcTc GhcTc
fun_ext = XFunBind GhcTc GhcTc
HsWrapper
new_co_fn } }
| Bool
otherwise
= ZonkEnv -> LHsBind GhcTc -> TcM (LHsBind GhcTc)
zonk_lbind ZonkEnv
env LHsBind GhcTc
GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
lbind
zonk_export :: ZonkEnv -> ABExport -> TcM ABExport
zonk_export :: ZonkEnv -> ABExport -> IOEnv (Env TcGblEnv TcLclEnv) ABExport
zonk_export ZonkEnv
env (ABE{ abe_wrap :: ABExport -> HsWrapper
abe_wrap = HsWrapper
wrap
, abe_poly :: ABExport -> TcTyVar
abe_poly = TcTyVar
poly_id
, abe_mono :: ABExport -> TcTyVar
abe_mono = TcTyVar
mono_id
, abe_prags :: ABExport -> TcSpecPrags
abe_prags = TcSpecPrags
prags })
= do TcTyVar
new_poly_id <- ZonkEnv -> TcTyVar -> TcM TcTyVar
zonkIdBndr ZonkEnv
env TcTyVar
poly_id
(ZonkEnv
_, HsWrapper
new_wrap) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
wrap
TcSpecPrags
new_prags <- ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags
zonkSpecPrags ZonkEnv
env TcSpecPrags
prags
ABExport -> IOEnv (Env TcGblEnv TcLclEnv) ABExport
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ABE{ abe_wrap :: HsWrapper
abe_wrap = HsWrapper
new_wrap
, abe_poly :: TcTyVar
abe_poly = TcTyVar
new_poly_id
, abe_mono :: TcTyVar
abe_mono = ZonkEnv -> TcTyVar -> TcTyVar
zonkIdOcc ZonkEnv
env TcTyVar
mono_id
, abe_prags :: TcSpecPrags
abe_prags = TcSpecPrags
new_prags })
zonk_bind ZonkEnv
env (PatSynBind XPatSynBind GhcTc GhcTc
x bind :: PatSynBind GhcTc GhcTc
bind@(PSB { psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id = L SrcSpanAnnN
loc TcTyVar
id
, psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_args = HsPatSynDetails GhcTc
details
, psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_def = LPat GhcTc
lpat
, psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir = HsPatSynDir GhcTc
dir }))
= do { TcTyVar
id' <- ZonkEnv -> TcTyVar -> TcM TcTyVar
zonkIdBndr ZonkEnv
env TcTyVar
id
; (ZonkEnv
env1, GenLocated SrcSpanAnnA (Pat GhcTc)
lpat') <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
lpat
; HsConDetails
Void (GenLocated SrcSpanAnnN TcTyVar) [RecordPatSynField GhcTc]
details' <- ZonkEnv -> HsPatSynDetails GhcTc -> TcM (HsPatSynDetails GhcTc)
zonkPatSynDetails ZonkEnv
env1 HsPatSynDetails GhcTc
details
; (ZonkEnv
_env2, HsPatSynDir GhcTc
dir') <- ZonkEnv -> HsPatSynDir GhcTc -> TcM (ZonkEnv, HsPatSynDir GhcTc)
zonkPatSynDir ZonkEnv
env1 HsPatSynDir GhcTc
dir
; HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc))
-> HsBindLR GhcTc GhcTc -> TcM (HsBindLR GhcTc GhcTc)
forall a b. (a -> b) -> a -> b
$ XPatSynBind GhcTc GhcTc
-> PatSynBind GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall idL idR.
XPatSynBind idL idR -> PatSynBind idL idR -> HsBindLR idL idR
PatSynBind XPatSynBind GhcTc GhcTc
x (PatSynBind GhcTc GhcTc -> HsBindLR GhcTc GhcTc)
-> PatSynBind GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall a b. (a -> b) -> a -> b
$
PatSynBind GhcTc GhcTc
bind { psb_id :: LIdP GhcTc
psb_id = SrcSpanAnnN -> TcTyVar -> GenLocated SrcSpanAnnN TcTyVar
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
loc TcTyVar
id'
, psb_args :: HsPatSynDetails GhcTc
psb_args = HsPatSynDetails GhcTc
HsConDetails
Void (GenLocated SrcSpanAnnN TcTyVar) [RecordPatSynField GhcTc]
details'
, psb_def :: LPat GhcTc
psb_def = LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
lpat'
, psb_dir :: HsPatSynDir GhcTc
psb_dir = HsPatSynDir GhcTc
dir' } }
zonkPatSynDetails :: ZonkEnv
-> HsPatSynDetails GhcTc
-> TcM (HsPatSynDetails GhcTc)
zonkPatSynDetails :: ZonkEnv -> HsPatSynDetails GhcTc -> TcM (HsPatSynDetails GhcTc)
zonkPatSynDetails ZonkEnv
env (PrefixCon [Void]
_ [LIdP GhcTc]
as)
= HsPatSynDetails GhcTc -> TcM (HsPatSynDetails GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsPatSynDetails GhcTc -> TcM (HsPatSynDetails GhcTc))
-> HsPatSynDetails GhcTc -> TcM (HsPatSynDetails GhcTc)
forall a b. (a -> b) -> a -> b
$ [Void]
-> [GenLocated SrcSpanAnnN TcTyVar]
-> HsConDetails
Void (GenLocated SrcSpanAnnN TcTyVar) [RecordPatSynField GhcTc]
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [Void]
noTypeArgs ((GenLocated SrcSpanAnnN TcTyVar -> GenLocated SrcSpanAnnN TcTyVar)
-> [GenLocated SrcSpanAnnN TcTyVar]
-> [GenLocated SrcSpanAnnN TcTyVar]
forall a b. (a -> b) -> [a] -> [b]
map (ZonkEnv
-> GenLocated SrcSpanAnnN TcTyVar -> GenLocated SrcSpanAnnN TcTyVar
zonkLIdOcc ZonkEnv
env) [LIdP GhcTc]
[GenLocated SrcSpanAnnN TcTyVar]
as)
zonkPatSynDetails ZonkEnv
env (InfixCon LIdP GhcTc
a1 LIdP GhcTc
a2)
= HsPatSynDetails GhcTc -> TcM (HsPatSynDetails GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsPatSynDetails GhcTc -> TcM (HsPatSynDetails GhcTc))
-> HsPatSynDetails GhcTc -> TcM (HsPatSynDetails GhcTc)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN TcTyVar
-> GenLocated SrcSpanAnnN TcTyVar
-> HsConDetails
Void (GenLocated SrcSpanAnnN TcTyVar) [RecordPatSynField GhcTc]
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon (ZonkEnv
-> GenLocated SrcSpanAnnN TcTyVar -> GenLocated SrcSpanAnnN TcTyVar
zonkLIdOcc ZonkEnv
env LIdP GhcTc
GenLocated SrcSpanAnnN TcTyVar
a1) (ZonkEnv
-> GenLocated SrcSpanAnnN TcTyVar -> GenLocated SrcSpanAnnN TcTyVar
zonkLIdOcc ZonkEnv
env LIdP GhcTc
GenLocated SrcSpanAnnN TcTyVar
a2)
zonkPatSynDetails ZonkEnv
env (RecCon [RecordPatSynField GhcTc]
flds)
= [RecordPatSynField GhcTc]
-> HsConDetails
Void (GenLocated SrcSpanAnnN TcTyVar) [RecordPatSynField GhcTc]
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon ([RecordPatSynField GhcTc]
-> HsConDetails
Void (GenLocated SrcSpanAnnN TcTyVar) [RecordPatSynField GhcTc])
-> IOEnv (Env TcGblEnv TcLclEnv) [RecordPatSynField GhcTc]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(HsConDetails
Void (GenLocated SrcSpanAnnN TcTyVar) [RecordPatSynField GhcTc])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RecordPatSynField GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (RecordPatSynField GhcTc))
-> [RecordPatSynField GhcTc]
-> IOEnv (Env TcGblEnv TcLclEnv) [RecordPatSynField GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ZonkEnv
-> RecordPatSynField GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (RecordPatSynField GhcTc)
zonkPatSynField ZonkEnv
env) [RecordPatSynField GhcTc]
flds
zonkPatSynField :: ZonkEnv -> RecordPatSynField GhcTc -> TcM (RecordPatSynField GhcTc)
zonkPatSynField :: ZonkEnv
-> RecordPatSynField GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (RecordPatSynField GhcTc)
zonkPatSynField ZonkEnv
env (RecordPatSynField FieldOcc GhcTc
x LIdP GhcTc
y) =
FieldOcc GhcTc -> LIdP GhcTc -> RecordPatSynField GhcTc
FieldOcc GhcTc
-> GenLocated SrcSpanAnnN TcTyVar -> RecordPatSynField GhcTc
forall pass. FieldOcc pass -> LIdP pass -> RecordPatSynField pass
RecordPatSynField (FieldOcc GhcTc
-> GenLocated SrcSpanAnnN TcTyVar -> RecordPatSynField GhcTc)
-> TcM (FieldOcc GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnN TcTyVar -> RecordPatSynField GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc ZonkEnv
env FieldOcc GhcTc
x IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnN TcTyVar -> RecordPatSynField GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnN TcTyVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (RecordPatSynField GhcTc)
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) (a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenLocated SrcSpanAnnN TcTyVar
-> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnN TcTyVar)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ZonkEnv
-> GenLocated SrcSpanAnnN TcTyVar -> GenLocated SrcSpanAnnN TcTyVar
zonkLIdOcc ZonkEnv
env LIdP GhcTc
GenLocated SrcSpanAnnN TcTyVar
y)
zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTc
-> TcM (ZonkEnv, HsPatSynDir GhcTc)
zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTc -> TcM (ZonkEnv, HsPatSynDir GhcTc)
zonkPatSynDir ZonkEnv
env HsPatSynDir GhcTc
Unidirectional = (ZonkEnv, HsPatSynDir GhcTc) -> TcM (ZonkEnv, HsPatSynDir GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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 a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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 (LocatedA (HsExpr GhcTc))
mg' <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
mg
(ZonkEnv, HsPatSynDir GhcTc) -> TcM (ZonkEnv, HsPatSynDir GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, MatchGroup GhcTc (LHsExpr GhcTc) -> HsPatSynDir GhcTc
forall id. MatchGroup id (LHsExpr id) -> HsPatSynDir id
ExplicitBidirectional MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
mg')
zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags
zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags
zonkSpecPrags ZonkEnv
_ TcSpecPrags
IsDefaultMethod = TcSpecPrags -> TcM TcSpecPrags
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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 a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LTcSpecPrag -> IOEnv (Env TcGblEnv TcLclEnv) LTcSpecPrag
zonk_prag [LTcSpecPrag]
ps
where
zonk_prag :: LTcSpecPrag -> IOEnv (Env TcGblEnv TcLclEnv) LTcSpecPrag
zonk_prag (L SrcSpan
loc (SpecPrag TcTyVar
id HsWrapper
co_fn InlinePragma
inl))
= do { (ZonkEnv
_, HsWrapper
co_fn') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
co_fn
; LTcSpecPrag -> IOEnv (Env TcGblEnv TcLclEnv) LTcSpecPrag
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> TcSpecPrag -> LTcSpecPrag
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (TcTyVar -> HsWrapper -> InlinePragma -> TcSpecPrag
SpecPrag (ZonkEnv -> TcTyVar -> TcTyVar
zonkIdOcc ZonkEnv
env TcTyVar
id) HsWrapper
co_fn' InlinePragma
inl)) }
zonkMatchGroup :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns
=> ZonkEnv
-> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup :: forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L Anno
[GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))]
l [GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))]
ms
, mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext = MatchGroupTc [Scaled Kind]
arg_tys Kind
res_ty
, mg_origin :: forall p body. MatchGroup p body -> Origin
mg_origin = Origin
origin })
= do { [GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))]
ms' <- (GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))))
-> [GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> LMatch GhcTc (LocatedA (body GhcTc))
-> TcM (LMatch GhcTc (LocatedA (body GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> LMatch GhcTc (LocatedA (body GhcTc))
-> TcM (LMatch GhcTc (LocatedA (body GhcTc)))
zonkMatch ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody) [GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))]
ms
; [Scaled Kind]
arg_tys' <- ZonkEnv -> [Scaled Kind] -> TcM [Scaled Kind]
zonkScaledTcTypesToTypesX ZonkEnv
env [Scaled Kind]
arg_tys
; Kind
res_ty' <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env Kind
res_ty
; MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MG { mg_alts :: XRec GhcTc [LMatch GhcTc (LocatedA (body GhcTc))]
mg_alts = Anno
[GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))]
-> [GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))]
-> GenLocated
(Anno
[GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))])
[GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))]
forall l e. l -> e -> GenLocated l e
L Anno
[GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))]
l [GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))]
ms'
, mg_ext :: XMG GhcTc (LocatedA (body GhcTc))
mg_ext = [Scaled Kind] -> Kind -> MatchGroupTc
MatchGroupTc [Scaled Kind]
arg_tys' Kind
res_ty'
, mg_origin :: Origin
mg_origin = Origin
origin }) }
zonkMatch :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns
=> ZonkEnv
-> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> LMatch GhcTc (LocatedA (body GhcTc))
-> TcM (LMatch GhcTc (LocatedA (body GhcTc)))
zonkMatch :: forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> LMatch GhcTc (LocatedA (body GhcTc))
-> TcM (LMatch GhcTc (LocatedA (body GhcTc)))
zonkMatch ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (L Anno (Match GhcTc (LocatedA (body GhcTc)))
loc match :: Match GhcTc (LocatedA (body GhcTc))
match@(Match { m_pats :: forall p body. Match p body -> [LPat p]
m_pats = [LPat GhcTc]
pats
, m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs GhcTc (LocatedA (body GhcTc))
grhss }))
= do { (ZonkEnv
env1, [GenLocated SrcSpanAnnA (Pat GhcTc)]
new_pats) <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env [LPat GhcTc]
pats
; GRHSs GhcTc (LocatedA (body GhcTc))
new_grhss <- ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> GRHSs GhcTc (LocatedA (body GhcTc))
-> TcM (GRHSs GhcTc (LocatedA (body GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> GRHSs GhcTc (LocatedA (body GhcTc))
-> TcM (GRHSs GhcTc (LocatedA (body GhcTc)))
zonkGRHSs ZonkEnv
env1 ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody GRHSs GhcTc (LocatedA (body GhcTc))
grhss
; GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc))))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Anno (Match GhcTc (LocatedA (body GhcTc)))
-> Match GhcTc (LocatedA (body GhcTc))
-> GenLocated
(Anno (Match GhcTc (LocatedA (body GhcTc))))
(Match GhcTc (LocatedA (body GhcTc)))
forall l e. l -> e -> GenLocated l e
L Anno (Match GhcTc (LocatedA (body GhcTc)))
loc (Match GhcTc (LocatedA (body GhcTc))
match { m_pats :: [LPat GhcTc]
m_pats = [LPat GhcTc]
[GenLocated SrcSpanAnnA (Pat GhcTc)]
new_pats, m_grhss :: GRHSs GhcTc (LocatedA (body GhcTc))
m_grhss = GRHSs GhcTc (LocatedA (body GhcTc))
new_grhss })) }
zonkGRHSs :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns
=> ZonkEnv
-> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> GRHSs GhcTc (LocatedA (body GhcTc))
-> TcM (GRHSs GhcTc (LocatedA (body GhcTc)))
zonkGRHSs :: forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> GRHSs GhcTc (LocatedA (body GhcTc))
-> TcM (GRHSs GhcTc (LocatedA (body GhcTc)))
zonkGRHSs ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (GRHSs XCGRHSs GhcTc (LocatedA (body GhcTc))
x [LGRHS GhcTc (LocatedA (body GhcTc))]
grhss HsLocalBinds GhcTc
binds) = do
(ZonkEnv
new_env, HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env HsLocalBinds GhcTc
binds
let
zonk_grhs :: GRHS GhcTc (LocatedA (body GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (GRHS GhcTc (LocatedA (body GhcTc)))
zonk_grhs (GRHS XCGRHS GhcTc (LocatedA (body GhcTc))
xx [GuardLStmt GhcTc]
guarded LocatedA (body GhcTc)
rhs)
= do (ZonkEnv
env2, [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_guarded) <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (HsExpr GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
new_env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (LocatedA (HsExpr GhcTc))]
guarded
LocatedA (body GhcTc)
new_rhs <- ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody ZonkEnv
env2 LocatedA (body GhcTc)
rhs
GRHS GhcTc (LocatedA (body GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (GRHS GhcTc (LocatedA (body GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCGRHS GhcTc (LocatedA (body GhcTc))
-> [GuardLStmt GhcTc]
-> LocatedA (body GhcTc)
-> GRHS GhcTc (LocatedA (body GhcTc))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcTc (LocatedA (body GhcTc))
xx [GuardLStmt GhcTc]
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_guarded LocatedA (body GhcTc)
new_rhs)
[GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (body GhcTc)))]
new_grhss <- (GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (GRHS GhcTc (LocatedA (body GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (body GhcTc)))))
-> [GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (body GhcTc)))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (body GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((GRHS GhcTc (LocatedA (body GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (GRHS GhcTc (LocatedA (body GhcTc))))
-> GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (GRHS GhcTc (LocatedA (body GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (body GhcTc))))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA GRHS GhcTc (LocatedA (body GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (GRHS GhcTc (LocatedA (body GhcTc)))
zonk_grhs) [LGRHS GhcTc (LocatedA (body GhcTc))]
[GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (body GhcTc)))]
grhss
GRHSs GhcTc (LocatedA (body GhcTc))
-> TcM (GRHSs GhcTc (LocatedA (body GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCGRHSs GhcTc (LocatedA (body GhcTc))
-> [LGRHS GhcTc (LocatedA (body GhcTc))]
-> HsLocalBinds GhcTc
-> GRHSs GhcTc (LocatedA (body GhcTc))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcTc (LocatedA (body GhcTc))
x [LGRHS GhcTc (LocatedA (body GhcTc))]
[GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (body GhcTc)))]
new_grhss HsLocalBinds GhcTc
new_binds)
zonkLExprs :: ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc]
zonkLExpr :: ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkExpr :: ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkLExprs :: ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc]
zonkLExprs ZonkEnv
env [LHsExpr GhcTc]
exprs = (LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> [LocatedA (HsExpr GhcTc)]
-> IOEnv (Env TcGblEnv TcLclEnv) [LocatedA (HsExpr GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env) [LHsExpr GhcTc]
[LocatedA (HsExpr GhcTc)]
exprs
zonkLExpr :: ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr = (HsExpr GhcTc -> TcM (HsExpr GhcTc))
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env) LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
expr
zonkExpr :: ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env (HsVar XVar GhcTc
x (L SrcSpanAnnN
l TcTyVar
id))
= Bool -> SDoc -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Maybe DataCon -> Bool
forall a. Maybe a -> Bool
isNothing (TcTyVar -> Maybe DataCon
isDataConId_maybe TcTyVar
id)) (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
id) (TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc))
-> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcTc -> LIdP GhcTc -> HsExpr GhcTc
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcTc
x (SrcSpanAnnN -> TcTyVar -> GenLocated SrcSpanAnnN TcTyVar
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l (ZonkEnv -> TcTyVar -> TcTyVar
zonkIdOcc ZonkEnv
env TcTyVar
id)))
zonkExpr ZonkEnv
env (HsUnboundVar XUnboundVar GhcTc
her OccName
occ)
= do HoleExprRef
her' <- HoleExprRef -> TcM HoleExprRef
zonk_her XUnboundVar GhcTc
HoleExprRef
her
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XUnboundVar GhcTc -> OccName -> HsExpr GhcTc
forall p. XUnboundVar p -> OccName -> HsExpr p
HsUnboundVar XUnboundVar GhcTc
HoleExprRef
her' OccName
occ)
where
zonk_her :: HoleExprRef -> TcM HoleExprRef
zonk_her :: HoleExprRef -> TcM HoleExprRef
zonk_her (HER IORef EvTerm
ref Kind
ty Unique
u)
= do IORef EvTerm
-> (EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm)
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a env. IORef a -> (a -> IOEnv env a) -> IOEnv env ()
updMutVarM IORef EvTerm
ref (ZonkEnv -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
zonkEvTerm ZonkEnv
env)
Kind
ty' <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env Kind
ty
HoleExprRef -> TcM HoleExprRef
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef EvTerm -> Kind -> Unique -> HoleExprRef
HER IORef EvTerm
ref Kind
ty' Unique
u)
zonkExpr ZonkEnv
env (HsRecSel XRecSel GhcTc
_ (FieldOcc XCFieldOcc GhcTc
v XRec GhcTc RdrName
occ))
= HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XRecSel GhcTc -> FieldOcc GhcTc -> HsExpr GhcTc
forall p. XRecSel p -> FieldOcc p -> HsExpr p
HsRecSel XRecSel GhcTc
NoExtField
noExtField (XCFieldOcc GhcTc -> XRec GhcTc RdrName -> FieldOcc GhcTc
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc (ZonkEnv -> TcTyVar -> TcTyVar
zonkIdOcc ZonkEnv
env XCFieldOcc GhcTc
TcTyVar
v) XRec GhcTc RdrName
occ))
zonkExpr ZonkEnv
_ (HsIPVar XIPVar GhcTc
x HsIPName
_) = DataConCantHappen -> TcM (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XIPVar GhcTc
DataConCantHappen
x
zonkExpr ZonkEnv
_ (HsOverLabel XOverLabel GhcTc
x FastString
_) = DataConCantHappen -> TcM (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XOverLabel GhcTc
DataConCantHappen
x
zonkExpr ZonkEnv
env (HsLit XLitE GhcTc
x (HsRat XHsRat GhcTc
e FractionalLit
f Kind
ty))
= do Kind
new_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env Kind
ty
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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 -> Kind -> HsLit GhcTc
forall x. XHsRat x -> FractionalLit -> Kind -> HsLit x
HsRat XHsRat GhcTc
e FractionalLit
f Kind
new_ty))
zonkExpr ZonkEnv
_ (HsLit XLitE GhcTc
x HsLit GhcTc
lit)
= HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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 a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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 (LocatedA (HsExpr GhcTc))
new_matches <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
matches
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLam GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam GhcTc
x MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
new_matches)
zonkExpr ZonkEnv
env (HsLamCase XLamCase GhcTc
x LamCaseVariant
lc_variant MatchGroup GhcTc (LHsExpr GhcTc)
matches)
= do MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
new_matches <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
matches
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLamCase GhcTc
-> LamCaseVariant
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> HsExpr GhcTc
forall p.
XLamCase p
-> LamCaseVariant -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase XLamCase GhcTc
x LamCaseVariant
lc_variant MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
new_matches)
zonkExpr ZonkEnv
env (HsApp XApp GhcTc
x LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
= do LocatedA (HsExpr GhcTc)
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
LocatedA (HsExpr GhcTc)
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
LocatedA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e2)
zonkExpr ZonkEnv
env (HsAppType XAppTypeE GhcTc
ty LHsExpr GhcTc
e LHsWcType (NoGhcTc GhcTc)
t)
= do LocatedA (HsExpr GhcTc)
new_e <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
Kind
new_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env XAppTypeE GhcTc
Kind
ty
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
Kind
new_ty LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e LHsWcType (NoGhcTc GhcTc)
t)
zonkExpr ZonkEnv
env (HsTypedBracket XTypedBracket GhcTc
hsb_tc LHsExpr GhcTc
body)
= (\HsBracketTc
x -> XTypedBracket GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XTypedBracket p -> LHsExpr p -> HsExpr p
HsTypedBracket XTypedBracket GhcTc
HsBracketTc
x LHsExpr GhcTc
body) (HsBracketTc -> HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) HsBracketTc -> TcM (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> HsBracketTc -> IOEnv (Env TcGblEnv TcLclEnv) HsBracketTc
zonkBracket ZonkEnv
env XTypedBracket GhcTc
HsBracketTc
hsb_tc
zonkExpr ZonkEnv
env (HsUntypedBracket XUntypedBracket GhcTc
hsb_tc HsQuote GhcTc
body)
= (\HsBracketTc
x -> XUntypedBracket GhcTc -> HsQuote GhcTc -> HsExpr GhcTc
forall p. XUntypedBracket p -> HsQuote p -> HsExpr p
HsUntypedBracket XUntypedBracket GhcTc
HsBracketTc
x HsQuote GhcTc
body) (HsBracketTc -> HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) HsBracketTc -> TcM (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> HsBracketTc -> IOEnv (Env TcGblEnv TcLclEnv) HsBracketTc
zonkBracket ZonkEnv
env XUntypedBracket GhcTc
HsBracketTc
hsb_tc
zonkExpr ZonkEnv
env (HsSpliceE XSpliceE GhcTc
_ (XSplice (HsSplicedT DelayedSplice
s))) =
DelayedSplice -> TcM (HsExpr GhcTc)
runTopSplice DelayedSplice
s TcM (HsExpr GhcTc)
-> (HsExpr GhcTc -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc)
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) a
-> (a -> IOEnv (Env TcGblEnv TcLclEnv) b)
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env
zonkExpr ZonkEnv
_ e :: HsExpr GhcTc
e@(HsSpliceE XSpliceE GhcTc
_ HsSplice GhcTc
_) = String -> SDoc -> TcM (HsExpr GhcTc)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"zonkExpr: HsSpliceE" (HsExpr GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcTc
e)
zonkExpr ZonkEnv
_ (OpApp XOpApp GhcTc
x LHsExpr GhcTc
_ LHsExpr GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen -> TcM (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XOpApp GhcTc
DataConCantHappen
x
zonkExpr ZonkEnv
env (NegApp XNegApp GhcTc
x LHsExpr GhcTc
expr SyntaxExpr GhcTc
op)
= do (ZonkEnv
env', SyntaxExprTc
new_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
op
LocatedA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env' LHsExpr GhcTc
expr
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
LocatedA (HsExpr GhcTc)
new_expr SyntaxExpr GhcTc
SyntaxExprTc
new_op)
zonkExpr ZonkEnv
env (HsPar XPar GhcTc
x LHsToken "(" GhcTc
lpar LHsExpr GhcTc
e LHsToken ")" GhcTc
rpar)
= do LocatedA (HsExpr GhcTc)
new_e <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPar GhcTc
-> LHsToken "(" GhcTc
-> LHsExpr GhcTc
-> LHsToken ")" GhcTc
-> HsExpr GhcTc
forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar XPar GhcTc
x LHsToken "(" GhcTc
lpar LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e LHsToken ")" GhcTc
rpar)
zonkExpr ZonkEnv
_ (SectionL XSectionL GhcTc
x LHsExpr GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen -> TcM (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XSectionL GhcTc
DataConCantHappen
x
zonkExpr ZonkEnv
_ (SectionR XSectionR GhcTc
x LHsExpr GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen -> TcM (HsExpr GhcTc)
forall a. DataConCantHappen -> a
dataConCantHappen XSectionR GhcTc
DataConCantHappen
x
zonkExpr ZonkEnv
env (ExplicitTuple XExplicitTuple GhcTc
x [HsTupArg GhcTc]
tup_args Boxity
boxed)
= do { [HsTupArg GhcTc]
new_tup_args <- (HsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc))
-> [HsTupArg GhcTc]
-> IOEnv (Env TcGblEnv TcLclEnv) [HsTupArg GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
zonk_tup_arg [HsTupArg GhcTc]
tup_args
; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitTuple GhcTc -> [HsTupArg GhcTc] -> Boxity -> HsExpr GhcTc
forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple GhcTc
x [HsTupArg GhcTc]
new_tup_args Boxity
boxed) }
where
zonk_tup_arg :: HsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
zonk_tup_arg (Present XPresent GhcTc
x LHsExpr GhcTc
e) = do { LocatedA (HsExpr GhcTc)
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
; HsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPresent GhcTc -> LHsExpr GhcTc -> HsTupArg GhcTc
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcTc
x LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
e') }
zonk_tup_arg (Missing XMissing GhcTc
t) = do { Scaled Kind
t' <- ZonkEnv -> Scaled Kind -> TcM (Scaled Kind)
zonkScaledTcTypeToTypeX ZonkEnv
env XMissing GhcTc
Scaled Kind
t
; HsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XMissing GhcTc -> HsTupArg GhcTc
forall id. XMissing id -> HsTupArg id
Missing XMissing GhcTc
Scaled Kind
t') }
zonkExpr ZonkEnv
env (ExplicitSum XExplicitSum GhcTc
args ConTag
alt ConTag
arity LHsExpr GhcTc
expr)
= do [Kind]
new_args <- (Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind)
-> [Kind] -> IOEnv (Env TcGblEnv TcLclEnv) [Kind]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env) [Kind]
XExplicitSum GhcTc
args
LocatedA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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 [Kind]
XExplicitSum GhcTc
new_args ConTag
alt ConTag
arity LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_expr)
zonkExpr ZonkEnv
env (HsCase XCase GhcTc
x LHsExpr GhcTc
expr MatchGroup GhcTc (LHsExpr GhcTc)
ms)
= do LocatedA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
new_ms <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (HsExpr GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
ms
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
LocatedA (HsExpr GhcTc)
new_expr MatchGroup GhcTc (LHsExpr GhcTc)
MatchGroup GhcTc (LocatedA (HsExpr GhcTc))
new_ms)
zonkExpr ZonkEnv
env (HsIf XIf GhcTc
x LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 LHsExpr GhcTc
e3)
= do LocatedA (HsExpr GhcTc)
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
LocatedA (HsExpr GhcTc)
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
LocatedA (HsExpr GhcTc)
new_e3 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e3
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XIf GhcTc
-> LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XIf p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsIf XIf GhcTc
x LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e2 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e3)
zonkExpr ZonkEnv
env (HsMultiIf XMultiIf GhcTc
ty [LGRHS GhcTc (LHsExpr GhcTc)]
alts)
= do { [GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (HsExpr GhcTc)))]
alts' <- (GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (HsExpr GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (HsExpr GhcTc)))))
-> [GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (HsExpr GhcTc)))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (HsExpr GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((GRHS GhcTc (LocatedA (HsExpr GhcTc))
-> TcM (GRHS GhcTc (LocatedA (HsExpr GhcTc))))
-> GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (HsExpr GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (HsExpr GhcTc))))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA GRHS GhcTc (LocatedA (HsExpr GhcTc))
-> TcM (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
zonk_alt) [LGRHS GhcTc (LHsExpr GhcTc)]
[GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (HsExpr GhcTc)))]
alts
; Kind
ty' <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env XMultiIf GhcTc
Kind
ty
; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcTc -> TcM (HsExpr GhcTc))
-> HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ XMultiIf GhcTc -> [LGRHS GhcTc (LHsExpr GhcTc)] -> HsExpr GhcTc
forall p. XMultiIf p -> [LGRHS p (LHsExpr p)] -> HsExpr p
HsMultiIf XMultiIf GhcTc
Kind
ty' [LGRHS GhcTc (LHsExpr GhcTc)]
[GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns))
(GRHS GhcTc (LocatedA (HsExpr GhcTc)))]
alts' }
where zonk_alt :: GRHS GhcTc (LocatedA (HsExpr GhcTc))
-> TcM (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
zonk_alt (GRHS XCGRHS GhcTc (LocatedA (HsExpr GhcTc))
x [GuardLStmt GhcTc]
guard LocatedA (HsExpr GhcTc)
expr)
= do { (ZonkEnv
env', [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
guard') <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (HsExpr GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (LocatedA (HsExpr GhcTc))]
guard
; LocatedA (HsExpr GhcTc)
expr' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env' LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
expr
; GRHS GhcTc (LocatedA (HsExpr GhcTc))
-> TcM (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GRHS GhcTc (LocatedA (HsExpr GhcTc))
-> TcM (GRHS GhcTc (LocatedA (HsExpr GhcTc))))
-> GRHS GhcTc (LocatedA (HsExpr GhcTc))
-> TcM (GRHS GhcTc (LocatedA (HsExpr GhcTc)))
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcTc (LocatedA (HsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> LocatedA (HsExpr GhcTc)
-> GRHS GhcTc (LocatedA (HsExpr GhcTc))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcTc (LocatedA (HsExpr GhcTc))
x [GuardLStmt GhcTc]
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
guard' LocatedA (HsExpr GhcTc)
expr' }
zonkExpr ZonkEnv
env (HsLet XLet GhcTc
x LHsToken "let" GhcTc
tkLet HsLocalBinds GhcTc
binds LHsToken "in" GhcTc
tkIn LHsExpr GhcTc
expr)
= do (ZonkEnv
new_env, HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env HsLocalBinds GhcTc
binds
LocatedA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
new_env LHsExpr GhcTc
expr
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLet GhcTc
-> LHsToken "let" GhcTc
-> HsLocalBinds GhcTc
-> LHsToken "in" GhcTc
-> LHsExpr GhcTc
-> HsExpr GhcTc
forall p.
XLet p
-> LHsToken "let" p
-> HsLocalBinds p
-> LHsToken "in" p
-> LHsExpr p
-> HsExpr p
HsLet XLet GhcTc
x LHsToken "let" GhcTc
tkLet HsLocalBinds GhcTc
new_binds LHsToken "in" GhcTc
tkIn LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_expr)
zonkExpr ZonkEnv
env (HsDo XDo GhcTc
ty HsDoFlavour
do_or_lc (L SrcSpanAnnL
l [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
stmts))
= do (ZonkEnv
_, [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_stmts) <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (HsExpr GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
zonkLExpr [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
stmts
Kind
new_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env XDo GhcTc
Kind
ty
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XDo GhcTc
-> HsDoFlavour -> XRec GhcTc [GuardLStmt GhcTc] -> HsExpr GhcTc
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo GhcTc
Kind
new_ty HsDoFlavour
do_or_lc (SrcSpanAnnL
-> [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_stmts))
zonkExpr ZonkEnv
env (ExplicitList XExplicitList GhcTc
ty [LHsExpr GhcTc]
exprs)
= do Kind
new_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env XExplicitList GhcTc
Kind
ty
[LocatedA (HsExpr GhcTc)]
new_exprs <- ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc]
zonkLExprs ZonkEnv
env [LHsExpr GhcTc]
exprs
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitList GhcTc -> [LHsExpr GhcTc] -> HsExpr GhcTc
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcTc
Kind
new_ty [LHsExpr GhcTc]
[LocatedA (HsExpr GhcTc)]
new_exprs)
zonkExpr ZonkEnv
env expr :: HsExpr GhcTc
expr@(RecordCon { rcon_ext :: forall p. HsExpr p -> XRecordCon p
rcon_ext = XRecordCon GhcTc
con_expr, rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds = HsRecordBinds GhcTc
rbinds })
= do { HsExpr GhcTc
new_con_expr <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env XRecordCon GhcTc
HsExpr GhcTc
con_expr
; HsRecFields GhcTc (LocatedA (HsExpr GhcTc))
new_rbinds <- ZonkEnv -> HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc)
zonkRecFields ZonkEnv
env HsRecordBinds GhcTc
rbinds
; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcTc
expr { rcon_ext :: XRecordCon GhcTc
rcon_ext = XRecordCon GhcTc
HsExpr GhcTc
new_con_expr
, rcon_flds :: HsRecordBinds GhcTc
rcon_flds = HsRecordBinds GhcTc
HsRecFields GhcTc (LocatedA (HsExpr GhcTc))
new_rbinds }) }
zonkExpr ZonkEnv
env (RecordUpd { rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
rupd_flds = Left [LHsRecUpdField GhcTc]
rbinds
, rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_expr = LHsExpr GhcTc
expr
, rupd_ext :: forall p. HsExpr p -> XRecordUpd p
rupd_ext = RecordUpdTc {
rupd_cons :: RecordUpdTc -> [ConLike]
rupd_cons = [ConLike]
cons
, rupd_in_tys :: RecordUpdTc -> [Kind]
rupd_in_tys = [Kind]
in_tys
, rupd_out_tys :: RecordUpdTc -> [Kind]
rupd_out_tys = [Kind]
out_tys
, rupd_wrap :: RecordUpdTc -> HsWrapper
rupd_wrap = HsWrapper
req_wrap }})
= do { LocatedA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
; [Kind]
new_in_tys <- (Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind)
-> [Kind] -> IOEnv (Env TcGblEnv TcLclEnv) [Kind]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env) [Kind]
in_tys
; [Kind]
new_out_tys <- (Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind)
-> [Kind] -> IOEnv (Env TcGblEnv TcLclEnv) [Kind]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env) [Kind]
out_tys
; [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))]
new_rbinds <- ZonkEnv -> [LHsRecUpdField GhcTc] -> TcM [LHsRecUpdField GhcTc]
zonkRecUpdFields ZonkEnv
env [LHsRecUpdField GhcTc]
rbinds
; (ZonkEnv
_, HsWrapper
new_recwrap) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
req_wrap
; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (
RecordUpd {
rupd_expr :: LHsExpr GhcTc
rupd_expr = LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_expr
, rupd_flds :: Either [LHsRecUpdField GhcTc] [LHsRecUpdProj GhcTc]
rupd_flds = [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))]
-> Either
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (FieldLabelStrings GhcTc))
(LocatedA (HsExpr GhcTc)))]
forall a b. a -> Either a b
Left [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))]
new_rbinds
, rupd_ext :: XRecordUpd GhcTc
rupd_ext = RecordUpdTc {
rupd_cons :: [ConLike]
rupd_cons = [ConLike]
cons
, rupd_in_tys :: [Kind]
rupd_in_tys = [Kind]
new_in_tys
, rupd_out_tys :: [Kind]
rupd_out_tys = [Kind]
new_out_tys
, rupd_wrap :: HsWrapper
rupd_wrap = HsWrapper
new_recwrap }}) }
zonkExpr ZonkEnv
_ (RecordUpd {}) = String -> TcM (HsExpr GhcTc)
forall a. String -> a
panic String
"GHC.Tc.Utils.Zonk: zonkExpr: The impossible happened!"
zonkExpr ZonkEnv
env (ExprWithTySig XExprWithTySig GhcTc
_ LHsExpr GhcTc
e LHsSigWcType (NoGhcTc GhcTc)
ty)
= do { LocatedA (HsExpr GhcTc)
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
LocatedA (HsExpr GhcTc)
e' LHsSigWcType (NoGhcTc GhcTc)
ty) }
zonkExpr ZonkEnv
env (ArithSeq XArithSeq GhcTc
expr Maybe (SyntaxExpr GhcTc)
wit ArithSeqInfo GhcTc
info)
= do (ZonkEnv
env1, Maybe SyntaxExprTc
new_wit) <- ZonkEnv
-> Maybe SyntaxExprTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
zonkWit ZonkEnv
env Maybe (SyntaxExpr GhcTc)
Maybe SyntaxExprTc
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 a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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)
Maybe SyntaxExprTc
new_wit ArithSeqInfo GhcTc
new_info)
where zonkWit :: ZonkEnv
-> Maybe SyntaxExprTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
zonkWit ZonkEnv
env Maybe SyntaxExprTc
Nothing = (ZonkEnv, Maybe SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Maybe SyntaxExprTc
forall a. Maybe a
Nothing)
zonkWit ZonkEnv
env (Just SyntaxExprTc
fln) = (SyntaxExprTc -> Maybe SyntaxExprTc)
-> (ZonkEnv, SyntaxExprTc) -> (ZonkEnv, Maybe SyntaxExprTc)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second SyntaxExprTc -> Maybe SyntaxExprTc
forall a. a -> Maybe a
Just ((ZonkEnv, SyntaxExprTc) -> (ZonkEnv, Maybe SyntaxExprTc))
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
SyntaxExprTc
fln
zonkExpr ZonkEnv
env (HsPragE XPragE GhcTc
x HsPragE GhcTc
prag LHsExpr GhcTc
expr)
= do LocatedA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPragE GhcTc -> HsPragE GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XPragE p -> HsPragE p -> LHsExpr p -> HsExpr p
HsPragE XPragE GhcTc
x HsPragE GhcTc
prag LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_expr)
zonkExpr ZonkEnv
env (HsProc XProc GhcTc
x LPat GhcTc
pat LHsCmdTop GhcTc
body)
= do { (ZonkEnv
env1, GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat) <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat
; GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (HsCmdTop GhcTc)
new_body <- ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
zonkCmdTop ZonkEnv
env1 LHsCmdTop GhcTc
body
; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XProc GhcTc -> LPat GhcTc -> LHsCmdTop GhcTc -> HsExpr GhcTc
forall p. XProc p -> LPat p -> LHsCmdTop p -> HsExpr p
HsProc XProc GhcTc
x LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat LHsCmdTop GhcTc
GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (HsCmdTop GhcTc)
new_body) }
zonkExpr ZonkEnv
env (HsStatic (NameSet
fvs, Kind
ty) LHsExpr GhcTc
expr)
= do Kind
new_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env Kind
ty
XStatic GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XStatic p -> LHsExpr p -> HsExpr p
HsStatic (NameSet
fvs, Kind
new_ty) (LocatedA (HsExpr GhcTc) -> HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
-> TcM (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
zonkExpr ZonkEnv
env (XExpr (WrapExpr (HsWrap 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 a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XXExpr GhcTc -> HsExpr GhcTc
forall p. XXExpr p -> HsExpr p
XExpr (HsWrap HsExpr -> XXExprGhcTc
WrapExpr (HsWrapper -> HsExpr GhcTc -> HsWrap HsExpr
forall (hs_syn :: * -> *).
HsWrapper -> hs_syn GhcTc -> HsWrap hs_syn
HsWrap HsWrapper
new_co_fn HsExpr GhcTc
new_expr)))
zonkExpr ZonkEnv
env (XExpr (ExpansionExpr (HsExpanded HsExpr GhcRn
a HsExpr GhcTc
b)))
= XXExpr GhcTc -> HsExpr GhcTc
XXExprGhcTc -> HsExpr GhcTc
forall p. XXExpr p -> HsExpr p
XExpr (XXExprGhcTc -> HsExpr GhcTc)
-> (HsExpr GhcTc -> XXExprGhcTc) -> HsExpr GhcTc -> HsExpr GhcTc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpansion (HsExpr GhcRn) (HsExpr GhcTc) -> XXExprGhcTc
ExpansionExpr (HsExpansion (HsExpr GhcRn) (HsExpr GhcTc) -> XXExprGhcTc)
-> (HsExpr GhcTc -> HsExpansion (HsExpr GhcRn) (HsExpr GhcTc))
-> HsExpr GhcTc
-> XXExprGhcTc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcRn
-> HsExpr GhcTc -> HsExpansion (HsExpr GhcRn) (HsExpr GhcTc)
forall orig expanded. orig -> expanded -> HsExpansion orig expanded
HsExpanded HsExpr GhcRn
a (HsExpr GhcTc -> HsExpr GhcTc)
-> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env HsExpr GhcTc
b
zonkExpr ZonkEnv
env (XExpr (ConLikeTc ConLike
con [TcTyVar]
tvs [Scaled Kind]
tys))
= XXExpr GhcTc -> HsExpr GhcTc
XXExprGhcTc -> HsExpr GhcTc
forall p. XXExpr p -> HsExpr p
XExpr (XXExprGhcTc -> HsExpr GhcTc)
-> ([Scaled Kind] -> XXExprGhcTc) -> [Scaled Kind] -> HsExpr GhcTc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConLike -> [TcTyVar] -> [Scaled Kind] -> XXExprGhcTc
ConLikeTc ConLike
con [TcTyVar]
tvs ([Scaled Kind] -> HsExpr GhcTc)
-> TcM [Scaled Kind] -> TcM (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Scaled Kind -> TcM (Scaled Kind))
-> [Scaled Kind] -> TcM [Scaled Kind]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Scaled Kind -> TcM (Scaled Kind)
zonk_scale [Scaled Kind]
tys
where
zonk_scale :: Scaled Kind -> TcM (Scaled Kind)
zonk_scale (Scaled Kind
m Kind
ty) = Kind -> Kind -> Scaled Kind
forall a. Kind -> a -> Scaled a
Scaled (Kind -> Kind -> Scaled Kind)
-> IOEnv (Env TcGblEnv TcLclEnv) Kind
-> IOEnv (Env TcGblEnv TcLclEnv) (Kind -> Scaled Kind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env Kind
m IOEnv (Env TcGblEnv TcLclEnv) (Kind -> Scaled Kind)
-> IOEnv (Env TcGblEnv TcLclEnv) Kind -> TcM (Scaled Kind)
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) (a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Kind
ty
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)
zonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTc
-> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env (SyntaxExprTc { syn_expr :: SyntaxExprTc -> HsExpr GhcTc
syn_expr = HsExpr GhcTc
expr
, syn_arg_wraps :: SyntaxExprTc -> [HsWrapper]
syn_arg_wraps = [HsWrapper]
arg_wraps
, syn_res_wrap :: SyntaxExprTc -> 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, SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, SyntaxExprTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, SyntaxExprTc { syn_expr :: HsExpr GhcTc
syn_expr = HsExpr GhcTc
expr'
, syn_arg_wraps :: [HsWrapper]
syn_arg_wraps = [HsWrapper]
arg_wraps'
, syn_res_wrap :: HsWrapper
syn_res_wrap = HsWrapper
res_wrap' }) }
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
SyntaxExprTc
NoSyntaxExprTc = (ZonkEnv, SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, SyntaxExprTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, SyntaxExprTc
NoSyntaxExprTc)
zonkLCmd :: ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkCmd :: ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc)
zonkLCmd :: ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env LHsCmd GhcTc
cmd = (HsCmd GhcTc -> TcM (HsCmd GhcTc))
-> LocatedA (HsCmd GhcTc) -> TcRn (LocatedA (HsCmd GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc)
zonkCmd ZonkEnv
env) LHsCmd GhcTc
LocatedA (HsCmd GhcTc)
cmd
zonkCmd :: ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc)
zonkCmd ZonkEnv
env (XCmd (HsWrap 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 a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XXCmd GhcTc -> HsCmd GhcTc
forall id. XXCmd id -> HsCmd id
XCmd (HsWrapper -> HsCmd GhcTc -> HsWrap HsCmd
forall (hs_syn :: * -> *).
HsWrapper -> hs_syn GhcTc -> HsWrap hs_syn
HsWrap HsWrapper
w' HsCmd GhcTc
cmd')) }
zonkCmd ZonkEnv
env (HsCmdArrApp XCmdArrApp GhcTc
ty LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 HsArrAppType
ho Bool
rl)
= do LocatedA (HsExpr GhcTc)
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
LocatedA (HsExpr GhcTc)
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
Kind
new_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env XCmdArrApp GhcTc
Kind
ty
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdArrApp GhcTc
-> LHsExpr GhcTc
-> LHsExpr GhcTc
-> HsArrAppType
-> Bool
-> HsCmd GhcTc
forall id.
XCmdArrApp id
-> LHsExpr id -> LHsExpr id -> HsArrAppType -> Bool -> HsCmd id
HsCmdArrApp XCmdArrApp GhcTc
Kind
new_ty LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e2 HsArrAppType
ho Bool
rl)
zonkCmd ZonkEnv
env (HsCmdArrForm XCmdArrForm GhcTc
x LHsExpr GhcTc
op LexicalFixity
f Maybe Fixity
fixity [LHsCmdTop GhcTc]
args)
= do LocatedA (HsExpr GhcTc)
new_op <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
op
[GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (HsCmdTop GhcTc)]
new_args <- (GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (HsCmdTop GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (HsCmdTop GhcTc)))
-> [GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (HsCmdTop GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (HsCmdTop GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
zonkCmdTop ZonkEnv
env) [LHsCmdTop GhcTc]
[GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (HsCmdTop GhcTc)]
args
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
LocatedA (HsExpr GhcTc)
new_op LexicalFixity
f Maybe Fixity
fixity [LHsCmdTop GhcTc]
[GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (HsCmdTop GhcTc)]
new_args)
zonkCmd ZonkEnv
env (HsCmdApp XCmdApp GhcTc
x LHsCmd GhcTc
c LHsExpr GhcTc
e)
= do LocatedA (HsCmd GhcTc)
new_c <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env LHsCmd GhcTc
c
LocatedA (HsExpr GhcTc)
new_e <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
LocatedA (HsCmd GhcTc)
new_c LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e)
zonkCmd ZonkEnv
env (HsCmdLam XCmdLam GhcTc
x MatchGroup GhcTc (LHsCmd GhcTc)
matches)
= do MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
new_matches <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsCmd GhcTc) -> TcRn (LocatedA (HsCmd GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (HsCmd GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
ZonkEnv -> LocatedA (HsCmd GhcTc) -> TcRn (LocatedA (HsCmd GhcTc))
zonkLCmd MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
matches
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLam GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
forall id. XCmdLam id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLam XCmdLam GhcTc
x MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
new_matches)
zonkCmd ZonkEnv
env (HsCmdPar XCmdPar GhcTc
x LHsToken "(" GhcTc
lpar LHsCmd GhcTc
c LHsToken ")" GhcTc
rpar)
= do LocatedA (HsCmd GhcTc)
new_c <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env LHsCmd GhcTc
c
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdPar GhcTc
-> LHsToken "(" GhcTc
-> LHsCmd GhcTc
-> LHsToken ")" GhcTc
-> HsCmd GhcTc
forall id.
XCmdPar id
-> LHsToken "(" id -> LHsCmd id -> LHsToken ")" id -> HsCmd id
HsCmdPar XCmdPar GhcTc
x LHsToken "(" GhcTc
lpar LHsCmd GhcTc
LocatedA (HsCmd GhcTc)
new_c LHsToken ")" GhcTc
rpar)
zonkCmd ZonkEnv
env (HsCmdCase XCmdCase GhcTc
x LHsExpr GhcTc
expr MatchGroup GhcTc (LHsCmd GhcTc)
ms)
= do LocatedA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
new_ms <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsCmd GhcTc) -> TcRn (LocatedA (HsCmd GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (HsCmd GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
ZonkEnv -> LocatedA (HsCmd GhcTc) -> TcRn (LocatedA (HsCmd GhcTc))
zonkLCmd MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
ms
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
LocatedA (HsExpr GhcTc)
new_expr MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
new_ms)
zonkCmd ZonkEnv
env (HsCmdLamCase XCmdLamCase GhcTc
x LamCaseVariant
lc_variant MatchGroup GhcTc (LHsCmd GhcTc)
ms)
= do MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
new_ms <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsCmd GhcTc) -> TcRn (LocatedA (HsCmd GhcTc)))
-> MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (HsCmd GhcTc)))
forall (body :: * -> *).
(Anno (GRHS GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnn' (EpAnn NoEpAnns)) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> MatchGroup GhcTc (LocatedA (body GhcTc))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
ZonkEnv -> LocatedA (HsCmd GhcTc) -> TcRn (LocatedA (HsCmd GhcTc))
zonkLCmd MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
ms
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLamCase GhcTc
-> LamCaseVariant -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
forall id.
XCmdLamCase id
-> LamCaseVariant -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLamCase XCmdLamCase GhcTc
x LamCaseVariant
lc_variant MatchGroup GhcTc (LHsCmd GhcTc)
MatchGroup GhcTc (LocatedA (HsCmd GhcTc))
new_ms)
zonkCmd ZonkEnv
env (HsCmdIf XCmdIf GhcTc
x SyntaxExpr GhcTc
eCond LHsExpr GhcTc
ePred LHsCmd GhcTc
cThen LHsCmd GhcTc
cElse)
= do { (ZonkEnv
env1, SyntaxExprTc
new_eCond) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
eCond
; LocatedA (HsExpr GhcTc)
new_ePred <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env1 LHsExpr GhcTc
ePred
; LocatedA (HsCmd GhcTc)
new_cThen <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env1 LHsCmd GhcTc
cThen
; LocatedA (HsCmd GhcTc)
new_cElse <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env1 LHsCmd GhcTc
cElse
; HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdIf GhcTc
-> SyntaxExpr GhcTc
-> LHsExpr GhcTc
-> LHsCmd GhcTc
-> LHsCmd GhcTc
-> HsCmd GhcTc
forall id.
XCmdIf id
-> SyntaxExpr id
-> LHsExpr id
-> LHsCmd id
-> LHsCmd id
-> HsCmd id
HsCmdIf XCmdIf GhcTc
x SyntaxExpr GhcTc
SyntaxExprTc
new_eCond LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_ePred LHsCmd GhcTc
LocatedA (HsCmd GhcTc)
new_cThen LHsCmd GhcTc
LocatedA (HsCmd GhcTc)
new_cElse) }
zonkCmd ZonkEnv
env (HsCmdLet XCmdLet GhcTc
x LHsToken "let" GhcTc
tkLet HsLocalBinds GhcTc
binds LHsToken "in" GhcTc
tkIn LHsCmd GhcTc
cmd)
= do (ZonkEnv
new_env, HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env HsLocalBinds GhcTc
binds
LocatedA (HsCmd GhcTc)
new_cmd <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
new_env LHsCmd GhcTc
cmd
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLet GhcTc
-> LHsToken "let" GhcTc
-> HsLocalBinds GhcTc
-> LHsToken "in" GhcTc
-> LHsCmd GhcTc
-> HsCmd GhcTc
forall id.
XCmdLet id
-> LHsToken "let" id
-> HsLocalBinds id
-> LHsToken "in" id
-> LHsCmd id
-> HsCmd id
HsCmdLet XCmdLet GhcTc
x LHsToken "let" GhcTc
tkLet HsLocalBinds GhcTc
new_binds LHsToken "in" GhcTc
tkIn LHsCmd GhcTc
LocatedA (HsCmd GhcTc)
new_cmd)
zonkCmd ZonkEnv
env (HsCmdDo XCmdDo GhcTc
ty (L SrcSpanAnnL
l [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
stmts))
= do (ZonkEnv
_, [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
new_stmts) <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsCmd GhcTc) -> TcRn (LocatedA (HsCmd GhcTc)))
-> [LStmt GhcTc (LocatedA (HsCmd GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (HsCmd GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
ZonkEnv -> LocatedA (HsCmd GhcTc) -> TcRn (LocatedA (HsCmd GhcTc))
zonkLCmd [LStmt GhcTc (LocatedA (HsCmd GhcTc))]
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
stmts
Kind
new_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env XCmdDo GhcTc
Kind
ty
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdDo GhcTc -> XRec GhcTc [CmdLStmt GhcTc] -> HsCmd GhcTc
forall id. XCmdDo id -> XRec id [CmdLStmt id] -> HsCmd id
HsCmdDo XCmdDo GhcTc
Kind
new_ty (SrcSpanAnnL
-> [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
l [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsCmd GhcTc)))]
new_stmts))
zonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
zonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
zonkCmdTop ZonkEnv
env LHsCmdTop GhcTc
cmd = (HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc))
-> GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (HsCmdTop GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (HsCmdTop GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc)
zonk_cmd_top ZonkEnv
env) LHsCmdTop GhcTc
GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (HsCmdTop GhcTc)
cmd
zonk_cmd_top :: ZonkEnv -> HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc)
zonk_cmd_top :: ZonkEnv -> HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc)
zonk_cmd_top ZonkEnv
env (HsCmdTop (CmdTopTc Kind
stack_tys Kind
ty CmdSyntaxTable GhcTc
ids) LHsCmd GhcTc
cmd)
= do LocatedA (HsCmd GhcTc)
new_cmd <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env LHsCmd GhcTc
cmd
Kind
new_stack_tys <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env Kind
stack_tys
Kind
new_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env Kind
ty
CmdSyntaxTable GhcTc
new_ids <- (HsExpr GhcTc -> TcM (HsExpr GhcTc))
-> CmdSyntaxTable GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (CmdSyntaxTable 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) CmdSyntaxTable GhcTc
ids
Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (Kind -> Bool
isLiftedTypeKind ((() :: Constraint) => Kind -> Kind
Kind -> Kind
tcTypeKind Kind
new_stack_tys))
HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdTop GhcTc -> LHsCmd GhcTc -> HsCmdTop GhcTc
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
HsCmdTop (Kind -> Kind -> CmdSyntaxTable GhcTc -> CmdTopTc
CmdTopTc Kind
new_stack_tys Kind
new_ty CmdSyntaxTable GhcTc
new_ids) LHsCmd GhcTc
LocatedA (HsCmd GhcTc)
new_cmd)
zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
WpHole = (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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 a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, HsWrapper -> HsWrapper -> HsWrapper
WpCompose HsWrapper
c1' HsWrapper
c2') }
zonkCoFn ZonkEnv
env (WpFun HsWrapper
c1 HsWrapper
c2 Scaled Kind
t1) = do { (ZonkEnv
env1, HsWrapper
c1') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
c1
; (ZonkEnv
env2, HsWrapper
c2') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env1 HsWrapper
c2
; Scaled Kind
t1' <- ZonkEnv -> Scaled Kind -> TcM (Scaled Kind)
zonkScaledTcTypeToTypeX ZonkEnv
env2 Scaled Kind
t1
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, HsWrapper -> HsWrapper -> Scaled Kind -> HsWrapper
WpFun HsWrapper
c1' HsWrapper
c2' Scaled Kind
t1') }
zonkCoFn ZonkEnv
env (WpCast TcCoercionR
co) = do { TcCoercionR
co' <- ZonkEnv -> TcCoercionR -> TcM TcCoercionR
zonkCoToCo ZonkEnv
env TcCoercionR
co
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, TcCoercionR -> HsWrapper
WpCast TcCoercionR
co') }
zonkCoFn ZonkEnv
env (WpEvLam TcTyVar
ev) = do { (ZonkEnv
env', TcTyVar
ev') <- ZonkEnv
-> TcTyVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
zonkEvBndrX ZonkEnv
env TcTyVar
ev
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', TcTyVar -> HsWrapper
WpEvLam TcTyVar
ev') }
zonkCoFn ZonkEnv
env (WpEvApp EvTerm
arg) = do { EvTerm
arg' <- ZonkEnv -> EvTerm -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
zonkEvTerm ZonkEnv
env EvTerm
arg
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, EvTerm -> HsWrapper
WpEvApp EvTerm
arg') }
zonkCoFn ZonkEnv
env (WpTyLam TcTyVar
tv) = Bool -> TcM (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall a. HasCallStack => Bool -> a -> a
assert (TcTyVar -> Bool
isImmutableTyVar TcTyVar
tv) (TcM (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper))
-> TcM (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall a b. (a -> b) -> a -> b
$
do { (ZonkEnv
env', TcTyVar
tv') <- ZonkEnv
-> TcTyVar -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, TcTyVar)
zonkTyBndrX ZonkEnv
env TcTyVar
tv
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', TcTyVar -> HsWrapper
WpTyLam TcTyVar
tv') }
zonkCoFn ZonkEnv
env (WpTyApp Kind
ty) = do { Kind
ty' <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env Kind
ty
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Kind -> HsWrapper
WpTyApp Kind
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 a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, TcEvBinds -> HsWrapper
WpLet TcEvBinds
bs') }
zonkCoFn ZonkEnv
env (WpMultCoercion TcCoercionR
co) = do { TcCoercionR
co' <- ZonkEnv -> TcCoercionR -> TcM TcCoercionR
zonkCoToCo ZonkEnv
env TcCoercionR
co
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, TcCoercionR -> HsWrapper
WpMultCoercion TcCoercionR
co') }
zonkOverLit :: ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
zonkOverLit :: ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
zonkOverLit ZonkEnv
env lit :: HsOverLit GhcTc
lit@(OverLit {ol_ext :: forall p. HsOverLit p -> XOverLit p
ol_ext = x :: XOverLit GhcTc
x@OverLitTc { $sel:ol_witness:OverLitTc :: OverLitTc -> HsExpr GhcTc
ol_witness = HsExpr GhcTc
e, $sel:ol_type:OverLitTc :: OverLitTc -> Kind
ol_type = Kind
ty } })
= do { Kind
ty' <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env Kind
ty
; HsExpr GhcTc
e' <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env HsExpr GhcTc
e
; HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsOverLit GhcTc
lit { ol_ext :: XOverLit GhcTc
ol_ext = XOverLit GhcTc
OverLitTc
x { $sel:ol_witness:OverLitTc :: HsExpr GhcTc
ol_witness = HsExpr GhcTc
e'
, $sel:ol_type:OverLitTc :: Kind
ol_type = Kind
ty' } }) }
zonkBracket :: ZonkEnv -> HsBracketTc -> TcM HsBracketTc
zonkBracket :: ZonkEnv -> HsBracketTc -> IOEnv (Env TcGblEnv TcLclEnv) HsBracketTc
zonkBracket ZonkEnv
env (HsBracketTc HsQuote GhcRn
hsb_thing Kind
ty Maybe QuoteWrapper
wrap [PendingTcSplice]
bs)
= do Maybe QuoteWrapper
wrap' <- (QuoteWrapper -> IOEnv (Env TcGblEnv TcLclEnv) QuoteWrapper)
-> Maybe QuoteWrapper
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe QuoteWrapper)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse QuoteWrapper -> IOEnv (Env TcGblEnv TcLclEnv) QuoteWrapper
zonkQuoteWrap Maybe QuoteWrapper
wrap
[PendingTcSplice]
bs' <- (PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice)
-> [PendingTcSplice]
-> IOEnv (Env TcGblEnv TcLclEnv) [PendingTcSplice]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ZonkEnv
-> PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice
zonk_b ZonkEnv
env) [PendingTcSplice]
bs
Kind
new_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env Kind
ty
HsBracketTc -> IOEnv (Env TcGblEnv TcLclEnv) HsBracketTc
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsQuote GhcRn
-> Kind -> Maybe QuoteWrapper -> [PendingTcSplice] -> HsBracketTc
HsBracketTc HsQuote GhcRn
hsb_thing Kind
new_ty Maybe QuoteWrapper
wrap' [PendingTcSplice]
bs')
where
zonkQuoteWrap :: QuoteWrapper -> IOEnv (Env TcGblEnv TcLclEnv) QuoteWrapper
zonkQuoteWrap (QuoteWrapper TcTyVar
ev Kind
ty) = do
let ev' :: TcTyVar
ev' = ZonkEnv -> TcTyVar -> TcTyVar
zonkIdOcc ZonkEnv
env TcTyVar
ev
Kind
ty' <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env Kind
ty
QuoteWrapper -> IOEnv (Env TcGblEnv TcLclEnv) QuoteWrapper
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TcTyVar -> Kind -> QuoteWrapper
QuoteWrapper TcTyVar
ev' Kind
ty')
zonk_b :: ZonkEnv
-> PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice
zonk_b ZonkEnv
env' (PendingTcSplice Name
n LHsExpr GhcTc
e) = do LocatedA (HsExpr GhcTc)
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env' LHsExpr GhcTc
e
PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> LHsExpr GhcTc -> PendingTcSplice
PendingTcSplice Name
n LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
e')
zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
zonkArithSeq ZonkEnv
env (From LHsExpr GhcTc
e)
= do LocatedA (HsExpr GhcTc)
new_e <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcTc -> ArithSeqInfo GhcTc
forall id. LHsExpr id -> ArithSeqInfo id
From LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e)
zonkArithSeq ZonkEnv
env (FromThen LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
= do LocatedA (HsExpr GhcTc)
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
LocatedA (HsExpr GhcTc)
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
LocatedA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e2)
zonkArithSeq ZonkEnv
env (FromTo LHsExpr GhcTc
e1 LHsExpr GhcTc
e2)
= do LocatedA (HsExpr GhcTc)
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
LocatedA (HsExpr GhcTc)
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
LocatedA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e2)
zonkArithSeq ZonkEnv
env (FromThenTo LHsExpr GhcTc
e1 LHsExpr GhcTc
e2 LHsExpr GhcTc
e3)
= do LocatedA (HsExpr GhcTc)
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
LocatedA (HsExpr GhcTc)
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
LocatedA (HsExpr GhcTc)
new_e3 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e3
ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
LocatedA (HsExpr GhcTc)
new_e1 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e2 LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_e3)
zonkStmts :: Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA
=> ZonkEnv
-> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts :: forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
_ [] = (ZonkEnv,
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv,
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, [])
zonkStmts ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (LStmt GhcTc (LocatedA (body GhcTc))
s:[LStmt GhcTc (LocatedA (body GhcTc))]
ss) = do { (ZonkEnv
env1, GenLocated SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
s') <- (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
-> GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> TcM
(ZonkEnv,
GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))))
forall a b c ann.
(a -> TcM (b, c))
-> GenLocated (SrcSpanAnn' ann) a
-> TcM (b, GenLocated (SrcSpanAnn' ann) c)
wrapLocSndMA (ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody) LStmt GhcTc (LocatedA (body GhcTc))
GenLocated SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
s
; (ZonkEnv
env2, [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
ss') <- ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env1 ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody [LStmt GhcTc (LocatedA (body GhcTc))]
ss
; (ZonkEnv,
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv,
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, GenLocated SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
s' GenLocated SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
-> [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
forall a. a -> [a] -> [a]
: [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
ss') }
zonkStmt :: Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA
=> ZonkEnv
-> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> Stmt GhcTc (LocatedA (body GhcTc))
-> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc)))
zonkStmt :: forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
_ (ParStmt XParStmt GhcTc GhcTc (LocatedA (body GhcTc))
bind_ty [ParStmtBlock GhcTc GhcTc]
stmts_w_bndrs HsExpr GhcTc
mzip_op SyntaxExpr GhcTc
bind_op)
= do { (ZonkEnv
env1, SyntaxExprTc
new_bind_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_op
; Kind
new_bind_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env1 XParStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 :: [TcTyVar]
new_binders = [TcTyVar
b | ParStmtBlock XParStmtBlock GhcTc GhcTc
_ [GuardLStmt GhcTc]
_ [IdP GhcTc]
bs SyntaxExpr GhcTc
_ <- [ParStmtBlock GhcTc GhcTc]
new_stmts_w_bndrs
, TcTyVar
b <- [IdP GhcTc]
[TcTyVar]
bs]
env2 :: ZonkEnv
env2 = ZonkEnv -> [TcTyVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env1 [TcTyVar]
new_binders
; HsExpr GhcTc
new_mzip <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env2 HsExpr GhcTc
mzip_op
; (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2
, XParStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> [ParStmtBlock GhcTc GhcTc]
-> HsExpr GhcTc
-> SyntaxExpr GhcTc
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XParStmt idL idR body
-> [ParStmtBlock idL idR]
-> HsExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
ParStmt XParStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
new_bind_ty [ParStmtBlock GhcTc GhcTc]
new_stmts_w_bndrs HsExpr GhcTc
new_mzip SyntaxExpr GhcTc
SyntaxExprTc
new_bind_op)}
where
zonk_branch :: ZonkEnv -> ParStmtBlock GhcTc GhcTc
-> TcM (ParStmtBlock GhcTc GhcTc)
zonk_branch :: ZonkEnv
-> ParStmtBlock GhcTc GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ParStmtBlock GhcTc GhcTc)
zonk_branch ZonkEnv
env1 (ParStmtBlock XParStmtBlock GhcTc GhcTc
x [GuardLStmt GhcTc]
stmts [IdP GhcTc]
bndrs SyntaxExpr GhcTc
return_op)
= do { (ZonkEnv
env2, [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_stmts) <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (HsExpr GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env1 ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (LocatedA (HsExpr GhcTc))]
stmts
; (ZonkEnv
env3, SyntaxExprTc
new_return) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env2 SyntaxExpr GhcTc
return_op
; ParStmtBlock GhcTc GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ParStmtBlock GhcTc GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XParStmtBlock GhcTc GhcTc
-> [GuardLStmt GhcTc]
-> [IdP GhcTc]
-> SyntaxExpr GhcTc
-> ParStmtBlock GhcTc GhcTc
forall idL idR.
XParStmtBlock idL idR
-> [ExprLStmt idL]
-> [IdP idR]
-> SyntaxExpr idR
-> ParStmtBlock idL idR
ParStmtBlock XParStmtBlock GhcTc GhcTc
x [GuardLStmt GhcTc]
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_stmts (ZonkEnv -> [TcTyVar] -> [TcTyVar]
zonkIdOccs ZonkEnv
env3 [IdP GhcTc]
[TcTyVar]
bndrs)
SyntaxExpr GhcTc
SyntaxExprTc
new_return) }
zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (RecStmt { recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_stmts = L SrcSpanAnnL
_ [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (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 :: RecStmtTc -> Kind
recS_bind_ty = Kind
bind_ty
, recS_later_rets :: RecStmtTc -> [HsExpr GhcTc]
recS_later_rets = [HsExpr GhcTc]
later_rets
, recS_rec_rets :: RecStmtTc -> [HsExpr GhcTc]
recS_rec_rets = [HsExpr GhcTc]
rec_rets
, recS_ret_ty :: RecStmtTc -> Kind
recS_ret_ty = Kind
ret_ty} })
= do { (ZonkEnv
env1, SyntaxExprTc
new_bind_id) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_id
; (ZonkEnv
env2, SyntaxExprTc
new_mfix_id) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
mfix_id
; (ZonkEnv
env3, SyntaxExprTc
new_ret_id) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env2 SyntaxExpr GhcTc
ret_id
; Kind
new_bind_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env3 Kind
bind_ty
; [TcTyVar]
new_rvs <- ZonkEnv -> [TcTyVar] -> TcM [TcTyVar]
zonkIdBndrs ZonkEnv
env3 [IdP GhcTc]
[TcTyVar]
rvs
; [TcTyVar]
new_lvs <- ZonkEnv -> [TcTyVar] -> TcM [TcTyVar]
zonkIdBndrs ZonkEnv
env3 [IdP GhcTc]
[TcTyVar]
lvs
; Kind
new_ret_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env3 Kind
ret_ty
; let env4 :: ZonkEnv
env4 = ZonkEnv -> [TcTyVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env3 [TcTyVar]
new_rvs
; (ZonkEnv
env5, [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
new_segStmts) <- ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmtLR GhcTc GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmtLR GhcTc GhcTc (LocatedA (body GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env4 ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody [LStmtLR GhcTc GhcTc (LocatedA (body GhcTc))]
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
segStmts
; [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env5) [HsExpr GhcTc]
rec_rets
; (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> [TcTyVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env3 [TcTyVar]
new_lvs,
RecStmt { recS_stmts :: XRec GhcTc [LStmtLR GhcTc GhcTc (LocatedA (body GhcTc))]
recS_stmts = [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
-> GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
forall a an. a -> LocatedAn an a
noLocA [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))]
new_segStmts
, recS_later_ids :: [IdP GhcTc]
recS_later_ids = [IdP GhcTc]
[TcTyVar]
new_lvs
, recS_rec_ids :: [IdP GhcTc]
recS_rec_ids = [IdP GhcTc]
[TcTyVar]
new_rvs, recS_ret_fn :: SyntaxExpr GhcTc
recS_ret_fn = SyntaxExpr GhcTc
SyntaxExprTc
new_ret_id
, recS_mfix_fn :: SyntaxExpr GhcTc
recS_mfix_fn = SyntaxExpr GhcTc
SyntaxExprTc
new_mfix_id, recS_bind_fn :: SyntaxExpr GhcTc
recS_bind_fn = SyntaxExpr GhcTc
SyntaxExprTc
new_bind_id
, recS_ext :: XRecStmt GhcTc GhcTc (LocatedA (body GhcTc))
recS_ext = RecStmtTc
{ recS_bind_ty :: Kind
recS_bind_ty = Kind
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 :: Kind
recS_ret_ty = Kind
new_ret_ty } }) }
zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (BodyStmt XBodyStmt GhcTc GhcTc (LocatedA (body GhcTc))
ty LocatedA (body GhcTc)
body SyntaxExpr GhcTc
then_op SyntaxExpr GhcTc
guard_op)
= do (ZonkEnv
env1, SyntaxExprTc
new_then_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
then_op
(ZonkEnv
env2, SyntaxExprTc
new_guard_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
guard_op
LocatedA (body GhcTc)
new_body <- ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody ZonkEnv
env2 LocatedA (body GhcTc)
body
Kind
new_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env2 XBodyStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
ty
(ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, XBodyStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> LocatedA (body GhcTc)
-> SyntaxExpr GhcTc
-> SyntaxExpr GhcTc
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
new_ty LocatedA (body GhcTc)
new_body SyntaxExpr GhcTc
SyntaxExprTc
new_then_op SyntaxExpr GhcTc
SyntaxExprTc
new_guard_op)
zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (LastStmt XLastStmt GhcTc GhcTc (LocatedA (body GhcTc))
x LocatedA (body GhcTc)
body Maybe Bool
noret SyntaxExpr GhcTc
ret_op)
= do (ZonkEnv
env1, SyntaxExprTc
new_ret) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
ret_op
LocatedA (body GhcTc)
new_body <- ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody ZonkEnv
env1 LocatedA (body GhcTc)
body
(ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, XLastStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> LocatedA (body GhcTc)
-> Maybe Bool
-> SyntaxExpr GhcTc
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt GhcTc GhcTc (LocatedA (body GhcTc))
x LocatedA (body GhcTc)
new_body Maybe Bool
noret SyntaxExpr GhcTc
SyntaxExprTc
new_ret)
zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
_ (TransStmt { trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_stmts = [GuardLStmt GhcTc]
stmts, trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_bndrs = [(IdP GhcTc, IdP GhcTc)]
binderMap
, trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_by = Maybe (LHsExpr GhcTc)
by, trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_form = TransForm
form, trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_using = LHsExpr GhcTc
using
, trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_ret = SyntaxExpr GhcTc
return_op, trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind = SyntaxExpr GhcTc
bind_op
, trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_ext = XTransStmt GhcTc GhcTc (LocatedA (body GhcTc))
bind_arg_ty
, trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
trS_fmap = HsExpr GhcTc
liftM_op })
= do {
; (ZonkEnv
env1, SyntaxExprTc
bind_op') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_op
; Kind
bind_arg_ty' <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env1 XTransStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
bind_arg_ty
; (ZonkEnv
env2, [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
stmts') <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (HsExpr GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env1 ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (LocatedA (HsExpr GhcTc))]
stmts
; Maybe (LocatedA (HsExpr GhcTc))
by' <- (LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> Maybe (LocatedA (HsExpr GhcTc))
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (LocatedA (HsExpr GhcTc)))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
fmapMaybeM (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env2) Maybe (LHsExpr GhcTc)
Maybe (LocatedA (HsExpr GhcTc))
by
; LocatedA (HsExpr GhcTc)
using' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env2 LHsExpr GhcTc
using
; (ZonkEnv
env3, SyntaxExprTc
return_op') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env2 SyntaxExpr GhcTc
return_op
; [(TcTyVar, TcTyVar)]
binderMap' <- ((TcTyVar, TcTyVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (TcTyVar, TcTyVar))
-> [(TcTyVar, TcTyVar)]
-> IOEnv (Env TcGblEnv TcLclEnv) [(TcTyVar, TcTyVar)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ZonkEnv
-> (TcTyVar, TcTyVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (TcTyVar, TcTyVar)
zonkBinderMapEntry ZonkEnv
env3) [(IdP GhcTc, IdP GhcTc)]
[(TcTyVar, TcTyVar)]
binderMap
; HsExpr GhcTc
liftM_op' <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env3 HsExpr GhcTc
liftM_op
; let env3' :: ZonkEnv
env3' = ZonkEnv -> [TcTyVar] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env3 (((TcTyVar, TcTyVar) -> TcTyVar)
-> [(TcTyVar, TcTyVar)] -> [TcTyVar]
forall a b. (a -> b) -> [a] -> [b]
map (TcTyVar, TcTyVar) -> TcTyVar
forall a b. (a, b) -> b
snd [(TcTyVar, TcTyVar)]
binderMap')
; (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env3', TransStmt { trS_stmts :: [GuardLStmt GhcTc]
trS_stmts = [GuardLStmt GhcTc]
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
stmts', trS_bndrs :: [(IdP GhcTc, IdP GhcTc)]
trS_bndrs = [(IdP GhcTc, IdP GhcTc)]
[(TcTyVar, TcTyVar)]
binderMap'
, trS_by :: Maybe (LHsExpr GhcTc)
trS_by = Maybe (LHsExpr GhcTc)
Maybe (LocatedA (HsExpr GhcTc))
by', trS_form :: TransForm
trS_form = TransForm
form, trS_using :: LHsExpr GhcTc
trS_using = LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
using'
, trS_ret :: SyntaxExpr GhcTc
trS_ret = SyntaxExpr GhcTc
SyntaxExprTc
return_op', trS_bind :: SyntaxExpr GhcTc
trS_bind = SyntaxExpr GhcTc
SyntaxExprTc
bind_op'
, trS_ext :: XTransStmt GhcTc GhcTc (LocatedA (body GhcTc))
trS_ext = XTransStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
bind_arg_ty'
, trS_fmap :: HsExpr GhcTc
trS_fmap = HsExpr GhcTc
liftM_op' }) }
where
zonkBinderMapEntry :: ZonkEnv
-> (TcTyVar, TcTyVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (TcTyVar, TcTyVar)
zonkBinderMapEntry ZonkEnv
env (TcTyVar
oldBinder, TcTyVar
newBinder) = do
let oldBinder' :: TcTyVar
oldBinder' = ZonkEnv -> TcTyVar -> TcTyVar
zonkIdOcc ZonkEnv
env TcTyVar
oldBinder
TcTyVar
newBinder' <- ZonkEnv -> TcTyVar -> TcM TcTyVar
zonkIdBndr ZonkEnv
env TcTyVar
newBinder
(TcTyVar, TcTyVar)
-> IOEnv (Env TcGblEnv TcLclEnv) (TcTyVar, TcTyVar)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TcTyVar
oldBinder', TcTyVar
newBinder')
zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
_ (LetStmt XLetStmt GhcTc GhcTc (LocatedA (body GhcTc))
x HsLocalBinds GhcTc
binds)
= do (ZonkEnv
env1, HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env HsLocalBinds GhcTc
binds
(ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, XLetStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> HsLocalBinds GhcTc -> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcTc GhcTc (LocatedA (body GhcTc))
x HsLocalBinds GhcTc
new_binds)
zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody (BindStmt XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
xbs LPat GhcTc
pat LocatedA (body GhcTc)
body)
= do { (ZonkEnv
env1, SyntaxExprTc
new_bind) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env (XBindStmtTc -> SyntaxExpr GhcTc
xbstc_bindOp XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
XBindStmtTc
xbs)
; Kind
new_w <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env1 (XBindStmtTc -> Kind
xbstc_boundResultMult XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
XBindStmtTc
xbs)
; Kind
new_bind_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env1 (XBindStmtTc -> Kind
xbstc_boundResultType XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
XBindStmtTc
xbs)
; LocatedA (body GhcTc)
new_body <- ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
zBody ZonkEnv
env1 LocatedA (body GhcTc)
body
; (ZonkEnv
env2, GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat) <- ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env1 LPat GhcTc
pat
; Maybe SyntaxExprTc
new_fail <- case XBindStmtTc -> Maybe (SyntaxExpr GhcTc)
xbstc_failOp XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
XBindStmtTc
xbs of
Maybe (SyntaxExpr GhcTc)
Nothing -> Maybe SyntaxExprTc
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SyntaxExprTc
forall a. Maybe a
Nothing
Just SyntaxExpr GhcTc
f -> ((ZonkEnv, SyntaxExprTc) -> Maybe SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SyntaxExprTc -> Maybe SyntaxExprTc
forall a. a -> Maybe a
Just (SyntaxExprTc -> Maybe SyntaxExprTc)
-> ((ZonkEnv, SyntaxExprTc) -> SyntaxExprTc)
-> (ZonkEnv, SyntaxExprTc)
-> Maybe SyntaxExprTc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZonkEnv, SyntaxExprTc) -> SyntaxExprTc
forall a b. (a, b) -> b
snd) (ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
f)
; (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( ZonkEnv
env2
, XBindStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> LPat GhcTc
-> LocatedA (body GhcTc)
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt (XBindStmtTc
{ xbstc_bindOp :: SyntaxExpr GhcTc
xbstc_bindOp = SyntaxExpr GhcTc
SyntaxExprTc
new_bind
, xbstc_boundResultType :: Kind
xbstc_boundResultType = Kind
new_bind_ty
, xbstc_boundResultMult :: Kind
xbstc_boundResultMult = Kind
new_w
, xbstc_failOp :: Maybe (SyntaxExpr GhcTc)
xbstc_failOp = Maybe (SyntaxExpr GhcTc)
Maybe SyntaxExprTc
new_fail
})
LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
new_pat LocatedA (body GhcTc)
new_body) }
zonkStmt ZonkEnv
env ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))
_zBody (ApplicativeStmt XApplicativeStmt GhcTc GhcTc (LocatedA (body GhcTc))
body_ty [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args Maybe (SyntaxExpr GhcTc)
mb_join)
= do { (ZonkEnv
env1, Maybe SyntaxExprTc
new_mb_join) <- ZonkEnv
-> Maybe SyntaxExprTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
zonk_join ZonkEnv
env Maybe (SyntaxExpr GhcTc)
Maybe SyntaxExprTc
mb_join
; (ZonkEnv
env2, [(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args) <- ZonkEnv
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
zonk_args ZonkEnv
env1 [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
[(SyntaxExprTc, ApplicativeArg GhcTc)]
args
; Kind
new_body_ty <- ZonkEnv -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Kind
zonkTcTypeToTypeX ZonkEnv
env2 XApplicativeStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
body_ty
; (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
-> TcM (ZonkEnv, StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( ZonkEnv
env2
, XApplicativeStmt GhcTc GhcTc (LocatedA (body GhcTc))
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> Maybe (SyntaxExpr GhcTc)
-> StmtLR GhcTc GhcTc (LocatedA (body GhcTc))
forall idL idR body.
XApplicativeStmt idL idR body
-> [(SyntaxExpr idR, ApplicativeArg idL)]
-> Maybe (SyntaxExpr idR)
-> StmtLR idL idR body
ApplicativeStmt XApplicativeStmt GhcTc GhcTc (LocatedA (body GhcTc))
Kind
new_body_ty [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
[(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args Maybe (SyntaxExpr GhcTc)
Maybe SyntaxExprTc
new_mb_join) }
where
zonk_join :: ZonkEnv
-> Maybe SyntaxExprTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
zonk_join ZonkEnv
env Maybe SyntaxExprTc
Nothing = (ZonkEnv, Maybe SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Maybe SyntaxExprTc
forall a. Maybe a
Nothing)
zonk_join ZonkEnv
env (Just SyntaxExprTc
j) = (SyntaxExprTc -> Maybe SyntaxExprTc)
-> (ZonkEnv, SyntaxExprTc) -> (ZonkEnv, Maybe SyntaxExprTc)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second SyntaxExprTc -> Maybe SyntaxExprTc
forall a. a -> Maybe a
Just ((ZonkEnv, SyntaxExprTc) -> (ZonkEnv, Maybe SyntaxExprTc))
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe SyntaxExprTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
SyntaxExprTc
j
get_pat :: (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> LPat GhcTc
get_pat :: (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> LPat GhcTc
get_pat (SyntaxExpr GhcTc
_, ApplicativeArgOne XApplicativeArgOne GhcTc
_ LPat GhcTc
pat LHsExpr GhcTc
_ Bool
_) = LPat GhcTc
pat
get_pat (SyntaxExpr GhcTc
_, ApplicativeArgMany XApplicativeArgMany GhcTc
_ [GuardLStmt GhcTc]
_ HsExpr GhcTc
_ LPat GhcTc
pat HsDoFlavour
_) = LPat GhcTc
pat
replace_pat :: LPat GhcTc
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
replace_pat :: LPat GhcTc
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
replace_pat LPat GhcTc
pat (SyntaxExpr GhcTc
op, ApplicativeArgOne XApplicativeArgOne GhcTc
fail_op LPat GhcTc
_ LHsExpr GhcTc
a Bool
isBody)
= (SyntaxExpr GhcTc
op, XApplicativeArgOne GhcTc
-> LPat GhcTc -> LHsExpr GhcTc -> Bool -> ApplicativeArg GhcTc
forall idL.
XApplicativeArgOne idL
-> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
ApplicativeArgOne XApplicativeArgOne GhcTc
fail_op LPat GhcTc
pat LHsExpr GhcTc
a Bool
isBody)
replace_pat LPat GhcTc
pat (SyntaxExpr GhcTc
op, ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
a HsExpr GhcTc
b LPat GhcTc
_ HsDoFlavour
c)
= (SyntaxExpr GhcTc
op, XApplicativeArgMany GhcTc
-> [GuardLStmt GhcTc]
-> HsExpr GhcTc
-> LPat GhcTc
-> HsDoFlavour
-> ApplicativeArg GhcTc
forall idL.
XApplicativeArgMany idL
-> [ExprLStmt idL]
-> HsExpr idL
-> LPat idL
-> HsDoFlavour
-> ApplicativeArg idL
ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
a HsExpr GhcTc
b LPat GhcTc
pat HsDoFlavour
c)
zonk_args :: ZonkEnv
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
zonk_args ZonkEnv
env [(SyntaxExprTc, ApplicativeArg GhcTc)]
args
= do { (ZonkEnv
env1, [(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args_rev) <- ZonkEnv
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
zonk_args_rev ZonkEnv
env ([(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a. [a] -> [a]
reverse [(SyntaxExprTc, ApplicativeArg GhcTc)]
args)
; (ZonkEnv
env2, [GenLocated SrcSpanAnnA (Pat GhcTc)]
new_pats) <- ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
zonkPats ZonkEnv
env1 (((SyntaxExprTc, ApplicativeArg GhcTc)
-> GenLocated SrcSpanAnnA (Pat GhcTc))
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
forall a b. (a -> b) -> [a] -> [b]
map (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> LPat GhcTc
(SyntaxExprTc, ApplicativeArg GhcTc)
-> GenLocated SrcSpanAnnA (Pat GhcTc)
get_pat [(SyntaxExprTc, ApplicativeArg GhcTc)]
args)
; (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, String
-> (GenLocated SrcSpanAnnA (Pat GhcTc)
-> (SyntaxExprTc, ApplicativeArg GhcTc)
-> (SyntaxExprTc, ApplicativeArg GhcTc))
-> [GenLocated SrcSpanAnnA (Pat GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithEqual String
"zonkStmt" LPat GhcTc
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
GenLocated SrcSpanAnnA (Pat GhcTc)
-> (SyntaxExprTc, ApplicativeArg GhcTc)
-> (SyntaxExprTc, ApplicativeArg GhcTc)
replace_pat
[GenLocated SrcSpanAnnA (Pat GhcTc)]
new_pats ([(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a. [a] -> [a]
reverse [(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args_rev)) }
zonk_args_rev :: ZonkEnv
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
zonk_args_rev ZonkEnv
env ((SyntaxExprTc
op, ApplicativeArg GhcTc
arg) : [(SyntaxExprTc, ApplicativeArg GhcTc)]
args)
= do { (ZonkEnv
env1, SyntaxExprTc
new_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
SyntaxExprTc
op
; ApplicativeArg GhcTc
new_arg <- ZonkEnv
-> ApplicativeArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
zonk_arg ZonkEnv
env1 ApplicativeArg GhcTc
arg
; (ZonkEnv
env2, [(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args) <- ZonkEnv
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
zonk_args_rev ZonkEnv
env1 [(SyntaxExprTc, ApplicativeArg GhcTc)]
args
; (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, (SyntaxExprTc
new_op, ApplicativeArg GhcTc
new_arg) (SyntaxExprTc, ApplicativeArg GhcTc)
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
-> [(SyntaxExprTc, ApplicativeArg GhcTc)]
forall a. a -> [a] -> [a]
: [(SyntaxExprTc, ApplicativeArg GhcTc)]
new_args) }
zonk_args_rev ZonkEnv
env [] = (ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExprTc, ApplicativeArg GhcTc)])
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, [])
zonk_arg :: ZonkEnv
-> ApplicativeArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
zonk_arg ZonkEnv
env (ApplicativeArgOne XApplicativeArgOne GhcTc
fail_op LPat GhcTc
pat LHsExpr GhcTc
expr Bool
isBody)
= do { LocatedA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
; Maybe SyntaxExprTc
new_fail <- Maybe SyntaxExprTc
-> (SyntaxExprTc -> IOEnv (Env TcGblEnv TcLclEnv) SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe SyntaxExprTc
XApplicativeArgOne GhcTc
fail_op ((SyntaxExprTc -> IOEnv (Env TcGblEnv TcLclEnv) SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
-> (SyntaxExprTc -> IOEnv (Env TcGblEnv TcLclEnv) SyntaxExprTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
forall a b. (a -> b) -> a -> b
$ \SyntaxExprTc
old_fail ->
do { (ZonkEnv
_, SyntaxExprTc
fail') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
SyntaxExprTc
old_fail
; SyntaxExprTc -> IOEnv (Env TcGblEnv TcLclEnv) SyntaxExprTc
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return SyntaxExprTc
fail'
}
; ApplicativeArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XApplicativeArgOne GhcTc
-> LPat GhcTc -> LHsExpr GhcTc -> Bool -> ApplicativeArg GhcTc
forall idL.
XApplicativeArgOne idL
-> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
ApplicativeArgOne Maybe SyntaxExprTc
XApplicativeArgOne GhcTc
new_fail LPat GhcTc
pat LHsExpr GhcTc
LocatedA (HsExpr GhcTc)
new_expr Bool
isBody) }
zonk_arg ZonkEnv
env (ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
stmts HsExpr GhcTc
ret LPat GhcTc
pat HsDoFlavour
ctxt)
= do { (ZonkEnv
env1, [GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_stmts) <- ZonkEnv
-> (ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc)))
-> [LStmt GhcTc (LocatedA (HsExpr GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (HsExpr GhcTc))])
forall (body :: * -> *).
(Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))
~ SrcSpanAnnA) =>
ZonkEnv
-> (ZonkEnv
-> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc)))
-> [LStmt GhcTc (LocatedA (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
ZonkEnv
-> LocatedA (HsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr GhcTc))
zonkLExpr [GuardLStmt GhcTc]
[LStmt GhcTc (LocatedA (HsExpr GhcTc))]
stmts
; HsExpr GhcTc
new_ret <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env1 HsExpr GhcTc
ret
; ApplicativeArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XApplicativeArgMany GhcTc
-> [GuardLStmt GhcTc]
-> HsExpr GhcTc
-> LPat GhcTc
-> HsDoFlavour
-> ApplicativeArg GhcTc
forall idL.
XApplicativeArgMany idL
-> [ExprLStmt idL]
-> HsExpr idL
-> LPat idL
-> HsDoFlavour
-> ApplicativeArg idL
ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
[GenLocated
SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
new_stmts HsExpr GhcTc
new_ret LPat GhcTc
pat HsDoFlavour
ctxt) }
zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc)
zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc)
zonkRecFields ZonkEnv
env (HsRecFields [LHsRecField GhcTc (LHsExpr GhcTc)]
flds Maybe (Located ConTag)
dd)
= do { [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))]
flds' <- (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))))
zonk_rbind [LHsRecField GhcTc (LHsExpr GhcTc)]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))]
flds
; HsRecFields GhcTc (LocatedA (HsExpr GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(HsRecFields GhcTc (LocatedA (HsExpr GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsRecField GhcTc (LocatedA (HsExpr GhcTc))]
-> Maybe (Located ConTag)
-> HsRecFields GhcTc (LocatedA (HsExpr GhcTc))
forall p arg.
[LHsRecField p arg] -> Maybe (Located ConTag) -> HsRecFields p arg
HsRecFields [LHsRecField GhcTc (LocatedA (HsExpr GhcTc))]
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))]
flds' Maybe (Located ConTag)
dd) }
where
zonk_rbind :: GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))))
zonk_rbind (L SrcSpanAnnA
l HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))
fld)
= do { GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc)
new_id <- (FieldOcc GhcTc -> TcM (FieldOcc GhcTc))
-> GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc)
-> TcRn
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc ZonkEnv
env) (HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))
-> GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc)
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))
fld)
; LocatedA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env (HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))
-> LocatedA (HsExpr GhcTc)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))
fld)
; GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsFieldBind
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))
fld { hfbLHS :: GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc)
hfbLHS = GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc)
new_id
, hfbRHS :: LocatedA (HsExpr GhcTc)
hfbRHS = LocatedA (HsExpr GhcTc)
new_expr })) }
zonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTc]
-> TcM [LHsRecUpdField GhcTc]
zonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTc] -> TcM [LHsRecUpdField GhcTc]
zonkRecUpdFields ZonkEnv
env = (GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))))
-> [GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))))
zonk_rbind
where
zonk_rbind :: GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))))
zonk_rbind (L SrcSpanAnnA
l HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))
fld)
= do { GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc)
new_id <- (FieldOcc GhcTc -> TcM (FieldOcc GhcTc))
-> GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc)
-> TcRn
(GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc))
forall a b ann.
(a -> TcM b)
-> GenLocated (SrcSpanAnn' ann) a
-> TcRn (GenLocated (SrcSpanAnn' ann) b)
wrapLocMA (ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc ZonkEnv
env) (HsFieldBind (LAmbiguousFieldOcc GhcTc) (LocatedA (HsExpr GhcTc))
-> LFieldOcc GhcTc
forall arg.
HsFieldBind (LAmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
hsRecUpdFieldOcc HsFieldBind (LAmbiguousFieldOcc GhcTc) (LocatedA (HsExpr GhcTc))
HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))
fld)
; LocatedA (HsExpr GhcTc)
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env (HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))
-> LocatedA (HsExpr GhcTc)
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))
fld)
; GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))
-> GenLocated
SrcSpanAnnA
(HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsFieldBind
(GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc))
(LocatedA (HsExpr GhcTc))
fld { hfbLHS :: GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc)
hfbLHS = (FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc)
-> GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc)
-> GenLocated
(SrcSpanAnn' (EpAnn NoEpAnns)) (AmbiguousFieldOcc GhcTc)
forall a b.
(a -> b)
-> GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) a
-> GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc
ambiguousFieldOcc GenLocated (SrcSpanAnn' (EpAnn NoEpAnns)) (FieldOcc GhcTc)
new_id
, hfbRHS :: LocatedA (HsExpr GhcTc)
hfbRHS = LocatedA (HsExpr GhcTc)
new_expr })) }
zonkPat :: ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat :: ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
zonkPat ZonkEnv
env LPat GhcTc
pat = (Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc))
-> GenLocated SrcSpanAnnA (Pat GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, GenLocated SrcSpanAnnA (Pat GhcTc))
forall a b c ann.
(a -> TcM (b, c))
-> GenLocated (SrcSpanAnn' ann) a
-> TcM (b, GenLocated (SrcSpanAnn' ann) c)
wrapLocSndMA (ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc)
zonk_pat ZonkEnv
env) LPat GhcTc
GenLocated SrcSpanAnnA (Pat GhcTc)
pat
zonk_pat :: ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv,