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