TcHsSyn.hs 68.1 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

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

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

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

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

91
hsPatType :: Pat GhcTc -> Type
Ben Gamari's avatar
Ben Gamari committed
92 93 94 95 96 97 98 99 100 101 102 103 104
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
105
hsPatType (ConPatOut { pat_con = L _ con, pat_arg_tys = tys })
Ben Gamari's avatar
Ben Gamari committed
106 107 108 109 110 111 112 113
                                      = 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
114 115 116 117
hsLitType (HsChar _ _)       = charTy
hsLitType (HsCharPrim _ _)   = charPrimTy
hsLitType (HsString _ _)     = stringTy
hsLitType (HsStringPrim _ _) = addrPrimTy
118
hsLitType (HsInt _ _)        = intTy
119 120 121 122 123
hsLitType (HsIntPrim _ _)    = intPrimTy
hsLitType (HsWordPrim _ _)   = wordPrimTy
hsLitType (HsInt64Prim _ _)  = int64PrimTy
hsLitType (HsWord64Prim _ _) = word64PrimTy
hsLitType (HsInteger _ _ ty) = ty
124 125 126
hsLitType (HsRat _ _ ty)     = ty
hsLitType (HsFloatPrim _ _)  = floatPrimTy
hsLitType (HsDoublePrim _ _) = doublePrimTy
127

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

130
shortCutLit :: DynFlags -> OverLitVal -> TcType -> Maybe (HsExpr GhcTcId)
131
shortCutLit dflags (HsIntegral int@(IL src neg i)) ty
Ben Gamari's avatar
Ben Gamari committed
132
  | isIntTy ty  && inIntRange  dflags i = Just (HsLit (HsInt def int))
133
  | isWordTy ty && inWordRange dflags i = Just (mkLit wordDataCon (HsWordPrim src i))
Ben Gamari's avatar
Ben Gamari committed
134
  | isIntegerTy ty = Just (HsLit (HsInteger src i ty))
135
  | otherwise = shortCutLit dflags (HsFractional (integralFractionalLit neg i)) ty
136 137 138 139 140
        -- 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
141

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

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

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

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

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

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

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

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

178 179 180
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
181

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

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

195 196 197
-- | 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
198 199 200 201 202 203 204 205 206 207 208 209
-- 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.
210 211
--
-- Confused by zonking? See Note [What is zonking?] in TcMType.
212 213
data ZonkEnv
  = ZonkEnv
dreixel's avatar
dreixel committed
214
      UnboundTyVarZonker
215 216
      (TyCoVarEnv TyVar)
      (IdEnv      Var)         -- What variables are in scope
217 218 219 220 221 222 223
        -- 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
224
  ppr (ZonkEnv _ _ty_env var_env) = pprUFM var_env (vcat . map ppr)
225 226


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

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

234 235 236 237 238
-- | 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
239
  = ZonkEnv zonk_ty ty_env (extendVarEnvList id_env [(id,id) | id <- ids])
240 241 242 243 244 245 246 247 248 249 250 251
  -- 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
252

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

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

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

niteria's avatar
niteria committed
265 266 267 268 269
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
270

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

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

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

298
-- zonkIdBndr is used *after* typechecking to get the Id's type
299
-- to its final form.  The TyVarEnv give
300
zonkIdBndr :: ZonkEnv -> TcId -> TcM Id
301 302 303 304 305 306
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'))
307 308

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

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

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

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

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

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

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

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

Simon Peyton Jones's avatar
Simon Peyton Jones committed
346
zonkTyBndrX :: ZonkEnv -> TcTyVar -> TcM (ZonkEnv, TyVar)
347 348
-- 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
349
zonkTyBndrX env tv
350 351
  = ASSERT( isImmutableTyVar tv )
    do { ki <- zonkTcTypeToType env (tyVarKind tv)
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
352
               -- Internal names tidy up better, for iface files.
353 354
       ; let tv' = mkTyVar (tyVarName tv) ki
       ; return (extendTyZonkEnv1 env tv', tv') }
355

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

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

367
zonkTopExpr :: HsExpr GhcTcId -> TcM (HsExpr GhcTc)
368 369
zonkTopExpr e = zonkExpr emptyZonkEnv e

370
zonkTopLExpr :: LHsExpr GhcTcId -> TcM (LHsExpr GhcTc)
371 372
zonkTopLExpr e = zonkLExpr emptyZonkEnv e

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

---------------------------------------------
395 396
zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTcId
               -> TcM (ZonkEnv, HsLocalBinds GhcTc)
397 398 399
zonkLocalBinds env EmptyLocalBinds
  = return (env, EmptyLocalBinds)

Ben Gamari's avatar
Ben Gamari committed
400
zonkLocalBinds _ (HsValBinds (ValBindsIn {}))
401 402
  = panic "zonkLocalBinds" -- Not in typechecker output

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

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

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

434
---------------------------------------------
435
zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTcId -> TcM (LHsBinds GhcTc)
436
zonkMonoBinds env binds = mapBagM (zonk_lbind env) binds
cactus's avatar
cactus committed
437

438
zonk_lbind :: ZonkEnv -> LHsBind GhcTcId -> TcM (LHsBind GhcTc)
439
zonk_lbind env = wrapLocM (zonk_bind env)
440

441
zonk_bind :: ZonkEnv -> HsBind GhcTcId -> TcM (HsBind GhcTc)
442
zonk_bind env bind@(PatBind { pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty})
443 444 445 446
  = 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 }) }
447

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

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

461 462 463
zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
                        , abs_ev_binds = ev_binds
                        , abs_exports = exports
464 465
                        , abs_binds = val_binds
                        , abs_sig = has_sig })
466
  = ASSERT( all isImmutableTyVar tyvars )
dreixel's avatar
dreixel committed
467 468
    do { (env0, new_tyvars) <- zonkTyBndrsX env tyvars
       ; (env1, new_evs) <- zonkEvBndrsX env0 evs
469
       ; (env2, new_ev_binds) <- zonkTcEvBinds_s env1 ev_binds
470
       ; (new_val_bind, new_exports) <- fixM $ \ ~(new_val_binds, _) ->
471 472 473 474
         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
475
            ; return (new_val_binds, new_exports) }
dreixel's avatar
dreixel committed
476 477
       ; return (AbsBinds { abs_tvs = new_tyvars, abs_ev_vars = new_evs
                          , abs_ev_binds = new_ev_binds
478 479
                          , abs_exports = new_exports, abs_binds = new_val_bind
                          , abs_sig = has_sig }) }
sof's avatar
sof committed
480
  where
481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501
    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
502 503 504
        = do new_poly_id <- zonkIdBndr env poly_id
             (_, new_wrap) <- zonkCoFn env wrap
             new_prags <- zonkSpecPrags env prags
505
             return (ABE{ abe_wrap = new_wrap
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
506
                        , abe_poly = new_poly_id
ian@well-typed.com's avatar
ian@well-typed.com committed
507 508
                        , abe_mono = zonkIdOcc env mono_id
                        , abe_prags = new_prags })
509

510 511 512 513
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
514
  = do { id' <- zonkIdBndr env id
515
       ; (env1, lpat') <- zonkPat env lpat
516
       ; let details' = zonkPatSynDetails env1 details
cactus's avatar
cactus committed
517
       ; (_env2, dir') <- zonkPatSynDir env1 dir
518 519 520 521 522
       ; return $ PatSynBind $
                  bind { psb_id = L loc id'
                       , psb_args = details'
                       , psb_def = lpat'
                       , psb_dir = dir' } }
cactus's avatar
cactus committed
523 524 525

zonkPatSynDetails :: ZonkEnv
                  -> HsPatSynDetails (Located TcId)
526 527 528 529 530 531 532
                  -> 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
533

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

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

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

Austin Seipp's avatar
Austin Seipp committed
555 556 557
{-
************************************************************************
*                                                                      *
558
\subsection[BackSubst-Match-GRHSs]{Match and GRHSs}
Austin Seipp's avatar
Austin Seipp committed
559 560 561
*                                                                      *
************************************************************************
-}
562

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

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

584
-------------------------------------------------------------------------
585
zonkGRHSs :: ZonkEnv
586 587 588
          -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
          -> GRHSs GhcTcId (Located (body GhcTcId))
          -> TcM (GRHSs GhcTc (Located (body GhcTc)))
589

590
zonkGRHSs env zBody (GRHSs grhss (L l binds)) = do
ian@well-typed.com's avatar
ian@well-typed.com committed
591
    (new_env, new_binds) <- zonkLocalBinds env binds
592
    let
593
        zonk_grhs (GRHS guarded rhs)
ian@well-typed.com's avatar
ian@well-typed.com committed
594 595 596 597
          = 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
598
    return (GRHSs new_grhss (L l new_binds))
599

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

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

612
zonkLExprs env exprs = mapM (zonkLExpr env) exprs
613
zonkLExpr  env expr  = wrapLocM (zonkExpr env) expr
614

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

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

Ben Gamari's avatar
Ben Gamari committed
621 622
zonkExpr _ (HsIPVar id)
  = return (HsIPVar id)
623

624
zonkExpr _ e@HsOverLabel{} = return e
Adam Gundry's avatar
Adam Gundry committed
625

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

Ben Gamari's avatar
Ben Gamari committed
630 631
zonkExpr _ (HsLit lit)
  = return (HsLit lit)
632

Ben Gamari's avatar
Ben Gamari committed
633
zonkExpr env (HsOverLit lit)
634
  = do  { lit' <- zonkOverLit env lit
Ben Gamari's avatar
Ben Gamari committed
635
        ; return (HsOverLit lit') }
636

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

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

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

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

Ben Gamari's avatar
Ben Gamari committed
655
zonkExpr _ e@(HsRnBracketOut _ _)
gmainland's avatar
gmainland committed
656 657
  = pprPanic "zonkExpr: HsRnBracketOut" (ppr e)

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

Ben Gamari's avatar
Ben Gamari committed
665 666
zonkExpr _ (HsSpliceE s) = WARN( True, ppr s ) -- Should not happen
                           return (HsSpliceE s)
667

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

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

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

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

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

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

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

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

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

Ben Gamari's avatar
Ben Gamari committed
718
zonkExpr env (HsIf (Just fun) e1 e2 e3)
719 720 721 722
  = 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
723
       return (HsIf (Just new_fun) new_e1 new_e2 new_e3)
724

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

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

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

744
zonkExpr env (ExplicitList ty wit exprs)
745 746 747
  = 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
748
       return (ExplicitList new_ty new_wit new_exprs)
749 750
   where zonkWit env Nothing    = return (env, Nothing)
         zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln
751 752

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

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

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

Ben Gamari's avatar
Ben Gamari committed
775
zonkExpr env (ExprWithTySigOut e ty)
776
  = do { e' <- zonkLExpr env e
Ben Gamari's avatar
Ben Gamari committed
777
       ; return (ExprWithTySigOut e' ty) }
778

779
zonkExpr env (ArithSeq expr wit info)
780 781 782
  = 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
783
       return (ArithSeq new_expr new_wit new_info)
784 785
   where zonkWit env Nothing    = return (env, Nothing)
         zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln
786

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

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

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

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

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

811
-- StaticPointers extension
812 813
zonkExpr env (HsStatic fvs expr)
  = HsStatic fvs <$> zonkLExpr env expr
814

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