TcHsSyn.hs 68 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
dreixel's avatar
dreixel committed
55
import Type
56
import Coercion
57
import ConLike
58
import DataCon
niteria's avatar
niteria committed
59
import HscTypes
60
import Name
niteria's avatar
niteria committed
61
import NameEnv
62
import Var
63
import VarEnv
64
import DynFlags
65
import Literal
66 67 68
import BasicTypes
import Maybes
import SrcLoc
sof's avatar
sof committed
69
import Bag
sof's avatar
sof committed
70
import Outputable
71
import Util
72
import UniqFM
73

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

Ian Lynagh's avatar
Ian Lynagh committed
291
zonkIdOccs :: ZonkEnv -> [TcId] -> [Id]
292
zonkIdOccs env ids = map (zonkIdOcc env) ids
293

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

zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id]
305
zonkIdBndrs env ids = mapM (zonkIdBndr env) ids
306 307 308

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

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

313
zonkEvBndrsX :: ZonkEnv -> [EvVar] -> TcM (ZonkEnv, [Var])
314
zonkEvBndrsX = mapAccumLM zonkEvBndrX
315 316 317 318 319

zonkEvBndrX :: ZonkEnv -> EvVar -> TcM (ZonkEnv, EvVar)
-- Works for dictionaries and coercions
zonkEvBndrX env var
  = do { var' <- zonkEvBndr env var
320
       ; return (extendZonkEnv env [var'], var') }
321 322 323 324

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

332 333 334 335 336 337
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
338

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

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

Simon Peyton Jones's avatar
Simon Peyton Jones committed
352 353 354
zonkTyVarBindersX :: ZonkEnv -> [TyVarBndr TcTyVar vis]
                             -> TcM (ZonkEnv, [TyVarBndr TyVar vis])
zonkTyVarBindersX = mapAccumLM zonkTyVarBinderX
355

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

363
zonkTopExpr :: HsExpr GhcTcId -> TcM (HsExpr GhcTc)
364 365
zonkTopExpr e = zonkExpr emptyZonkEnv e

366
zonkTopLExpr :: LHsExpr GhcTcId -> TcM (LHsExpr GhcTc)
367 368
zonkTopLExpr e = zonkLExpr emptyZonkEnv e

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

---------------------------------------------
391 392
zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTcId
               -> TcM (ZonkEnv, HsLocalBinds GhcTc)
393 394 395
zonkLocalBinds env EmptyLocalBinds
  = return (env, EmptyLocalBinds)

Ben Gamari's avatar
Ben Gamari committed
396
zonkLocalBinds _ (HsValBinds (ValBindsIn {}))
397 398
  = panic "zonkLocalBinds" -- Not in typechecker output

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

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

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

430
---------------------------------------------
431
zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTcId -> TcM (LHsBinds GhcTc)
432
zonkMonoBinds env binds = mapBagM (zonk_lbind env) binds
cactus's avatar
cactus committed
433

434
zonk_lbind :: ZonkEnv -> LHsBind GhcTcId -> TcM (LHsBind GhcTc)
435
zonk_lbind env = wrapLocM (zonk_bind env)
436

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

444
zonk_bind env (VarBind { var_id = var, var_rhs = expr, var_inline = inl })
445 446 447 448
  = do { new_var  <- zonkIdBndr env var
       ; new_expr <- zonkLExpr env expr
       ; return (VarBind { var_id = new_var, var_rhs = new_expr, var_inline = inl }) }

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

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

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

zonkPatSynDetails :: ZonkEnv
                  -> HsPatSynDetails (Located TcId)
                  -> TcM (HsPatSynDetails (Located Id))
zonkPatSynDetails env = traverse (wrapLocM $ zonkIdBndr env)

525 526
zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTcId
              -> TcM (ZonkEnv, HsPatSynDir GhcTc)
cactus's avatar
cactus committed
527 528
zonkPatSynDir env Unidirectional = return (env, Unidirectional)
zonkPatSynDir env ImplicitBidirectional = return (env, ImplicitBidirectional)
529 530 531
zonkPatSynDir env (ExplicitBidirectional mg) = do
    mg' <- zonkMatchGroup env zonkLExpr mg
    return (env, ExplicitBidirectional mg')
cactus's avatar
cactus committed
532

533 534
zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags
zonkSpecPrags _   IsDefaultMethod = return IsDefaultMethod
535
zonkSpecPrags env (SpecPrags ps)  = do { ps' <- zonkLTcSpecPrags env ps
536
                                       ; return (SpecPrags ps') }
537 538 539 540

zonkLTcSpecPrags :: ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
zonkLTcSpecPrags env ps
  = mapM zonk_prag ps
541
  where
542
    zonk_prag (L loc (SpecPrag id co_fn inl))
543 544
        = do { (_, co_fn') <- zonkCoFn env co_fn
             ; return (L loc (SpecPrag (zonkIdOcc env id) co_fn' inl)) }
545

Austin Seipp's avatar
Austin Seipp committed
546 547 548
{-
************************************************************************
*                                                                      *
549
\subsection[BackSubst-Match-GRHSs]{Match and GRHSs}
Austin Seipp's avatar
Austin Seipp committed
550 551 552
*                                                                      *
************************************************************************
-}
553

554
zonkMatchGroup :: ZonkEnv
555 556 557
            -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
            -> MatchGroup GhcTcId (Located (body GhcTcId))
            -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
558 559
zonkMatchGroup env zBody (MG { mg_alts = L l ms, mg_arg_tys = arg_tys
                             , mg_res_ty = res_ty, mg_origin = origin })
560 561 562
  = do  { ms' <- mapM (zonkMatch env zBody) ms
        ; arg_tys' <- zonkTcTypeToTypes env arg_tys
        ; res_ty'  <- zonkTcTypeToType env res_ty
563 564
        ; return (MG { mg_alts = L l ms', mg_arg_tys = arg_tys'
                     , mg_res_ty = res_ty', mg_origin = origin }) }
565

566
zonkMatch :: ZonkEnv
567 568 569
          -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
          -> LMatch GhcTcId (Located (body GhcTcId))
          -> TcM (LMatch GhcTc (Located (body GhcTc)))
570
zonkMatch env zBody (L loc match@(Match { m_pats = pats, m_grhss = grhss }))
571 572
  = do  { (env1, new_pats) <- zonkPats env pats
        ; new_grhss <- zonkGRHSs env1 zBody grhss
573
        ; return (L loc (match { m_pats = new_pats, m_grhss = new_grhss })) }
574

575
-------------------------------------------------------------------------
576
zonkGRHSs :: ZonkEnv
577 578 579
          -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
          -> GRHSs GhcTcId (Located (body GhcTcId))
          -> TcM (GRHSs GhcTc (Located (body GhcTc)))
580

581
zonkGRHSs env zBody (GRHSs grhss (L l binds)) = do
ian@well-typed.com's avatar
ian@well-typed.com committed
582
    (new_env, new_binds) <- zonkLocalBinds env binds
583
    let
584
        zonk_grhs (GRHS guarded rhs)
ian@well-typed.com's avatar
ian@well-typed.com committed
585 586 587 588
          = 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
589
    return (GRHSs new_grhss (L l new_binds))
590

Austin Seipp's avatar
Austin Seipp committed
591 592 593
{-
************************************************************************
*                                                                      *
594
\subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr}
Austin Seipp's avatar
Austin Seipp committed
595 596 597
*                                                                      *
************************************************************************
-}
598

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

603
zonkLExprs env exprs = mapM (zonkLExpr env) exprs
604
zonkLExpr  env expr  = wrapLocM (zonkExpr env) expr
605

Ben Gamari's avatar
Ben Gamari committed
606
zonkExpr env (HsVar (L l id))
Ben Gamari's avatar
Ben Gamari committed
607
  = ASSERT2( isNothing (isDataConId_maybe id), ppr id )
Ben Gamari's avatar
Ben Gamari committed
608
    return (HsVar (L l (zonkIdOcc env id)))
609 610

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

Ben Gamari's avatar
Ben Gamari committed
612 613
zonkExpr _ (HsIPVar id)
  = return (HsIPVar id)
614

615
zonkExpr _ e@HsOverLabel{} = return e
Adam Gundry's avatar
Adam Gundry committed
616

Ben Gamari's avatar
Ben Gamari committed
617
zonkExpr env (HsLit (HsRat e f ty))
ian@well-typed.com's avatar
ian@well-typed.com committed
618
  = do new_ty <- zonkTcTypeToType env ty
Ben Gamari's avatar
Ben Gamari committed
619
       return (HsLit (HsRat e f new_ty))
sof's avatar
sof committed
620

Ben Gamari's avatar
Ben Gamari committed
621 622
zonkExpr _ (HsLit lit)
  = return (HsLit lit)
623

Ben Gamari's avatar
Ben Gamari committed
624
zonkExpr env (HsOverLit lit)
625
  = do  { lit' <- zonkOverLit env lit
Ben Gamari's avatar
Ben Gamari committed
626
        ; return (HsOverLit lit') }
627

Ben Gamari's avatar
Ben Gamari committed
628
zonkExpr env (HsLam matches)
ian@well-typed.com's avatar
ian@well-typed.com committed
629
  = do new_matches <- zonkMatchGroup env zonkLExpr matches
Ben Gamari's avatar
Ben Gamari committed
630
       return (HsLam new_matches)
631

Ben Gamari's avatar
Ben Gamari committed
632
zonkExpr env (HsLamCase matches)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
633
  = do new_matches <- zonkMatchGroup env zonkLExpr matches
Ben Gamari's avatar
Ben Gamari committed
634
       return (HsLamCase new_matches)
635

Ben Gamari's avatar
Ben Gamari committed
636
zonkExpr env (HsApp e1 e2)
ian@well-typed.com's avatar
ian@well-typed.com committed
637 638
  = do new_e1 <- zonkLExpr env e1
       new_e2 <- zonkLExpr env e2
Ben Gamari's avatar
Ben Gamari committed
639
       return (HsApp new_e1 new_e2)
640

Ben Gamari's avatar
Ben Gamari committed
641
zonkExpr env (HsAppTypeOut e t)
642
  = do new_e <- zonkLExpr env e
Ben Gamari's avatar
Ben Gamari committed
643
       return (HsAppTypeOut new_e t)
644 645
       -- NB: the type is an HsType; can't zonk that!

Ben Gamari's avatar
Ben Gamari committed
646
zonkExpr _ e@(HsRnBracketOut _ _)
gmainland's avatar
gmainland committed
647 648
  = pprPanic "zonkExpr: HsRnBracketOut" (ppr e)

Ben Gamari's avatar
Ben Gamari committed
649
zonkExpr env (HsTcBracketOut body bs)
ian@well-typed.com's avatar
ian@well-typed.com committed
650
  = do bs' <- mapM zonk_b bs
Ben Gamari's avatar
Ben Gamari committed
651
       return (HsTcBracketOut body bs')
652
  where
653 654
    zonk_b (PendingTcSplice n e) = do e' <- zonkLExpr env e
                                      return (PendingTcSplice n e')
gmainland's avatar
gmainland committed
655

Ben Gamari's avatar
Ben Gamari committed
656 657
zonkExpr _ (HsSpliceE s) = WARN( True, ppr s ) -- Should not happen
                           return (HsSpliceE s)
658

Ben Gamari's avatar
Ben Gamari committed
659
zonkExpr env (OpApp e1 op fixity e2)
ian@well-typed.com's avatar
ian@well-typed.com committed
660 661 662
  = do new_e1 <- zonkLExpr env e1
       new_op <- zonkLExpr env op
       new_e2 <- zonkLExpr env e2
Ben Gamari's avatar
Ben Gamari committed
663
       return (OpApp new_e1 new_op fixity new_e2)
664

Ben Gamari's avatar
Ben Gamari committed
665
zonkExpr env (NegApp expr op)
666 667
  = do (env', new_op) <- zonkSyntaxExpr env op
       new_expr <- zonkLExpr env' expr
Ben Gamari's avatar
Ben Gamari committed
668
       return (NegApp new_expr new_op)
669

Ben Gamari's avatar
Ben Gamari committed
670
zonkExpr env (HsPar e)
ian@well-typed.com's avatar
ian@well-typed.com committed
671
  = do new_e <- zonkLExpr env e
Ben Gamari's avatar
Ben Gamari committed
672
       return (HsPar new_e)
673

Ben Gamari's avatar
Ben Gamari committed
674
zonkExpr env (SectionL expr op)
ian@well-typed.com's avatar
ian@well-typed.com committed
675 676
  = do new_expr <- zonkLExpr env expr
       new_op   <- zonkLExpr env op
Ben Gamari's avatar
Ben Gamari committed
677
       return (SectionL new_expr new_op)
678

Ben Gamari's avatar
Ben Gamari committed
679
zonkExpr env (SectionR op expr)
ian@well-typed.com's avatar
ian@well-typed.com committed
680 681
  = do new_op   <- zonkLExpr env op
       new_expr <- zonkLExpr env expr
Ben Gamari's avatar
Ben Gamari committed
682
       return (SectionR new_op new_expr)
683

Ben Gamari's avatar
Ben Gamari committed
684
zonkExpr env (ExplicitTuple tup_args boxed)
685
  = do { new_tup_args <- mapM zonk_tup_arg tup_args
Ben Gamari's avatar
Ben Gamari committed
686
       ; return (ExplicitTuple new_tup_args boxed) }
687
  where
Ben Gamari's avatar
Ben Gamari committed
688 689
    zonk_tup_arg (L l (Present e)) = do { e' <- zonkLExpr env e
                                        ; return (L l (Present e')) }
690 691
    zonk_tup_arg (L l (Missing t)) = do { t' <- zonkTcTypeToType env t
                                        ; return (L l (Missing t')) }
692

Ben Gamari's avatar
Ben Gamari committed
693
zonkExpr env (ExplicitSum alt arity expr args)
694 695
  = do new_args <- mapM (zonkTcTypeToType env) args
       new_expr <- zonkLExpr env expr
Ben Gamari's avatar
Ben Gamari committed
696
       return (ExplicitSum alt arity new_expr new_args)
697

Ben Gamari's avatar
Ben Gamari committed
698
zonkExpr env (HsCase expr ms)
ian@well-typed.com's avatar
ian@well-typed.com committed
699 700
  = do new_expr <- zonkLExpr env expr
       new_ms <- zonkMatchGroup env zonkLExpr ms
Ben Gamari's avatar
Ben Gamari committed
701
       return (HsCase new_expr new_ms)
702

Ben Gamari's avatar
Ben Gamari committed
703
zonkExpr env (HsIf Nothing e1 e2 e3)
704 705 706
  = do new_e1 <- zonkLExpr env e1
       new_e2 <- zonkLExpr env e2
       new_e3 <- zonkLExpr env e3
Ben Gamari's avatar
Ben Gamari committed
707
       return (HsIf Nothing new_e1 new_e2 new_e3)
708

Ben Gamari's avatar
Ben Gamari committed
709
zonkExpr env (HsIf (Just fun) e1 e2 e3)
710 711 712 713
  = 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
714
       return (HsIf (Just new_fun) new_e1 new_e2 new_e3)
715

716 717 718
zonkExpr env (HsMultiIf ty alts)
  = do { alts' <- mapM (wrapLocM zonk_alt) alts
       ; ty'   <- zonkTcTypeToType env ty
719
       ; return $ HsMultiIf ty' alts' }
720
  where zonk_alt (GRHS guard expr)
721
          = do { (env', guard') <- zonkStmts env zonkLExpr guard
722
               ; expr'          <- zonkLExpr env' expr
723
               ; return $ GRHS guard' expr' }
724

Ben Gamari's avatar
Ben Gamari committed
725
zonkExpr env (HsLet (L l binds) expr)
ian@well-typed.com's avatar
ian@well-typed.com committed
726 727
  = do (new_env, new_binds) <- zonkLocalBinds env binds
       new_expr <- zonkLExpr new_env expr
Ben Gamari's avatar
Ben Gamari committed
728
       return (HsLet (L l new_binds) new_expr)
729

Ben Gamari's avatar
Ben Gamari committed
730
zonkExpr env (HsDo do_or_lc (L l stmts) ty)
ian@well-typed.com's avatar
ian@well-typed.com committed
731 732
  = do (_, new_stmts) <- zonkStmts env zonkLExpr stmts
       new_ty <- zonkTcTypeToType env ty
Ben Gamari's avatar
Ben Gamari committed
733
       return (HsDo do_or_lc (L l new_stmts) new_ty)
734

735
zonkExpr env (ExplicitList ty wit exprs)
736 737 738
  = 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
739
       return (ExplicitList new_ty new_wit new_exprs)
740 741
   where zonkWit env Nothing    = return (env, Nothing)
         zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln
742 743

zonkExpr env (ExplicitPArr ty exprs)
ian@well-typed.com's avatar
ian@well-typed.com committed
744 745 746
  = do new_ty <- zonkTcTypeToType env ty
       new_exprs <- zonkLExprs env exprs
       return (ExplicitPArr new_ty new_exprs)
747

Ben Gamari's avatar
Ben Gamari committed
748 749
zonkExpr env expr@(RecordCon { rcon_con_expr = con_expr, rcon_flds = rbinds })
  = do  { new_con_expr <- zonkExpr env con_expr
750
        ; new_rbinds   <- zonkRecFields env rbinds
Ben Gamari's avatar
Ben Gamari committed
751
        ; return (expr { rcon_con_expr = new_con_expr
752
                       , rcon_flds = new_rbinds }) }
753

Ben Gamari's avatar
Ben Gamari committed
754 755 756
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 })
757 758 759
  = do  { new_expr    <- zonkLExpr env expr
        ; new_in_tys  <- mapM (zonkTcTypeToType env) in_tys
        ; new_out_tys <- mapM (zonkTcTypeToType env) out_tys
760
        ; new_rbinds  <- zonkRecUpdFields env rbinds
Matthew Pickering's avatar
Matthew Pickering committed
761
        ; (_, new_recwrap) <- zonkCoFn env req_wrap
762
        ; return (RecordUpd { rupd_expr = new_expr, rupd_flds =  new_rbinds
Ben Gamari's avatar
Ben Gamari committed
763 764
                            , rupd_cons = cons, rupd_in_tys = new_in_tys
                            , rupd_out_tys = new_out_tys, rupd_wrap = new_recwrap }) }
765

Ben Gamari's avatar
Ben Gamari committed
766
zonkExpr env (ExprWithTySigOut e ty)
767
  = do { e' <- zonkLExpr env e
Ben Gamari's avatar
Ben Gamari committed
768
       ; return (ExprWithTySigOut e' ty) }
769

770
zonkExpr env (ArithSeq expr wit info)
771 772 773
  = 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
774
       return (ArithSeq new_expr new_wit new_info)
775 776
   where zonkWit env Nothing    = return (env, Nothing)
         zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln
777

778
zonkExpr env (PArrSeq expr info)
ian@well-typed.com's avatar
ian@well-typed.com committed
779 780 781
  = do new_expr <- zonkExpr env expr
       new_info <- zonkArithSeq env info
       return (PArrSeq new_expr new_info)
782

Ben Gamari's avatar
Ben Gamari committed
783
zonkExpr env (HsSCC src lbl expr)
ian@well-typed.com's avatar
ian@well-typed.com committed
784
  = do new_expr <- zonkLExpr env expr
Ben Gamari's avatar
Ben Gamari committed
785
       return (HsSCC src lbl new_expr)
786

Ben Gamari's avatar
Ben Gamari committed
787
zonkExpr env (HsTickPragma src info srcInfo expr)
ian@well-typed.com's avatar
ian@well-typed.com committed
788
  = do new_expr <- zonkLExpr env expr
Ben Gamari's avatar
Ben Gamari committed
789
       return (HsTickPragma src info srcInfo new_expr)
andy@galois.com's avatar
andy@galois.com committed
790

791
-- hdaume: core annotations
Ben Gamari's avatar
Ben Gamari committed
792
zonkExpr env (HsCoreAnn 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 (HsCoreAnn src lbl new_expr)
795

796
-- arrow notation extensions
Ben Gamari's avatar
Ben Gamari committed
797
zonkExpr env (HsProc pat body)
798 799
  = do  { (env1, new_pat) <- zonkPat env pat
        ; new_body <- zonkCmdTop env1 body
Ben Gamari's avatar
Ben Gamari committed
800
        ; return (HsProc new_pat new_body) }
801

802
-- StaticPointers extension
803 804
zonkExpr env (HsStatic fvs expr)
  = HsStatic fvs <$> zonkLExpr env expr
805

Ben Gamari's avatar
Ben Gamari committed
806
zonkExpr env (HsWrap co_fn expr)
ian@well-typed.com's avatar
ian@well-typed.com committed
807 808
  = do (env1, new_co_fn) <- zonkCoFn env co_fn
       new_expr <- zonkExpr env1 expr
Ben Gamari's avatar
Ben Gamari committed
809
       return (HsWrap new_co_fn new_expr)
810

811
zonkExpr _ e@(HsUnboundVar {}) = return e
812

Ian Lynagh's avatar
Ian Lynagh committed
813
zonkExpr _ expr = pprPanic "zonkExpr" (ppr expr)
814

815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836
-------------------------------------------------------------------------
{-
Note [Skolems in zonkSyntaxExpr]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider rebindable syntax with something like

  (>>=) :: (forall x. blah) -> (forall y. blah') -> blah''

The x and y become skolems that are in scope when type-checking the
arguments to the bind. This means that we must extend the ZonkEnv with
these skolems when zonking the arguments to the bind. But the skolems
are different between the two arguments, and so we should theoretically
carry around different environments to use for the different arguments.

However, this becomes a logistical nightmare, especially in dealing with
the more exotic Stmt forms. So, we simplify by making the critical
assumption that the uniques of the skolems are different. (This assumption
is justified by the use of newUnique in TcMType.instSkolTyCoVarX.)
Now, we can safely just extend one environment.
-}

-- See Note [Skolems in zonkSyntaxExpr]