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