{-# LANGUAGE CPP, TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
module TcHsSyn (
hsLitType, hsLPatType, hsPatType,
mkHsDictLet, mkHsApp,
mkHsAppTy, mkHsCaseAlt,
shortCutLit, hsOverLitName,
conLikeResTy,
TcId, TcIdSet,
zonkTopDecls, zonkTopExpr, zonkTopLExpr,
zonkTopBndrs,
ZonkEnv, ZonkFlexi(..), emptyZonkEnv, mkEmptyZonkEnv, initZonkEnv,
zonkTyVarBinders, zonkTyVarBindersX, zonkTyVarBinderX,
zonkTyBndrs, zonkTyBndrsX,
zonkTcTypeToType, zonkTcTypeToTypeX,
zonkTcTypesToTypes, zonkTcTypesToTypesX,
zonkTyVarOcc,
zonkCoToCo,
zonkEvBinds, zonkTcEvBinds,
zonkTcMethInfoToMethInfoX,
lookupTyVarOcc
) where
#include "HsVersions.h"
import GhcPrelude
import HsSyn
import Id
import IdInfo
import TcRnMonad
import PrelNames
import BuildTyCl ( TcMethInfo, MethInfo )
import TcType
import TcMType
import TcEnv ( tcLookupGlobalOnly )
import TcEvidence
import TysPrim
import TyCon
import TysWiredIn
import Type
import Coercion
import ConLike
import DataCon
import HscTypes
import Name
import NameEnv
import Var
import VarEnv
import DynFlags
import Literal
import BasicTypes
import Maybes
import SrcLoc
import Bag
import Outputable
import Util
import UniqFM
import CoreSyn
import {-# SOURCE #-} TcSplice (runTopSplice)
import Control.Monad
import Data.List ( partition )
import Control.Arrow ( second )
hsLPatType :: OutPat GhcTc -> Type
hsLPatType :: OutPat GhcTc -> Type
hsLPatType lpat :: OutPat GhcTc
lpat = OutPat GhcTc -> Type
hsPatType (OutPat GhcTc -> SrcSpanLess (OutPat GhcTc)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc OutPat GhcTc
lpat)
hsPatType :: Pat GhcTc -> Type
hsPatType :: OutPat GhcTc -> Type
hsPatType (ParPat _ pat :: OutPat GhcTc
pat) = OutPat GhcTc -> Type
hsLPatType OutPat GhcTc
pat
hsPatType (WildPat ty :: XWildPat GhcTc
ty) = Type
XWildPat GhcTc
ty
hsPatType (VarPat _ lvar :: Located (IdP GhcTc)
lvar) = Id -> Type
idType (Located Id -> SrcSpanLess (Located Id)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Id
Located (IdP GhcTc)
lvar)
hsPatType (BangPat _ pat :: OutPat GhcTc
pat) = OutPat GhcTc -> Type
hsLPatType OutPat GhcTc
pat
hsPatType (LazyPat _ pat :: OutPat GhcTc
pat) = OutPat GhcTc -> Type
hsLPatType OutPat GhcTc
pat
hsPatType (LitPat _ lit :: HsLit GhcTc
lit) = HsLit GhcTc -> Type
forall (p :: Pass). HsLit (GhcPass p) -> Type
hsLitType HsLit GhcTc
lit
hsPatType (AsPat _ var :: Located (IdP GhcTc)
var _) = Id -> Type
idType (Located Id -> SrcSpanLess (Located Id)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Id
Located (IdP GhcTc)
var)
hsPatType (ViewPat ty :: XViewPat GhcTc
ty _ _) = Type
XViewPat GhcTc
ty
hsPatType (ListPat (ListPatTc ty Nothing) _) = Type -> Type
mkListTy Type
ty
hsPatType (ListPat (ListPatTc _ (Just (ty,_))) _) = Type
ty
hsPatType (TuplePat tys :: XTuplePat GhcTc
tys _ bx :: Boxity
bx) = Boxity -> [Type] -> Type
mkTupleTy Boxity
bx [Type]
XTuplePat GhcTc
tys
hsPatType (SumPat tys :: XSumPat GhcTc
tys _ _ _ ) = [Type] -> Type
mkSumTy [Type]
XSumPat GhcTc
tys
hsPatType (ConPatOut { pat_con :: forall p. Pat p -> Located ConLike
pat_con = Located ConLike
lcon
, pat_arg_tys :: forall p. Pat p -> [Type]
pat_arg_tys = [Type]
tys })
= ConLike -> [Type] -> Type
conLikeResTy (Located ConLike -> SrcSpanLess (Located ConLike)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ConLike
lcon) [Type]
tys
hsPatType (SigPat ty :: XSigPat GhcTc
ty _ _) = Type
XSigPat GhcTc
ty
hsPatType (NPat ty :: XNPat GhcTc
ty _ _ _) = Type
XNPat GhcTc
ty
hsPatType (NPlusKPat ty :: XNPlusKPat GhcTc
ty _ _ _ _ _) = Type
XNPlusKPat GhcTc
ty
hsPatType (CoPat _ _ _ ty :: Type
ty) = Type
ty
hsPatType p :: OutPat GhcTc
p = String -> SDoc -> Type
forall a. HasCallStack => String -> SDoc -> a
pprPanic "hsPatType" (OutPat GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr OutPat GhcTc
p)
hsLitType :: HsLit (GhcPass p) -> TcType
hsLitType :: HsLit (GhcPass p) -> Type
hsLitType (HsChar _ _) = Type
charTy
hsLitType (HsCharPrim _ _) = Type
charPrimTy
hsLitType (HsString _ _) = Type
stringTy
hsLitType (HsStringPrim _ _) = Type
addrPrimTy
hsLitType (HsInt _ _) = Type
intTy
hsLitType (HsIntPrim _ _) = Type
intPrimTy
hsLitType (HsWordPrim _ _) = Type
wordPrimTy
hsLitType (HsInt64Prim _ _) = Type
int64PrimTy
hsLitType (HsWord64Prim _ _) = Type
word64PrimTy
hsLitType (HsInteger _ _ ty :: Type
ty) = Type
ty
hsLitType (HsRat _ _ ty :: Type
ty) = Type
ty
hsLitType (HsFloatPrim _ _) = Type
floatPrimTy
hsLitType (HsDoublePrim _ _) = Type
doublePrimTy
hsLitType (XLit p :: XXLit (GhcPass p)
p) = String -> SDoc -> Type
forall a. HasCallStack => String -> SDoc -> a
pprPanic "hsLitType" (NoExt -> SDoc
forall a. Outputable a => a -> SDoc
ppr XXLit (GhcPass p)
NoExt
p)
shortCutLit :: DynFlags -> OverLitVal -> TcType -> Maybe (HsExpr GhcTcId)
shortCutLit :: DynFlags -> OverLitVal -> Type -> Maybe (HsExpr GhcTc)
shortCutLit dflags :: DynFlags
dflags (HsIntegral int :: IntegralLit
int@(IL src :: SourceText
src neg :: Bool
neg i :: Integer
i)) ty :: Type
ty
| Type -> Bool
isIntTy Type
ty Bool -> Bool -> Bool
&& DynFlags -> Integer -> Bool
inIntRange DynFlags
dflags Integer
i = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
NoExt
noExt (XHsInt GhcTc -> IntegralLit -> HsLit GhcTc
forall x. XHsInt x -> IntegralLit -> HsLit x
HsInt XHsInt GhcTc
NoExt
noExt IntegralLit
int))
| Type -> Bool
isWordTy Type
ty Bool -> Bool -> Bool
&& DynFlags -> Integer -> Bool
inWordRange DynFlags
dflags Integer
i = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit DataCon
wordDataCon (XHsWordPrim GhcTc -> Integer -> HsLit GhcTc
forall x. XHsWordPrim x -> Integer -> HsLit x
HsWordPrim SourceText
XHsWordPrim GhcTc
src Integer
i))
| Type -> Bool
isIntegerTy Type
ty = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
NoExt
noExt (XHsInteger GhcTc -> Integer -> Type -> HsLit GhcTc
forall x. XHsInteger x -> Integer -> Type -> HsLit x
HsInteger SourceText
XHsInteger GhcTc
src Integer
i Type
ty))
| Bool
otherwise = DynFlags -> OverLitVal -> Type -> Maybe (HsExpr GhcTc)
shortCutLit DynFlags
dflags (FractionalLit -> OverLitVal
HsFractional (Bool -> Integer -> FractionalLit
integralFractionalLit Bool
neg Integer
i)) Type
ty
shortCutLit _ (HsFractional f :: FractionalLit
f) ty :: Type
ty
| Type -> Bool
isFloatTy Type
ty = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit DataCon
floatDataCon (XHsFloatPrim GhcTc -> FractionalLit -> HsLit GhcTc
forall x. XHsFloatPrim x -> FractionalLit -> HsLit x
HsFloatPrim XHsFloatPrim GhcTc
NoExt
noExt FractionalLit
f))
| Type -> Bool
isDoubleTy Type
ty = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit DataCon
doubleDataCon (XHsDoublePrim GhcTc -> FractionalLit -> HsLit GhcTc
forall x. XHsDoublePrim x -> FractionalLit -> HsLit x
HsDoublePrim XHsDoublePrim GhcTc
NoExt
noExt FractionalLit
f))
| Bool
otherwise = Maybe (HsExpr GhcTc)
forall a. Maybe a
Nothing
shortCutLit _ (HsIsString src :: SourceText
src s :: FastString
s) ty :: Type
ty
| Type -> Bool
isStringTy Type
ty = HsExpr GhcTc -> Maybe (HsExpr GhcTc)
forall a. a -> Maybe a
Just (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
NoExt
noExt (XHsString GhcTc -> FastString -> HsLit GhcTc
forall x. XHsString x -> FastString -> HsLit x
HsString SourceText
XHsString GhcTc
src FastString
s))
| Bool
otherwise = Maybe (HsExpr GhcTc)
forall a. Maybe a
Nothing
mkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc
mkLit con :: DataCon
con lit :: HsLit GhcTc
lit = XApp GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcTc
NoExt
noExt (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 Id
ze_tv_env :: TyCoVarEnv TyCoVar
, ZonkEnv -> TyCoVarEnv Id
ze_id_env :: IdEnv Id
, ZonkEnv -> TcRef (TyVarEnv Type)
ze_meta_tv_env :: TcRef (TyVarEnv Type) }
data ZonkFlexi
= DefaultFlexi
| SkolemiseFlexi
| RuntimeUnkFlexi
instance Outputable ZonkEnv where
ppr :: ZonkEnv -> SDoc
ppr (ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
var_env}) = TyCoVarEnv Id -> ([Id] -> SDoc) -> SDoc
forall a. UniqFM a -> ([a] -> SDoc) -> SDoc
pprUFM TyCoVarEnv Id
var_env ([SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> ([Id] -> [SDoc]) -> [Id] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id -> SDoc) -> [Id] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr)
emptyZonkEnv :: TcM ZonkEnv
emptyZonkEnv :: TcM ZonkEnv
emptyZonkEnv = ZonkFlexi -> TcM ZonkEnv
mkEmptyZonkEnv ZonkFlexi
DefaultFlexi
mkEmptyZonkEnv :: ZonkFlexi -> TcM ZonkEnv
mkEmptyZonkEnv :: ZonkFlexi -> TcM ZonkEnv
mkEmptyZonkEnv flexi :: ZonkFlexi
flexi
= do { TcRef (TyVarEnv Type)
mtv_env_ref <- TyVarEnv Type -> TcRnIf TcGblEnv TcLclEnv (TcRef (TyVarEnv Type))
forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
newTcRef TyVarEnv Type
forall a. VarEnv a
emptyVarEnv
; ZonkEnv -> TcM ZonkEnv
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv :: ZonkFlexi
-> TyCoVarEnv Id
-> TyCoVarEnv Id
-> TcRef (TyVarEnv Type)
-> ZonkEnv
ZonkEnv { ze_flexi :: ZonkFlexi
ze_flexi = ZonkFlexi
flexi
, ze_tv_env :: TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id
forall a. VarEnv a
emptyVarEnv
, ze_id_env :: TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
forall a. VarEnv a
emptyVarEnv
, ze_meta_tv_env :: TcRef (TyVarEnv Type)
ze_meta_tv_env = TcRef (TyVarEnv Type)
mtv_env_ref }) }
initZonkEnv :: (ZonkEnv -> a -> TcM b) -> a -> TcM b
initZonkEnv :: (ZonkEnv -> a -> TcM b) -> a -> TcM b
initZonkEnv do_it :: ZonkEnv -> a -> TcM b
do_it x :: a
x = do { ZonkEnv
ze <- ZonkFlexi -> TcM ZonkEnv
mkEmptyZonkEnv ZonkFlexi
DefaultFlexi
; ZonkEnv -> a -> TcM b
do_it ZonkEnv
ze a
x }
extendIdZonkEnvRec :: ZonkEnv -> [Var] -> ZonkEnv
extendIdZonkEnvRec :: ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ze :: ZonkEnv
ze@(ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
id_env }) ids :: [Id]
ids
= ZonkEnv
ze { ze_id_env :: TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id -> [(Id, Id)] -> TyCoVarEnv Id
forall a. VarEnv a -> [(Id, a)] -> VarEnv a
extendVarEnvList TyCoVarEnv Id
id_env [(Id
id,Id
id) | Id
id <- [Id]
ids] }
extendZonkEnv :: ZonkEnv -> [Var] -> ZonkEnv
extendZonkEnv :: ZonkEnv -> [Id] -> ZonkEnv
extendZonkEnv ze :: ZonkEnv
ze@(ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id
tyco_env, ze_id_env :: ZonkEnv -> TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
id_env }) vars :: [Id]
vars
= ZonkEnv
ze { ze_tv_env :: TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id -> [(Id, Id)] -> TyCoVarEnv Id
forall a. VarEnv a -> [(Id, a)] -> VarEnv a
extendVarEnvList TyCoVarEnv Id
tyco_env [(Id
tv,Id
tv) | Id
tv <- [Id]
tycovars]
, ze_id_env :: TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id -> [(Id, Id)] -> TyCoVarEnv Id
forall a. VarEnv a -> [(Id, a)] -> VarEnv a
extendVarEnvList TyCoVarEnv Id
id_env [(Id
id,Id
id) | Id
id <- [Id]
ids] }
where
(tycovars :: [Id]
tycovars, ids :: [Id]
ids) = (Id -> Bool) -> [Id] -> ([Id], [Id])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Id -> Bool
isTyCoVar [Id]
vars
extendIdZonkEnv1 :: ZonkEnv -> Var -> ZonkEnv
extendIdZonkEnv1 :: ZonkEnv -> Id -> ZonkEnv
extendIdZonkEnv1 ze :: ZonkEnv
ze@(ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
id_env }) id :: Id
id
= ZonkEnv
ze { ze_id_env :: TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id -> Id -> Id -> TyCoVarEnv Id
forall a. VarEnv a -> Id -> a -> VarEnv a
extendVarEnv TyCoVarEnv Id
id_env Id
id Id
id }
extendTyZonkEnv1 :: ZonkEnv -> TyVar -> ZonkEnv
extendTyZonkEnv1 :: ZonkEnv -> Id -> ZonkEnv
extendTyZonkEnv1 ze :: ZonkEnv
ze@(ZonkEnv { ze_tv_env :: ZonkEnv -> TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id
ty_env }) tv :: Id
tv
= ZonkEnv
ze { ze_tv_env :: TyCoVarEnv Id
ze_tv_env = TyCoVarEnv Id -> Id -> Id -> TyCoVarEnv Id
forall a. VarEnv a -> Id -> a -> VarEnv a
extendVarEnv TyCoVarEnv Id
ty_env Id
tv Id
tv }
setZonkType :: ZonkEnv -> ZonkFlexi -> ZonkEnv
setZonkType :: ZonkEnv -> ZonkFlexi -> ZonkEnv
setZonkType ze :: ZonkEnv
ze flexi :: ZonkFlexi
flexi = ZonkEnv
ze { ze_flexi :: ZonkFlexi
ze_flexi = ZonkFlexi
flexi }
zonkEnvIds :: ZonkEnv -> TypeEnv
zonkEnvIds :: ZonkEnv -> TypeEnv
zonkEnvIds (ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
id_env})
= [(Name, TyThing)] -> TypeEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Id -> Name
forall a. NamedThing a => a -> Name
getName Id
id, Id -> TyThing
AnId Id
id) | Id
id <- TyCoVarEnv Id -> [Id]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM TyCoVarEnv Id
id_env]
zonkLIdOcc :: ZonkEnv -> Located TcId -> Located Id
zonkLIdOcc :: ZonkEnv -> Located Id -> Located Id
zonkLIdOcc env :: ZonkEnv
env = (SrcSpanLess (Located Id) -> SrcSpanLess (Located Id))
-> Located Id -> Located Id
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> SrcSpanLess b) -> a -> b
onHasSrcSpan (ZonkEnv -> Id -> Id
zonkIdOcc ZonkEnv
env)
zonkIdOcc :: ZonkEnv -> TcId -> Id
zonkIdOcc :: ZonkEnv -> Id -> Id
zonkIdOcc (ZonkEnv { ze_id_env :: ZonkEnv -> TyCoVarEnv Id
ze_id_env = TyCoVarEnv Id
id_env}) id :: Id
id
| Id -> Bool
isLocalVar Id
id = TyCoVarEnv Id -> Id -> Maybe Id
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv TyCoVarEnv Id
id_env Id
id Maybe Id -> Id -> Id
forall a. Maybe a -> a -> a
`orElse`
Id
id
| Bool
otherwise = Id
id
zonkIdOccs :: ZonkEnv -> [TcId] -> [Id]
zonkIdOccs :: ZonkEnv -> [Id] -> [Id]
zonkIdOccs env :: ZonkEnv
env ids :: [Id]
ids = (Id -> Id) -> [Id] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (ZonkEnv -> Id -> Id
zonkIdOcc ZonkEnv
env) [Id]
ids
zonkIdBndr :: ZonkEnv -> TcId -> TcM Id
zonkIdBndr :: ZonkEnv -> Id -> TcM Id
zonkIdBndr env :: ZonkEnv
env v :: Id
v
= do Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env (Id -> Type
idType Id
v)
Type -> SDoc -> TcM ()
ensureNotLevPoly Type
ty'
(String -> SDoc
text "In the type of binder" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
v))
Id -> TcM Id
forall (m :: * -> *) a. Monad m => a -> m a
return (HasDebugCallStack => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> Type -> IdInfo
`setLevityInfoWithType` Type
ty') (Id -> Type -> Id
setIdType Id
v Type
ty'))
zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id]
zonkIdBndrs :: ZonkEnv -> [Id] -> TcM [Id]
zonkIdBndrs env :: ZonkEnv
env ids :: [Id]
ids = (Id -> TcM Id) -> [Id] -> TcM [Id]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env) [Id]
ids
zonkTopBndrs :: [TcId] -> TcM [Id]
zonkTopBndrs :: [Id] -> TcM [Id]
zonkTopBndrs ids :: [Id]
ids = (ZonkEnv -> [Id] -> TcM [Id]) -> [Id] -> TcM [Id]
forall a b. (ZonkEnv -> a -> TcM b) -> a -> TcM b
initZonkEnv ZonkEnv -> [Id] -> TcM [Id]
zonkIdBndrs [Id]
ids
zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTcId -> TcM (FieldOcc GhcTc)
zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc env :: ZonkEnv
env (FieldOcc sel :: XCFieldOcc GhcTc
sel lbl :: Located RdrName
lbl)
= (Id -> FieldOcc GhcTc) -> TcM Id -> TcM (FieldOcc GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Id -> Located RdrName -> FieldOcc GhcTc)
-> Located RdrName -> Id -> FieldOcc GhcTc
forall a b c. (a -> b -> c) -> b -> a -> c
flip Id -> Located RdrName -> FieldOcc GhcTc
forall pass. XCFieldOcc pass -> Located RdrName -> FieldOcc pass
FieldOcc) Located RdrName
lbl) (TcM Id -> TcM (FieldOcc GhcTc)) -> TcM Id -> TcM (FieldOcc GhcTc)
forall a b. (a -> b) -> a -> b
$ ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
XCFieldOcc GhcTc
sel
zonkFieldOcc _ (XFieldOcc _) = String -> TcM (FieldOcc GhcTc)
forall a. String -> a
panic "zonkFieldOcc"
zonkEvBndrsX :: ZonkEnv -> [EvVar] -> TcM (ZonkEnv, [Var])
zonkEvBndrsX :: ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
zonkEvBndrsX = (ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id))
-> ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkEvBndrX
zonkEvBndrX :: ZonkEnv -> EvVar -> TcM (ZonkEnv, EvVar)
zonkEvBndrX :: ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkEvBndrX env :: ZonkEnv
env var :: Id
var
= do { Id
var' <- ZonkEnv -> Id -> TcM Id
zonkEvBndr ZonkEnv
env Id
var
; (ZonkEnv, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> [Id] -> ZonkEnv
extendZonkEnv ZonkEnv
env [Id
var'], Id
var') }
zonkEvBndr :: ZonkEnv -> EvVar -> TcM EvVar
zonkEvBndr :: ZonkEnv -> Id -> TcM Id
zonkEvBndr env :: ZonkEnv
env var :: Id
var
= do { let var_ty :: Type
var_ty = Id -> Type
varType Id
var
; Type
ty <-
{-# SCC "zonkEvBndr_zonkTcTypeToType" #-}
ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
var_ty
; Id -> TcM Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Type -> Id
setVarType Id
var Type
ty) }
zonkCoreBndrX :: ZonkEnv -> Var -> TcM (ZonkEnv, Var)
zonkCoreBndrX :: ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkCoreBndrX env :: ZonkEnv
env v :: Id
v
| Id -> Bool
isId Id
v = do { Id
v' <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
v
; (ZonkEnv, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> Id -> ZonkEnv
extendIdZonkEnv1 ZonkEnv
env Id
v', Id
v') }
| Bool
otherwise = ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkTyBndrX ZonkEnv
env Id
v
zonkCoreBndrsX :: ZonkEnv -> [Var] -> TcM (ZonkEnv, [Var])
zonkCoreBndrsX :: ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
zonkCoreBndrsX = (ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id))
-> ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkCoreBndrX
zonkTyBndrs :: [TcTyVar] -> TcM (ZonkEnv, [TyVar])
zonkTyBndrs :: [Id] -> TcM (ZonkEnv, [Id])
zonkTyBndrs = (ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id]))
-> [Id] -> TcM (ZonkEnv, [Id])
forall a b. (ZonkEnv -> a -> TcM b) -> a -> TcM b
initZonkEnv ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
zonkTyBndrsX
zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])
zonkTyBndrsX :: ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
zonkTyBndrsX = (ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id))
-> ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkTyBndrX
zonkTyBndrX :: ZonkEnv -> TcTyVar -> TcM (ZonkEnv, TyVar)
zonkTyBndrX :: ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkTyBndrX env :: ZonkEnv
env tv :: Id
tv
= ASSERT2( isImmutableTyVar tv, ppr tv <+> dcolon <+> ppr (tyVarKind tv) )
do { Type
ki <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env (Id -> Type
tyVarKind Id
tv)
; let tv' :: Id
tv' = Name -> Type -> Id
mkTyVar (Id -> Name
tyVarName Id
tv) Type
ki
; (ZonkEnv, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> Id -> ZonkEnv
extendTyZonkEnv1 ZonkEnv
env Id
tv', Id
tv') }
zonkTyVarBinders :: [VarBndr TcTyVar vis]
-> TcM (ZonkEnv, [VarBndr TyVar vis])
zonkTyVarBinders :: [VarBndr Id vis] -> TcM (ZonkEnv, [VarBndr Id vis])
zonkTyVarBinders = (ZonkEnv -> [VarBndr Id vis] -> TcM (ZonkEnv, [VarBndr Id vis]))
-> [VarBndr Id vis] -> TcM (ZonkEnv, [VarBndr Id vis])
forall a b. (ZonkEnv -> a -> TcM b) -> a -> TcM b
initZonkEnv ZonkEnv -> [VarBndr Id vis] -> TcM (ZonkEnv, [VarBndr Id vis])
forall vis.
ZonkEnv -> [VarBndr Id vis] -> TcM (ZonkEnv, [VarBndr Id vis])
zonkTyVarBindersX
zonkTyVarBindersX :: ZonkEnv -> [VarBndr TcTyVar vis]
-> TcM (ZonkEnv, [VarBndr TyVar vis])
zonkTyVarBindersX :: ZonkEnv -> [VarBndr Id vis] -> TcM (ZonkEnv, [VarBndr Id vis])
zonkTyVarBindersX = (ZonkEnv
-> VarBndr Id vis
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, VarBndr Id vis))
-> ZonkEnv -> [VarBndr Id vis] -> TcM (ZonkEnv, [VarBndr Id vis])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv
-> VarBndr Id vis
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, VarBndr Id vis)
forall vis.
ZonkEnv -> VarBndr Id vis -> TcM (ZonkEnv, VarBndr Id vis)
zonkTyVarBinderX
zonkTyVarBinderX :: ZonkEnv -> VarBndr TcTyVar vis
-> TcM (ZonkEnv, VarBndr TyVar vis)
zonkTyVarBinderX :: ZonkEnv -> VarBndr Id vis -> TcM (ZonkEnv, VarBndr Id vis)
zonkTyVarBinderX env :: ZonkEnv
env (Bndr tv :: Id
tv vis :: vis
vis)
= do { (env' :: ZonkEnv
env', tv' :: Id
tv') <- ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkTyBndrX ZonkEnv
env Id
tv
; (ZonkEnv, VarBndr Id vis) -> TcM (ZonkEnv, VarBndr Id vis)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', Id -> vis -> VarBndr Id vis
forall var argf. var -> argf -> VarBndr var argf
Bndr Id
tv' vis
vis) }
zonkTopExpr :: HsExpr GhcTcId -> TcM (HsExpr GhcTc)
zonkTopExpr :: HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkTopExpr e :: HsExpr GhcTc
e = (ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc))
-> HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a b. (ZonkEnv -> a -> TcM b) -> a -> TcM b
initZonkEnv ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr HsExpr GhcTc
e
zonkTopLExpr :: LHsExpr GhcTcId -> TcM (LHsExpr GhcTc)
zonkTopLExpr :: LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkTopLExpr e :: LHsExpr GhcTc
e = (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
forall a b. (ZonkEnv -> a -> TcM b) -> a -> TcM b
initZonkEnv ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr LHsExpr GhcTc
e
zonkTopDecls :: Bag EvBind
-> LHsBinds GhcTcId
-> [LRuleDecl GhcTcId] -> [LTcSpecPrag]
-> [LForeignDecl GhcTcId]
-> TcM (TypeEnv,
Bag EvBind,
LHsBinds GhcTc,
[LForeignDecl GhcTc],
[LTcSpecPrag],
[LRuleDecl GhcTc])
zonkTopDecls :: Bag EvBind
-> LHsBinds GhcTc
-> [LRuleDecl GhcTc]
-> [LTcSpecPrag]
-> [LForeignDecl GhcTc]
-> TcM
(TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
[LTcSpecPrag], [LRuleDecl GhcTc])
zonkTopDecls ev_binds :: Bag EvBind
ev_binds binds :: LHsBinds GhcTc
binds rules :: [LRuleDecl GhcTc]
rules imp_specs :: [LTcSpecPrag]
imp_specs fords :: [LForeignDecl GhcTc]
fords
= do { (env1 :: ZonkEnv
env1, ev_binds' :: Bag EvBind
ev_binds') <- (ZonkEnv -> Bag EvBind -> TcM (ZonkEnv, Bag EvBind))
-> Bag EvBind -> TcM (ZonkEnv, Bag EvBind)
forall a b. (ZonkEnv -> a -> TcM b) -> a -> TcM b
initZonkEnv ZonkEnv -> Bag EvBind -> TcM (ZonkEnv, Bag EvBind)
zonkEvBinds Bag EvBind
ev_binds
; (env2 :: ZonkEnv
env2, binds' :: LHsBinds GhcTc
binds') <- ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds ZonkEnv
env1 LHsBinds GhcTc
binds
; [LRuleDecl GhcTc]
rules' <- ZonkEnv -> [LRuleDecl GhcTc] -> TcM [LRuleDecl GhcTc]
zonkRules ZonkEnv
env2 [LRuleDecl GhcTc]
rules
; [LTcSpecPrag]
specs' <- ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
zonkLTcSpecPrags ZonkEnv
env2 [LTcSpecPrag]
imp_specs
; [LForeignDecl GhcTc]
fords' <- ZonkEnv -> [LForeignDecl GhcTc] -> TcM [LForeignDecl GhcTc]
zonkForeignExports ZonkEnv
env2 [LForeignDecl GhcTc]
fords
; (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
[LTcSpecPrag], [LRuleDecl GhcTc])
-> TcM
(TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
[LTcSpecPrag], [LRuleDecl GhcTc])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> TypeEnv
zonkEnvIds ZonkEnv
env2, Bag EvBind
ev_binds', LHsBinds GhcTc
binds', [LForeignDecl GhcTc]
fords', [LTcSpecPrag]
specs', [LRuleDecl GhcTc]
rules') }
zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTcId
-> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds env :: ZonkEnv
env (EmptyLocalBinds x :: XEmptyLocalBinds GhcTc GhcTc
x)
= (ZonkEnv, HsLocalBinds GhcTc) -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, (XEmptyLocalBinds GhcTc GhcTc -> HsLocalBinds GhcTc
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds GhcTc GhcTc
x))
zonkLocalBinds _ (HsValBinds _ (ValBinds {}))
= String -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall a. String -> a
panic "zonkLocalBinds"
zonkLocalBinds env :: ZonkEnv
env (HsValBinds x :: XHsValBinds GhcTc GhcTc
x (XValBindsLR (NValBinds binds sigs)))
= do { (env1 :: ZonkEnv
env1, new_binds :: [(RecFlag, LHsBinds GhcTc)]
new_binds) <- ZonkEnv
-> [(RecFlag, LHsBinds GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, [(RecFlag, LHsBinds GhcTc)])
forall a.
ZonkEnv
-> [(a, LHsBinds GhcTc)]
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(a, LHsBinds GhcTc)])
go ZonkEnv
env [(RecFlag, LHsBinds GhcTc)]
binds
; (ZonkEnv, HsLocalBinds GhcTc) -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, XHsValBinds GhcTc GhcTc
-> HsValBindsLR GhcTc GhcTc -> HsLocalBinds GhcTc
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcTc GhcTc
x (XXValBindsLR GhcTc GhcTc -> HsValBindsLR GhcTc GhcTc
forall idL idR. XXValBindsLR idL idR -> HsValBindsLR idL idR
XValBindsLR ([(RecFlag, LHsBinds GhcTc)] -> [LSig GhcRn] -> NHsValBindsLR GhcTc
forall idL.
[(RecFlag, LHsBinds idL)] -> [LSig GhcRn] -> NHsValBindsLR idL
NValBinds [(RecFlag, LHsBinds GhcTc)]
new_binds [LSig GhcRn]
sigs))) }
where
go :: ZonkEnv
-> [(a, LHsBinds GhcTc)]
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(a, LHsBinds GhcTc)])
go env :: ZonkEnv
env []
= (ZonkEnv, [(a, LHsBinds GhcTc)])
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(a, LHsBinds GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, [])
go env :: ZonkEnv
env ((r :: a
r,b :: LHsBinds GhcTc
b):bs :: [(a, LHsBinds GhcTc)]
bs)
= do { (env1 :: ZonkEnv
env1, b' :: LHsBinds GhcTc
b') <- ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds ZonkEnv
env LHsBinds GhcTc
b
; (env2 :: ZonkEnv
env2, bs' :: [(a, LHsBinds GhcTc)]
bs') <- ZonkEnv
-> [(a, LHsBinds GhcTc)]
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(a, LHsBinds GhcTc)])
go ZonkEnv
env1 [(a, LHsBinds GhcTc)]
bs
; (ZonkEnv, [(a, LHsBinds GhcTc)])
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [(a, LHsBinds GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, (a
r,LHsBinds GhcTc
b')(a, LHsBinds GhcTc)
-> [(a, LHsBinds GhcTc)] -> [(a, LHsBinds GhcTc)]
forall a. a -> [a] -> [a]
:[(a, LHsBinds GhcTc)]
bs') }
zonkLocalBinds env :: ZonkEnv
env (HsIPBinds x :: XHsIPBinds GhcTc GhcTc
x (IPBinds dict_binds :: XIPBinds GhcTc
dict_binds binds :: [LIPBind GhcTc]
binds )) = do
[LIPBind GhcTc]
new_binds <- (LIPBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LIPBind GhcTc))
-> [LIPBind GhcTc] -> IOEnv (Env TcGblEnv TcLclEnv) [LIPBind GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((SrcSpanLess (LIPBind GhcTc) -> TcM (SrcSpanLess (LIPBind GhcTc)))
-> LIPBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LIPBind GhcTc)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM SrcSpanLess (LIPBind GhcTc) -> TcM (SrcSpanLess (LIPBind GhcTc))
IPBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (IPBind GhcTc)
zonk_ip_bind) [LIPBind GhcTc]
binds
let
env1 :: ZonkEnv
env1 = ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env
[ Id
IdP GhcTc
n | (LIPBind GhcTc -> Located (SrcSpanLess (LIPBind GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L _ (IPBind _ (Right n) _)) <- [LIPBind GhcTc]
new_binds]
(env2 :: ZonkEnv
env2, new_dict_binds :: TcEvBinds
new_dict_binds) <- ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds)
zonkTcEvBinds ZonkEnv
env1 XIPBinds GhcTc
TcEvBinds
dict_binds
(ZonkEnv, HsLocalBinds GhcTc) -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, XHsIPBinds GhcTc GhcTc -> HsIPBinds GhcTc -> HsLocalBinds GhcTc
forall idL idR.
XHsIPBinds idL idR -> HsIPBinds idR -> HsLocalBindsLR idL idR
HsIPBinds XHsIPBinds GhcTc GhcTc
x (XIPBinds GhcTc -> [LIPBind GhcTc] -> HsIPBinds GhcTc
forall id. XIPBinds id -> [LIPBind id] -> HsIPBinds id
IPBinds XIPBinds GhcTc
TcEvBinds
new_dict_binds [LIPBind GhcTc]
new_binds))
where
zonk_ip_bind :: IPBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (IPBind GhcTc)
zonk_ip_bind (IPBind x :: XCIPBind GhcTc
x n :: Either (Located HsIPName) (IdP GhcTc)
n e :: LHsExpr GhcTc
e)
= do Either (Located HsIPName) Id
n' <- (Id -> TcM Id)
-> Either (Located HsIPName) Id
-> TcM (Either (Located HsIPName) Id)
forall a b.
(a -> TcM b)
-> Either (Located HsIPName) a -> TcM (Either (Located HsIPName) b)
mapIPNameTc (ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env) Either (Located HsIPName) Id
Either (Located HsIPName) (IdP GhcTc)
n
LHsExpr GhcTc
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
IPBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (IPBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCIPBind GhcTc
-> Either (Located HsIPName) (IdP GhcTc)
-> LHsExpr GhcTc
-> IPBind GhcTc
forall id.
XCIPBind id
-> Either (Located HsIPName) (IdP id) -> LHsExpr id -> IPBind id
IPBind XCIPBind GhcTc
x Either (Located HsIPName) Id
Either (Located HsIPName) (IdP GhcTc)
n' LHsExpr GhcTc
e')
zonk_ip_bind (XIPBind _) = String -> IOEnv (Env TcGblEnv TcLclEnv) (IPBind GhcTc)
forall a. String -> a
panic "zonkLocalBinds : XCIPBind"
zonkLocalBinds _ (HsIPBinds _ (XHsIPBinds _))
= String -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall a. String -> a
panic "zonkLocalBinds"
zonkLocalBinds _ (XHsLocalBindsLR _)
= String -> TcM (ZonkEnv, HsLocalBinds GhcTc)
forall a. String -> a
panic "zonkLocalBinds"
zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTcId -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds env :: ZonkEnv
env binds :: LHsBinds GhcTc
binds
= ((ZonkEnv, LHsBinds GhcTc) -> TcM (ZonkEnv, LHsBinds GhcTc))
-> TcM (ZonkEnv, LHsBinds GhcTc)
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM (\ ~(_, new_binds :: LHsBinds GhcTc
new_binds) -> do
{ let env1 :: ZonkEnv
env1 = ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env (LHsBinds GhcTc -> [IdP GhcTc]
forall (p :: Pass) idR.
LHsBindsLR (GhcPass p) idR -> [IdP (GhcPass p)]
collectHsBindsBinders LHsBinds GhcTc
new_binds)
; LHsBinds GhcTc
binds' <- ZonkEnv -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
zonkMonoBinds ZonkEnv
env1 LHsBinds GhcTc
binds
; (ZonkEnv, LHsBinds GhcTc) -> TcM (ZonkEnv, LHsBinds GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, LHsBinds GhcTc
binds') })
zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTcId -> TcM (LHsBinds GhcTc)
zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
zonkMonoBinds env :: ZonkEnv
env binds :: LHsBinds GhcTc
binds = (LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc))
-> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM (ZonkEnv
-> LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
zonk_lbind ZonkEnv
env) LHsBinds GhcTc
binds
zonk_lbind :: ZonkEnv -> LHsBind GhcTcId -> TcM (LHsBind GhcTc)
zonk_lbind :: ZonkEnv
-> LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
zonk_lbind env :: ZonkEnv
env = (SrcSpanLess (LHsBind GhcTc) -> TcM (SrcSpanLess (LHsBind GhcTc)))
-> LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> HsBind GhcTc -> TcM (HsBind GhcTc)
zonk_bind ZonkEnv
env)
zonk_bind :: ZonkEnv -> HsBind GhcTcId -> TcM (HsBind GhcTc)
zonk_bind :: ZonkEnv -> HsBind GhcTc -> TcM (HsBind GhcTc)
zonk_bind env :: ZonkEnv
env bind :: HsBind GhcTc
bind@(PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = OutPat GhcTc
pat, pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_rhs = GRHSs GhcTc (LHsExpr GhcTc)
grhss
, pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
pat_ext = NPatBindTc fvs ty})
= do { (_env :: ZonkEnv
_env, new_pat :: OutPat GhcTc
new_pat) <- ZonkEnv -> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
zonkPat ZonkEnv
env OutPat GhcTc
pat
; GRHSs GhcTc (LHsExpr GhcTc)
new_grhss <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> GRHSs GhcTc (LHsExpr GhcTc)
-> TcM (GRHSs GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> GRHSs GhcTc (Located (body GhcTc))
-> TcM (GRHSs GhcTc (Located (body GhcTc)))
zonkGRHSs ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr GRHSs GhcTc (LHsExpr GhcTc)
grhss
; Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
ty
; HsBind GhcTc -> TcM (HsBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBind GhcTc
bind { pat_lhs :: OutPat GhcTc
pat_lhs = OutPat GhcTc
new_pat, pat_rhs :: GRHSs GhcTc (LHsExpr GhcTc)
pat_rhs = GRHSs GhcTc (LHsExpr GhcTc)
new_grhss
, pat_ext :: XPatBind GhcTc GhcTc
pat_ext = NameSet -> Type -> NPatBindTc
NPatBindTc NameSet
fvs Type
new_ty }) }
zonk_bind env :: ZonkEnv
env (VarBind { var_ext :: forall idL idR. HsBindLR idL idR -> XVarBind idL idR
var_ext = XVarBind GhcTc GhcTc
x
, var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id = IdP GhcTc
var, var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
var_rhs = LHsExpr GhcTc
expr, var_inline :: forall idL idR. HsBindLR idL idR -> Bool
var_inline = Bool
inl })
= do { Id
new_var <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
IdP GhcTc
var
; LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
; HsBind GhcTc -> TcM (HsBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarBind :: forall idL idR.
XVarBind idL idR
-> IdP idL -> LHsExpr idR -> Bool -> HsBindLR idL idR
VarBind { var_ext :: XVarBind GhcTc GhcTc
var_ext = XVarBind GhcTc GhcTc
x
, var_id :: IdP GhcTc
var_id = Id
IdP GhcTc
new_var
, var_rhs :: LHsExpr GhcTc
var_rhs = LHsExpr GhcTc
new_expr
, var_inline :: Bool
var_inline = Bool
inl }) }
zonk_bind env :: ZonkEnv
env bind :: HsBind GhcTc
bind@(FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id = (Located (IdP GhcTc) -> Located (SrcSpanLess (Located Id))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L loc :: SrcSpan
loc var :: SrcSpanLess (Located Id)
var)
, fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
ms
, fun_co_fn :: forall idL idR. HsBindLR idL idR -> HsWrapper
fun_co_fn = HsWrapper
co_fn })
= do { Id
new_var <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env SrcSpanLess (Located Id)
Id
var
; (env1 :: ZonkEnv
env1, new_co_fn :: HsWrapper
new_co_fn) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
co_fn
; MatchGroup GhcTc (LHsExpr GhcTc)
new_ms <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env1 ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
ms
; HsBind GhcTc -> TcM (HsBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBind GhcTc
bind { fun_id :: Located (IdP GhcTc)
fun_id = SrcSpan -> SrcSpanLess (Located Id) -> Located Id
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located Id)
Id
new_var
, fun_matches :: MatchGroup GhcTc (LHsExpr GhcTc)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
new_ms
, fun_co_fn :: HsWrapper
fun_co_fn = HsWrapper
new_co_fn }) }
zonk_bind env :: ZonkEnv
env (AbsBinds { abs_tvs :: forall idL idR. HsBindLR idL idR -> [Id]
abs_tvs = [Id]
tyvars, abs_ev_vars :: forall idL idR. HsBindLR idL idR -> [Id]
abs_ev_vars = [Id]
evs
, abs_ev_binds :: forall idL idR. HsBindLR idL idR -> [TcEvBinds]
abs_ev_binds = [TcEvBinds]
ev_binds
, abs_exports :: forall idL idR. HsBindLR idL idR -> [ABExport idL]
abs_exports = [ABExport GhcTc]
exports
, abs_binds :: forall idL idR. HsBindLR idL idR -> LHsBinds idL
abs_binds = LHsBinds GhcTc
val_binds
, abs_sig :: forall idL idR. HsBindLR idL idR -> Bool
abs_sig = Bool
has_sig })
= ASSERT( all isImmutableTyVar tyvars )
do { (env0 :: ZonkEnv
env0, new_tyvars :: [Id]
new_tyvars) <- ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
zonkTyBndrsX ZonkEnv
env [Id]
tyvars
; (env1 :: ZonkEnv
env1, new_evs :: [Id]
new_evs) <- ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
zonkEvBndrsX ZonkEnv
env0 [Id]
evs
; (env2 :: ZonkEnv
env2, new_ev_binds :: [TcEvBinds]
new_ev_binds) <- ZonkEnv -> [TcEvBinds] -> TcM (ZonkEnv, [TcEvBinds])
zonkTcEvBinds_s ZonkEnv
env1 [TcEvBinds]
ev_binds
; (new_val_bind :: LHsBinds GhcTc
new_val_bind, new_exports :: [ABExport GhcTc]
new_exports) <- ((LHsBinds GhcTc, [ABExport GhcTc])
-> IOEnv
(Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc]))
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc])
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM (((LHsBinds GhcTc, [ABExport GhcTc])
-> IOEnv
(Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc]))
-> IOEnv
(Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc]))
-> ((LHsBinds GhcTc, [ABExport GhcTc])
-> IOEnv
(Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc]))
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc])
forall a b. (a -> b) -> a -> b
$ \ ~(new_val_binds :: LHsBinds GhcTc
new_val_binds, _) ->
do { let env3 :: ZonkEnv
env3 = ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env2 ([Id] -> ZonkEnv) -> [Id] -> ZonkEnv
forall a b. (a -> b) -> a -> b
$
LHsBinds GhcTc -> [IdP GhcTc]
forall (p :: Pass) idR.
LHsBindsLR (GhcPass p) idR -> [IdP (GhcPass p)]
collectHsBindsBinders LHsBinds GhcTc
new_val_binds
; LHsBinds GhcTc
new_val_binds <- (LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc))
-> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bag a -> m (Bag b)
mapBagM (ZonkEnv
-> LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
zonk_val_bind ZonkEnv
env3) LHsBinds GhcTc
val_binds
; [ABExport GhcTc]
new_exports <- (ABExport GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport GhcTc))
-> [ABExport GhcTc]
-> IOEnv (Env TcGblEnv TcLclEnv) [ABExport GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv
-> ABExport GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport GhcTc)
forall p p.
(IdP p ~ Id, IdP p ~ Id, XABE p ~ XABE p) =>
ZonkEnv -> ABExport p -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport p)
zonk_export ZonkEnv
env3) [ABExport GhcTc]
exports
; (LHsBinds GhcTc, [ABExport GhcTc])
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsBinds GhcTc, [ABExport GhcTc])
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsBinds GhcTc
new_val_binds, [ABExport GhcTc]
new_exports) }
; HsBind GhcTc -> TcM (HsBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (AbsBinds :: forall idL idR.
XAbsBinds idL idR
-> [Id]
-> [Id]
-> [ABExport idL]
-> [TcEvBinds]
-> LHsBinds idL
-> Bool
-> HsBindLR idL idR
AbsBinds { abs_ext :: XAbsBinds GhcTc GhcTc
abs_ext = XAbsBinds GhcTc GhcTc
NoExt
noExt
, abs_tvs :: [Id]
abs_tvs = [Id]
new_tyvars, abs_ev_vars :: [Id]
abs_ev_vars = [Id]
new_evs
, abs_ev_binds :: [TcEvBinds]
abs_ev_binds = [TcEvBinds]
new_ev_binds
, abs_exports :: [ABExport GhcTc]
abs_exports = [ABExport GhcTc]
new_exports, abs_binds :: LHsBinds GhcTc
abs_binds = LHsBinds GhcTc
new_val_bind
, abs_sig :: Bool
abs_sig = Bool
has_sig }) }
where
zonk_val_bind :: ZonkEnv
-> LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
zonk_val_bind env :: ZonkEnv
env lbind :: LHsBind GhcTc
lbind
| Bool
has_sig
, (LHsBind GhcTc -> Located (SrcSpanLess (LHsBind GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L loc :: SrcSpan
loc bind :: SrcSpanLess (LHsBind GhcTc)
bind@(FunBind { fun_id = (dL->L mloc mono_id)
, fun_matches = ms
, fun_co_fn = co_fn })) <- LHsBind GhcTc
lbind
= do { Id
new_mono_id <- (Type -> TcM Type) -> Id -> TcM Id
forall (m :: * -> *). Monad m => (Type -> m Type) -> Id -> m Id
updateVarTypeM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) SrcSpanLess (Located Id)
Id
mono_id
; (env' :: ZonkEnv
env', new_co_fn :: HsWrapper
new_co_fn) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
co_fn
; MatchGroup GhcTc (LHsExpr GhcTc)
new_ms <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env' ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
ms
; LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc))
-> LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> SrcSpanLess (LHsBind GhcTc) -> LHsBind GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (SrcSpanLess (LHsBind GhcTc) -> LHsBind GhcTc)
-> SrcSpanLess (LHsBind GhcTc) -> LHsBind GhcTc
forall a b. (a -> b) -> a -> b
$
SrcSpanLess (LHsBind GhcTc)
HsBind GhcTc
bind { fun_id :: Located (IdP GhcTc)
fun_id = SrcSpan -> SrcSpanLess (Located Id) -> Located Id
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
mloc SrcSpanLess (Located Id)
Id
new_mono_id
, fun_matches :: MatchGroup GhcTc (LHsExpr GhcTc)
fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
new_ms
, fun_co_fn :: HsWrapper
fun_co_fn = HsWrapper
new_co_fn } }
| Bool
otherwise
= ZonkEnv
-> LHsBind GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBind GhcTc)
zonk_lbind ZonkEnv
env LHsBind GhcTc
lbind
zonk_export :: ZonkEnv -> ABExport p -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport p)
zonk_export env :: ZonkEnv
env (ABE{ abe_ext :: forall p. ABExport p -> XABE p
abe_ext = XABE p
x
, abe_wrap :: forall p. ABExport p -> HsWrapper
abe_wrap = HsWrapper
wrap
, abe_poly :: forall p. ABExport p -> IdP p
abe_poly = IdP p
poly_id
, abe_mono :: forall p. ABExport p -> IdP p
abe_mono = IdP p
mono_id
, abe_prags :: forall p. ABExport p -> TcSpecPrags
abe_prags = TcSpecPrags
prags })
= do Id
new_poly_id <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
IdP p
poly_id
(_, new_wrap :: HsWrapper
new_wrap) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
wrap
TcSpecPrags
new_prags <- ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags
zonkSpecPrags ZonkEnv
env TcSpecPrags
prags
ABExport p -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport p)
forall (m :: * -> *) a. Monad m => a -> m a
return (ABE :: forall p.
XABE p -> IdP p -> IdP p -> HsWrapper -> TcSpecPrags -> ABExport p
ABE{ abe_ext :: XABE p
abe_ext = XABE p
XABE p
x
, abe_wrap :: HsWrapper
abe_wrap = HsWrapper
new_wrap
, abe_poly :: IdP p
abe_poly = Id
IdP p
new_poly_id
, abe_mono :: IdP p
abe_mono = ZonkEnv -> Id -> Id
zonkIdOcc ZonkEnv
env Id
IdP p
mono_id
, abe_prags :: TcSpecPrags
abe_prags = TcSpecPrags
new_prags })
zonk_export _ (XABExport _) = String -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport p)
forall a. String -> a
panic "zonk_bind: XABExport"
zonk_bind env :: ZonkEnv
env (PatSynBind x :: XPatSynBind GhcTc GhcTc
x bind :: PatSynBind GhcTc GhcTc
bind@(PSB { psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
psb_id = (Located (IdP GhcTc) -> Located (SrcSpanLess (Located Id))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L loc :: SrcSpan
loc id :: SrcSpanLess (Located Id)
id)
, psb_args :: forall idL idR.
PatSynBind idL idR -> HsPatSynDetails (Located (IdP idR))
psb_args = HsPatSynDetails (Located (IdP GhcTc))
details
, psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_def = OutPat GhcTc
lpat
, psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir = HsPatSynDir GhcTc
dir }))
= do { Id
id' <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env SrcSpanLess (Located Id)
Id
id
; (env1 :: ZonkEnv
env1, lpat' :: OutPat GhcTc
lpat') <- ZonkEnv -> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
zonkPat ZonkEnv
env OutPat GhcTc
lpat
; let details' :: HsPatSynDetails (Located Id)
details' = ZonkEnv
-> HsPatSynDetails (Located Id) -> HsPatSynDetails (Located Id)
zonkPatSynDetails ZonkEnv
env1 HsPatSynDetails (Located Id)
HsPatSynDetails (Located (IdP GhcTc))
details
; (_env2 :: ZonkEnv
_env2, dir' :: HsPatSynDir GhcTc
dir') <- ZonkEnv -> HsPatSynDir GhcTc -> TcM (ZonkEnv, HsPatSynDir GhcTc)
zonkPatSynDir ZonkEnv
env1 HsPatSynDir GhcTc
dir
; HsBind GhcTc -> TcM (HsBind GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsBind GhcTc -> TcM (HsBind GhcTc))
-> HsBind GhcTc -> TcM (HsBind GhcTc)
forall a b. (a -> b) -> a -> b
$ XPatSynBind GhcTc GhcTc -> PatSynBind GhcTc GhcTc -> HsBind GhcTc
forall idL idR.
XPatSynBind idL idR -> PatSynBind idL idR -> HsBindLR idL idR
PatSynBind XPatSynBind GhcTc GhcTc
x (PatSynBind GhcTc GhcTc -> HsBind GhcTc)
-> PatSynBind GhcTc GhcTc -> HsBind GhcTc
forall a b. (a -> b) -> a -> b
$
PatSynBind GhcTc GhcTc
bind { psb_id :: Located (IdP GhcTc)
psb_id = SrcSpan -> SrcSpanLess (Located Id) -> Located Id
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located Id)
Id
id'
, psb_args :: HsPatSynDetails (Located (IdP GhcTc))
psb_args = HsPatSynDetails (Located Id)
HsPatSynDetails (Located (IdP GhcTc))
details'
, psb_def :: OutPat GhcTc
psb_def = OutPat GhcTc
lpat'
, psb_dir :: HsPatSynDir GhcTc
psb_dir = HsPatSynDir GhcTc
dir' } }
zonk_bind _ (PatSynBind _ (XPatSynBind _)) = String -> TcM (HsBind GhcTc)
forall a. String -> a
panic "zonk_bind"
zonk_bind _ (XHsBindsLR _) = String -> TcM (HsBind GhcTc)
forall a. String -> a
panic "zonk_bind"
zonkPatSynDetails :: ZonkEnv
-> HsPatSynDetails (Located TcId)
-> HsPatSynDetails (Located Id)
zonkPatSynDetails :: ZonkEnv
-> HsPatSynDetails (Located Id) -> HsPatSynDetails (Located Id)
zonkPatSynDetails env :: ZonkEnv
env (PrefixCon as :: [Located Id]
as)
= [Located Id] -> HsPatSynDetails (Located Id)
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon ((Located Id -> Located Id) -> [Located Id] -> [Located Id]
forall a b. (a -> b) -> [a] -> [b]
map (ZonkEnv -> Located Id -> Located Id
zonkLIdOcc ZonkEnv
env) [Located Id]
as)
zonkPatSynDetails env :: ZonkEnv
env (InfixCon a1 :: Located Id
a1 a2 :: Located Id
a2)
= Located Id -> Located Id -> HsPatSynDetails (Located Id)
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon (ZonkEnv -> Located Id -> Located Id
zonkLIdOcc ZonkEnv
env Located Id
a1) (ZonkEnv -> Located Id -> Located Id
zonkLIdOcc ZonkEnv
env Located Id
a2)
zonkPatSynDetails env :: ZonkEnv
env (RecCon flds :: [RecordPatSynField (Located Id)]
flds)
= [RecordPatSynField (Located Id)] -> HsPatSynDetails (Located Id)
forall arg rec. rec -> HsConDetails arg rec
RecCon ((RecordPatSynField (Located Id) -> RecordPatSynField (Located Id))
-> [RecordPatSynField (Located Id)]
-> [RecordPatSynField (Located Id)]
forall a b. (a -> b) -> [a] -> [b]
map ((Located Id -> Located Id)
-> RecordPatSynField (Located Id) -> RecordPatSynField (Located Id)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ZonkEnv -> Located Id -> Located Id
zonkLIdOcc ZonkEnv
env)) [RecordPatSynField (Located Id)]
flds)
zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTcId
-> TcM (ZonkEnv, HsPatSynDir GhcTc)
zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTc -> TcM (ZonkEnv, HsPatSynDir GhcTc)
zonkPatSynDir env :: ZonkEnv
env Unidirectional = (ZonkEnv, HsPatSynDir GhcTc) -> TcM (ZonkEnv, HsPatSynDir GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, HsPatSynDir GhcTc
forall id. HsPatSynDir id
Unidirectional)
zonkPatSynDir env :: ZonkEnv
env ImplicitBidirectional = (ZonkEnv, HsPatSynDir GhcTc) -> TcM (ZonkEnv, HsPatSynDir GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, HsPatSynDir GhcTc
forall id. HsPatSynDir id
ImplicitBidirectional)
zonkPatSynDir env :: ZonkEnv
env (ExplicitBidirectional mg :: MatchGroup GhcTc (LHsExpr GhcTc)
mg) = do
MatchGroup GhcTc (LHsExpr GhcTc)
mg' <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
mg
(ZonkEnv, HsPatSynDir GhcTc) -> TcM (ZonkEnv, HsPatSynDir GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, MatchGroup GhcTc (LHsExpr GhcTc) -> HsPatSynDir GhcTc
forall id. MatchGroup id (LHsExpr id) -> HsPatSynDir id
ExplicitBidirectional MatchGroup GhcTc (LHsExpr GhcTc)
mg')
zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags
zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags
zonkSpecPrags _ IsDefaultMethod = TcSpecPrags -> TcM TcSpecPrags
forall (m :: * -> *) a. Monad m => a -> m a
return TcSpecPrags
IsDefaultMethod
zonkSpecPrags env :: ZonkEnv
env (SpecPrags ps :: [LTcSpecPrag]
ps) = do { [LTcSpecPrag]
ps' <- ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
zonkLTcSpecPrags ZonkEnv
env [LTcSpecPrag]
ps
; TcSpecPrags -> TcM TcSpecPrags
forall (m :: * -> *) a. Monad m => a -> m a
return ([LTcSpecPrag] -> TcSpecPrags
SpecPrags [LTcSpecPrag]
ps') }
zonkLTcSpecPrags :: ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
zonkLTcSpecPrags :: ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
zonkLTcSpecPrags env :: ZonkEnv
env ps :: [LTcSpecPrag]
ps
= (LTcSpecPrag -> IOEnv (Env TcGblEnv TcLclEnv) LTcSpecPrag)
-> [LTcSpecPrag] -> TcM [LTcSpecPrag]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LTcSpecPrag -> IOEnv (Env TcGblEnv TcLclEnv) LTcSpecPrag
zonk_prag [LTcSpecPrag]
ps
where
zonk_prag :: LTcSpecPrag -> IOEnv (Env TcGblEnv TcLclEnv) LTcSpecPrag
zonk_prag (LTcSpecPrag -> Located (SrcSpanLess LTcSpecPrag)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L loc :: SrcSpan
loc (SpecPrag id co_fn inl))
= do { (_, co_fn' :: HsWrapper
co_fn') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
co_fn
; LTcSpecPrag -> IOEnv (Env TcGblEnv TcLclEnv) LTcSpecPrag
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> SrcSpanLess LTcSpecPrag -> LTcSpecPrag
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (Id -> HsWrapper -> InlinePragma -> TcSpecPrag
SpecPrag (ZonkEnv -> Id -> Id
zonkIdOcc ZonkEnv
env Id
id) HsWrapper
co_fn' InlinePragma
inl)) }
zonkMatchGroup :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTcId (Located (body GhcTcId))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup env :: ZonkEnv
env zBody :: ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = (Located [LMatch GhcTc (Located (body GhcTc))]
-> Located
(SrcSpanLess (Located [LMatch GhcTc (Located (body GhcTc))]))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l ms :: SrcSpanLess (Located [LMatch GhcTc (Located (body GhcTc))])
ms)
, mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext = MatchGroupTc arg_tys res_ty
, mg_origin :: forall p body. MatchGroup p body -> Origin
mg_origin = Origin
origin })
= do { [LMatch GhcTc (Located (body GhcTc))]
ms' <- (LMatch GhcTc (Located (body GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (LMatch GhcTc (Located (body GhcTc))))
-> [LMatch GhcTc (Located (body GhcTc))]
-> IOEnv
(Env TcGblEnv TcLclEnv) [LMatch GhcTc (Located (body GhcTc))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> LMatch GhcTc (Located (body GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (LMatch GhcTc (Located (body GhcTc)))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> LMatch GhcTc (Located (body GhcTc))
-> TcM (LMatch GhcTc (Located (body GhcTc)))
zonkMatch ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody) [LMatch GhcTc (Located (body GhcTc))]
SrcSpanLess (Located [LMatch GhcTc (Located (body GhcTc))])
ms
; [Type]
arg_tys' <- ZonkEnv -> [Type] -> TcM [Type]
zonkTcTypesToTypesX ZonkEnv
env [Type]
arg_tys
; Type
res_ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
res_ty
; MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (MG :: forall p body.
XMG p body
-> Located [LMatch p body] -> Origin -> MatchGroup p body
MG { mg_alts :: Located [LMatch GhcTc (Located (body GhcTc))]
mg_alts = SrcSpan
-> SrcSpanLess (Located [LMatch GhcTc (Located (body GhcTc))])
-> Located [LMatch GhcTc (Located (body GhcTc))]
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l [LMatch GhcTc (Located (body GhcTc))]
SrcSpanLess (Located [LMatch GhcTc (Located (body GhcTc))])
ms'
, mg_ext :: XMG GhcTc (Located (body GhcTc))
mg_ext = [Type] -> Type -> MatchGroupTc
MatchGroupTc [Type]
arg_tys' Type
res_ty'
, mg_origin :: Origin
mg_origin = Origin
origin }) }
zonkMatchGroup _ _ (XMatchGroup {}) = String -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
forall a. String -> a
panic "zonkMatchGroup"
zonkMatch :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
-> LMatch GhcTcId (Located (body GhcTcId))
-> TcM (LMatch GhcTc (Located (body GhcTc)))
zonkMatch :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> LMatch GhcTc (Located (body GhcTc))
-> TcM (LMatch GhcTc (Located (body GhcTc)))
zonkMatch env :: ZonkEnv
env zBody :: ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (LMatch GhcTc (Located (body GhcTc))
-> Located (SrcSpanLess (LMatch GhcTc (Located (body GhcTc))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L loc :: SrcSpan
loc match :: SrcSpanLess (LMatch GhcTc (Located (body GhcTc)))
match@(Match { m_pats = pats
, m_grhss = grhss }))
= do { (env1 :: ZonkEnv
env1, new_pats :: [OutPat GhcTc]
new_pats) <- ZonkEnv -> [OutPat GhcTc] -> TcM (ZonkEnv, [OutPat GhcTc])
zonkPats ZonkEnv
env [OutPat GhcTc]
pats
; GRHSs GhcTc (Located (body GhcTc))
new_grhss <- ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> GRHSs GhcTc (Located (body GhcTc))
-> TcM (GRHSs GhcTc (Located (body GhcTc)))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> GRHSs GhcTc (Located (body GhcTc))
-> TcM (GRHSs GhcTc (Located (body GhcTc)))
zonkGRHSs ZonkEnv
env1 ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody GRHSs GhcTc (Located (body GhcTc))
grhss
; LMatch GhcTc (Located (body GhcTc))
-> TcM (LMatch GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> SrcSpanLess (LMatch GhcTc (Located (body GhcTc)))
-> LMatch GhcTc (Located (body GhcTc))
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (SrcSpanLess (LMatch GhcTc (Located (body GhcTc)))
Match GhcTc (Located (body GhcTc))
match { m_pats :: [OutPat GhcTc]
m_pats = [OutPat GhcTc]
new_pats, m_grhss :: GRHSs GhcTc (Located (body GhcTc))
m_grhss = GRHSs GhcTc (Located (body GhcTc))
new_grhss })) }
zonkMatch _ _ (LMatch GhcTc (Located (body GhcTc))
-> Located (SrcSpanLess (LMatch GhcTc (Located (body GhcTc))))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L _ (XMatch _)) = String -> TcM (LMatch GhcTc (Located (body GhcTc)))
forall a. String -> a
panic "zonkMatch"
zonkMatch _ _ _ = String -> TcM (LMatch GhcTc (Located (body GhcTc)))
forall a. String -> a
panic "zonkMatch: Impossible Match"
zonkGRHSs :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
-> GRHSs GhcTcId (Located (body GhcTcId))
-> TcM (GRHSs GhcTc (Located (body GhcTc)))
zonkGRHSs :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> GRHSs GhcTc (Located (body GhcTc))
-> TcM (GRHSs GhcTc (Located (body GhcTc)))
zonkGRHSs env :: ZonkEnv
env zBody :: ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (GRHSs x :: XCGRHSs GhcTc (Located (body GhcTc))
x grhss :: [LGRHS GhcTc (Located (body GhcTc))]
grhss (LHsLocalBinds GhcTc -> Located (SrcSpanLess (LHsLocalBinds GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l binds :: SrcSpanLess (LHsLocalBinds GhcTc)
binds)) = do
(new_env :: ZonkEnv
new_env, new_binds :: HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
binds
let
zonk_grhs :: GRHS GhcTc (Located (body GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (GRHS GhcTc (Located (body GhcTc)))
zonk_grhs (GRHS xx :: XCGRHS GhcTc (Located (body GhcTc))
xx guarded :: [GuardLStmt GhcTc]
guarded rhs :: Located (body GhcTc)
rhs)
= do (env2 :: ZonkEnv
env2, new_guarded :: [GuardLStmt GhcTc]
new_guarded) <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> TcM (ZonkEnv, [GuardLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
new_env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr [GuardLStmt GhcTc]
guarded
Located (body GhcTc)
new_rhs <- ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody ZonkEnv
env2 Located (body GhcTc)
rhs
GRHS GhcTc (Located (body GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (GRHS GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (XCGRHS GhcTc (Located (body GhcTc))
-> [GuardLStmt GhcTc]
-> Located (body GhcTc)
-> GRHS GhcTc (Located (body GhcTc))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcTc (Located (body GhcTc))
xx [GuardLStmt GhcTc]
new_guarded Located (body GhcTc)
new_rhs)
zonk_grhs (XGRHS _) = String
-> IOEnv
(Env TcGblEnv TcLclEnv) (GRHS GhcTc (Located (body GhcTc)))
forall a. String -> a
panic "zonkGRHSs"
[LGRHS GhcTc (Located (body GhcTc))]
new_grhss <- (LGRHS GhcTc (Located (body GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (LGRHS GhcTc (Located (body GhcTc))))
-> [LGRHS GhcTc (Located (body GhcTc))]
-> IOEnv
(Env TcGblEnv TcLclEnv) [LGRHS GhcTc (Located (body GhcTc))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((SrcSpanLess (LGRHS GhcTc (Located (body GhcTc)))
-> TcM (SrcSpanLess (LGRHS GhcTc (Located (body GhcTc)))))
-> LGRHS GhcTc (Located (body GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (LGRHS GhcTc (Located (body GhcTc)))
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM SrcSpanLess (LGRHS GhcTc (Located (body GhcTc)))
-> TcM (SrcSpanLess (LGRHS GhcTc (Located (body GhcTc))))
GRHS GhcTc (Located (body GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (GRHS GhcTc (Located (body GhcTc)))
zonk_grhs) [LGRHS GhcTc (Located (body GhcTc))]
grhss
GRHSs GhcTc (Located (body GhcTc))
-> TcM (GRHSs GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (XCGRHSs GhcTc (Located (body GhcTc))
-> [LGRHS GhcTc (Located (body GhcTc))]
-> LHsLocalBinds GhcTc
-> GRHSs GhcTc (Located (body GhcTc))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcTc (Located (body GhcTc))
x [LGRHS GhcTc (Located (body GhcTc))]
new_grhss (SrcSpan -> SrcSpanLess (LHsLocalBinds GhcTc) -> LHsLocalBinds GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
new_binds))
zonkGRHSs _ _ (XGRHSs _) = String -> TcM (GRHSs GhcTc (Located (body GhcTc)))
forall a. String -> a
panic "zonkGRHSs"
zonkLExprs :: ZonkEnv -> [LHsExpr GhcTcId] -> TcM [LHsExpr GhcTc]
zonkLExpr :: ZonkEnv -> LHsExpr GhcTcId -> TcM (LHsExpr GhcTc)
zonkExpr :: ZonkEnv -> HsExpr GhcTcId -> TcM (HsExpr GhcTc)
zonkLExprs :: ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc]
zonkLExprs env :: ZonkEnv
env exprs :: [LHsExpr GhcTc]
exprs = (LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env) [LHsExpr GhcTc]
exprs
zonkLExpr :: ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr env :: ZonkEnv
env expr :: LHsExpr GhcTc
expr = (SrcSpanLess (LHsExpr GhcTc) -> TcM (SrcSpanLess (LHsExpr GhcTc)))
-> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env) LHsExpr GhcTc
expr
zonkExpr :: ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr env :: ZonkEnv
env (HsVar x :: XVar GhcTc
x (Located (IdP GhcTc) -> Located (SrcSpanLess (Located Id))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l id :: SrcSpanLess (Located Id)
id))
= ASSERT2( isNothing (isDataConId_maybe id), ppr id )
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcTc -> Located (IdP GhcTc) -> HsExpr GhcTc
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar GhcTc
x (SrcSpan -> SrcSpanLess (Located Id) -> Located Id
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (ZonkEnv -> Id -> Id
zonkIdOcc ZonkEnv
env SrcSpanLess (Located Id)
Id
id)))
zonkExpr _ e :: HsExpr GhcTc
e@(HsConLikeOut {}) = HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return HsExpr GhcTc
e
zonkExpr _ (HsIPVar x :: XIPVar GhcTc
x id :: HsIPName
id)
= HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XIPVar GhcTc -> HsIPName -> HsExpr GhcTc
forall p. XIPVar p -> HsIPName -> HsExpr p
HsIPVar XIPVar GhcTc
x HsIPName
id)
zonkExpr _ e :: HsExpr GhcTc
e@HsOverLabel{} = HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return HsExpr GhcTc
e
zonkExpr env :: ZonkEnv
env (HsLit x :: XLitE GhcTc
x (HsRat e :: XHsRat GhcTc
e f :: FractionalLit
f ty :: Type
ty))
= do Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
ty
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
x (XHsRat GhcTc -> FractionalLit -> Type -> HsLit GhcTc
forall x. XHsRat x -> FractionalLit -> Type -> HsLit x
HsRat XHsRat GhcTc
e FractionalLit
f Type
new_ty))
zonkExpr _ (HsLit x :: XLitE GhcTc
x lit :: HsLit GhcTc
lit)
= HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcTc
x HsLit GhcTc
lit)
zonkExpr env :: ZonkEnv
env (HsOverLit x :: XOverLitE GhcTc
x lit :: HsOverLit GhcTc
lit)
= do { HsOverLit GhcTc
lit' <- ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
zonkOverLit ZonkEnv
env HsOverLit GhcTc
lit
; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XOverLitE GhcTc -> HsOverLit GhcTc -> HsExpr GhcTc
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XOverLitE GhcTc
x HsOverLit GhcTc
lit') }
zonkExpr env :: ZonkEnv
env (HsLam x :: XLam GhcTc
x matches :: MatchGroup GhcTc (LHsExpr GhcTc)
matches)
= do MatchGroup GhcTc (LHsExpr GhcTc)
new_matches <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
matches
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLam GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam GhcTc
x MatchGroup GhcTc (LHsExpr GhcTc)
new_matches)
zonkExpr env :: ZonkEnv
env (HsLamCase x :: XLamCase GhcTc
x matches :: MatchGroup GhcTc (LHsExpr GhcTc)
matches)
= do MatchGroup GhcTc (LHsExpr GhcTc)
new_matches <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
matches
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLamCase GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
forall p. XLamCase p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase XLamCase GhcTc
x MatchGroup GhcTc (LHsExpr GhcTc)
new_matches)
zonkExpr env :: ZonkEnv
env (HsApp x :: XApp GhcTc
x e1 :: LHsExpr GhcTc
e1 e2 :: LHsExpr GhcTc
e2)
= do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
LHsExpr GhcTc
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XApp GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcTc
x LHsExpr GhcTc
new_e1 LHsExpr GhcTc
new_e2)
zonkExpr env :: ZonkEnv
env (HsAppType x :: XAppTypeE GhcTc
x e :: LHsExpr GhcTc
e t :: LHsWcType (NoGhcTc GhcTc)
t)
= do LHsExpr GhcTc
new_e <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XAppTypeE GhcTc
-> LHsExpr GhcTc -> LHsWcType (NoGhcTc GhcTc) -> HsExpr GhcTc
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcTc
x LHsExpr GhcTc
new_e LHsWcType (NoGhcTc GhcTc)
t)
zonkExpr _ e :: HsExpr GhcTc
e@(HsRnBracketOut _ _ _)
= String -> SDoc -> TcM (HsExpr GhcTc)
forall a. HasCallStack => String -> SDoc -> a
pprPanic "zonkExpr: HsRnBracketOut" (HsExpr GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcTc
e)
zonkExpr env :: ZonkEnv
env (HsTcBracketOut x :: XTcBracketOut GhcTc
x body :: HsBracket GhcRn
body bs :: [PendingTcSplice]
bs)
= do [PendingTcSplice]
bs' <- (PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice)
-> [PendingTcSplice]
-> IOEnv (Env TcGblEnv TcLclEnv) [PendingTcSplice]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice
zonk_b [PendingTcSplice]
bs
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XTcBracketOut GhcTc
-> HsBracket GhcRn -> [PendingTcSplice] -> HsExpr GhcTc
forall p.
XTcBracketOut p -> HsBracket GhcRn -> [PendingTcSplice] -> HsExpr p
HsTcBracketOut XTcBracketOut GhcTc
x HsBracket GhcRn
body [PendingTcSplice]
bs')
where
zonk_b :: PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice
zonk_b (PendingTcSplice n :: Name
n e :: LHsExpr GhcTc
e) = do LHsExpr GhcTc
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
PendingTcSplice -> IOEnv (Env TcGblEnv TcLclEnv) PendingTcSplice
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> LHsExpr GhcTc -> PendingTcSplice
PendingTcSplice Name
n LHsExpr GhcTc
e')
zonkExpr env :: ZonkEnv
env (HsSpliceE _ (HsSplicedT s :: DelayedSplice
s)) =
DelayedSplice -> TcM (HsExpr GhcTc)
runTopSplice DelayedSplice
s TcM (HsExpr GhcTc)
-> (HsExpr GhcTc -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env
zonkExpr _ (HsSpliceE x :: XSpliceE GhcTc
x s :: HsSplice GhcTc
s) = WARN( True, ppr s )
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XSpliceE GhcTc -> HsSplice GhcTc -> HsExpr GhcTc
forall p. XSpliceE p -> HsSplice p -> HsExpr p
HsSpliceE XSpliceE GhcTc
x HsSplice GhcTc
s)
zonkExpr env :: ZonkEnv
env (OpApp fixity :: XOpApp GhcTc
fixity e1 :: LHsExpr GhcTc
e1 op :: LHsExpr GhcTc
op e2 :: LHsExpr GhcTc
e2)
= do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
LHsExpr GhcTc
new_op <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
op
LHsExpr GhcTc
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XOpApp GhcTc
-> LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcTc
fixity LHsExpr GhcTc
new_e1 LHsExpr GhcTc
new_op LHsExpr GhcTc
new_e2)
zonkExpr env :: ZonkEnv
env (NegApp x :: XNegApp GhcTc
x expr :: LHsExpr GhcTc
expr op :: SyntaxExpr GhcTc
op)
= do (env' :: ZonkEnv
env', new_op :: SyntaxExpr GhcTc
new_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
op
LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env' LHsExpr GhcTc
expr
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XNegApp GhcTc -> LHsExpr GhcTc -> SyntaxExpr GhcTc -> HsExpr GhcTc
forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
NegApp XNegApp GhcTc
x LHsExpr GhcTc
new_expr SyntaxExpr GhcTc
new_op)
zonkExpr env :: ZonkEnv
env (HsPar x :: XPar GhcTc
x e :: LHsExpr GhcTc
e)
= do LHsExpr GhcTc
new_e <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XPar GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar GhcTc
x LHsExpr GhcTc
new_e)
zonkExpr env :: ZonkEnv
env (SectionL x :: XSectionL GhcTc
x expr :: LHsExpr GhcTc
expr op :: LHsExpr GhcTc
op)
= do LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
LHsExpr GhcTc
new_op <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
op
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XSectionL GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XSectionL p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionL XSectionL GhcTc
x LHsExpr GhcTc
new_expr LHsExpr GhcTc
new_op)
zonkExpr env :: ZonkEnv
env (SectionR x :: XSectionR GhcTc
x op :: LHsExpr GhcTc
op expr :: LHsExpr GhcTc
expr)
= do LHsExpr GhcTc
new_op <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
op
LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XSectionR GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionR XSectionR GhcTc
x LHsExpr GhcTc
new_op LHsExpr GhcTc
new_expr)
zonkExpr env :: ZonkEnv
env (ExplicitTuple x :: XExplicitTuple GhcTc
x tup_args :: [LHsTupArg GhcTc]
tup_args boxed :: Boxity
boxed)
= do { [LHsTupArg GhcTc]
new_tup_args <- (LHsTupArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc))
-> [LHsTupArg GhcTc]
-> IOEnv (Env TcGblEnv TcLclEnv) [LHsTupArg GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc)
zonk_tup_arg [LHsTupArg GhcTc]
tup_args
; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitTuple GhcTc -> [LHsTupArg GhcTc] -> Boxity -> HsExpr GhcTc
forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple GhcTc
x [LHsTupArg GhcTc]
new_tup_args Boxity
boxed) }
where
zonk_tup_arg :: LHsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc)
zonk_tup_arg (LHsTupArg GhcTc -> Located (SrcSpanLess (LHsTupArg GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l (Present x e)) = do { LHsExpr GhcTc
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
; LHsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> SrcSpanLess (LHsTupArg GhcTc) -> LHsTupArg GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (XPresent GhcTc -> LHsExpr GhcTc -> HsTupArg GhcTc
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcTc
x LHsExpr GhcTc
e')) }
zonk_tup_arg (LHsTupArg GhcTc -> Located (SrcSpanLess (LHsTupArg GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l (Missing t)) = do { Type
t' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XMissing GhcTc
t
; LHsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> SrcSpanLess (LHsTupArg GhcTc) -> LHsTupArg GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (XMissing GhcTc -> HsTupArg GhcTc
forall id. XMissing id -> HsTupArg id
Missing Type
XMissing GhcTc
t')) }
zonk_tup_arg (LHsTupArg GhcTc -> Located (SrcSpanLess (LHsTupArg GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L _ (XTupArg{})) = String -> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc)
forall a. String -> a
panic "zonkExpr.XTupArg"
zonk_tup_arg _ = String -> IOEnv (Env TcGblEnv TcLclEnv) (LHsTupArg GhcTc)
forall a. String -> a
panic "zonk_tup_arg: Impossible Match"
zonkExpr env :: ZonkEnv
env (ExplicitSum args :: XExplicitSum GhcTc
args alt :: Int
alt arity :: Int
arity expr :: LHsExpr GhcTc
expr)
= do [Type]
new_args <- (Type -> TcM Type) -> [Type] -> TcM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) [Type]
XExplicitSum GhcTc
args
LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitSum GhcTc -> Int -> Int -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XExplicitSum p -> Int -> Int -> LHsExpr p -> HsExpr p
ExplicitSum [Type]
XExplicitSum GhcTc
new_args Int
alt Int
arity LHsExpr GhcTc
new_expr)
zonkExpr env :: ZonkEnv
env (HsCase x :: XCase GhcTc
x expr :: LHsExpr GhcTc
expr ms :: MatchGroup GhcTc (LHsExpr GhcTc)
ms)
= do LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
MatchGroup GhcTc (LHsExpr GhcTc)
new_ms <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr MatchGroup GhcTc (LHsExpr GhcTc)
ms
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCase GhcTc
-> LHsExpr GhcTc
-> MatchGroup GhcTc (LHsExpr GhcTc)
-> HsExpr GhcTc
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase XCase GhcTc
x LHsExpr GhcTc
new_expr MatchGroup GhcTc (LHsExpr GhcTc)
new_ms)
zonkExpr env :: ZonkEnv
env (HsIf x :: XIf GhcTc
x Nothing e1 :: LHsExpr GhcTc
e1 e2 :: LHsExpr GhcTc
e2 e3 :: LHsExpr GhcTc
e3)
= do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
LHsExpr GhcTc
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
LHsExpr GhcTc
new_e3 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e3
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XIf GhcTc
-> Maybe (SyntaxExpr GhcTc)
-> LHsExpr GhcTc
-> LHsExpr GhcTc
-> LHsExpr GhcTc
-> HsExpr GhcTc
forall p.
XIf p
-> Maybe (SyntaxExpr p)
-> LHsExpr p
-> LHsExpr p
-> LHsExpr p
-> HsExpr p
HsIf XIf GhcTc
x Maybe (SyntaxExpr GhcTc)
forall a. Maybe a
Nothing LHsExpr GhcTc
new_e1 LHsExpr GhcTc
new_e2 LHsExpr GhcTc
new_e3)
zonkExpr env :: ZonkEnv
env (HsIf x :: XIf GhcTc
x (Just fun :: SyntaxExpr GhcTc
fun) e1 :: LHsExpr GhcTc
e1 e2 :: LHsExpr GhcTc
e2 e3 :: LHsExpr GhcTc
e3)
= do (env1 :: ZonkEnv
env1, new_fun :: SyntaxExpr GhcTc
new_fun) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
fun
LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env1 LHsExpr GhcTc
e1
LHsExpr GhcTc
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env1 LHsExpr GhcTc
e2
LHsExpr GhcTc
new_e3 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env1 LHsExpr GhcTc
e3
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XIf GhcTc
-> Maybe (SyntaxExpr GhcTc)
-> LHsExpr GhcTc
-> LHsExpr GhcTc
-> LHsExpr GhcTc
-> HsExpr GhcTc
forall p.
XIf p
-> Maybe (SyntaxExpr p)
-> LHsExpr p
-> LHsExpr p
-> LHsExpr p
-> HsExpr p
HsIf XIf GhcTc
x (SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc)
forall a. a -> Maybe a
Just SyntaxExpr GhcTc
new_fun) LHsExpr GhcTc
new_e1 LHsExpr GhcTc
new_e2 LHsExpr GhcTc
new_e3)
zonkExpr env :: ZonkEnv
env (HsMultiIf ty :: XMultiIf GhcTc
ty alts :: [LGRHS GhcTc (LHsExpr GhcTc)]
alts)
= do { [LGRHS GhcTc (LHsExpr GhcTc)]
alts' <- (LGRHS GhcTc (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LGRHS GhcTc (LHsExpr GhcTc)))
-> [LGRHS GhcTc (LHsExpr GhcTc)]
-> IOEnv (Env TcGblEnv TcLclEnv) [LGRHS GhcTc (LHsExpr GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((SrcSpanLess (LGRHS GhcTc (LHsExpr GhcTc))
-> TcM (SrcSpanLess (LGRHS GhcTc (LHsExpr GhcTc))))
-> LGRHS GhcTc (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (LGRHS GhcTc (LHsExpr GhcTc))
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM SrcSpanLess (LGRHS GhcTc (LHsExpr GhcTc))
-> TcM (SrcSpanLess (LGRHS GhcTc (LHsExpr GhcTc)))
GRHS GhcTc (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LHsExpr GhcTc))
zonk_alt) [LGRHS GhcTc (LHsExpr GhcTc)]
alts
; Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XMultiIf GhcTc
ty
; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcTc -> TcM (HsExpr GhcTc))
-> HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall a b. (a -> b) -> a -> b
$ XMultiIf GhcTc -> [LGRHS GhcTc (LHsExpr GhcTc)] -> HsExpr GhcTc
forall p. XMultiIf p -> [LGRHS p (LHsExpr p)] -> HsExpr p
HsMultiIf Type
XMultiIf GhcTc
ty' [LGRHS GhcTc (LHsExpr GhcTc)]
alts' }
where zonk_alt :: GRHS GhcTc (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LHsExpr GhcTc))
zonk_alt (GRHS x :: XCGRHS GhcTc (LHsExpr GhcTc)
x guard :: [GuardLStmt GhcTc]
guard expr :: LHsExpr GhcTc
expr)
= do { (env' :: ZonkEnv
env', guard' :: [GuardLStmt GhcTc]
guard') <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> TcM (ZonkEnv, [GuardLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr [GuardLStmt GhcTc]
guard
; LHsExpr GhcTc
expr' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env' LHsExpr GhcTc
expr
; GRHS GhcTc (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LHsExpr GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (GRHS GhcTc (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LHsExpr GhcTc)))
-> GRHS GhcTc (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LHsExpr GhcTc))
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcTc (LHsExpr GhcTc)
-> [GuardLStmt GhcTc]
-> LHsExpr GhcTc
-> GRHS GhcTc (LHsExpr GhcTc)
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcTc (LHsExpr GhcTc)
x [GuardLStmt GhcTc]
guard' LHsExpr GhcTc
expr' }
zonk_alt (XGRHS _) = String
-> IOEnv (Env TcGblEnv TcLclEnv) (GRHS GhcTc (LHsExpr GhcTc))
forall a. String -> a
panic "zonkExpr.HsMultiIf"
zonkExpr env :: ZonkEnv
env (HsLet x :: XLet GhcTc
x (LHsLocalBinds GhcTc -> Located (SrcSpanLess (LHsLocalBinds GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l binds :: SrcSpanLess (LHsLocalBinds GhcTc)
binds) expr :: LHsExpr GhcTc
expr)
= do (new_env :: ZonkEnv
new_env, new_binds :: HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
binds
LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
new_env LHsExpr GhcTc
expr
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLet GhcTc -> LHsLocalBinds GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XLet p -> LHsLocalBinds p -> LHsExpr p -> HsExpr p
HsLet XLet GhcTc
x (SrcSpan -> SrcSpanLess (LHsLocalBinds GhcTc) -> LHsLocalBinds GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
new_binds) LHsExpr GhcTc
new_expr)
zonkExpr env :: ZonkEnv
env (HsDo ty :: XDo GhcTc
ty do_or_lc :: HsStmtContext Name
do_or_lc (Located [GuardLStmt GhcTc]
-> Located (SrcSpanLess (Located [GuardLStmt GhcTc]))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l stmts :: SrcSpanLess (Located [GuardLStmt GhcTc])
stmts))
= do (_, new_stmts :: [GuardLStmt GhcTc]
new_stmts) <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> TcM (ZonkEnv, [GuardLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr [GuardLStmt GhcTc]
SrcSpanLess (Located [GuardLStmt GhcTc])
stmts
Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XDo GhcTc
ty
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XDo GhcTc
-> HsStmtContext Name -> Located [GuardLStmt GhcTc] -> HsExpr GhcTc
forall p.
XDo p -> HsStmtContext Name -> Located [ExprLStmt p] -> HsExpr p
HsDo Type
XDo GhcTc
new_ty HsStmtContext Name
do_or_lc (SrcSpan
-> SrcSpanLess (Located [GuardLStmt GhcTc])
-> Located [GuardLStmt GhcTc]
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l [GuardLStmt GhcTc]
SrcSpanLess (Located [GuardLStmt GhcTc])
new_stmts))
zonkExpr env :: ZonkEnv
env (ExplicitList ty :: XExplicitList GhcTc
ty wit :: Maybe (SyntaxExpr GhcTc)
wit exprs :: [LHsExpr GhcTc]
exprs)
= do (env1 :: ZonkEnv
env1, new_wit :: Maybe (SyntaxExpr GhcTc)
new_wit) <- ZonkEnv
-> Maybe (SyntaxExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
zonkWit ZonkEnv
env Maybe (SyntaxExpr GhcTc)
wit
Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env1 Type
XExplicitList GhcTc
ty
[LHsExpr GhcTc]
new_exprs <- ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc]
zonkLExprs ZonkEnv
env1 [LHsExpr GhcTc]
exprs
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitList GhcTc
-> Maybe (SyntaxExpr GhcTc) -> [LHsExpr GhcTc] -> HsExpr GhcTc
forall p.
XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
ExplicitList Type
XExplicitList GhcTc
new_ty Maybe (SyntaxExpr GhcTc)
new_wit [LHsExpr GhcTc]
new_exprs)
where zonkWit :: ZonkEnv
-> Maybe (SyntaxExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
zonkWit env :: ZonkEnv
env Nothing = (ZonkEnv, Maybe (SyntaxExpr GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Maybe (SyntaxExpr GhcTc)
forall a. Maybe a
Nothing)
zonkWit env :: ZonkEnv
env (Just fln :: SyntaxExpr GhcTc
fln) = (SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc))
-> (ZonkEnv, SyntaxExpr GhcTc)
-> (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc)
forall a. a -> Maybe a
Just ((ZonkEnv, SyntaxExpr GhcTc)
-> (ZonkEnv, Maybe (SyntaxExpr GhcTc)))
-> TcM (ZonkEnv, SyntaxExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
fln
zonkExpr env :: ZonkEnv
env expr :: HsExpr GhcTc
expr@(RecordCon { rcon_ext :: forall p. HsExpr p -> XRecordCon p
rcon_ext = XRecordCon GhcTc
ext, rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds = HsRecordBinds GhcTc
rbinds })
= do { HsExpr GhcTc
new_con_expr <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env (RecordConTc -> HsExpr GhcTc
rcon_con_expr XRecordCon GhcTc
RecordConTc
ext)
; HsRecordBinds GhcTc
new_rbinds <- ZonkEnv -> HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc)
zonkRecFields ZonkEnv
env HsRecordBinds GhcTc
rbinds
; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcTc
expr { rcon_ext :: XRecordCon GhcTc
rcon_ext = XRecordCon GhcTc
RecordConTc
ext { rcon_con_expr :: HsExpr GhcTc
rcon_con_expr = HsExpr GhcTc
new_con_expr }
, rcon_flds :: HsRecordBinds GhcTc
rcon_flds = HsRecordBinds GhcTc
new_rbinds }) }
zonkExpr env :: ZonkEnv
env (RecordUpd { rupd_flds :: forall p. HsExpr p -> [LHsRecUpdField p]
rupd_flds = [LHsRecUpdField GhcTc]
rbinds
, rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_expr = LHsExpr GhcTc
expr
, rupd_ext :: forall p. HsExpr p -> XRecordUpd p
rupd_ext = RecordUpdTc
{ rupd_cons = cons, rupd_in_tys = in_tys
, rupd_out_tys = out_tys, rupd_wrap = req_wrap }})
= do { LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
; [Type]
new_in_tys <- (Type -> TcM Type) -> [Type] -> TcM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) [Type]
in_tys
; [Type]
new_out_tys <- (Type -> TcM Type) -> [Type] -> TcM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) [Type]
out_tys
; [LHsRecUpdField GhcTc]
new_rbinds <- ZonkEnv -> [LHsRecUpdField GhcTc] -> TcM [LHsRecUpdField GhcTc]
zonkRecUpdFields ZonkEnv
env [LHsRecUpdField GhcTc]
rbinds
; (_, new_recwrap :: HsWrapper
new_recwrap) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
req_wrap
; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (RecordUpd :: forall p.
XRecordUpd p -> LHsExpr p -> [LHsRecUpdField p] -> HsExpr p
RecordUpd { rupd_expr :: LHsExpr GhcTc
rupd_expr = LHsExpr GhcTc
new_expr, rupd_flds :: [LHsRecUpdField GhcTc]
rupd_flds = [LHsRecUpdField GhcTc]
new_rbinds
, rupd_ext :: XRecordUpd GhcTc
rupd_ext = RecordUpdTc :: [ConLike] -> [Type] -> [Type] -> HsWrapper -> RecordUpdTc
RecordUpdTc
{ rupd_cons :: [ConLike]
rupd_cons = [ConLike]
cons, rupd_in_tys :: [Type]
rupd_in_tys = [Type]
new_in_tys
, rupd_out_tys :: [Type]
rupd_out_tys = [Type]
new_out_tys
, rupd_wrap :: HsWrapper
rupd_wrap = HsWrapper
new_recwrap }}) }
zonkExpr env :: ZonkEnv
env (ExprWithTySig _ e :: LHsExpr GhcTc
e ty :: LHsSigWcType (NoGhcTc GhcTc)
ty)
= do { LHsExpr GhcTc
e' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExprWithTySig GhcTc
-> LHsExpr GhcTc -> LHsSigWcType (NoGhcTc GhcTc) -> HsExpr GhcTc
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig XExprWithTySig GhcTc
NoExt
noExt LHsExpr GhcTc
e' LHsSigWcType (NoGhcTc GhcTc)
ty) }
zonkExpr env :: ZonkEnv
env (ArithSeq expr :: XArithSeq GhcTc
expr wit :: Maybe (SyntaxExpr GhcTc)
wit info :: ArithSeqInfo GhcTc
info)
= do (env1 :: ZonkEnv
env1, new_wit :: Maybe (SyntaxExpr GhcTc)
new_wit) <- ZonkEnv
-> Maybe (SyntaxExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
zonkWit ZonkEnv
env Maybe (SyntaxExpr GhcTc)
wit
HsExpr GhcTc
new_expr <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env XArithSeq GhcTc
HsExpr GhcTc
expr
ArithSeqInfo GhcTc
new_info <- ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
zonkArithSeq ZonkEnv
env1 ArithSeqInfo GhcTc
info
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XArithSeq GhcTc
-> Maybe (SyntaxExpr GhcTc) -> ArithSeqInfo GhcTc -> HsExpr GhcTc
forall p.
XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
ArithSeq XArithSeq GhcTc
HsExpr GhcTc
new_expr Maybe (SyntaxExpr GhcTc)
new_wit ArithSeqInfo GhcTc
new_info)
where zonkWit :: ZonkEnv
-> Maybe (SyntaxExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
zonkWit env :: ZonkEnv
env Nothing = (ZonkEnv, Maybe (SyntaxExpr GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Maybe (SyntaxExpr GhcTc)
forall a. Maybe a
Nothing)
zonkWit env :: ZonkEnv
env (Just fln :: SyntaxExpr GhcTc
fln) = (SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc))
-> (ZonkEnv, SyntaxExpr GhcTc)
-> (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc)
forall a. a -> Maybe a
Just ((ZonkEnv, SyntaxExpr GhcTc)
-> (ZonkEnv, Maybe (SyntaxExpr GhcTc)))
-> TcM (ZonkEnv, SyntaxExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
fln
zonkExpr env :: ZonkEnv
env (HsSCC x :: XSCC GhcTc
x src :: SourceText
src lbl :: StringLiteral
lbl expr :: LHsExpr GhcTc
expr)
= do LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XSCC GhcTc
-> SourceText -> StringLiteral -> LHsExpr GhcTc -> HsExpr GhcTc
forall p.
XSCC p -> SourceText -> StringLiteral -> LHsExpr p -> HsExpr p
HsSCC XSCC GhcTc
x SourceText
src StringLiteral
lbl LHsExpr GhcTc
new_expr)
zonkExpr env :: ZonkEnv
env (HsTickPragma x :: XTickPragma GhcTc
x src :: SourceText
src info :: (StringLiteral, (Int, Int), (Int, Int))
info srcInfo :: ((SourceText, SourceText), (SourceText, SourceText))
srcInfo expr :: LHsExpr GhcTc
expr)
= do LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XTickPragma GhcTc
-> SourceText
-> (StringLiteral, (Int, Int), (Int, Int))
-> ((SourceText, SourceText), (SourceText, SourceText))
-> LHsExpr GhcTc
-> HsExpr GhcTc
forall p.
XTickPragma p
-> SourceText
-> (StringLiteral, (Int, Int), (Int, Int))
-> ((SourceText, SourceText), (SourceText, SourceText))
-> LHsExpr p
-> HsExpr p
HsTickPragma XTickPragma GhcTc
x SourceText
src (StringLiteral, (Int, Int), (Int, Int))
info ((SourceText, SourceText), (SourceText, SourceText))
srcInfo LHsExpr GhcTc
new_expr)
zonkExpr env :: ZonkEnv
env (HsCoreAnn x :: XCoreAnn GhcTc
x src :: SourceText
src lbl :: StringLiteral
lbl expr :: LHsExpr GhcTc
expr)
= do LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCoreAnn GhcTc
-> SourceText -> StringLiteral -> LHsExpr GhcTc -> HsExpr GhcTc
forall p.
XCoreAnn p -> SourceText -> StringLiteral -> LHsExpr p -> HsExpr p
HsCoreAnn XCoreAnn GhcTc
x SourceText
src StringLiteral
lbl LHsExpr GhcTc
new_expr)
zonkExpr env :: ZonkEnv
env (HsProc x :: XProc GhcTc
x pat :: OutPat GhcTc
pat body :: LHsCmdTop GhcTc
body)
= do { (env1 :: ZonkEnv
env1, new_pat :: OutPat GhcTc
new_pat) <- ZonkEnv -> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
zonkPat ZonkEnv
env OutPat GhcTc
pat
; LHsCmdTop GhcTc
new_body <- ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
zonkCmdTop ZonkEnv
env1 LHsCmdTop GhcTc
body
; HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XProc GhcTc -> OutPat GhcTc -> LHsCmdTop GhcTc -> HsExpr GhcTc
forall p. XProc p -> LPat p -> LHsCmdTop p -> HsExpr p
HsProc XProc GhcTc
x OutPat GhcTc
new_pat LHsCmdTop GhcTc
new_body) }
zonkExpr env :: ZonkEnv
env (HsStatic fvs :: XStatic GhcTc
fvs expr :: LHsExpr GhcTc
expr)
= XStatic GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
forall p. XStatic p -> LHsExpr p -> HsExpr p
HsStatic XStatic GhcTc
fvs (LHsExpr GhcTc -> HsExpr GhcTc)
-> TcM (LHsExpr GhcTc) -> TcM (HsExpr GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
zonkExpr env :: ZonkEnv
env (HsWrap x :: XWrap GhcTc
x co_fn :: HsWrapper
co_fn expr :: HsExpr GhcTc
expr)
= do (env1 :: ZonkEnv
env1, new_co_fn :: HsWrapper
new_co_fn) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
co_fn
HsExpr GhcTc
new_expr <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env1 HsExpr GhcTc
expr
HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XWrap GhcTc -> HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
forall p. XWrap p -> HsWrapper -> HsExpr p -> HsExpr p
HsWrap XWrap GhcTc
x HsWrapper
new_co_fn HsExpr GhcTc
new_expr)
zonkExpr _ e :: HsExpr GhcTc
e@(HsUnboundVar {}) = HsExpr GhcTc -> TcM (HsExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return HsExpr GhcTc
e
zonkExpr _ expr :: HsExpr GhcTc
expr = String -> SDoc -> TcM (HsExpr GhcTc)
forall a. HasCallStack => String -> SDoc -> a
pprPanic "zonkExpr" (HsExpr GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcTc
expr)
zonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTcId
-> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr env :: ZonkEnv
env (SyntaxExpr { syn_expr :: forall p. SyntaxExpr p -> HsExpr p
syn_expr = HsExpr GhcTc
expr
, syn_arg_wraps :: forall p. SyntaxExpr p -> [HsWrapper]
syn_arg_wraps = [HsWrapper]
arg_wraps
, syn_res_wrap :: forall p. SyntaxExpr p -> HsWrapper
syn_res_wrap = HsWrapper
res_wrap })
= do { (env0 :: ZonkEnv
env0, res_wrap' :: 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
; (env1 :: ZonkEnv
env1, arg_wraps' :: [HsWrapper]
arg_wraps') <- (ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper))
-> ZonkEnv
-> [HsWrapper]
-> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, [HsWrapper])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env0 [HsWrapper]
arg_wraps
; (ZonkEnv, SyntaxExpr GhcTc) -> TcM (ZonkEnv, SyntaxExpr GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, SyntaxExpr :: forall p. HsExpr p -> [HsWrapper] -> HsWrapper -> SyntaxExpr p
SyntaxExpr { syn_expr :: HsExpr GhcTc
syn_expr = HsExpr GhcTc
expr'
, syn_arg_wraps :: [HsWrapper]
syn_arg_wraps = [HsWrapper]
arg_wraps'
, syn_res_wrap :: HsWrapper
syn_res_wrap = HsWrapper
res_wrap' }) }
zonkLCmd :: ZonkEnv -> LHsCmd GhcTcId -> TcM (LHsCmd GhcTc)
zonkCmd :: ZonkEnv -> HsCmd GhcTcId -> TcM (HsCmd GhcTc)
zonkLCmd :: ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd env :: ZonkEnv
env cmd :: LHsCmd GhcTc
cmd = (SrcSpanLess (LHsCmd GhcTc) -> TcM (SrcSpanLess (LHsCmd GhcTc)))
-> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc)
zonkCmd ZonkEnv
env) LHsCmd GhcTc
cmd
zonkCmd :: ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc)
zonkCmd env :: ZonkEnv
env (HsCmdWrap x :: XCmdWrap GhcTc
x w :: HsWrapper
w cmd :: HsCmd GhcTc
cmd)
= do { (env1 :: ZonkEnv
env1, w' :: HsWrapper
w') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
w
; HsCmd GhcTc
cmd' <- ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc)
zonkCmd ZonkEnv
env1 HsCmd GhcTc
cmd
; HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdWrap GhcTc -> HsWrapper -> HsCmd GhcTc -> HsCmd GhcTc
forall id. XCmdWrap id -> HsWrapper -> HsCmd id -> HsCmd id
HsCmdWrap XCmdWrap GhcTc
x HsWrapper
w' HsCmd GhcTc
cmd') }
zonkCmd env :: ZonkEnv
env (HsCmdArrApp ty :: XCmdArrApp GhcTc
ty e1 :: LHsExpr GhcTc
e1 e2 :: LHsExpr GhcTc
e2 ho :: HsArrAppType
ho rl :: Bool
rl)
= do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
LHsExpr GhcTc
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XCmdArrApp GhcTc
ty
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdArrApp GhcTc
-> LHsExpr GhcTc
-> LHsExpr GhcTc
-> HsArrAppType
-> Bool
-> HsCmd GhcTc
forall id.
XCmdArrApp id
-> LHsExpr id -> LHsExpr id -> HsArrAppType -> Bool -> HsCmd id
HsCmdArrApp Type
XCmdArrApp GhcTc
new_ty LHsExpr GhcTc
new_e1 LHsExpr GhcTc
new_e2 HsArrAppType
ho Bool
rl)
zonkCmd env :: ZonkEnv
env (HsCmdArrForm x :: XCmdArrForm GhcTc
x op :: LHsExpr GhcTc
op f :: LexicalFixity
f fixity :: Maybe Fixity
fixity args :: [LHsCmdTop GhcTc]
args)
= do LHsExpr GhcTc
new_op <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
op
[LHsCmdTop GhcTc]
new_args <- (LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc))
-> [LHsCmdTop GhcTc]
-> IOEnv (Env TcGblEnv TcLclEnv) [LHsCmdTop GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
zonkCmdTop ZonkEnv
env) [LHsCmdTop GhcTc]
args
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdArrForm GhcTc
-> LHsExpr GhcTc
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop GhcTc]
-> HsCmd GhcTc
forall id.
XCmdArrForm id
-> LHsExpr id
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop id]
-> HsCmd id
HsCmdArrForm XCmdArrForm GhcTc
x LHsExpr GhcTc
new_op LexicalFixity
f Maybe Fixity
fixity [LHsCmdTop GhcTc]
new_args)
zonkCmd env :: ZonkEnv
env (HsCmdApp x :: XCmdApp GhcTc
x c :: LHsCmd GhcTc
c e :: LHsExpr GhcTc
e)
= do LHsCmd GhcTc
new_c <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env LHsCmd GhcTc
c
LHsExpr GhcTc
new_e <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdApp GhcTc -> LHsCmd GhcTc -> LHsExpr GhcTc -> HsCmd GhcTc
forall id. XCmdApp id -> LHsCmd id -> LHsExpr id -> HsCmd id
HsCmdApp XCmdApp GhcTc
x LHsCmd GhcTc
new_c LHsExpr GhcTc
new_e)
zonkCmd env :: ZonkEnv
env (HsCmdLam x :: XCmdLam GhcTc
x matches :: MatchGroup GhcTc (LHsCmd GhcTc)
matches)
= do MatchGroup GhcTc (LHsCmd GhcTc)
new_matches <- ZonkEnv
-> (ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc))
-> MatchGroup GhcTc (LHsCmd GhcTc)
-> TcM (MatchGroup GhcTc (LHsCmd GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd MatchGroup GhcTc (LHsCmd GhcTc)
matches
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLam GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
forall id. XCmdLam id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLam XCmdLam GhcTc
x MatchGroup GhcTc (LHsCmd GhcTc)
new_matches)
zonkCmd env :: ZonkEnv
env (HsCmdPar x :: XCmdPar GhcTc
x c :: LHsCmd GhcTc
c)
= do LHsCmd GhcTc
new_c <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env LHsCmd GhcTc
c
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdPar GhcTc -> LHsCmd GhcTc -> HsCmd GhcTc
forall id. XCmdPar id -> LHsCmd id -> HsCmd id
HsCmdPar XCmdPar GhcTc
x LHsCmd GhcTc
new_c)
zonkCmd env :: ZonkEnv
env (HsCmdCase x :: XCmdCase GhcTc
x expr :: LHsExpr GhcTc
expr ms :: MatchGroup GhcTc (LHsCmd GhcTc)
ms)
= do LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
MatchGroup GhcTc (LHsCmd GhcTc)
new_ms <- ZonkEnv
-> (ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc))
-> MatchGroup GhcTc (LHsCmd GhcTc)
-> TcM (MatchGroup GhcTc (LHsCmd GhcTc))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd MatchGroup GhcTc (LHsCmd GhcTc)
ms
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdCase GhcTc
-> LHsExpr GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
forall id.
XCmdCase id -> LHsExpr id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdCase XCmdCase GhcTc
x LHsExpr GhcTc
new_expr MatchGroup GhcTc (LHsCmd GhcTc)
new_ms)
zonkCmd env :: ZonkEnv
env (HsCmdIf x :: XCmdIf GhcTc
x eCond :: Maybe (SyntaxExpr GhcTc)
eCond ePred :: LHsExpr GhcTc
ePred cThen :: LHsCmd GhcTc
cThen cElse :: LHsCmd GhcTc
cElse)
= do { (env1 :: ZonkEnv
env1, new_eCond :: Maybe (SyntaxExpr GhcTc)
new_eCond) <- ZonkEnv
-> Maybe (SyntaxExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
zonkWit ZonkEnv
env Maybe (SyntaxExpr GhcTc)
eCond
; LHsExpr GhcTc
new_ePred <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env1 LHsExpr GhcTc
ePred
; LHsCmd GhcTc
new_cThen <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env1 LHsCmd GhcTc
cThen
; LHsCmd GhcTc
new_cElse <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env1 LHsCmd GhcTc
cElse
; HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdIf GhcTc
-> Maybe (SyntaxExpr GhcTc)
-> LHsExpr GhcTc
-> LHsCmd GhcTc
-> LHsCmd GhcTc
-> HsCmd GhcTc
forall id.
XCmdIf id
-> Maybe (SyntaxExpr id)
-> LHsExpr id
-> LHsCmd id
-> LHsCmd id
-> HsCmd id
HsCmdIf XCmdIf GhcTc
x Maybe (SyntaxExpr GhcTc)
new_eCond LHsExpr GhcTc
new_ePred LHsCmd GhcTc
new_cThen LHsCmd GhcTc
new_cElse) }
where
zonkWit :: ZonkEnv
-> Maybe (SyntaxExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
zonkWit env :: ZonkEnv
env Nothing = (ZonkEnv, Maybe (SyntaxExpr GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Maybe (SyntaxExpr GhcTc)
forall a. Maybe a
Nothing)
zonkWit env :: ZonkEnv
env (Just w :: SyntaxExpr GhcTc
w) = (SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc))
-> (ZonkEnv, SyntaxExpr GhcTc)
-> (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc)
forall a. a -> Maybe a
Just ((ZonkEnv, SyntaxExpr GhcTc)
-> (ZonkEnv, Maybe (SyntaxExpr GhcTc)))
-> TcM (ZonkEnv, SyntaxExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
w
zonkCmd env :: ZonkEnv
env (HsCmdLet x :: XCmdLet GhcTc
x (LHsLocalBinds GhcTc -> Located (SrcSpanLess (LHsLocalBinds GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l binds :: SrcSpanLess (LHsLocalBinds GhcTc)
binds) cmd :: LHsCmd GhcTc
cmd)
= do (new_env :: ZonkEnv
new_env, new_binds :: HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
binds
LHsCmd GhcTc
new_cmd <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
new_env LHsCmd GhcTc
cmd
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLet GhcTc -> LHsLocalBinds GhcTc -> LHsCmd GhcTc -> HsCmd GhcTc
forall id. XCmdLet id -> LHsLocalBinds id -> LHsCmd id -> HsCmd id
HsCmdLet XCmdLet GhcTc
x (SrcSpan -> SrcSpanLess (LHsLocalBinds GhcTc) -> LHsLocalBinds GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
new_binds) LHsCmd GhcTc
new_cmd)
zonkCmd env :: ZonkEnv
env (HsCmdDo ty :: XCmdDo GhcTc
ty (Located [CmdLStmt GhcTc]
-> Located (SrcSpanLess (Located [CmdLStmt GhcTc]))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l stmts :: SrcSpanLess (Located [CmdLStmt GhcTc])
stmts))
= do (_, new_stmts :: [CmdLStmt GhcTc]
new_stmts) <- ZonkEnv
-> (ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc))
-> [CmdLStmt GhcTc]
-> TcM (ZonkEnv, [CmdLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd [CmdLStmt GhcTc]
SrcSpanLess (Located [CmdLStmt GhcTc])
stmts
Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XCmdDo GhcTc
ty
HsCmd GhcTc -> TcM (HsCmd GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdDo GhcTc -> Located [CmdLStmt GhcTc] -> HsCmd GhcTc
forall id. XCmdDo id -> Located [CmdLStmt id] -> HsCmd id
HsCmdDo Type
XCmdDo GhcTc
new_ty (SrcSpan
-> SrcSpanLess (Located [CmdLStmt GhcTc])
-> Located [CmdLStmt GhcTc]
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l [CmdLStmt GhcTc]
SrcSpanLess (Located [CmdLStmt GhcTc])
new_stmts))
zonkCmd _ (XCmd{}) = String -> TcM (HsCmd GhcTc)
forall a. String -> a
panic "zonkCmd"
zonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTcId -> TcM (LHsCmdTop GhcTc)
zonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
zonkCmdTop env :: ZonkEnv
env cmd :: LHsCmdTop GhcTc
cmd = (SrcSpanLess (LHsCmdTop GhcTc)
-> TcM (SrcSpanLess (LHsCmdTop GhcTc)))
-> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc)
zonk_cmd_top ZonkEnv
env) LHsCmdTop GhcTc
cmd
zonk_cmd_top :: ZonkEnv -> HsCmdTop GhcTcId -> TcM (HsCmdTop GhcTc)
zonk_cmd_top :: ZonkEnv -> HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc)
zonk_cmd_top env :: ZonkEnv
env (HsCmdTop (CmdTopTc stack_tys ty ids) cmd :: LHsCmd GhcTc
cmd)
= do LHsCmd GhcTc
new_cmd <- ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
zonkLCmd ZonkEnv
env LHsCmd GhcTc
cmd
Type
new_stack_tys <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
stack_tys
Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
ty
[(Name, HsExpr GhcTc)]
new_ids <- (HsExpr GhcTc -> TcM (HsExpr GhcTc))
-> [(Name, HsExpr GhcTc)]
-> IOEnv (Env TcGblEnv TcLclEnv) [(Name, HsExpr GhcTc)]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> [(a, b)] -> m [(a, c)]
mapSndM (ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env) [(Name, HsExpr GhcTc)]
ids
MASSERT( isLiftedTypeKind (tcTypeKind new_stack_tys) )
HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdTop GhcTc -> LHsCmd GhcTc -> HsCmdTop GhcTc
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
HsCmdTop (Type -> Type -> [(Name, HsExpr GhcTc)] -> CmdTopTc
CmdTopTc Type
new_stack_tys Type
new_ty [(Name, HsExpr GhcTc)]
new_ids) LHsCmd GhcTc
new_cmd)
zonk_cmd_top _ (XCmdTop {}) = String -> TcM (HsCmdTop GhcTc)
forall a. String -> a
panic "zonk_cmd_top"
zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn env :: ZonkEnv
env WpHole = (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, HsWrapper
WpHole)
zonkCoFn env :: ZonkEnv
env (WpCompose c1 :: HsWrapper
c1 c2 :: HsWrapper
c2) = do { (env1 :: ZonkEnv
env1, c1' :: HsWrapper
c1') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
c1
; (env2 :: ZonkEnv
env2, c2' :: HsWrapper
c2') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env1 HsWrapper
c2
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, HsWrapper -> HsWrapper -> HsWrapper
WpCompose HsWrapper
c1' HsWrapper
c2') }
zonkCoFn env :: ZonkEnv
env (WpFun c1 :: HsWrapper
c1 c2 :: HsWrapper
c2 t1 :: Type
t1 d :: SDoc
d) = do { (env1 :: ZonkEnv
env1, c1' :: HsWrapper
c1') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env HsWrapper
c1
; (env2 :: ZonkEnv
env2, c2' :: HsWrapper
c2') <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env1 HsWrapper
c2
; Type
t1' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env2 Type
t1
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, HsWrapper -> HsWrapper -> Type -> SDoc -> HsWrapper
WpFun HsWrapper
c1' HsWrapper
c2' Type
t1' SDoc
d) }
zonkCoFn env :: ZonkEnv
env (WpCast co :: TcCoercionR
co) = do { TcCoercionR
co' <- ZonkEnv -> TcCoercionR -> TcM TcCoercionR
zonkCoToCo ZonkEnv
env TcCoercionR
co
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, TcCoercionR -> HsWrapper
WpCast TcCoercionR
co') }
zonkCoFn env :: ZonkEnv
env (WpEvLam ev :: Id
ev) = do { (env' :: ZonkEnv
env', ev' :: Id
ev') <- ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkEvBndrX ZonkEnv
env Id
ev
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', Id -> HsWrapper
WpEvLam Id
ev') }
zonkCoFn env :: ZonkEnv
env (WpEvApp arg :: EvTerm
arg) = do { EvTerm
arg' <- ZonkEnv -> EvTerm -> TcM EvTerm
zonkEvTerm ZonkEnv
env EvTerm
arg
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, EvTerm -> HsWrapper
WpEvApp EvTerm
arg') }
zonkCoFn env :: ZonkEnv
env (WpTyLam tv :: Id
tv) = ASSERT( isImmutableTyVar tv )
do { (env' :: ZonkEnv
env', tv' :: Id
tv') <- ZonkEnv -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (ZonkEnv, Id)
zonkTyBndrX ZonkEnv
env Id
tv
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', Id -> HsWrapper
WpTyLam Id
tv') }
zonkCoFn env :: ZonkEnv
env (WpTyApp ty :: Type
ty) = do { Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
ty
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Type -> HsWrapper
WpTyApp Type
ty') }
zonkCoFn env :: ZonkEnv
env (WpLet bs :: TcEvBinds
bs) = do { (env1 :: ZonkEnv
env1, bs' :: TcEvBinds
bs') <- ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds)
zonkTcEvBinds ZonkEnv
env TcEvBinds
bs
; (ZonkEnv, HsWrapper) -> TcM (ZonkEnv, HsWrapper)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, TcEvBinds -> HsWrapper
WpLet TcEvBinds
bs') }
zonkOverLit :: ZonkEnv -> HsOverLit GhcTcId -> TcM (HsOverLit GhcTc)
zonkOverLit :: ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
zonkOverLit env :: ZonkEnv
env lit :: HsOverLit GhcTc
lit@(OverLit {ol_ext :: forall p. HsOverLit p -> XOverLit p
ol_ext = OverLitTc r ty, ol_witness :: forall p. HsOverLit p -> HsExpr p
ol_witness = HsExpr GhcTc
e })
= do { Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
ty
; HsExpr GhcTc
e' <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env HsExpr GhcTc
e
; HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsOverLit GhcTc
lit { ol_witness :: HsExpr GhcTc
ol_witness = HsExpr GhcTc
e', ol_ext :: XOverLit GhcTc
ol_ext = Bool -> Type -> OverLitTc
OverLitTc Bool
r Type
ty' }) }
zonkOverLit _ XOverLit{} = String -> TcM (HsOverLit GhcTc)
forall a. String -> a
panic "zonkOverLit"
zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTcId -> TcM (ArithSeqInfo GhcTc)
zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
zonkArithSeq env :: ZonkEnv
env (From e :: LHsExpr GhcTc
e)
= do LHsExpr GhcTc
new_e <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e
ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcTc -> ArithSeqInfo GhcTc
forall id. LHsExpr id -> ArithSeqInfo id
From LHsExpr GhcTc
new_e)
zonkArithSeq env :: ZonkEnv
env (FromThen e1 :: LHsExpr GhcTc
e1 e2 :: LHsExpr GhcTc
e2)
= do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
LHsExpr GhcTc
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThen LHsExpr GhcTc
new_e1 LHsExpr GhcTc
new_e2)
zonkArithSeq env :: ZonkEnv
env (FromTo e1 :: LHsExpr GhcTc
e1 e2 :: LHsExpr GhcTc
e2)
= do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
LHsExpr GhcTc
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromTo LHsExpr GhcTc
new_e1 LHsExpr GhcTc
new_e2)
zonkArithSeq env :: ZonkEnv
env (FromThenTo e1 :: LHsExpr GhcTc
e1 e2 :: LHsExpr GhcTc
e2 e3 :: LHsExpr GhcTc
e3)
= do LHsExpr GhcTc
new_e1 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e1
LHsExpr GhcTc
new_e2 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e2
LHsExpr GhcTc
new_e3 <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
e3
ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcTc
-> LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
forall id.
LHsExpr id -> LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThenTo LHsExpr GhcTc
new_e1 LHsExpr GhcTc
new_e2 LHsExpr GhcTc
new_e3)
zonkStmts :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTcId (Located (body GhcTcId))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts env :: ZonkEnv
env _ [] = (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, [])
zonkStmts env :: ZonkEnv
env zBody :: ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (s :: LStmt GhcTc (Located (body GhcTc))
s:ss :: [LStmt GhcTc (Located (body GhcTc))]
ss) = do { (env1 :: ZonkEnv
env1, s' :: LStmt GhcTc (Located (body GhcTc))
s') <- (SrcSpanLess (LStmt GhcTc (Located (body GhcTc)))
-> TcM (ZonkEnv, SrcSpanLess (LStmt GhcTc (Located (body GhcTc)))))
-> LStmt GhcTc (Located (body GhcTc))
-> TcM (ZonkEnv, LStmt GhcTc (Located (body GhcTc)))
forall a c b.
(HasSrcSpan a, HasSrcSpan c) =>
(SrcSpanLess a -> TcM (b, SrcSpanLess c)) -> a -> TcM (b, c)
wrapLocSndM (ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> Stmt GhcTc (Located (body GhcTc))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> Stmt GhcTc (Located (body GhcTc))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
zonkStmt ZonkEnv
env ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody) LStmt GhcTc (Located (body GhcTc))
s
; (env2 :: ZonkEnv
env2, ss' :: [LStmt GhcTc (Located (body GhcTc))]
ss') <- ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env1 ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody [LStmt GhcTc (Located (body GhcTc))]
ss
; (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, LStmt GhcTc (Located (body GhcTc))
s' LStmt GhcTc (Located (body GhcTc))
-> [LStmt GhcTc (Located (body GhcTc))]
-> [LStmt GhcTc (Located (body GhcTc))]
forall a. a -> [a] -> [a]
: [LStmt GhcTc (Located (body GhcTc))]
ss') }
zonkStmt :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
-> Stmt GhcTcId (Located (body GhcTcId))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
zonkStmt :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> Stmt GhcTc (Located (body GhcTc))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
zonkStmt env :: ZonkEnv
env _ (ParStmt bind_ty :: XParStmt GhcTc GhcTc (Located (body GhcTc))
bind_ty stmts_w_bndrs :: [ParStmtBlock GhcTc GhcTc]
stmts_w_bndrs mzip_op :: HsExpr GhcTc
mzip_op bind_op :: SyntaxExpr GhcTc
bind_op)
= do { (env1 :: ZonkEnv
env1, new_bind_op :: SyntaxExpr GhcTc
new_bind_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_op
; Type
new_bind_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env1 Type
XParStmt GhcTc GhcTc (Located (body GhcTc))
bind_ty
; [ParStmtBlock GhcTc GhcTc]
new_stmts_w_bndrs <- (ParStmtBlock GhcTc GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ParStmtBlock GhcTc GhcTc))
-> [ParStmtBlock GhcTc GhcTc]
-> IOEnv (Env TcGblEnv TcLclEnv) [ParStmtBlock GhcTc GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv
-> ParStmtBlock GhcTc GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ParStmtBlock GhcTc GhcTc)
zonk_branch ZonkEnv
env1) [ParStmtBlock GhcTc GhcTc]
stmts_w_bndrs
; let new_binders :: [Id]
new_binders = [Id
b | ParStmtBlock _ _ bs :: [IdP GhcTc]
bs _ <- [ParStmtBlock GhcTc GhcTc]
new_stmts_w_bndrs
, Id
b <- [Id]
[IdP GhcTc]
bs]
env2 :: ZonkEnv
env2 = ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env1 [Id]
new_binders
; HsExpr GhcTc
new_mzip <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env2 HsExpr GhcTc
mzip_op
; (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2
, XParStmt GhcTc GhcTc (Located (body GhcTc))
-> [ParStmtBlock GhcTc GhcTc]
-> HsExpr GhcTc
-> SyntaxExpr GhcTc
-> Stmt GhcTc (Located (body GhcTc))
forall idL idR body.
XParStmt idL idR body
-> [ParStmtBlock idL idR]
-> HsExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
ParStmt Type
XParStmt GhcTc GhcTc (Located (body GhcTc))
new_bind_ty [ParStmtBlock GhcTc GhcTc]
new_stmts_w_bndrs HsExpr GhcTc
new_mzip SyntaxExpr GhcTc
new_bind_op)}
where
zonk_branch :: ZonkEnv
-> ParStmtBlock GhcTc GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ParStmtBlock GhcTc GhcTc)
zonk_branch env1 :: ZonkEnv
env1 (ParStmtBlock x :: XParStmtBlock GhcTc GhcTc
x stmts :: [GuardLStmt GhcTc]
stmts bndrs :: [IdP GhcTc]
bndrs return_op :: SyntaxExpr GhcTc
return_op)
= do { (env2 :: ZonkEnv
env2, new_stmts :: [GuardLStmt GhcTc]
new_stmts) <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> TcM (ZonkEnv, [GuardLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env1 ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr [GuardLStmt GhcTc]
stmts
; (env3 :: ZonkEnv
env3, new_return :: SyntaxExpr GhcTc
new_return) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env2 SyntaxExpr GhcTc
return_op
; ParStmtBlock GhcTc GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ParStmtBlock GhcTc GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XParStmtBlock GhcTc GhcTc
-> [GuardLStmt GhcTc]
-> [IdP GhcTc]
-> SyntaxExpr GhcTc
-> ParStmtBlock GhcTc GhcTc
forall idL idR.
XParStmtBlock idL idR
-> [ExprLStmt idL]
-> [IdP idR]
-> SyntaxExpr idR
-> ParStmtBlock idL idR
ParStmtBlock XParStmtBlock GhcTc GhcTc
x [GuardLStmt GhcTc]
new_stmts (ZonkEnv -> [Id] -> [Id]
zonkIdOccs ZonkEnv
env3 [Id]
[IdP GhcTc]
bndrs)
SyntaxExpr GhcTc
new_return) }
zonk_branch _ (XParStmtBlock{}) = String -> IOEnv (Env TcGblEnv TcLclEnv) (ParStmtBlock GhcTc GhcTc)
forall a. String -> a
panic "zonkStmt"
zonkStmt env :: ZonkEnv
env zBody :: ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (RecStmt { recS_stmts :: forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
recS_stmts = [LStmtLR GhcTc GhcTc (Located (body GhcTc))]
segStmts, recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_later_ids = [IdP GhcTc]
lvs, recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
recS_rec_ids = [IdP GhcTc]
rvs
, recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_ret_fn = SyntaxExpr GhcTc
ret_id, recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_mfix_fn = SyntaxExpr GhcTc
mfix_id
, recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
recS_bind_fn = SyntaxExpr GhcTc
bind_id
, recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
recS_ext =
RecStmtTc { recS_bind_ty = bind_ty
, recS_later_rets = later_rets
, recS_rec_rets = rec_rets
, recS_ret_ty = ret_ty} })
= do { (env1 :: ZonkEnv
env1, new_bind_id :: SyntaxExpr GhcTc
new_bind_id) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_id
; (env2 :: ZonkEnv
env2, new_mfix_id :: SyntaxExpr GhcTc
new_mfix_id) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
mfix_id
; (env3 :: ZonkEnv
env3, new_ret_id :: SyntaxExpr GhcTc
new_ret_id) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env2 SyntaxExpr GhcTc
ret_id
; Type
new_bind_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env3 Type
bind_ty
; [Id]
new_rvs <- ZonkEnv -> [Id] -> TcM [Id]
zonkIdBndrs ZonkEnv
env3 [Id]
[IdP GhcTc]
rvs
; [Id]
new_lvs <- ZonkEnv -> [Id] -> TcM [Id]
zonkIdBndrs ZonkEnv
env3 [Id]
[IdP GhcTc]
lvs
; Type
new_ret_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env3 Type
ret_ty
; let env4 :: ZonkEnv
env4 = ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env3 [Id]
new_rvs
; (env5 :: ZonkEnv
env5, new_segStmts :: [LStmtLR GhcTc GhcTc (Located (body GhcTc))]
new_segStmts) <- ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmtLR GhcTc GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmtLR GhcTc GhcTc (Located (body GhcTc))])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env4 ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody [LStmtLR GhcTc GhcTc (Located (body GhcTc))]
segStmts
; [HsExpr GhcTc]
new_later_rets <- (HsExpr GhcTc -> TcM (HsExpr GhcTc))
-> [HsExpr GhcTc] -> IOEnv (Env TcGblEnv TcLclEnv) [HsExpr GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env5) [HsExpr GhcTc]
later_rets
; [HsExpr GhcTc]
new_rec_rets <- (HsExpr GhcTc -> TcM (HsExpr GhcTc))
-> [HsExpr GhcTc] -> IOEnv (Env TcGblEnv TcLclEnv) [HsExpr GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env5) [HsExpr GhcTc]
rec_rets
; (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env3 [Id]
new_lvs,
RecStmt :: forall idL idR body.
XRecStmt idL idR body
-> [LStmtLR idL idR body]
-> [IdP idR]
-> [IdP idR]
-> SyntaxExpr idR
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
RecStmt { recS_stmts :: [LStmtLR GhcTc GhcTc (Located (body GhcTc))]
recS_stmts = [LStmtLR GhcTc GhcTc (Located (body GhcTc))]
new_segStmts, recS_later_ids :: [IdP GhcTc]
recS_later_ids = [Id]
[IdP GhcTc]
new_lvs
, recS_rec_ids :: [IdP GhcTc]
recS_rec_ids = [Id]
[IdP GhcTc]
new_rvs, recS_ret_fn :: SyntaxExpr GhcTc
recS_ret_fn = SyntaxExpr GhcTc
new_ret_id
, recS_mfix_fn :: SyntaxExpr GhcTc
recS_mfix_fn = SyntaxExpr GhcTc
new_mfix_id, recS_bind_fn :: SyntaxExpr GhcTc
recS_bind_fn = SyntaxExpr GhcTc
new_bind_id
, recS_ext :: XRecStmt GhcTc GhcTc (Located (body GhcTc))
recS_ext = RecStmtTc :: Type -> [HsExpr GhcTc] -> [HsExpr GhcTc] -> Type -> RecStmtTc
RecStmtTc
{ recS_bind_ty :: Type
recS_bind_ty = Type
new_bind_ty
, recS_later_rets :: [HsExpr GhcTc]
recS_later_rets = [HsExpr GhcTc]
new_later_rets
, recS_rec_rets :: [HsExpr GhcTc]
recS_rec_rets = [HsExpr GhcTc]
new_rec_rets
, recS_ret_ty :: Type
recS_ret_ty = Type
new_ret_ty } }) }
zonkStmt env :: ZonkEnv
env zBody :: ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (BodyStmt ty :: XBodyStmt GhcTc GhcTc (Located (body GhcTc))
ty body :: Located (body GhcTc)
body then_op :: SyntaxExpr GhcTc
then_op guard_op :: SyntaxExpr GhcTc
guard_op)
= do (env1 :: ZonkEnv
env1, new_then_op :: SyntaxExpr GhcTc
new_then_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
then_op
(env2 :: ZonkEnv
env2, new_guard_op :: SyntaxExpr GhcTc
new_guard_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
guard_op
Located (body GhcTc)
new_body <- ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody ZonkEnv
env2 Located (body GhcTc)
body
Type
new_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env2 Type
XBodyStmt GhcTc GhcTc (Located (body GhcTc))
ty
(ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, XBodyStmt GhcTc GhcTc (Located (body GhcTc))
-> Located (body GhcTc)
-> SyntaxExpr GhcTc
-> SyntaxExpr GhcTc
-> Stmt GhcTc (Located (body GhcTc))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt Type
XBodyStmt GhcTc GhcTc (Located (body GhcTc))
new_ty Located (body GhcTc)
new_body SyntaxExpr GhcTc
new_then_op SyntaxExpr GhcTc
new_guard_op)
zonkStmt env :: ZonkEnv
env zBody :: ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (LastStmt x :: XLastStmt GhcTc GhcTc (Located (body GhcTc))
x body :: Located (body GhcTc)
body noret :: Bool
noret ret_op :: SyntaxExpr GhcTc
ret_op)
= do (env1 :: ZonkEnv
env1, new_ret :: SyntaxExpr GhcTc
new_ret) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
ret_op
Located (body GhcTc)
new_body <- ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody ZonkEnv
env1 Located (body GhcTc)
body
(ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, XLastStmt GhcTc GhcTc (Located (body GhcTc))
-> Located (body GhcTc)
-> Bool
-> SyntaxExpr GhcTc
-> Stmt GhcTc (Located (body GhcTc))
forall idL idR body.
XLastStmt idL idR body
-> body -> Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt GhcTc GhcTc (Located (body GhcTc))
x Located (body GhcTc)
new_body Bool
noret SyntaxExpr GhcTc
new_ret)
zonkStmt env :: ZonkEnv
env _ (TransStmt { trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_stmts = [GuardLStmt GhcTc]
stmts, trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
trS_bndrs = [(IdP GhcTc, IdP GhcTc)]
binderMap
, trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_by = Maybe (LHsExpr GhcTc)
by, trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_form = TransForm
form, trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_using = LHsExpr GhcTc
using
, trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_ret = SyntaxExpr GhcTc
return_op, trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
trS_bind = SyntaxExpr GhcTc
bind_op
, trS_ext :: forall idL idR body. StmtLR idL idR body -> XTransStmt idL idR body
trS_ext = XTransStmt GhcTc GhcTc (Located (body GhcTc))
bind_arg_ty
, trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
trS_fmap = HsExpr GhcTc
liftM_op })
= do {
; (env1 :: ZonkEnv
env1, bind_op' :: SyntaxExpr GhcTc
bind_op') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_op
; Type
bind_arg_ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env1 Type
XTransStmt GhcTc GhcTc (Located (body GhcTc))
bind_arg_ty
; (env2 :: ZonkEnv
env2, stmts' :: [GuardLStmt GhcTc]
stmts') <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> TcM (ZonkEnv, [GuardLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env1 ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr [GuardLStmt GhcTc]
stmts
; Maybe (LHsExpr GhcTc)
by' <- (LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> Maybe (LHsExpr GhcTc)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (LHsExpr GhcTc))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
fmapMaybeM (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env2) Maybe (LHsExpr GhcTc)
by
; LHsExpr GhcTc
using' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env2 LHsExpr GhcTc
using
; (env3 :: ZonkEnv
env3, return_op' :: SyntaxExpr GhcTc
return_op') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env2 SyntaxExpr GhcTc
return_op
; [(Id, Id)]
binderMap' <- ((Id, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (Id, Id))
-> [(Id, Id)] -> IOEnv (Env TcGblEnv TcLclEnv) [(Id, Id)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> (Id, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (Id, Id)
zonkBinderMapEntry ZonkEnv
env3) [(Id, Id)]
[(IdP GhcTc, IdP GhcTc)]
binderMap
; HsExpr GhcTc
liftM_op' <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env3 HsExpr GhcTc
liftM_op
; let env3' :: ZonkEnv
env3' = ZonkEnv -> [Id] -> ZonkEnv
extendIdZonkEnvRec ZonkEnv
env3 (((Id, Id) -> Id) -> [(Id, Id)] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (Id, Id) -> Id
forall a b. (a, b) -> b
snd [(Id, Id)]
binderMap')
; (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env3', TransStmt :: forall idL idR body.
XTransStmt idL idR body
-> TransForm
-> [ExprLStmt idL]
-> [(IdP idR, IdP idR)]
-> LHsExpr idR
-> Maybe (LHsExpr idR)
-> SyntaxExpr idR
-> SyntaxExpr idR
-> HsExpr idR
-> StmtLR idL idR body
TransStmt { trS_stmts :: [GuardLStmt GhcTc]
trS_stmts = [GuardLStmt GhcTc]
stmts', trS_bndrs :: [(IdP GhcTc, IdP GhcTc)]
trS_bndrs = [(Id, Id)]
[(IdP GhcTc, IdP GhcTc)]
binderMap'
, trS_by :: Maybe (LHsExpr GhcTc)
trS_by = Maybe (LHsExpr GhcTc)
by', trS_form :: TransForm
trS_form = TransForm
form, trS_using :: LHsExpr GhcTc
trS_using = LHsExpr GhcTc
using'
, trS_ret :: SyntaxExpr GhcTc
trS_ret = SyntaxExpr GhcTc
return_op', trS_bind :: SyntaxExpr GhcTc
trS_bind = SyntaxExpr GhcTc
bind_op'
, trS_ext :: XTransStmt GhcTc GhcTc (Located (body GhcTc))
trS_ext = Type
XTransStmt GhcTc GhcTc (Located (body GhcTc))
bind_arg_ty'
, trS_fmap :: HsExpr GhcTc
trS_fmap = HsExpr GhcTc
liftM_op' }) }
where
zonkBinderMapEntry :: ZonkEnv -> (Id, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (Id, Id)
zonkBinderMapEntry env :: ZonkEnv
env (oldBinder :: Id
oldBinder, newBinder :: Id
newBinder) = do
let oldBinder' :: Id
oldBinder' = ZonkEnv -> Id -> Id
zonkIdOcc ZonkEnv
env Id
oldBinder
Id
newBinder' <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env Id
newBinder
(Id, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (Id, Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (Id
oldBinder', Id
newBinder')
zonkStmt env :: ZonkEnv
env _ (LetStmt x :: XLetStmt GhcTc GhcTc (Located (body GhcTc))
x (LHsLocalBinds GhcTc -> Located (SrcSpanLess (LHsLocalBinds GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l binds :: SrcSpanLess (LHsLocalBinds GhcTc)
binds))
= do (env1 :: ZonkEnv
env1, new_binds :: HsLocalBinds GhcTc
new_binds) <- ZonkEnv -> HsLocalBinds GhcTc -> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds ZonkEnv
env SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
binds
(ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env1, XLetStmt GhcTc GhcTc (Located (body GhcTc))
-> LHsLocalBinds GhcTc -> Stmt GhcTc (Located (body GhcTc))
forall idL idR body.
XLetStmt idL idR body
-> LHsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcTc GhcTc (Located (body GhcTc))
x (SrcSpan -> SrcSpanLess (LHsLocalBinds GhcTc) -> LHsLocalBinds GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (LHsLocalBinds GhcTc)
HsLocalBinds GhcTc
new_binds))
zonkStmt env :: ZonkEnv
env zBody :: ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody (BindStmt bind_ty :: XBindStmt GhcTc GhcTc (Located (body GhcTc))
bind_ty pat :: OutPat GhcTc
pat body :: Located (body GhcTc)
body bind_op :: SyntaxExpr GhcTc
bind_op fail_op :: SyntaxExpr GhcTc
fail_op)
= do { (env1 :: ZonkEnv
env1, new_bind :: SyntaxExpr GhcTc
new_bind) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
bind_op
; Type
new_bind_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env1 Type
XBindStmt GhcTc GhcTc (Located (body GhcTc))
bind_ty
; Located (body GhcTc)
new_body <- ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
zBody ZonkEnv
env1 Located (body GhcTc)
body
; (env2 :: ZonkEnv
env2, new_pat :: OutPat GhcTc
new_pat) <- ZonkEnv -> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
zonkPat ZonkEnv
env1 OutPat GhcTc
pat
; (_, new_fail :: SyntaxExpr GhcTc
new_fail) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env1 SyntaxExpr GhcTc
fail_op
; (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ZonkEnv
env2
, XBindStmt GhcTc GhcTc (Located (body GhcTc))
-> OutPat GhcTc
-> Located (body GhcTc)
-> SyntaxExpr GhcTc
-> SyntaxExpr GhcTc
-> Stmt GhcTc (Located (body GhcTc))
forall idL idR body.
XBindStmt idL idR body
-> LPat idL
-> body
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
BindStmt Type
XBindStmt GhcTc GhcTc (Located (body GhcTc))
new_bind_ty OutPat GhcTc
new_pat Located (body GhcTc)
new_body SyntaxExpr GhcTc
new_bind SyntaxExpr GhcTc
new_fail) }
zonkStmt env :: ZonkEnv
env _zBody :: ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc))
_zBody (ApplicativeStmt body_ty :: XApplicativeStmt GhcTc GhcTc (Located (body GhcTc))
body_ty args :: [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args mb_join :: Maybe (SyntaxExpr GhcTc)
mb_join)
= do { (env1 :: ZonkEnv
env1, new_mb_join :: Maybe (SyntaxExpr GhcTc)
new_mb_join) <- ZonkEnv
-> Maybe (SyntaxExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
zonk_join ZonkEnv
env Maybe (SyntaxExpr GhcTc)
mb_join
; (env2 :: ZonkEnv
env2, new_args :: [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
new_args) <- ZonkEnv
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
zonk_args ZonkEnv
env1 [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args
; Type
new_body_ty <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env2 Type
XApplicativeStmt GhcTc GhcTc (Located (body GhcTc))
body_ty
; (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, XApplicativeStmt GhcTc GhcTc (Located (body GhcTc))
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> Maybe (SyntaxExpr GhcTc)
-> Stmt GhcTc (Located (body GhcTc))
forall idL idR body.
XApplicativeStmt idL idR body
-> [(SyntaxExpr idR, ApplicativeArg idL)]
-> Maybe (SyntaxExpr idR)
-> StmtLR idL idR body
ApplicativeStmt Type
XApplicativeStmt GhcTc GhcTc (Located (body GhcTc))
new_body_ty [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
new_args Maybe (SyntaxExpr GhcTc)
new_mb_join) }
where
zonk_join :: ZonkEnv
-> Maybe (SyntaxExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
zonk_join env :: ZonkEnv
env Nothing = (ZonkEnv, Maybe (SyntaxExpr GhcTc))
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, Maybe (SyntaxExpr GhcTc)
forall a. Maybe a
Nothing)
zonk_join env :: ZonkEnv
env (Just j :: SyntaxExpr GhcTc
j) = (SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc))
-> (ZonkEnv, SyntaxExpr GhcTc)
-> (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second SyntaxExpr GhcTc -> Maybe (SyntaxExpr GhcTc)
forall a. a -> Maybe a
Just ((ZonkEnv, SyntaxExpr GhcTc)
-> (ZonkEnv, Maybe (SyntaxExpr GhcTc)))
-> TcM (ZonkEnv, SyntaxExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (ZonkEnv, Maybe (SyntaxExpr GhcTc))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
j
get_pat :: (a, ApplicativeArg idL) -> LPat idL
get_pat (_, ApplicativeArgOne _ pat :: LPat idL
pat _ _) = LPat idL
pat
get_pat (_, ApplicativeArgMany _ _ _ pat :: LPat idL
pat) = LPat idL
pat
get_pat (_, XApplicativeArg _) = String -> LPat idL
forall a. String -> a
panic "zonkStmt"
replace_pat :: LPat idL -> (a, ApplicativeArg idL) -> (a, ApplicativeArg idL)
replace_pat pat :: LPat idL
pat (op :: a
op, ApplicativeArgOne x :: XApplicativeArgOne idL
x _ a :: LHsExpr idL
a isBody :: Bool
isBody)
= (a
op, XApplicativeArgOne idL
-> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
forall idL.
XApplicativeArgOne idL
-> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
ApplicativeArgOne XApplicativeArgOne idL
x LPat idL
pat LHsExpr idL
a Bool
isBody)
replace_pat pat :: LPat idL
pat (op :: a
op, ApplicativeArgMany x :: XApplicativeArgMany idL
x a :: [ExprLStmt idL]
a b :: HsExpr idL
b _)
= (a
op, XApplicativeArgMany idL
-> [ExprLStmt idL] -> HsExpr idL -> LPat idL -> ApplicativeArg idL
forall idL.
XApplicativeArgMany idL
-> [ExprLStmt idL] -> HsExpr idL -> LPat idL -> ApplicativeArg idL
ApplicativeArgMany XApplicativeArgMany idL
x [ExprLStmt idL]
a HsExpr idL
b LPat idL
pat)
replace_pat _ (_, XApplicativeArg _) = String -> (a, ApplicativeArg idL)
forall a. String -> a
panic "zonkStmt"
zonk_args :: ZonkEnv
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
zonk_args env :: ZonkEnv
env args :: [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args
= do { (env1 :: ZonkEnv
env1, new_args_rev :: [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
new_args_rev) <- ZonkEnv
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
zonk_args_rev ZonkEnv
env ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
forall a. [a] -> [a]
reverse [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args)
; (env2 :: ZonkEnv
env2, new_pats :: [OutPat GhcTc]
new_pats) <- ZonkEnv -> [OutPat GhcTc] -> TcM (ZonkEnv, [OutPat GhcTc])
zonkPats ZonkEnv
env1 (((SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> OutPat GhcTc)
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)] -> [OutPat GhcTc]
forall a b. (a -> b) -> [a] -> [b]
map (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> OutPat GhcTc
forall a idL. (a, ApplicativeArg idL) -> LPat idL
get_pat [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args)
; (ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, (OutPat GhcTc
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc))
-> [OutPat GhcTc]
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith OutPat GhcTc
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
forall idL a.
LPat idL -> (a, ApplicativeArg idL) -> (a, ApplicativeArg idL)
replace_pat [OutPat GhcTc]
new_pats ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
forall a. [a] -> [a]
reverse [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
new_args_rev)) }
zonk_args_rev :: ZonkEnv
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
zonk_args_rev env :: ZonkEnv
env ((op :: SyntaxExpr GhcTc
op, arg :: ApplicativeArg GhcTc
arg) : args :: [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args)
= do { (env1 :: ZonkEnv
env1, new_op :: SyntaxExpr GhcTc
new_op) <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
op
; ApplicativeArg GhcTc
new_arg <- ZonkEnv
-> ApplicativeArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
zonk_arg ZonkEnv
env1 ApplicativeArg GhcTc
arg
; (env2 :: ZonkEnv
env2, new_args :: [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
new_args) <- ZonkEnv
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
zonk_args_rev ZonkEnv
env1 [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
args
; (ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env2, (SyntaxExpr GhcTc
new_op, ApplicativeArg GhcTc
new_arg) (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
-> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
forall a. a -> [a] -> [a]
: [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
new_args) }
zonk_args_rev env :: ZonkEnv
env [] = (ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
-> IOEnv
(Env TcGblEnv TcLclEnv)
(ZonkEnv, [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, [])
zonk_arg :: ZonkEnv
-> ApplicativeArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
zonk_arg env :: ZonkEnv
env (ApplicativeArgOne x :: XApplicativeArgOne GhcTc
x pat :: OutPat GhcTc
pat expr :: LHsExpr GhcTc
expr isBody :: Bool
isBody)
= do { LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
; ApplicativeArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XApplicativeArgOne GhcTc
-> OutPat GhcTc -> LHsExpr GhcTc -> Bool -> ApplicativeArg GhcTc
forall idL.
XApplicativeArgOne idL
-> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
ApplicativeArgOne XApplicativeArgOne GhcTc
x OutPat GhcTc
pat LHsExpr GhcTc
new_expr Bool
isBody) }
zonk_arg env :: ZonkEnv
env (ApplicativeArgMany x :: XApplicativeArgMany GhcTc
x stmts :: [GuardLStmt GhcTc]
stmts ret :: HsExpr GhcTc
ret pat :: OutPat GhcTc
pat)
= do { (env1 :: ZonkEnv
env1, new_stmts :: [GuardLStmt GhcTc]
new_stmts) <- ZonkEnv
-> (ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
-> [GuardLStmt GhcTc]
-> TcM (ZonkEnv, [GuardLStmt GhcTc])
forall (body :: * -> *).
ZonkEnv
-> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
-> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts ZonkEnv
env ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr [GuardLStmt GhcTc]
stmts
; HsExpr GhcTc
new_ret <- ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkExpr ZonkEnv
env1 HsExpr GhcTc
ret
; ApplicativeArg GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (XApplicativeArgMany GhcTc
-> [GuardLStmt GhcTc]
-> HsExpr GhcTc
-> OutPat GhcTc
-> ApplicativeArg GhcTc
forall idL.
XApplicativeArgMany idL
-> [ExprLStmt idL] -> HsExpr idL -> LPat idL -> ApplicativeArg idL
ApplicativeArgMany XApplicativeArgMany GhcTc
x [GuardLStmt GhcTc]
new_stmts HsExpr GhcTc
new_ret OutPat GhcTc
pat) }
zonk_arg _ (XApplicativeArg _) = String -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
forall a. String -> a
panic "zonkStmt.XApplicativeArg"
zonkStmt _ _ (XStmtLR _) = String -> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
forall a. String -> a
panic "zonkStmt"
zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTcId -> TcM (HsRecordBinds GhcTcId)
zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc)
zonkRecFields env :: ZonkEnv
env (HsRecFields flds :: [LHsRecField GhcTc (LHsExpr GhcTc)]
flds dd :: Maybe Int
dd)
= do { [LHsRecField GhcTc (LHsExpr GhcTc)]
flds' <- (LHsRecField GhcTc (LHsExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (LHsRecField GhcTc (LHsExpr GhcTc)))
-> [LHsRecField GhcTc (LHsExpr GhcTc)]
-> IOEnv
(Env TcGblEnv TcLclEnv) [LHsRecField GhcTc (LHsExpr GhcTc)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsRecField GhcTc (LHsExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (LHsRecField GhcTc (LHsExpr GhcTc))
zonk_rbind [LHsRecField GhcTc (LHsExpr GhcTc)]
flds
; HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return ([LHsRecField GhcTc (LHsExpr GhcTc)]
-> Maybe Int -> HsRecordBinds GhcTc
forall p arg. [LHsRecField p arg] -> Maybe Int -> HsRecFields p arg
HsRecFields [LHsRecField GhcTc (LHsExpr GhcTc)]
flds' Maybe Int
dd) }
where
zonk_rbind :: LHsRecField GhcTc (LHsExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (LHsRecField GhcTc (LHsExpr GhcTc))
zonk_rbind (LHsRecField GhcTc (LHsExpr GhcTc)
-> Located (SrcSpanLess (LHsRecField GhcTc (LHsExpr GhcTc)))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l fld :: SrcSpanLess (LHsRecField GhcTc (LHsExpr GhcTc))
fld)
= do { Located (FieldOcc GhcTc)
new_id <- (SrcSpanLess (Located (FieldOcc GhcTc))
-> TcM (SrcSpanLess (Located (FieldOcc GhcTc))))
-> Located (FieldOcc GhcTc) -> TcM (Located (FieldOcc GhcTc))
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc ZonkEnv
env) (HsRecField' (FieldOcc GhcTc) (LHsExpr GhcTc)
-> Located (FieldOcc GhcTc)
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl SrcSpanLess (LHsRecField GhcTc (LHsExpr GhcTc))
HsRecField' (FieldOcc GhcTc) (LHsExpr GhcTc)
fld)
; LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env (HsRecField' (FieldOcc GhcTc) (LHsExpr GhcTc) -> LHsExpr GhcTc
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg SrcSpanLess (LHsRecField GhcTc (LHsExpr GhcTc))
HsRecField' (FieldOcc GhcTc) (LHsExpr GhcTc)
fld)
; LHsRecField GhcTc (LHsExpr GhcTc)
-> IOEnv
(Env TcGblEnv TcLclEnv) (LHsRecField GhcTc (LHsExpr GhcTc))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> SrcSpanLess (LHsRecField GhcTc (LHsExpr GhcTc))
-> LHsRecField GhcTc (LHsExpr GhcTc)
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (SrcSpanLess (LHsRecField GhcTc (LHsExpr GhcTc))
HsRecField' (FieldOcc GhcTc) (LHsExpr GhcTc)
fld { hsRecFieldLbl :: Located (FieldOcc GhcTc)
hsRecFieldLbl = Located (FieldOcc GhcTc)
new_id
, hsRecFieldArg :: LHsExpr GhcTc
hsRecFieldArg = LHsExpr GhcTc
new_expr })) }
zonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTcId]
-> TcM [LHsRecUpdField GhcTcId]
zonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTc] -> TcM [LHsRecUpdField GhcTc]
zonkRecUpdFields env :: ZonkEnv
env = (LHsRecUpdField GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsRecUpdField GhcTc))
-> [LHsRecUpdField GhcTc] -> TcM [LHsRecUpdField GhcTc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LHsRecUpdField GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsRecUpdField GhcTc)
zonk_rbind
where
zonk_rbind :: LHsRecUpdField GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsRecUpdField GhcTc)
zonk_rbind (LHsRecUpdField GhcTc
-> Located (SrcSpanLess (LHsRecUpdField GhcTc))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l fld :: SrcSpanLess (LHsRecUpdField GhcTc)
fld)
= do { Located (FieldOcc GhcTc)
new_id <- (SrcSpanLess (Located (FieldOcc GhcTc))
-> TcM (SrcSpanLess (Located (FieldOcc GhcTc))))
-> Located (FieldOcc GhcTc) -> TcM (Located (FieldOcc GhcTc))
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc ZonkEnv
env) (HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcTc)
-> Located (FieldOcc GhcTc)
forall arg.
HsRecField' (AmbiguousFieldOcc GhcTc) arg
-> Located (FieldOcc GhcTc)
hsRecUpdFieldOcc SrcSpanLess (LHsRecUpdField GhcTc)
HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcTc)
fld)
; LHsExpr GhcTc
new_expr <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env (HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcTc)
-> LHsExpr GhcTc
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg SrcSpanLess (LHsRecUpdField GhcTc)
HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcTc)
fld)
; LHsRecUpdField GhcTc
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsRecUpdField GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> SrcSpanLess (LHsRecUpdField GhcTc) -> LHsRecUpdField GhcTc
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l (SrcSpanLess (LHsRecUpdField GhcTc)
HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcTc)
fld { hsRecFieldLbl :: Located (AmbiguousFieldOcc GhcTc)
hsRecFieldLbl = (FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc)
-> Located (FieldOcc GhcTc) -> Located (AmbiguousFieldOcc GhcTc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc
ambiguousFieldOcc Located (FieldOcc GhcTc)
new_id
, hsRecFieldArg :: LHsExpr GhcTc
hsRecFieldArg = LHsExpr GhcTc
new_expr })) }
mapIPNameTc :: (a -> TcM b) -> Either (Located HsIPName) a
-> TcM (Either (Located HsIPName) b)
mapIPNameTc :: (a -> TcM b)
-> Either (Located HsIPName) a -> TcM (Either (Located HsIPName) b)
mapIPNameTc _ (Left x :: Located HsIPName
x) = Either (Located HsIPName) b -> TcM (Either (Located HsIPName) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located HsIPName -> Either (Located HsIPName) b
forall a b. a -> Either a b
Left Located HsIPName
x)
mapIPNameTc f :: a -> TcM b
f (Right x :: a
x) = do b
r <- a -> TcM b
f a
x
Either (Located HsIPName) b -> TcM (Either (Located HsIPName) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either (Located HsIPName) b
forall a b. b -> Either a b
Right b
r)
zonkPat :: ZonkEnv -> OutPat GhcTcId -> TcM (ZonkEnv, OutPat GhcTc)
zonkPat :: ZonkEnv -> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
zonkPat env :: ZonkEnv
env pat :: OutPat GhcTc
pat = (SrcSpanLess (OutPat GhcTc)
-> TcM (ZonkEnv, SrcSpanLess (OutPat GhcTc)))
-> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
forall a c b.
(HasSrcSpan a, HasSrcSpan c) =>
(SrcSpanLess a -> TcM (b, SrcSpanLess c)) -> a -> TcM (b, c)
wrapLocSndM (ZonkEnv -> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
zonk_pat ZonkEnv
env) OutPat GhcTc
pat
zonk_pat :: ZonkEnv -> Pat GhcTcId -> TcM (ZonkEnv, Pat GhcTc)
zonk_pat :: ZonkEnv -> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
zonk_pat env :: ZonkEnv
env (ParPat x :: XParPat GhcTc
x p :: OutPat GhcTc
p)
= do { (env' :: ZonkEnv
env', p' :: OutPat GhcTc
p') <- ZonkEnv -> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
zonkPat ZonkEnv
env OutPat GhcTc
p
; (ZonkEnv, OutPat GhcTc) -> TcM (ZonkEnv, OutPat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XParPat GhcTc -> OutPat GhcTc -> OutPat GhcTc
forall p. XParPat p -> Pat p -> Pat p
ParPat XParPat GhcTc
x OutPat GhcTc
p') }
zonk_pat env :: ZonkEnv
env (WildPat ty :: XWildPat GhcTc
ty)
= do { Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XWildPat GhcTc
ty
; Type -> SDoc -> TcM ()
ensureNotLevPoly Type
ty'
(String -> SDoc
text "In a wildcard pattern")
; (ZonkEnv, OutPat GhcTc) -> TcM (ZonkEnv, OutPat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env, XWildPat GhcTc -> OutPat GhcTc
forall p. XWildPat p -> Pat p
WildPat Type
XWildPat GhcTc
ty') }
zonk_pat env :: ZonkEnv
env (VarPat x :: XVarPat GhcTc
x (Located (IdP GhcTc) -> Located (SrcSpanLess (Located Id))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L l :: SrcSpan
l v :: SrcSpanLess (Located Id)
v))
= do { Id
v' <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env SrcSpanLess (Located Id)
Id
v
; (ZonkEnv, OutPat GhcTc) -> TcM (ZonkEnv, OutPat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv -> Id -> ZonkEnv
extendIdZonkEnv1 ZonkEnv
env Id
v', XVarPat GhcTc -> Located (IdP GhcTc) -> OutPat GhcTc
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat XVarPat GhcTc
x (SrcSpan -> SrcSpanLess (Located Id) -> Located Id
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
l SrcSpanLess (Located Id)
Id
v')) }
zonk_pat env :: ZonkEnv
env (LazyPat x :: XLazyPat GhcTc
x pat :: OutPat GhcTc
pat)
= do { (env' :: ZonkEnv
env', pat' :: OutPat GhcTc
pat') <- ZonkEnv -> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
zonkPat ZonkEnv
env OutPat GhcTc
pat
; (ZonkEnv, OutPat GhcTc) -> TcM (ZonkEnv, OutPat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XLazyPat GhcTc -> OutPat GhcTc -> OutPat GhcTc
forall p. XLazyPat p -> Pat p -> Pat p
LazyPat XLazyPat GhcTc
x OutPat GhcTc
pat') }
zonk_pat env :: ZonkEnv
env (BangPat x :: XBangPat GhcTc
x pat :: OutPat GhcTc
pat)
= do { (env' :: ZonkEnv
env', pat' :: OutPat GhcTc
pat') <- ZonkEnv -> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
zonkPat ZonkEnv
env OutPat GhcTc
pat
; (ZonkEnv, OutPat GhcTc) -> TcM (ZonkEnv, OutPat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XBangPat GhcTc -> OutPat GhcTc -> OutPat GhcTc
forall p. XBangPat p -> Pat p -> Pat p
BangPat XBangPat GhcTc
x OutPat GhcTc
pat') }
zonk_pat env :: ZonkEnv
env (AsPat x :: XAsPat GhcTc
x (Located (IdP GhcTc) -> Located (SrcSpanLess (Located Id))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L loc :: SrcSpan
loc v :: SrcSpanLess (Located Id)
v) pat :: OutPat GhcTc
pat)
= do { Id
v' <- ZonkEnv -> Id -> TcM Id
zonkIdBndr ZonkEnv
env SrcSpanLess (Located Id)
Id
v
; (env' :: ZonkEnv
env', pat' :: OutPat GhcTc
pat') <- ZonkEnv -> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
zonkPat (ZonkEnv -> Id -> ZonkEnv
extendIdZonkEnv1 ZonkEnv
env Id
v') OutPat GhcTc
pat
; (ZonkEnv, OutPat GhcTc) -> TcM (ZonkEnv, OutPat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XAsPat GhcTc -> Located (IdP GhcTc) -> OutPat GhcTc -> OutPat GhcTc
forall p. XAsPat p -> Located (IdP p) -> Pat p -> Pat p
AsPat XAsPat GhcTc
x (SrcSpan -> SrcSpanLess (Located Id) -> Located Id
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc SrcSpanLess (Located Id)
Id
v') OutPat GhcTc
pat') }
zonk_pat env :: ZonkEnv
env (ViewPat ty :: XViewPat GhcTc
ty expr :: LHsExpr GhcTc
expr pat :: OutPat GhcTc
pat)
= do { LHsExpr GhcTc
expr' <- ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkLExpr ZonkEnv
env LHsExpr GhcTc
expr
; (env' :: ZonkEnv
env', pat' :: OutPat GhcTc
pat') <- ZonkEnv -> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
zonkPat ZonkEnv
env OutPat GhcTc
pat
; Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
XViewPat GhcTc
ty
; (ZonkEnv, OutPat GhcTc) -> TcM (ZonkEnv, OutPat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XViewPat GhcTc -> LHsExpr GhcTc -> OutPat GhcTc -> OutPat GhcTc
forall p. XViewPat p -> LHsExpr p -> Pat p -> Pat p
ViewPat Type
XViewPat GhcTc
ty' LHsExpr GhcTc
expr' OutPat GhcTc
pat') }
zonk_pat env :: ZonkEnv
env (ListPat (ListPatTc ty Nothing) pats :: [OutPat GhcTc]
pats)
= do { Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env Type
ty
; (env' :: ZonkEnv
env', pats' :: [OutPat GhcTc]
pats') <- ZonkEnv -> [OutPat GhcTc] -> TcM (ZonkEnv, [OutPat GhcTc])
zonkPats ZonkEnv
env [OutPat GhcTc]
pats
; (ZonkEnv, OutPat GhcTc) -> TcM (ZonkEnv, OutPat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XListPat GhcTc -> [OutPat GhcTc] -> OutPat GhcTc
forall p. XListPat p -> [Pat p] -> Pat p
ListPat (Type -> Maybe (Type, SyntaxExpr GhcTc) -> ListPatTc
ListPatTc Type
ty' Maybe (Type, SyntaxExpr GhcTc)
forall a. Maybe a
Nothing) [OutPat GhcTc]
pats') }
zonk_pat env :: ZonkEnv
env (ListPat (ListPatTc ty (Just (ty2,wit))) pats :: [OutPat GhcTc]
pats)
= do { (env' :: ZonkEnv
env', wit' :: SyntaxExpr GhcTc
wit') <- ZonkEnv -> SyntaxExpr GhcTc -> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr ZonkEnv
env SyntaxExpr GhcTc
wit
; Type
ty2' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env' Type
ty2
; Type
ty' <- ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env' Type
ty
; (env'' :: ZonkEnv
env'', pats' :: [OutPat GhcTc]
pats') <- ZonkEnv -> [OutPat GhcTc] -> TcM (ZonkEnv, [OutPat GhcTc])
zonkPats ZonkEnv
env' [OutPat GhcTc]
pats
; (ZonkEnv, OutPat GhcTc) -> TcM (ZonkEnv, OutPat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env'', XListPat GhcTc -> [OutPat GhcTc] -> OutPat GhcTc
forall p. XListPat p -> [Pat p] -> Pat p
ListPat (Type -> Maybe (Type, SyntaxExpr GhcTc) -> ListPatTc
ListPatTc Type
ty' ((Type, SyntaxExpr GhcTc) -> Maybe (Type, SyntaxExpr GhcTc)
forall a. a -> Maybe a
Just (Type
ty2',SyntaxExpr GhcTc
wit'))) [OutPat GhcTc]
pats') }
zonk_pat env :: ZonkEnv
env (TuplePat tys :: XTuplePat GhcTc
tys pats :: [OutPat GhcTc]
pats boxed :: Boxity
boxed)
= do { [Type]
tys' <- (Type -> TcM Type) -> [Type] -> TcM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) [Type]
XTuplePat GhcTc
tys
; (env' :: ZonkEnv
env', pats' :: [OutPat GhcTc]
pats') <- ZonkEnv -> [OutPat GhcTc] -> TcM (ZonkEnv, [OutPat GhcTc])
zonkPats ZonkEnv
env [OutPat GhcTc]
pats
; (ZonkEnv, OutPat GhcTc) -> TcM (ZonkEnv, OutPat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XTuplePat GhcTc -> [OutPat GhcTc] -> Boxity -> OutPat GhcTc
forall p. XTuplePat p -> [Pat p] -> Boxity -> Pat p
TuplePat [Type]
XTuplePat GhcTc
tys' [OutPat GhcTc]
pats' Boxity
boxed) }
zonk_pat env :: ZonkEnv
env (SumPat tys :: XSumPat GhcTc
tys pat :: OutPat GhcTc
pat alt :: Int
alt arity :: Int
arity )
= do { [Type]
tys' <- (Type -> TcM Type) -> [Type] -> TcM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) [Type]
XSumPat GhcTc
tys
; (env' :: ZonkEnv
env', pat' :: OutPat GhcTc
pat') <- ZonkEnv -> OutPat GhcTc -> TcM (ZonkEnv, OutPat GhcTc)
zonkPat ZonkEnv
env OutPat GhcTc
pat
; (ZonkEnv, OutPat GhcTc) -> TcM (ZonkEnv, OutPat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', XSumPat GhcTc -> OutPat GhcTc -> Int -> Int -> OutPat GhcTc
forall p. XSumPat p -> Pat p -> Int -> Int -> Pat p
SumPat [Type]
XSumPat GhcTc
tys' OutPat GhcTc
pat' Int
alt Int
arity) }
zonk_pat env :: ZonkEnv
env p :: OutPat GhcTc
p@(ConPatOut { pat_arg_tys :: forall p. Pat p -> [Type]
pat_arg_tys = [Type]
tys
, pat_tvs :: forall p. Pat p -> [Id]
pat_tvs = [Id]
tyvars
, pat_dicts :: forall p. Pat p -> [Id]
pat_dicts = [Id]
evs
, pat_binds :: forall p. Pat p -> TcEvBinds
pat_binds = TcEvBinds
binds
, pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails GhcTc
args
, pat_wrap :: forall p. Pat p -> HsWrapper
pat_wrap = HsWrapper
wrapper
, pat_con :: forall p. Pat p -> Located ConLike
pat_con = (Located ConLike -> Located (SrcSpanLess (Located ConLike))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L _ con :: SrcSpanLess (Located ConLike)
con) })
= ASSERT( all isImmutableTyVar tyvars )
do { [Type]
new_tys <- (Type -> TcM Type) -> [Type] -> TcM [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ZonkEnv -> Type -> TcM Type
zonkTcTypeToTypeX ZonkEnv
env) [Type]
tys
; case SrcSpanLess (Located ConLike)
con of
RealDataCon dc
| TyCon -> Bool
isUnboxedTupleTyCon (DataCon -> TyCon
dataConTyCon DataCon
dc)
-> (Type -> TcM ()) -> [Type] -> TcM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (SDoc -> Type -> TcM ()
checkForLevPoly SDoc
doc) ([Type] -> [Type]
dropRuntimeRepArgs [Type]
new_tys)
_ -> () -> TcM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
; (env0 :: ZonkEnv
env0, new_tyvars :: [Id]
new_tyvars) <- ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
zonkTyBndrsX ZonkEnv
env [Id]
tyvars
; (env1 :: ZonkEnv
env1, new_evs :: [Id]
new_evs) <- ZonkEnv -> [Id] -> TcM (ZonkEnv, [Id])
zonkEvBndrsX ZonkEnv
env0 [Id]
evs
; (env2 :: ZonkEnv
env2, new_binds :: TcEvBinds
new_binds) <- ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds)
zonkTcEvBinds ZonkEnv
env1 TcEvBinds
binds
; (env3 :: ZonkEnv
env3, new_wrapper :: HsWrapper
new_wrapper) <- ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
zonkCoFn ZonkEnv
env2 HsWrapper
wrapper
; (env' :: ZonkEnv
env', new_args :: HsConPatDetails GhcTc
new_args) <- ZonkEnv
-> HsConPatDetails GhcTc -> TcM (ZonkEnv, HsConPatDetails GhcTc)
forall id.
ZonkEnv
-> HsConDetails (OutPat GhcTc) (HsRecFields id (OutPat GhcTc))
-> TcM
(ZonkEnv,
HsConDetails (OutPat GhcTc) (HsRecFields id (OutPat GhcTc)))
zonkConStuff ZonkEnv
env3 HsConPatDetails GhcTc
args
; (ZonkEnv, OutPat GhcTc) -> TcM (ZonkEnv, OutPat GhcTc)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonkEnv
env', OutPat GhcTc
p { pat_arg_tys :: [Type]
pat_arg_tys = [Type]
new_tys,
pat_tvs :: [Id]
pat_tvs = [Id]
new_tyvars,
pat_dicts :: [Id]
pat_dicts = [Id]
new_evs,
pat_binds :: TcEvBinds
pat_binds = TcEvBinds
new_binds,
pat_args :: HsConPatDetails GhcTc
pat_args = HsConPatDetails GhcTc
new_args,
pat_wrap :: HsWrapper
pat_wrap = HsWrapper
new_wrapper}) }
where
doc :: SDoc
doc = String -> SDoc
text