ghc/compiler/typecheck/TcHsSyn.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996
   3 %
   4 \section[TcHsSyn]{Specialisations of the @HsSyn@ syntax for the typechecker}
   5
   6 This module is an extension of @HsSyn@ syntax, for use in the type
   7 checker.
   8
   9 \begin{code}
  10 module TcHsSyn (
  11         TcIdBndr(..), TcIdOcc(..),
  12
  13         TcMonoBinds(..), TcHsBinds(..), TcBind(..), TcPat(..),
  14         TcExpr(..), TcGRHSsAndBinds(..), TcGRHS(..), TcMatch(..),
  15         TcQual(..), TcStmt(..), TcArithSeqInfo(..), TcRecordBinds(..),
  16         TcHsModule(..),
  17
  18         TypecheckedHsBinds(..), TypecheckedBind(..),
  19         TypecheckedMonoBinds(..), TypecheckedPat(..),
  20         TypecheckedHsExpr(..), TypecheckedArithSeqInfo(..),
  21         TypecheckedQual(..), TypecheckedStmt(..),
  22         TypecheckedMatch(..), TypecheckedHsModule(..),
  23         TypecheckedGRHSsAndBinds(..), TypecheckedGRHS(..),
  24         TypecheckedRecordBinds(..),
  25
  26         mkHsTyApp, mkHsDictApp,
  27         mkHsTyLam, mkHsDictLam,
  28         tcIdType,
  29
  30         zonkBinds,
  31         zonkInst,
  32         zonkId,     -- TcIdBndr s -> NF_TcM s Id
  33         unZonkId    -- Id         -> NF_TcM s (TcIdBndr s)
  34   ) where
  35
  36 import Ubiq{-uitous-}
  37
  38 -- friends:
  39 import HsSyn    -- oodles of it
  40 import Id       ( GenId(..), IdDetails, PragmaInfo,     -- Can meddle modestly with Ids
  41                   DictVar(..), idType
  42                 )
  43
  44 -- others:
  45 import TcMonad
  46 import TcType   ( TcType(..), TcMaybe, TcTyVar(..),
  47                   zonkTcTypeToType, zonkTcTyVarToTyVar,
  48                   tcInstType
  49                 )
  50 import Usage    ( UVar(..) )
  51 import Util     ( panic )
  52
  53 import PprType  ( GenType, GenTyVar )   -- instances
  54 import TyVar    ( GenTyVar )            -- instances
  55 import Unique   ( Unique )              -- instances
  56 \end{code}
  57
  58
  59 Type definitions
  60 ~~~~~~~~~~~~~~~~
  61
  62 The @Tc...@ datatypes are the ones that apply {\em during} type checking.
  63 All the types in @Tc...@ things have mutable type-variables in them for
  64 unification.
  65
  66 At the end of type checking we zonk everything to @Typechecked...@ datatypes,
  67 which have immutable type variables in them.
  68
  69 \begin{code}
  70 type TcIdBndr s = GenId  (TcType s)     -- Binders are all TcTypes
  71 data TcIdOcc  s = TcId   (TcIdBndr s)   -- Bindees may be either
  72                 | RealId Id
  73
  74 type TcHsBinds s        = HsBinds (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
  75 type TcBind s           = Bind (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
  76 type TcMonoBinds s      = MonoBinds (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
  77 type TcPat s            = OutPat (TcTyVar s) UVar (TcIdOcc s)
  78 type TcExpr s           = HsExpr (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
  79 type TcGRHSsAndBinds s  = GRHSsAndBinds (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
  80 type TcGRHS s           = GRHS (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
  81 type TcMatch s          = Match (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
  82 type TcQual s           = Qual (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
  83 type TcStmt s           = Stmt (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
  84 type TcArithSeqInfo s   = ArithSeqInfo (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
  85 type TcRecordBinds s    = HsRecordBinds (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
  86 type TcHsModule s       = HsModule (TcTyVar s) UVar (TcIdOcc s) (TcPat s)
  87
  88 type TypecheckedPat             = OutPat        TyVar UVar Id
  89 type TypecheckedMonoBinds       = MonoBinds     TyVar UVar Id TypecheckedPat
  90 type TypecheckedHsBinds         = HsBinds       TyVar UVar Id TypecheckedPat
  91 type TypecheckedBind            = Bind          TyVar UVar Id TypecheckedPat
  92 type TypecheckedHsExpr          = HsExpr        TyVar UVar Id TypecheckedPat
  93 type TypecheckedArithSeqInfo    = ArithSeqInfo  TyVar UVar Id TypecheckedPat
  94 type TypecheckedQual            = Qual          TyVar UVar Id TypecheckedPat
  95 type TypecheckedStmt            = Stmt          TyVar UVar Id TypecheckedPat
  96 type TypecheckedMatch           = Match         TyVar UVar Id TypecheckedPat
  97 type TypecheckedGRHSsAndBinds   = GRHSsAndBinds TyVar UVar Id TypecheckedPat
  98 type TypecheckedGRHS            = GRHS          TyVar UVar Id TypecheckedPat
  99 type TypecheckedRecordBinds     = HsRecordBinds TyVar UVar Id TypecheckedPat
 100 type TypecheckedHsModule        = HsModule      TyVar UVar Id TypecheckedPat
 101 \end{code}
 102
 103 \begin{code}
 104 mkHsTyApp expr []  = expr
 105 mkHsTyApp expr tys = TyApp expr tys
 106
 107 mkHsDictApp expr []      = expr
 108 mkHsDictApp expr dict_vars = DictApp expr dict_vars
 109
 110 mkHsTyLam []     expr = expr
 111 mkHsTyLam tyvars expr = TyLam tyvars expr
 112
 113 mkHsDictLam []    expr = expr
 114 mkHsDictLam dicts expr = DictLam dicts expr
 115
 116 tcIdType :: TcIdOcc s -> TcType s
 117 tcIdType (TcId id) = idType id
 118 tcIdType other     = panic "tcIdType"
 119 \end{code}
 120
 121
 122
 123 \begin{code}
 124 instance Eq (TcIdOcc s) where
 125   (TcId id1)   == (TcId id2)   = id1 == id2
 126   (RealId id1) == (RealId id2) = id1 == id2
 127
 128 instance Outputable (TcIdOcc s) where
 129   ppr sty (TcId id)   = ppr sty id
 130   ppr sty (RealId id) = ppr sty id
 131
 132 instance NamedThing (TcIdOcc s) where
 133   getName (TcId id)   = getName id
 134   getName (RealId id) = getName id
 135 \end{code}
 136
 137
 138 %************************************************************************
 139 %*                                                                      *
 140 \subsection[BackSubst-HsBinds]{Running a substitution over @HsBinds@}
 141 %*                                                                      *
 142 %************************************************************************
 143
 144 \begin{code}
 145 zonkId   :: TcIdOcc s -> NF_TcM s Id
 146 unZonkId :: Id        -> NF_TcM s (TcIdBndr s)
 147
 148 zonkId (RealId id) = returnNF_Tc id
 149
 150 zonkId (TcId (Id u ty details prags info))
 151   = zonkTcTypeToType ty `thenNF_Tc` \ ty' ->
 152     returnNF_Tc (Id u ty' details prags info)
 153
 154 unZonkId (Id u ty details prags info)
 155   = tcInstType [] ty    `thenNF_Tc` \ ty' ->
 156     returnNF_Tc (Id u ty' details prags info)
 157 \end{code}
 158
 159 \begin{code}
 160 zonkInst :: (TcIdOcc s, TcExpr s) -> NF_TcM s (Id, TypecheckedHsExpr)
 161 zonkInst (id, expr)
 162   = zonkId id           `thenNF_Tc` \ id' ->
 163     zonkExpr expr       `thenNF_Tc` \ expr' ->
 164     returnNF_Tc (id', expr')
 165 \end{code}
 166
 167 \begin{code}
 168 zonkBinds :: TcHsBinds s -> NF_TcM s TypecheckedHsBinds
 169
 170 zonkBinds EmptyBinds = returnNF_Tc EmptyBinds
 171
 172 zonkBinds (ThenBinds binds1 binds2)
 173   = zonkBinds binds1  `thenNF_Tc` \ new_binds1 ->
 174     zonkBinds binds2  `thenNF_Tc` \ new_binds2 ->
 175     returnNF_Tc (ThenBinds new_binds1 new_binds2)
 176
 177 zonkBinds (SingleBind bind)
 178   = zonkBind bind  `thenNF_Tc` \ new_bind ->
 179     returnNF_Tc (SingleBind new_bind)
 180
 181 zonkBinds (AbsBinds tyvars dicts locprs dict_binds val_bind)
 182   = mapNF_Tc zonkTcTyVarToTyVar tyvars  `thenNF_Tc` \ new_tyvars ->
 183     mapNF_Tc zonkId dicts               `thenNF_Tc` \ new_dicts ->
 184     mapNF_Tc subst_pair locprs          `thenNF_Tc` \ new_locprs ->
 185     mapNF_Tc subst_bind dict_binds      `thenNF_Tc` \ new_dict_binds ->
 186     zonkBind val_bind                   `thenNF_Tc` \ new_val_bind ->
 187     returnNF_Tc (AbsBinds new_tyvars new_dicts new_locprs new_dict_binds new_val_bind)
 188   where
 189     subst_pair (l, g)
 190       = zonkId l        `thenNF_Tc` \ new_l ->
 191         zonkId g        `thenNF_Tc` \ new_g ->
 192         returnNF_Tc (new_l, new_g)
 193
 194     subst_bind (v, e)
 195       = zonkId v        `thenNF_Tc` \ new_v ->
 196         zonkExpr e      `thenNF_Tc` \ new_e ->
 197         returnNF_Tc (new_v, new_e)
 198 \end{code}
 199
 200 \begin{code}
 201 -------------------------------------------------------------------------
 202 zonkBind :: TcBind s -> NF_TcM s TypecheckedBind
 203
 204 zonkBind EmptyBind = returnNF_Tc EmptyBind
 205
 206 zonkBind (NonRecBind mbinds)
 207   = zonkMonoBinds mbinds        `thenNF_Tc` \ new_mbinds ->
 208     returnNF_Tc (NonRecBind new_mbinds)
 209
 210 zonkBind (RecBind mbinds)
 211   = zonkMonoBinds mbinds        `thenNF_Tc` \ new_mbinds ->
 212     returnNF_Tc (RecBind new_mbinds)
 213
 214 -------------------------------------------------------------------------
 215 zonkMonoBinds :: TcMonoBinds s -> NF_TcM s TypecheckedMonoBinds
 216
 217 zonkMonoBinds EmptyMonoBinds = returnNF_Tc EmptyMonoBinds
 218
 219 zonkMonoBinds (AndMonoBinds mbinds1 mbinds2)
 220   = zonkMonoBinds mbinds1  `thenNF_Tc` \ new_mbinds1 ->
 221     zonkMonoBinds mbinds2  `thenNF_Tc` \ new_mbinds2 ->
 222     returnNF_Tc (AndMonoBinds new_mbinds1 new_mbinds2)
 223
 224 zonkMonoBinds (PatMonoBind pat grhss_w_binds locn)
 225   = zonkPat pat                         `thenNF_Tc` \ new_pat ->
 226     zonkGRHSsAndBinds grhss_w_binds     `thenNF_Tc` \ new_grhss_w_binds ->
 227     returnNF_Tc (PatMonoBind new_pat new_grhss_w_binds locn)
 228
 229 zonkMonoBinds (VarMonoBind var expr)
 230   = zonkId var          `thenNF_Tc` \ new_var ->
 231     zonkExpr expr       `thenNF_Tc` \ new_expr ->
 232     returnNF_Tc (VarMonoBind new_var new_expr)
 233
 234 zonkMonoBinds (FunMonoBind name ms locn)
 235   = zonkId name                 `thenNF_Tc` \ new_name ->
 236     mapNF_Tc zonkMatch ms       `thenNF_Tc` \ new_ms ->
 237     returnNF_Tc (FunMonoBind new_name new_ms locn)
 238 \end{code}
 239
 240 %************************************************************************
 241 %*                                                                      *
 242 \subsection[BackSubst-Match-GRHSs]{Match and GRHSsAndBinds}
 243 %*                                                                      *
 244 %************************************************************************
 245
 246 \begin{code}
 247 zonkMatch :: TcMatch s -> NF_TcM s TypecheckedMatch
 248
 249 zonkMatch (PatMatch pat match)
 250   = zonkPat pat         `thenNF_Tc` \ new_pat ->
 251     zonkMatch match     `thenNF_Tc` \ new_match ->
 252     returnNF_Tc (PatMatch new_pat new_match)
 253
 254 zonkMatch (GRHSMatch grhss_w_binds)
 255   = zonkGRHSsAndBinds grhss_w_binds `thenNF_Tc` \ new_grhss_w_binds ->
 256     returnNF_Tc (GRHSMatch new_grhss_w_binds)
 257
 258 -------------------------------------------------------------------------
 259 zonkGRHSsAndBinds :: TcGRHSsAndBinds s
 260                    -> NF_TcM s TypecheckedGRHSsAndBinds
 261
 262 zonkGRHSsAndBinds (GRHSsAndBindsOut grhss binds ty)
 263   = mapNF_Tc zonk_grhs grhss    `thenNF_Tc` \ new_grhss ->
 264     zonkBinds binds             `thenNF_Tc` \ new_binds ->
 265     zonkTcTypeToType ty         `thenNF_Tc` \ new_ty ->
 266     returnNF_Tc (GRHSsAndBindsOut new_grhss new_binds new_ty)
 267   where
 268     zonk_grhs (GRHS guard expr locn)
 269       = zonkExpr guard  `thenNF_Tc` \ new_guard ->
 270         zonkExpr expr   `thenNF_Tc` \ new_expr  ->
 271         returnNF_Tc (GRHS new_guard new_expr locn)
 272
 273     zonk_grhs (OtherwiseGRHS expr locn)
 274       = zonkExpr expr   `thenNF_Tc` \ new_expr  ->
 275         returnNF_Tc (OtherwiseGRHS new_expr locn)
 276 \end{code}
 277
 278 %************************************************************************
 279 %*                                                                      *
 280 \subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr}
 281 %*                                                                      *
 282 %************************************************************************
 283
 284 ToDo: panic on things that can't be in @TypecheckedHsExpr@.
 285
 286 \begin{code}
 287 zonkExpr :: TcExpr s -> NF_TcM s TypecheckedHsExpr
 288
 289 zonkExpr (HsVar name)
 290   = zonkId name `thenNF_Tc` \ new_name ->
 291     returnNF_Tc (HsVar new_name)
 292
 293 zonkExpr (HsLitOut lit ty)
 294   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty  ->
 295     returnNF_Tc (HsLitOut lit new_ty)
 296
 297 zonkExpr (HsLam match)
 298   = zonkMatch match     `thenNF_Tc` \ new_match ->
 299     returnNF_Tc (HsLam new_match)
 300
 301 zonkExpr (HsApp e1 e2)
 302   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 303     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 304     returnNF_Tc (HsApp new_e1 new_e2)
 305
 306 zonkExpr (OpApp e1 op e2)
 307   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 308     zonkExpr op `thenNF_Tc` \ new_op ->
 309     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 310     returnNF_Tc (OpApp new_e1 new_op new_e2)
 311
 312 zonkExpr (SectionL expr op)
 313   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 314     zonkExpr op         `thenNF_Tc` \ new_op ->
 315     returnNF_Tc (SectionL new_expr new_op)
 316
 317 zonkExpr (SectionR op expr)
 318   = zonkExpr op         `thenNF_Tc` \ new_op ->
 319     zonkExpr expr       `thenNF_Tc` \ new_expr ->
 320     returnNF_Tc (SectionR new_op new_expr)
 321
 322 zonkExpr (CCall fun args may_gc is_casm result_ty)
 323   = mapNF_Tc zonkExpr args      `thenNF_Tc` \ new_args ->
 324     zonkTcTypeToType result_ty  `thenNF_Tc` \ new_result_ty ->
 325     returnNF_Tc (CCall fun new_args may_gc is_casm new_result_ty)
 326
 327 zonkExpr (HsSCC label expr)
 328   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 329     returnNF_Tc (HsSCC label new_expr)
 330
 331 zonkExpr (HsCase expr ms src_loc)
 332   = zonkExpr expr           `thenNF_Tc` \ new_expr ->
 333     mapNF_Tc zonkMatch ms   `thenNF_Tc` \ new_ms ->
 334     returnNF_Tc (HsCase new_expr new_ms src_loc)
 335
 336 zonkExpr (HsLet binds expr)
 337   = zonkBinds binds     `thenNF_Tc` \ new_binds ->
 338     zonkExpr expr       `thenNF_Tc` \ new_expr ->
 339     returnNF_Tc (HsLet new_binds new_expr)
 340
 341 zonkExpr (HsDoOut stmts m_id mz_id src_loc)
 342   = zonkStmts stmts     `thenNF_Tc` \ new_stmts ->
 343     zonkId m_id         `thenNF_Tc` \ m_new ->
 344     zonkId mz_id        `thenNF_Tc` \ mz_new ->
 345     returnNF_Tc (HsDoOut new_stmts m_new mz_new src_loc)
 346
 347 zonkExpr (ListComp expr quals)
 348   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 349     zonkQuals quals     `thenNF_Tc` \ new_quals ->
 350     returnNF_Tc (ListComp new_expr new_quals)
 351
 352 --ExplicitList: not in typechecked exprs
 353
 354 zonkExpr (ExplicitListOut ty exprs)
 355   = zonkTcTypeToType  ty        `thenNF_Tc` \ new_ty ->
 356     mapNF_Tc zonkExpr exprs     `thenNF_Tc` \ new_exprs ->
 357     returnNF_Tc (ExplicitListOut new_ty new_exprs)
 358
 359 zonkExpr (ExplicitTuple exprs)
 360   = mapNF_Tc zonkExpr exprs  `thenNF_Tc` \ new_exprs ->
 361     returnNF_Tc (ExplicitTuple new_exprs)
 362
 363 zonkExpr (RecordCon con rbinds)
 364   = panic "zonkExpr:RecordCon"
 365 zonkExpr (RecordUpd exp rbinds)
 366   = panic "zonkExpr:RecordUpd"
 367
 368 zonkExpr (HsIf e1 e2 e3 src_loc)
 369   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 370     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 371     zonkExpr e3 `thenNF_Tc` \ new_e3 ->
 372     returnNF_Tc (HsIf new_e1 new_e2 new_e3 src_loc)
 373
 374 zonkExpr (ArithSeqOut expr info)
 375   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 376     zonkArithSeq info   `thenNF_Tc` \ new_info ->
 377     returnNF_Tc (ArithSeqOut new_expr new_info)
 378
 379 zonkExpr (TyLam tyvars expr)
 380   = mapNF_Tc zonkTcTyVarToTyVar tyvars  `thenNF_Tc` \ new_tyvars ->
 381     zonkExpr expr                       `thenNF_Tc` \ new_expr ->
 382     returnNF_Tc (TyLam new_tyvars new_expr)
 383
 384 zonkExpr (TyApp expr tys)
 385   = zonkExpr expr                 `thenNF_Tc` \ new_expr ->
 386     mapNF_Tc zonkTcTypeToType tys `thenNF_Tc` \ new_tys ->
 387     returnNF_Tc (TyApp new_expr new_tys)
 388
 389 zonkExpr (DictLam dicts expr)
 390   = mapNF_Tc zonkId dicts       `thenNF_Tc` \ new_dicts ->
 391     zonkExpr expr               `thenNF_Tc` \ new_expr ->
 392     returnNF_Tc (DictLam new_dicts new_expr)
 393
 394 zonkExpr (DictApp expr dicts)
 395   = zonkExpr expr               `thenNF_Tc` \ new_expr ->
 396     mapNF_Tc zonkId dicts       `thenNF_Tc` \ new_dicts ->
 397     returnNF_Tc (DictApp new_expr new_dicts)
 398
 399 zonkExpr (ClassDictLam dicts methods expr)
 400   = mapNF_Tc zonkId dicts   `thenNF_Tc` \ new_dicts ->
 401     mapNF_Tc zonkId methods `thenNF_Tc` \ new_methods ->
 402     zonkExpr expr           `thenNF_Tc` \ new_expr ->
 403     returnNF_Tc (ClassDictLam new_dicts new_methods new_expr)
 404
 405 zonkExpr (Dictionary dicts methods)
 406   = mapNF_Tc zonkId dicts   `thenNF_Tc` \ new_dicts ->
 407     mapNF_Tc zonkId methods `thenNF_Tc` \ new_methods ->
 408     returnNF_Tc (Dictionary new_dicts new_methods)
 409
 410 zonkExpr (SingleDict name)
 411   = zonkId name         `thenNF_Tc` \ new_name ->
 412     returnNF_Tc (SingleDict new_name)
 413
 414 -------------------------------------------------------------------------
 415 zonkArithSeq :: TcArithSeqInfo s -> NF_TcM s TypecheckedArithSeqInfo
 416
 417 zonkArithSeq (From e)
 418   = zonkExpr e          `thenNF_Tc` \ new_e ->
 419     returnNF_Tc (From new_e)
 420
 421 zonkArithSeq (FromThen e1 e2)
 422   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 423     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 424     returnNF_Tc (FromThen new_e1 new_e2)
 425
 426 zonkArithSeq (FromTo e1 e2)
 427   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 428     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 429     returnNF_Tc (FromTo new_e1 new_e2)
 430
 431 zonkArithSeq (FromThenTo e1 e2 e3)
 432   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 433     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 434     zonkExpr e3 `thenNF_Tc` \ new_e3 ->
 435     returnNF_Tc (FromThenTo new_e1 new_e2 new_e3)
 436
 437 -------------------------------------------------------------------------
 438 zonkQuals :: [TcQual s] -> NF_TcM s [TypecheckedQual]
 439
 440 zonkQuals quals
 441   = mapNF_Tc zonk_qual quals
 442   where
 443     zonk_qual (GeneratorQual pat expr)
 444       = zonkPat  pat    `thenNF_Tc` \ new_pat ->
 445         zonkExpr expr   `thenNF_Tc` \ new_expr ->
 446         returnNF_Tc (GeneratorQual new_pat new_expr)
 447
 448     zonk_qual (FilterQual expr)
 449       = zonkExpr expr    `thenNF_Tc` \ new_expr ->
 450         returnNF_Tc (FilterQual new_expr)
 451
 452     zonk_qual (LetQual binds)
 453       = zonkBinds binds  `thenNF_Tc` \ new_binds ->
 454         returnNF_Tc (LetQual new_binds)
 455
 456 -------------------------------------------------------------------------
 457 zonkStmts :: [TcStmt s] -> NF_TcM s [TypecheckedStmt]
 458
 459 zonkStmts stmts
 460   = mapNF_Tc zonk_stmt stmts
 461   where
 462     zonk_stmt (BindStmt pat expr src_loc)
 463       = zonkPat  pat    `thenNF_Tc` \ new_pat ->
 464         zonkExpr expr   `thenNF_Tc` \ new_expr ->
 465         returnNF_Tc (BindStmt new_pat new_expr src_loc)
 466
 467     zonk_stmt (ExprStmt expr src_loc)
 468       = zonkExpr expr    `thenNF_Tc` \ new_expr ->
 469         returnNF_Tc (ExprStmt new_expr src_loc)
 470
 471     zonk_stmt (LetStmt binds)
 472       = zonkBinds binds  `thenNF_Tc` \ new_binds ->
 473         returnNF_Tc (LetStmt new_binds)
 474 \end{code}
 475
 476 %************************************************************************
 477 %*                                                                      *
 478 \subsection[BackSubst-Pats]{Patterns}
 479 %*                                                                      *
 480 %************************************************************************
 481
 482 \begin{code}
 483 zonkPat :: TcPat s -> NF_TcM s TypecheckedPat
 484
 485 zonkPat (WildPat ty)
 486   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty ->
 487     returnNF_Tc (WildPat new_ty)
 488
 489 zonkPat (VarPat v)
 490   = zonkId v        `thenNF_Tc` \ new_v ->
 491     returnNF_Tc (VarPat new_v)
 492
 493 zonkPat (LazyPat pat)
 494   = zonkPat pat     `thenNF_Tc` \ new_pat ->
 495     returnNF_Tc (LazyPat new_pat)
 496
 497 zonkPat (AsPat n pat)
 498   = zonkId n        `thenNF_Tc` \ new_n ->
 499     zonkPat pat     `thenNF_Tc` \ new_pat ->
 500     returnNF_Tc (AsPat new_n new_pat)
 501
 502 zonkPat (ConPat n ty pats)
 503   = zonkTcTypeToType ty      `thenNF_Tc` \ new_ty ->
 504     mapNF_Tc zonkPat pats    `thenNF_Tc` \ new_pats ->
 505     returnNF_Tc (ConPat n new_ty new_pats)
 506
 507 zonkPat (ConOpPat pat1 op pat2 ty)
 508   = zonkPat pat1            `thenNF_Tc` \ new_pat1 ->
 509     zonkPat pat2            `thenNF_Tc` \ new_pat2 ->
 510     zonkTcTypeToType ty     `thenNF_Tc` \ new_ty ->
 511     returnNF_Tc (ConOpPat new_pat1 op new_pat2 new_ty)
 512
 513 zonkPat (ListPat ty pats)
 514   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty ->
 515     mapNF_Tc zonkPat pats   `thenNF_Tc` \ new_pats ->
 516     returnNF_Tc (ListPat new_ty new_pats)
 517
 518 zonkPat (TuplePat pats)
 519   = mapNF_Tc zonkPat pats    `thenNF_Tc` \ new_pats ->
 520     returnNF_Tc (TuplePat new_pats)
 521
 522 zonkPat (LitPat lit ty)
 523   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty  ->
 524     returnNF_Tc (LitPat lit new_ty)
 525
 526 zonkPat (NPat lit ty expr)
 527   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty   ->
 528     zonkExpr expr           `thenNF_Tc` \ new_expr ->
 529     returnNF_Tc (NPat lit new_ty new_expr)
 530
 531 zonkPat (DictPat ds ms)
 532   = mapNF_Tc zonkId ds    `thenNF_Tc` \ new_ds ->
 533     mapNF_Tc zonkId ms    `thenNF_Tc` \ new_ms ->
 534     returnNF_Tc (DictPat new_ds new_ms)
 535 \end{code}
 536
 537