TcHsSyn.hs 68.9 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The AQUA Project, Glasgow University, 1996-1998

5 6

TcHsSyn: Specialisations of the @HsSyn@ syntax for the typechecker
7 8 9

This module is an extension of @HsSyn@ syntax, for use in the type
checker.
Austin Seipp's avatar
Austin Seipp committed
10
-}
11

12
{-# LANGUAGE CPP, TupleSections #-}
Ben Gamari's avatar
Ben Gamari committed
13
{-# LANGUAGE CPP, TypeFamilies #-}
14

15
module TcHsSyn (
16
        -- * Extracting types from HsSyn
17
        hsLitType, hsLPatType, hsPatType,
18 19 20

        -- * Other HsSyn functions
        mkHsDictLet, mkHsApp,
21
        mkHsAppTy, mkHsCaseAlt,
22
        shortCutLit, hsOverLitName,
23
        conLikeResTy,
24

25
        -- * re-exported from TcMonad
26 27
        TcId, TcIdSet,

28 29 30
        -- * Zonking
        -- | For a description of "zonking", see Note [What is zonking?]
        -- in TcMType
31
        zonkTopDecls, zonkTopExpr, zonkTopLExpr,
32
        zonkTopBndrs, zonkTyBndrsX,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
33
        zonkTyVarBindersX, zonkTyVarBinderX,
34
        emptyZonkEnv, mkEmptyZonkEnv,
35
        zonkTcTypeToType, zonkTcTypeToTypes, zonkTyVarOcc,
36
        zonkCoToCo, zonkSigType,
37
        zonkEvBinds, zonkTcEvBinds
38 39
  ) where

40
#include "HsVersions.h"
41

42 43
import GhcPrelude

44
import HsSyn
45
import Id
46
import IdInfo
47
import TcRnMonad
48
import PrelNames
49
import TcType
50
import TcMType
51
import TcEvidence
52
import TysPrim
53
import TyCon   ( isUnboxedTupleTyCon )
54
import TysWiredIn
Simon Peyton Jones's avatar
Simon Peyton Jones committed
55
import TyCoRep( CoercionHole(..) )
dreixel's avatar
dreixel committed
56
import Type
57
import Coercion
58
import ConLike
59
import DataCon
niteria's avatar
niteria committed
60
import HscTypes
61
import Name
niteria's avatar
niteria committed
62
import NameEnv
63
import Var
64
import VarEnv
65
import DynFlags
66
import Literal
67 68 69
import BasicTypes
import Maybes
import SrcLoc
sof's avatar
sof committed
70
import Bag
sof's avatar
sof committed
71
import Outputable
72
import Util
73
import UniqFM
74
import CoreSyn
75

76 77
import Control.Monad
import Data.List  ( partition )
78
import Control.Arrow ( second )
79

Austin Seipp's avatar
Austin Seipp committed
80 81 82
{-
************************************************************************
*                                                                      *
83
       Extracting the type from HsSyn
Austin Seipp's avatar
Austin Seipp committed
84 85
*                                                                      *
************************************************************************
86

Austin Seipp's avatar
Austin Seipp committed
87 88
-}

89
hsLPatType :: OutPat GhcTc -> Type
90 91
hsLPatType (L _ pat) = hsPatType pat

92
hsPatType :: Pat GhcTc -> Type
Ben Gamari's avatar
Ben Gamari committed
93 94 95 96 97 98 99 100 101 102 103 104 105
hsPatType (ParPat pat)                = hsLPatType pat
hsPatType (WildPat ty)                = ty
hsPatType (VarPat (L _ var))          = idType var
hsPatType (BangPat pat)               = hsLPatType pat
hsPatType (LazyPat pat)               = hsLPatType pat
hsPatType (LitPat lit)                = hsLitType lit
hsPatType (AsPat var _)               = idType (unLoc var)
hsPatType (ViewPat _ _ ty)            = ty
hsPatType (ListPat _ ty Nothing)      = mkListTy ty
hsPatType (ListPat _ _ (Just (ty,_))) = ty
hsPatType (PArrPat _ ty)              = mkPArrTy ty
hsPatType (TuplePat _ bx tys)         = mkTupleTy bx tys
hsPatType (SumPat _ _ _ tys)          = mkSumTy tys
106
hsPatType (ConPatOut { pat_con = L _ con, pat_arg_tys = tys })
Ben Gamari's avatar
Ben Gamari committed
107 108 109 110 111 112 113 114
                                      = conLikeResTy con tys
hsPatType (SigPatOut _ ty)            = ty
hsPatType (NPat _ _ _ ty)             = ty
hsPatType (NPlusKPat _ _ _ _ _ ty)    = ty
hsPatType (CoPat _ _ ty)              = ty
hsPatType p                           = pprPanic "hsPatType" (ppr p)

hsLitType :: HsLit p -> TcType
115 116 117 118
hsLitType (HsChar _ _)       = charTy
hsLitType (HsCharPrim _ _)   = charPrimTy
hsLitType (HsString _ _)     = stringTy
hsLitType (HsStringPrim _ _) = addrPrimTy
119
hsLitType (HsInt _ _)        = intTy
120 121 122 123 124
hsLitType (HsIntPrim _ _)    = intPrimTy
hsLitType (HsWordPrim _ _)   = wordPrimTy
hsLitType (HsInt64Prim _ _)  = int64PrimTy
hsLitType (HsWord64Prim _ _) = word64PrimTy
hsLitType (HsInteger _ _ ty) = ty
125 126 127
hsLitType (HsRat _ _ ty)     = ty
hsLitType (HsFloatPrim _ _)  = floatPrimTy
hsLitType (HsDoublePrim _ _) = doublePrimTy
128

Austin Seipp's avatar
Austin Seipp committed
129
-- Overloaded literals. Here mainly because it uses isIntTy etc
130

131
shortCutLit :: DynFlags -> OverLitVal -> TcType -> Maybe (HsExpr GhcTcId)
132
shortCutLit dflags (HsIntegral int@(IL src neg i)) ty
Ben Gamari's avatar
Ben Gamari committed
133
  | isIntTy ty  && inIntRange  dflags i = Just (HsLit (HsInt def int))
134
  | isWordTy ty && inWordRange dflags i = Just (mkLit wordDataCon (HsWordPrim src i))
Ben Gamari's avatar
Ben Gamari committed
135
  | isIntegerTy ty = Just (HsLit (HsInteger src i ty))
136
  | otherwise = shortCutLit dflags (HsFractional (integralFractionalLit neg i)) ty
137 138 139 140 141
        -- The 'otherwise' case is important
        -- Consider (3 :: Float).  Syntactically it looks like an IntLit,
        -- so we'll call shortCutIntLit, but of course it's a float
        -- This can make a big difference for programs with a lot of
        -- literals, compiled without -O
142

143
shortCutLit _ (HsFractional f) ty
Ben Gamari's avatar
Ben Gamari committed
144 145
  | isFloatTy ty  = Just (mkLit floatDataCon  (HsFloatPrim def f))
  | isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim def f))
146 147
  | otherwise     = Nothing

148
shortCutLit _ (HsIsString src s) ty
Ben Gamari's avatar
Ben Gamari committed
149
  | isStringTy ty = Just (HsLit (HsString src s))
150 151
  | otherwise     = Nothing

152
mkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc
Ben Gamari's avatar
Ben Gamari committed
153
mkLit con lit = HsApp (nlHsDataCon con) (nlHsLit lit)
154 155 156 157 158 159 160

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

Austin Seipp's avatar
Austin Seipp committed
162 163 164
{-
************************************************************************
*                                                                      *
165
\subsection[BackSubst-HsBinds]{Running a substitution over @HsBinds@}
Austin Seipp's avatar
Austin Seipp committed
166 167
*                                                                      *
************************************************************************
168

169 170
The rest of the zonking is done *after* typechecking.
The main zonking pass runs over the bindings
171 172 173

 a) to convert TcTyVars to TyVars etc, dereferencing any bindings etc
 b) convert unbound TcTyVar to Void
174
 c) convert each TcId to an Id by zonking its type
sof's avatar
sof committed
175

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

179 180 181
The Ids are converted by binding them in the normal Tc envt; that
way we maintain sharing; eg an Id is zonked at its binding site and they
all occurrences of that Id point to the common zonked copy
sof's avatar
sof committed
182

183
It's all pretty boring stuff, because HsSyn is such a large type, and
184
the environment manipulation is tiresome.
Austin Seipp's avatar
Austin Seipp committed
185
-}
186

187
-- Confused by zonking? See Note [What is zonking?] in TcMType.
188
type UnboundTyVarZonker = TcTyVar -> TcM Type
189
        -- How to zonk an unbound type variable
190 191 192
        -- The TcTyVar is
        --     (a) a MetaTv
        --     (b) Flexi and
Gabor Greif's avatar
Gabor Greif committed
193
        --     (c) its kind is already zonked
dreixel's avatar
dreixel committed
194 195
        -- Note [Zonking the LHS of a RULE]

196 197 198
-- | A ZonkEnv carries around several bits.
-- The UnboundTyVarZonker just zaps unbouned meta-tyvars to Any (as
-- defined in zonkTypeZapping), except on the LHS of rules. See
199 200 201 202 203 204 205 206 207 208 209 210
-- Note [Zonking the LHS of a RULE].
--
-- The (TyCoVarEnv TyVar) and is just an optimisation: when binding a
-- tyvar or covar, we zonk the kind right away and add a mapping to
-- the env. This prevents re-zonking the kind at every occurrence. But
-- this is *just* an optimisation.
--
-- The final (IdEnv Var) optimises zonking for Ids. It is
-- knot-tied. We must be careful never to put coercion variables
-- (which are Ids, after all) in the knot-tied env, because coercions
-- can appear in types, and we sometimes inspect a zonked type in this
-- module.
211 212
--
-- Confused by zonking? See Note [What is zonking?] in TcMType.
213 214
data ZonkEnv
  = ZonkEnv
dreixel's avatar
dreixel committed
215
      UnboundTyVarZonker
216 217
      (TyCoVarEnv TyVar)
      (IdEnv      Var)         -- What variables are in scope
218 219 220 221 222 223 224
        -- Maps an Id or EvVar to its zonked version; both have the same Name
        -- Note that all evidence (coercion variables as well as dictionaries)
        --      are kept in the ZonkEnv
        -- Only *type* abstraction is done by side effect
        -- Is only consulted lazily; hence knot-tying

instance Outputable ZonkEnv where
225
  ppr (ZonkEnv _ _ty_env var_env) = pprUFM var_env (vcat . map ppr)
226 227


228
-- The EvBinds have to already be zonked, but that's usually the case.
Ian Lynagh's avatar
Ian Lynagh committed
229
emptyZonkEnv :: ZonkEnv
230 231 232 233
emptyZonkEnv = mkEmptyZonkEnv zonkTypeZapping

mkEmptyZonkEnv :: UnboundTyVarZonker -> ZonkEnv
mkEmptyZonkEnv zonker = ZonkEnv zonker emptyVarEnv emptyVarEnv
234

235 236 237 238 239
-- | Extend the knot-tied environment.
extendIdZonkEnvRec :: ZonkEnv -> [Var] -> ZonkEnv
extendIdZonkEnvRec (ZonkEnv zonk_ty ty_env id_env) ids
    -- NB: Don't look at the var to decide which env't to put it in. That
    -- would end up knot-tying all the env'ts.
dreixel's avatar
dreixel committed
240
  = ZonkEnv zonk_ty ty_env (extendVarEnvList id_env [(id,id) | id <- ids])
241 242 243 244 245 246 247 248 249 250 251 252
  -- Given coercion variables will actually end up here. That's OK though:
  -- coercion variables are never looked up in the knot-tied env't, so zonking
  -- them simply doesn't get optimised. No one gets hurt. An improvement (?)
  -- would be to do SCC analysis in zonkEvBinds and then only knot-tie the
  -- recursive groups. But perhaps the time it takes to do the analysis is
  -- more than the savings.

extendZonkEnv :: ZonkEnv -> [Var] -> ZonkEnv
extendZonkEnv (ZonkEnv zonk_ty tyco_env id_env) vars
  = ZonkEnv zonk_ty (extendVarEnvList tyco_env [(tv,tv) | tv <- tycovars])
                    (extendVarEnvList id_env   [(id,id) | id <- ids])
  where (tycovars, ids) = partition isTyCoVar vars
253

dreixel's avatar
dreixel committed
254
extendIdZonkEnv1 :: ZonkEnv -> Var -> ZonkEnv
255
extendIdZonkEnv1 (ZonkEnv zonk_ty ty_env id_env) id
dreixel's avatar
dreixel committed
256
  = ZonkEnv zonk_ty ty_env (extendVarEnv id_env id id)
257

dreixel's avatar
dreixel committed
258
extendTyZonkEnv1 :: ZonkEnv -> TyVar -> ZonkEnv
259 260
extendTyZonkEnv1 (ZonkEnv zonk_ty ty_env id_env) tv
  = ZonkEnv zonk_ty (extendVarEnv ty_env tv tv) id_env
dreixel's avatar
dreixel committed
261 262

setZonkType :: ZonkEnv -> UnboundTyVarZonker -> ZonkEnv
263 264
setZonkType (ZonkEnv _ ty_env id_env) zonk_ty
  = ZonkEnv zonk_ty ty_env id_env
265

niteria's avatar
niteria committed
266 267 268 269 270
zonkEnvIds :: ZonkEnv -> TypeEnv
zonkEnvIds (ZonkEnv _ _ id_env) =
  mkNameEnv [(getName id, AnId id) | id <- nonDetEltsUFM id_env]
  -- It's OK to use nonDetEltsUFM here because we forget the ordering
  -- immediately by creating a TypeEnv
271

272 273 274
zonkLIdOcc :: ZonkEnv -> Located TcId -> Located Id
zonkLIdOcc env (L loc id) = L loc (zonkIdOcc env id)

275
zonkIdOcc :: ZonkEnv -> TcId -> Id
276
-- Ids defined in this module should be in the envt;
277 278
-- ignore others.  (Actually, data constructors are also
-- not LocalVars, even when locally defined, but that is fine.)
279 280
-- (Also foreign-imported things aren't currently in the ZonkEnv;
--  that's ok because they don't need zonking.)
281 282
--
-- Actually, Template Haskell works in 'chunks' of declarations, and
283
-- an earlier chunk won't be in the 'env' that the zonking phase
284
-- carries around.  Instead it'll be in the tcg_gbl_env, already fully
285
-- zonked.  There's no point in looking it up there (except for error
286 287 288 289
-- checking), and it's not conveniently to hand; hence the simple
-- 'orElse' case in the LocalVar branch.
--
-- Even without template splices, in module Main, the checking of
290
-- 'main' is done as a separate chunk.
291 292 293
zonkIdOcc (ZonkEnv _zonk_ty _ty_env id_env) id
  | isLocalVar id = lookupVarEnv id_env id `orElse`
                    id
294
  | otherwise     = id
295

Ian Lynagh's avatar
Ian Lynagh committed
296
zonkIdOccs :: ZonkEnv -> [TcId] -> [Id]
297
zonkIdOccs env ids = map (zonkIdOcc env) ids
298

299
-- zonkIdBndr is used *after* typechecking to get the Id's type
300
-- to its final form.  The TyVarEnv give
301
zonkIdBndr :: ZonkEnv -> TcId -> TcM Id
302 303 304 305 306 307
zonkIdBndr env v
  = do ty' <- zonkTcTypeToType env (idType v)
       ensureNotLevPoly ty'
         (text "In the type of binder" <+> quotes (ppr v))

       return (modifyIdInfo (`setLevityInfoWithType` ty') (setIdType v ty'))
308 309

zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id]
310
zonkIdBndrs env ids = mapM (zonkIdBndr env) ids
311 312 313

zonkTopBndrs :: [TcId] -> TcM [Id]
zonkTopBndrs ids = zonkIdBndrs emptyZonkEnv ids
314

315
zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTcId -> TcM (FieldOcc GhcTc)
Ben Gamari's avatar
Ben Gamari committed
316
zonkFieldOcc env (FieldOcc lbl sel) = fmap (FieldOcc lbl) $ zonkIdBndr env sel
317

318
zonkEvBndrsX :: ZonkEnv -> [EvVar] -> TcM (ZonkEnv, [Var])
319
zonkEvBndrsX = mapAccumLM zonkEvBndrX
320 321 322 323 324

zonkEvBndrX :: ZonkEnv -> EvVar -> TcM (ZonkEnv, EvVar)
-- Works for dictionaries and coercions
zonkEvBndrX env var
  = do { var' <- zonkEvBndr env var
325
       ; return (extendZonkEnv env [var'], var') }
326 327 328 329

zonkEvBndr :: ZonkEnv -> EvVar -> TcM EvVar
-- Works for dictionaries and coercions
-- Does not extend the ZonkEnv
330
zonkEvBndr env var
331
  = do { let var_ty = varType var
332
       ; ty <-
333 334
           {-# SCC "zonkEvBndr_zonkTcTypeToType" #-}
           zonkTcTypeToType env var_ty
dreixel's avatar
dreixel committed
335
       ; return (setVarType var ty) }
336

337
{-
338 339 340 341 342 343
zonkEvVarOcc :: ZonkEnv -> EvVar -> TcM EvTerm
zonkEvVarOcc env v
  | isCoVar v
  = EvCoercion <$> zonkCoVarOcc env v
  | otherwise
  = return (EvId $ zonkIdOcc env v)
344
-}
dreixel's avatar
dreixel committed
345

Simon Peyton Jones's avatar
Simon Peyton Jones committed
346
zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])
347
zonkTyBndrsX = mapAccumLM zonkTyBndrX
dreixel's avatar
dreixel committed
348

Simon Peyton Jones's avatar
Simon Peyton Jones committed
349
zonkTyBndrX :: ZonkEnv -> TcTyVar -> TcM (ZonkEnv, TyVar)
350 351
-- This guarantees to return a TyVar (not a TcTyVar)
-- then we add it to the envt, so all occurrences are replaced
dreixel's avatar
dreixel committed
352
zonkTyBndrX env tv
353 354
  = ASSERT( isImmutableTyVar tv )
    do { ki <- zonkTcTypeToType env (tyVarKind tv)
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
355
               -- Internal names tidy up better, for iface files.
356 357
       ; let tv' = mkTyVar (tyVarName tv) ki
       ; return (extendTyZonkEnv1 env tv', tv') }
358

Simon Peyton Jones's avatar
Simon Peyton Jones committed
359 360 361
zonkTyVarBindersX :: ZonkEnv -> [TyVarBndr TcTyVar vis]
                             -> TcM (ZonkEnv, [TyVarBndr TyVar vis])
zonkTyVarBindersX = mapAccumLM zonkTyVarBinderX
362

Simon Peyton Jones's avatar
Simon Peyton Jones committed
363 364 365 366
zonkTyVarBinderX :: ZonkEnv -> TyVarBndr TcTyVar vis
                            -> TcM (ZonkEnv, TyVarBndr TyVar vis)
-- Takes a TcTyVar and guarantees to return a TyVar
zonkTyVarBinderX env (TvBndr tv vis)
367
  = do { (env', tv') <- zonkTyBndrX env tv
368
       ; return (env', TvBndr tv' vis) }
369

370
zonkTopExpr :: HsExpr GhcTcId -> TcM (HsExpr GhcTc)
371 372
zonkTopExpr e = zonkExpr emptyZonkEnv e

373
zonkTopLExpr :: LHsExpr GhcTcId -> TcM (LHsExpr GhcTc)
374 375
zonkTopLExpr e = zonkLExpr emptyZonkEnv e

376
zonkTopDecls :: Bag EvBind
377 378 379
             -> LHsBinds GhcTcId
             -> [LRuleDecl GhcTcId] -> [LVectDecl GhcTcId] -> [LTcSpecPrag]
             -> [LForeignDecl GhcTcId]
niteria's avatar
niteria committed
380
             -> TcM (TypeEnv,
381
                     Bag EvBind,
382 383
                     LHsBinds GhcTc,
                     [LForeignDecl GhcTc],
384
                     [LTcSpecPrag],
385 386
                     [LRuleDecl    GhcTc],
                     [LVectDecl    GhcTc])
387
zonkTopDecls ev_binds binds rules vects imp_specs fords
388
  = do  { (env1, ev_binds') <- zonkEvBinds emptyZonkEnv ev_binds
389
        ; (env2, binds') <- zonkRecMonoBinds env1 binds
390 391 392
                        -- Top level is implicitly recursive
        ; rules' <- zonkRules env2 rules
        ; vects' <- zonkVects env2 vects
393
        ; specs' <- zonkLTcSpecPrags env2 imp_specs
394 395
        ; fords' <- zonkForeignExports env2 fords
        ; return (zonkEnvIds env2, ev_binds', binds', fords', specs', rules', vects') }
396 397

---------------------------------------------
398 399
zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTcId
               -> TcM (ZonkEnv, HsLocalBinds GhcTc)
400 401 402
zonkLocalBinds env EmptyLocalBinds
  = return (env, EmptyLocalBinds)

Ben Gamari's avatar
Ben Gamari committed
403
zonkLocalBinds _ (HsValBinds (ValBindsIn {}))
404 405
  = panic "zonkLocalBinds" -- Not in typechecker output

Ben Gamari's avatar
Ben Gamari committed
406
zonkLocalBinds env (HsValBinds (ValBindsOut binds sigs))
407
  = do  { (env1, new_binds) <- go env binds
Ben Gamari's avatar
Ben Gamari committed
408
        ; return (env1, HsValBinds (ValBindsOut new_binds sigs)) }
409
  where
410
    go env []
411
      = return (env, [])
412 413 414
    go env ((r,b):bs)
      = do { (env1, b')  <- zonkRecMonoBinds env b
           ; (env2, bs') <- go env1 bs
415
           ; return (env2, (r,b'):bs') }
416

ian@well-typed.com's avatar
ian@well-typed.com committed
417 418
zonkLocalBinds env (HsIPBinds (IPBinds binds dict_binds)) = do
    new_binds <- mapM (wrapLocM zonk_ip_bind) binds
419
    let
420
        env1 = extendIdZonkEnvRec env [ n | L _ (IPBind (Right n) _) <- new_binds]
ian@well-typed.com's avatar
ian@well-typed.com committed
421
    (env2, new_dict_binds) <- zonkTcEvBinds env1 dict_binds
422
    return (env2, HsIPBinds (IPBinds new_binds new_dict_binds))
423
  where
424
    zonk_ip_bind (IPBind n e)
ian@well-typed.com's avatar
ian@well-typed.com committed
425 426 427
        = do n' <- mapIPNameTc (zonkIdBndr env) n
             e' <- zonkLExpr env e
             return (IPBind n' e')
428

429
---------------------------------------------
430
zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTcId -> TcM (ZonkEnv, LHsBinds GhcTc)
431
zonkRecMonoBinds env binds
432
 = fixM (\ ~(_, new_binds) -> do
433
        { let env1 = extendIdZonkEnvRec env (collectHsBindsBinders new_binds)
434
        ; binds' <- zonkMonoBinds env1 binds
435 436
        ; return (env1, binds') })

437
---------------------------------------------
438
zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTcId -> TcM (LHsBinds GhcTc)
439
zonkMonoBinds env binds = mapBagM (zonk_lbind env) binds
cactus's avatar
cactus committed
440

441
zonk_lbind :: ZonkEnv -> LHsBind GhcTcId -> TcM (LHsBind GhcTc)
442
zonk_lbind env = wrapLocM (zonk_bind env)
443

444
zonk_bind :: ZonkEnv -> HsBind GhcTcId -> TcM (HsBind GhcTc)
445
zonk_bind env bind@(PatBind { pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty})
446 447 448 449
  = do  { (_env, new_pat) <- zonkPat env pat            -- Env already extended
        ; new_grhss <- zonkGRHSs env zonkLExpr grhss
        ; new_ty    <- zonkTcTypeToType env ty
        ; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss, pat_rhs_ty = new_ty }) }
450

451
zonk_bind env (VarBind { var_id = var, var_rhs = expr, var_inline = inl })
452 453 454 455
  = do { new_var  <- zonkIdBndr env var
       ; new_expr <- zonkLExpr env expr
       ; return (VarBind { var_id = new_var, var_rhs = new_expr, var_inline = inl }) }

456 457
zonk_bind env bind@(FunBind { fun_id = L loc var, fun_matches = ms
                            , fun_co_fn = co_fn })
458 459
  = do { new_var <- zonkIdBndr env var
       ; (env1, new_co_fn) <- zonkCoFn env co_fn
460
       ; new_ms <- zonkMatchGroup env1 zonkLExpr ms
461 462 463
       ; return (bind { fun_id = L loc new_var, fun_matches = new_ms
                      , fun_co_fn = new_co_fn }) }

464 465 466
zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
                        , abs_ev_binds = ev_binds
                        , abs_exports = exports
467 468
                        , abs_binds = val_binds
                        , abs_sig = has_sig })
469
  = ASSERT( all isImmutableTyVar tyvars )
dreixel's avatar
dreixel committed
470 471
    do { (env0, new_tyvars) <- zonkTyBndrsX env tyvars
       ; (env1, new_evs) <- zonkEvBndrsX env0 evs
472
       ; (env2, new_ev_binds) <- zonkTcEvBinds_s env1 ev_binds
473
       ; (new_val_bind, new_exports) <- fixM $ \ ~(new_val_binds, _) ->
474 475 476 477
         do { let env3 = extendIdZonkEnvRec env2 $
                         collectHsBindsBinders new_val_binds
            ; new_val_binds <- mapBagM (zonk_val_bind env3) val_binds
            ; new_exports   <- mapM (zonk_export env3) exports
478
            ; return (new_val_binds, new_exports) }
dreixel's avatar
dreixel committed
479 480
       ; return (AbsBinds { abs_tvs = new_tyvars, abs_ev_vars = new_evs
                          , abs_ev_binds = new_ev_binds
481 482
                          , abs_exports = new_exports, abs_binds = new_val_bind
                          , abs_sig = has_sig }) }
sof's avatar
sof committed
483
  where
484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504
    zonk_val_bind env lbind
      | has_sig
      , L loc bind@(FunBind { fun_id      = L mloc mono_id
                            , fun_matches = ms
                            , fun_co_fn   = co_fn }) <- lbind
      = do { new_mono_id <- updateVarTypeM (zonkTcTypeToType env) mono_id
                            -- Specifically /not/ zonkIdBndr; we do not
                            -- want to complain about a levity-polymorphic binder
           ; (env', new_co_fn) <- zonkCoFn env co_fn
           ; new_ms            <- zonkMatchGroup env' zonkLExpr ms
           ; return $ L loc $
             bind { fun_id      = L mloc new_mono_id
                  , fun_matches = new_ms
                  , fun_co_fn   = new_co_fn } }
      | otherwise
      = zonk_lbind env lbind   -- The normal case

    zonk_export env (ABE{ abe_wrap = wrap
                        , abe_poly = poly_id
                        , abe_mono = mono_id
                        , abe_prags = prags })
ian@well-typed.com's avatar
ian@well-typed.com committed
505 506 507
        = do new_poly_id <- zonkIdBndr env poly_id
             (_, new_wrap) <- zonkCoFn env wrap
             new_prags <- zonkSpecPrags env prags
508
             return (ABE{ abe_wrap = new_wrap
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
509
                        , abe_poly = new_poly_id
ian@well-typed.com's avatar
ian@well-typed.com committed
510 511
                        , abe_mono = zonkIdOcc env mono_id
                        , abe_prags = new_prags })
512

513 514 515 516
zonk_bind env (PatSynBind bind@(PSB { psb_id = L loc id
                                    , psb_args = details
                                    , psb_def = lpat
                                    , psb_dir = dir }))
cactus's avatar
cactus committed
517
  = do { id' <- zonkIdBndr env id
518
       ; (env1, lpat') <- zonkPat env lpat
519
       ; let details' = zonkPatSynDetails env1 details
cactus's avatar
cactus committed
520
       ; (_env2, dir') <- zonkPatSynDir env1 dir
521 522 523 524 525
       ; return $ PatSynBind $
                  bind { psb_id = L loc id'
                       , psb_args = details'
                       , psb_def = lpat'
                       , psb_dir = dir' } }
cactus's avatar
cactus committed
526 527 528

zonkPatSynDetails :: ZonkEnv
                  -> HsPatSynDetails (Located TcId)
529 530 531 532 533 534 535
                  -> HsPatSynDetails (Located Id)
zonkPatSynDetails env (PrefixCon as)
  = PrefixCon (map (zonkLIdOcc env) as)
zonkPatSynDetails env (InfixCon a1 a2)
  = InfixCon (zonkLIdOcc env a1) (zonkLIdOcc env a2)
zonkPatSynDetails env (RecCon flds)
  = RecCon (map (fmap (zonkLIdOcc env)) flds)
cactus's avatar
cactus committed
536

537 538
zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTcId
              -> TcM (ZonkEnv, HsPatSynDir GhcTc)
539
zonkPatSynDir env Unidirectional        = return (env, Unidirectional)
cactus's avatar
cactus committed
540
zonkPatSynDir env ImplicitBidirectional = return (env, ImplicitBidirectional)
541 542 543
zonkPatSynDir env (ExplicitBidirectional mg) = do
    mg' <- zonkMatchGroup env zonkLExpr mg
    return (env, ExplicitBidirectional mg')
cactus's avatar
cactus committed
544

545 546
zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags
zonkSpecPrags _   IsDefaultMethod = return IsDefaultMethod
547
zonkSpecPrags env (SpecPrags ps)  = do { ps' <- zonkLTcSpecPrags env ps
548
                                       ; return (SpecPrags ps') }
549 550 551 552

zonkLTcSpecPrags :: ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
zonkLTcSpecPrags env ps
  = mapM zonk_prag ps
553
  where
554
    zonk_prag (L loc (SpecPrag id co_fn inl))
555 556
        = do { (_, co_fn') <- zonkCoFn env co_fn
             ; return (L loc (SpecPrag (zonkIdOcc env id) co_fn' inl)) }
557

Austin Seipp's avatar
Austin Seipp committed
558 559 560
{-
************************************************************************
*                                                                      *
561
\subsection[BackSubst-Match-GRHSs]{Match and GRHSs}
Austin Seipp's avatar
Austin Seipp committed
562 563 564
*                                                                      *
************************************************************************
-}
565

566
zonkMatchGroup :: ZonkEnv
567 568 569
            -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
            -> MatchGroup GhcTcId (Located (body GhcTcId))
            -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
570 571
zonkMatchGroup env zBody (MG { mg_alts = L l ms, mg_arg_tys = arg_tys
                             , mg_res_ty = res_ty, mg_origin = origin })
572 573 574
  = do  { ms' <- mapM (zonkMatch env zBody) ms
        ; arg_tys' <- zonkTcTypeToTypes env arg_tys
        ; res_ty'  <- zonkTcTypeToType env res_ty
575 576
        ; return (MG { mg_alts = L l ms', mg_arg_tys = arg_tys'
                     , mg_res_ty = res_ty', mg_origin = origin }) }
577

578
zonkMatch :: ZonkEnv
579 580 581
          -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
          -> LMatch GhcTcId (Located (body GhcTcId))
          -> TcM (LMatch GhcTc (Located (body GhcTc)))
582
zonkMatch env zBody (L loc match@(Match { m_pats = pats, m_grhss = grhss }))
583 584
  = do  { (env1, new_pats) <- zonkPats env pats
        ; new_grhss <- zonkGRHSs env1 zBody grhss
585
        ; return (L loc (match { m_pats = new_pats, m_grhss = new_grhss })) }
586

587
-------------------------------------------------------------------------
588
zonkGRHSs :: ZonkEnv
589 590 591
          -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
          -> GRHSs GhcTcId (Located (body GhcTcId))
          -> TcM (GRHSs GhcTc (Located (body GhcTc)))
592

593
zonkGRHSs env zBody (GRHSs grhss (L l binds)) = do
ian@well-typed.com's avatar
ian@well-typed.com committed
594
    (new_env, new_binds) <- zonkLocalBinds env binds
595
    let
596
        zonk_grhs (GRHS guarded rhs)
ian@well-typed.com's avatar
ian@well-typed.com committed
597 598 599 600
          = do (env2, new_guarded) <- zonkStmts new_env zonkLExpr guarded
               new_rhs <- zBody env2 rhs
               return (GRHS new_guarded new_rhs)
    new_grhss <- mapM (wrapLocM zonk_grhs) grhss
601
    return (GRHSs new_grhss (L l new_binds))
602

Austin Seipp's avatar
Austin Seipp committed
603 604 605
{-
************************************************************************
*                                                                      *
606
\subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr}
Austin Seipp's avatar
Austin Seipp committed
607 608 609
*                                                                      *
************************************************************************
-}
610

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

615
zonkLExprs env exprs = mapM (zonkLExpr env) exprs
616
zonkLExpr  env expr  = wrapLocM (zonkExpr env) expr
617

Ben Gamari's avatar
Ben Gamari committed
618
zonkExpr env (HsVar (L l id))
Ben Gamari's avatar
Ben Gamari committed
619
  = ASSERT2( isNothing (isDataConId_maybe id), ppr id )
Ben Gamari's avatar
Ben Gamari committed
620
    return (HsVar (L l (zonkIdOcc env id)))
621 622

zonkExpr _ e@(HsConLikeOut {}) = return e
623

Ben Gamari's avatar
Ben Gamari committed
624 625
zonkExpr _ (HsIPVar id)
  = return (HsIPVar id)
626

627
zonkExpr _ e@HsOverLabel{} = return e
Adam Gundry's avatar
Adam Gundry committed
628

Ben Gamari's avatar
Ben Gamari committed
629
zonkExpr env (HsLit (HsRat e f ty))
ian@well-typed.com's avatar
ian@well-typed.com committed
630
  = do new_ty <- zonkTcTypeToType env ty
Ben Gamari's avatar
Ben Gamari committed
631
       return (HsLit (HsRat e f new_ty))
sof's avatar
sof committed
632

Ben Gamari's avatar
Ben Gamari committed
633 634
zonkExpr _ (HsLit lit)
  = return (HsLit lit)
635

Ben Gamari's avatar
Ben Gamari committed
636
zonkExpr env (HsOverLit lit)
637
  = do  { lit' <- zonkOverLit env lit
Ben Gamari's avatar
Ben Gamari committed
638
        ; return (HsOverLit lit') }
639

Ben Gamari's avatar
Ben Gamari committed
640
zonkExpr env (HsLam matches)
ian@well-typed.com's avatar
ian@well-typed.com committed
641
  = do new_matches <- zonkMatchGroup env zonkLExpr matches
Ben Gamari's avatar
Ben Gamari committed
642
       return (HsLam new_matches)
643

Ben Gamari's avatar
Ben Gamari committed
644
zonkExpr env (HsLamCase matches)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
645
  = do new_matches <- zonkMatchGroup env zonkLExpr matches
Ben Gamari's avatar
Ben Gamari committed
646
       return (HsLamCase new_matches)
647

Ben Gamari's avatar
Ben Gamari committed
648
zonkExpr env (HsApp e1 e2)
ian@well-typed.com's avatar
ian@well-typed.com committed
649 650
  = do new_e1 <- zonkLExpr env e1
       new_e2 <- zonkLExpr env e2
Ben Gamari's avatar
Ben Gamari committed
651
       return (HsApp new_e1 new_e2)
652

Ben Gamari's avatar
Ben Gamari committed
653
zonkExpr env (HsAppTypeOut e t)
654
  = do new_e <- zonkLExpr env e
Ben Gamari's avatar
Ben Gamari committed
655
       return (HsAppTypeOut new_e t)
656 657
       -- NB: the type is an HsType; can't zonk that!

Ben Gamari's avatar
Ben Gamari committed
658
zonkExpr _ e@(HsRnBracketOut _ _)
gmainland's avatar
gmainland committed
659 660
  = pprPanic "zonkExpr: HsRnBracketOut" (ppr e)

Ben Gamari's avatar
Ben Gamari committed
661
zonkExpr env (HsTcBracketOut body bs)
ian@well-typed.com's avatar
ian@well-typed.com committed
662
  = do bs' <- mapM zonk_b bs
Ben Gamari's avatar
Ben Gamari committed
663
       return (HsTcBracketOut body bs')
664
  where
665 666
    zonk_b (PendingTcSplice n e) = do e' <- zonkLExpr env e
                                      return (PendingTcSplice n e')
gmainland's avatar
gmainland committed
667

Ben Gamari's avatar
Ben Gamari committed
668 669
zonkExpr _ (HsSpliceE s) = WARN( True, ppr s ) -- Should not happen
                           return (HsSpliceE s)
670

Ben Gamari's avatar
Ben Gamari committed
671
zonkExpr env (OpApp e1 op fixity e2)
ian@well-typed.com's avatar
ian@well-typed.com committed
672 673 674
  = do new_e1 <- zonkLExpr env e1
       new_op <- zonkLExpr env op
       new_e2 <- zonkLExpr env e2
Ben Gamari's avatar
Ben Gamari committed
675
       return (OpApp new_e1 new_op fixity new_e2)
676

Ben Gamari's avatar
Ben Gamari committed
677
zonkExpr env (NegApp expr op)
678 679
  = do (env', new_op) <- zonkSyntaxExpr env op
       new_expr <- zonkLExpr env' expr
Ben Gamari's avatar
Ben Gamari committed
680
       return (NegApp new_expr new_op)
681

Ben Gamari's avatar
Ben Gamari committed
682
zonkExpr env (HsPar e)
ian@well-typed.com's avatar
ian@well-typed.com committed
683
  = do new_e <- zonkLExpr env e
Ben Gamari's avatar
Ben Gamari committed
684
       return (HsPar new_e)
685

Ben Gamari's avatar
Ben Gamari committed
686
zonkExpr env (SectionL expr op)
ian@well-typed.com's avatar
ian@well-typed.com committed
687 688
  = do new_expr <- zonkLExpr env expr
       new_op   <- zonkLExpr env op
Ben Gamari's avatar
Ben Gamari committed
689
       return (SectionL new_expr new_op)
690

Ben Gamari's avatar
Ben Gamari committed
691
zonkExpr env (SectionR op expr)
ian@well-typed.com's avatar
ian@well-typed.com committed
692 693
  = do new_op   <- zonkLExpr env op
       new_expr <- zonkLExpr env expr
Ben Gamari's avatar
Ben Gamari committed
694
       return (SectionR new_op new_expr)
695

Ben Gamari's avatar
Ben Gamari committed
696
zonkExpr env (ExplicitTuple tup_args boxed)
697
  = do { new_tup_args <- mapM zonk_tup_arg tup_args
Ben Gamari's avatar
Ben Gamari committed
698
       ; return (ExplicitTuple new_tup_args boxed) }
699
  where
Ben Gamari's avatar
Ben Gamari committed
700 701
    zonk_tup_arg (L l (Present e)) = do { e' <- zonkLExpr env e
                                        ; return (L l (Present e')) }
702 703
    zonk_tup_arg (L l (Missing t)) = do { t' <- zonkTcTypeToType env t
                                        ; return (L l (Missing t')) }
704

Ben Gamari's avatar
Ben Gamari committed
705
zonkExpr env (ExplicitSum alt arity expr args)
706 707
  = do new_args <- mapM (zonkTcTypeToType env) args
       new_expr <- zonkLExpr env expr
Ben Gamari's avatar
Ben Gamari committed
708
       return (ExplicitSum alt arity new_expr new_args)
709

Ben Gamari's avatar
Ben Gamari committed
710
zonkExpr env (HsCase expr ms)
ian@well-typed.com's avatar
ian@well-typed.com committed
711 712
  = do new_expr <- zonkLExpr env expr
       new_ms <- zonkMatchGroup env zonkLExpr ms
Ben Gamari's avatar
Ben Gamari committed
713
       return (HsCase new_expr new_ms)
714

Ben Gamari's avatar
Ben Gamari committed
715
zonkExpr env (HsIf Nothing e1 e2 e3)
716 717 718
  = do new_e1 <- zonkLExpr env e1
       new_e2 <- zonkLExpr env e2
       new_e3 <- zonkLExpr env e3
Ben Gamari's avatar
Ben Gamari committed
719
       return (HsIf Nothing new_e1 new_e2 new_e3)
720

Ben Gamari's avatar
Ben Gamari committed
721
zonkExpr env (HsIf (Just fun) e1 e2 e3)
722 723 724 725
  = do (env1, new_fun) <- zonkSyntaxExpr env fun
       new_e1 <- zonkLExpr env1 e1
       new_e2 <- zonkLExpr env1 e2
       new_e3 <- zonkLExpr env1 e3
Ben Gamari's avatar
Ben Gamari committed
726
       return (HsIf (Just new_fun) new_e1 new_e2 new_e3)
727

728 729 730
zonkExpr env (HsMultiIf ty alts)
  = do { alts' <- mapM (wrapLocM zonk_alt) alts
       ; ty'   <- zonkTcTypeToType env ty
731
       ; return $ HsMultiIf ty' alts' }
732
  where zonk_alt (GRHS guard expr)
733
          = do { (env', guard') <- zonkStmts env zonkLExpr guard
734
               ; expr'          <- zonkLExpr env' expr
735
               ; return $ GRHS guard' expr' }
736

Ben Gamari's avatar
Ben Gamari committed
737
zonkExpr env (HsLet (L l binds) expr)
ian@well-typed.com's avatar
ian@well-typed.com committed
738 739
  = do (new_env, new_binds) <- zonkLocalBinds env binds
       new_expr <- zonkLExpr new_env expr
Ben Gamari's avatar
Ben Gamari committed
740
       return (HsLet (L l new_binds) new_expr)
741

Ben Gamari's avatar
Ben Gamari committed
742
zonkExpr env (HsDo do_or_lc (L l stmts) ty)
ian@well-typed.com's avatar
ian@well-typed.com committed
743 744
  = do (_, new_stmts) <- zonkStmts env zonkLExpr stmts
       new_ty <- zonkTcTypeToType env ty
Ben Gamari's avatar
Ben Gamari committed
745
       return (HsDo do_or_lc (L l new_stmts) new_ty)
746

747
zonkExpr env (ExplicitList ty wit exprs)
748 749 750
  = do (env1, new_wit) <- zonkWit env wit
       new_ty <- zonkTcTypeToType env1 ty
       new_exprs <- zonkLExprs env1 exprs
ian@well-typed.com's avatar
ian@well-typed.com committed
751
       return (ExplicitList new_ty new_wit new_exprs)
752 753
   where zonkWit env Nothing    = return (env, Nothing)
         zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln
754 755

zonkExpr env (ExplicitPArr ty exprs)
ian@well-typed.com's avatar
ian@well-typed.com committed
756 757 758
  = do new_ty <- zonkTcTypeToType env ty
       new_exprs <- zonkLExprs env exprs
       return (ExplicitPArr new_ty new_exprs)
759

Ben Gamari's avatar
Ben Gamari committed
760 761
zonkExpr env expr@(RecordCon { rcon_con_expr = con_expr, rcon_flds = rbinds })
  = do  { new_con_expr <- zonkExpr env con_expr
762
        ; new_rbinds   <- zonkRecFields env rbinds
Ben Gamari's avatar
Ben Gamari committed
763
        ; return (expr { rcon_con_expr = new_con_expr
764
                       , rcon_flds = new_rbinds }) }
765

Ben Gamari's avatar
Ben Gamari committed
766 767 768
zonkExpr env (RecordUpd { rupd_expr = expr, rupd_flds = rbinds
                        , rupd_cons = cons, rupd_in_tys = in_tys
                        , rupd_out_tys = out_tys, rupd_wrap = req_wrap })
769 770 771
  = do  { new_expr    <- zonkLExpr env expr
        ; new_in_tys  <- mapM (zonkTcTypeToType env) in_tys
        ; new_out_tys <- mapM (zonkTcTypeToType env) out_tys
772
        ; new_rbinds  <- zonkRecUpdFields env rbinds
Matthew Pickering's avatar
Matthew Pickering committed
773
        ; (_, new_recwrap) <- zonkCoFn env req_wrap
774
        ; return (RecordUpd { rupd_expr = new_expr, rupd_flds =  new_rbinds
Ben Gamari's avatar
Ben Gamari committed
775 776
                            , rupd_cons = cons, rupd_in_tys = new_in_tys
                            , rupd_out_tys = new_out_tys, rupd_wrap = new_recwrap }) }
777

Ben Gamari's avatar
Ben Gamari committed
778
zonkExpr env (ExprWithTySigOut e ty)
779
  = do { e' <- zonkLExpr env e
Ben Gamari's avatar
Ben Gamari committed
780
       ; return (ExprWithTySigOut e' ty) }
781

782
zonkExpr env (ArithSeq expr wit info)
783 784 785
  = do (env1, new_wit) <- zonkWit env wit
       new_expr <- zonkExpr env expr
       new_info <- zonkArithSeq env1 info
ian@well-typed.com's avatar
ian@well-typed.com committed
786
       return (ArithSeq new_expr new_wit new_info)
787 788
   where zonkWit env Nothing    = return (env, Nothing)
         zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln
789

790
zonkExpr env (PArrSeq expr info)
ian@well-typed.com's avatar
ian@well-typed.com committed
791 792 793
  = do new_expr <- zonkExpr env expr
       new_info <- zonkArithSeq env info
       return (PArrSeq new_expr new_info)
794

Ben Gamari's avatar
Ben Gamari committed
795
zonkExpr env (HsSCC src lbl expr)
ian@well-typed.com's avatar
ian@well-typed.com committed
796
  = do new_expr <- zonkLExpr env expr
Ben Gamari's avatar
Ben Gamari committed
797
       return (HsSCC src lbl new_expr)
798

Ben Gamari's avatar
Ben Gamari committed
799
zonkExpr env (HsTickPragma src info srcInfo expr)
ian@well-typed.com's avatar
ian@well-typed.com committed
800
  = do new_expr <- zonkLExpr env expr
Ben Gamari's avatar
Ben Gamari committed
801
       return (HsTickPragma src info srcInfo new_expr)
andy@galois.com's avatar
andy@galois.com committed
802

803
-- hdaume: core annotations
Ben Gamari's avatar
Ben Gamari committed
804
zonkExpr env (HsCoreAnn src lbl expr)
ian@well-typed.com's avatar
ian@well-typed.com committed
805
  = do new_expr <- zonkLExpr env expr
Ben Gamari's avatar
Ben Gamari committed
806
       return (HsCoreAnn src lbl new_expr)
807

808
-- arrow notation extensions
Ben Gamari's avatar
Ben Gamari committed
809
zonkExpr env (HsProc pat body)
810 811
  = do  { (env1, new_pat) <- zonkPat env pat
        ; new_body <- zonkCmdTop env1 body
Ben Gamari's avatar
Ben Gamari committed
812
        ; return (HsProc new_pat new_body) }
813

814
-- StaticPointers extension
815 816
zonkExpr env (HsStatic fvs expr)
  = HsStatic fvs <$> zonkLExpr env expr
817

Ben Gamari's avatar
Ben Gamari committed
818
zonkExpr env (HsWrap co_fn expr)
ian@well-typed.com's avatar
ian@well-typed.com committed
819 820
  = do (env1, new_co_fn) <- zonkCoFn env co_fn
       new_expr <- zonkExpr env1 expr
Ben Gamari's avatar