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 inf ms locn)
 235   = zonkId name                 `thenNF_Tc` \ new_name ->
 236     mapNF_Tc zonkMatch ms       `thenNF_Tc` \ new_ms ->
 237     returnNF_Tc (FunMonoBind new_name inf 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 zonkMatch (SimpleMatch expr)
 259   = zonkExpr expr   `thenNF_Tc` \ new_expr ->
 260     returnNF_Tc (SimpleMatch new_expr)
 261
 262 -------------------------------------------------------------------------
 263 zonkGRHSsAndBinds :: TcGRHSsAndBinds s
 264                    -> NF_TcM s TypecheckedGRHSsAndBinds
 265
 266 zonkGRHSsAndBinds (GRHSsAndBindsOut grhss binds ty)
 267   = mapNF_Tc zonk_grhs grhss    `thenNF_Tc` \ new_grhss ->
 268     zonkBinds binds             `thenNF_Tc` \ new_binds ->
 269     zonkTcTypeToType ty         `thenNF_Tc` \ new_ty ->
 270     returnNF_Tc (GRHSsAndBindsOut new_grhss new_binds new_ty)
 271   where
 272     zonk_grhs (GRHS guard expr locn)
 273       = zonkExpr guard  `thenNF_Tc` \ new_guard ->
 274         zonkExpr expr   `thenNF_Tc` \ new_expr  ->
 275         returnNF_Tc (GRHS new_guard new_expr locn)
 276
 277     zonk_grhs (OtherwiseGRHS expr locn)
 278       = zonkExpr expr   `thenNF_Tc` \ new_expr  ->
 279         returnNF_Tc (OtherwiseGRHS new_expr locn)
 280 \end{code}
 281
 282 %************************************************************************
 283 %*                                                                      *
 284 \subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr}
 285 %*                                                                      *
 286 %************************************************************************
 287
 288 ToDo: panic on things that can't be in @TypecheckedHsExpr@.
 289
 290 \begin{code}
 291 zonkExpr :: TcExpr s -> NF_TcM s TypecheckedHsExpr
 292
 293 zonkExpr (HsVar name)
 294   = zonkId name `thenNF_Tc` \ new_name ->
 295     returnNF_Tc (HsVar new_name)
 296
 297 zonkExpr (HsLitOut lit ty)
 298   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty  ->
 299     returnNF_Tc (HsLitOut lit new_ty)
 300
 301 zonkExpr (HsLam match)
 302   = zonkMatch match     `thenNF_Tc` \ new_match ->
 303     returnNF_Tc (HsLam new_match)
 304
 305 zonkExpr (HsApp e1 e2)
 306   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 307     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 308     returnNF_Tc (HsApp new_e1 new_e2)
 309
 310 zonkExpr (OpApp e1 op e2)
 311   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 312     zonkExpr op `thenNF_Tc` \ new_op ->
 313     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 314     returnNF_Tc (OpApp new_e1 new_op new_e2)
 315
 316 zonkExpr (NegApp _) = panic "zonkExpr:NegApp"
 317 zonkExpr (HsPar _)  = panic "zonkExpr:HsPar"
 318
 319 zonkExpr (SectionL expr op)
 320   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 321     zonkExpr op         `thenNF_Tc` \ new_op ->
 322     returnNF_Tc (SectionL new_expr new_op)
 323
 324 zonkExpr (SectionR op expr)
 325   = zonkExpr op         `thenNF_Tc` \ new_op ->
 326     zonkExpr expr       `thenNF_Tc` \ new_expr ->
 327     returnNF_Tc (SectionR new_op 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 (HsIf e1 e2 e3 src_loc)
 335   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 336     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 337     zonkExpr e3 `thenNF_Tc` \ new_e3 ->
 338     returnNF_Tc (HsIf new_e1 new_e2 new_e3 src_loc)
 339
 340 zonkExpr (HsLet binds expr)
 341   = zonkBinds binds     `thenNF_Tc` \ new_binds ->
 342     zonkExpr expr       `thenNF_Tc` \ new_expr ->
 343     returnNF_Tc (HsLet new_binds new_expr)
 344
 345 zonkExpr (HsDo _ _) = panic "zonkExpr:HsDo"
 346
 347 zonkExpr (HsDoOut stmts m_id mz_id src_loc)
 348   = zonkStmts stmts     `thenNF_Tc` \ new_stmts ->
 349     zonkId m_id         `thenNF_Tc` \ m_new ->
 350     zonkId mz_id        `thenNF_Tc` \ mz_new ->
 351     returnNF_Tc (HsDoOut new_stmts m_new mz_new src_loc)
 352
 353 zonkExpr (ListComp expr quals)
 354   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 355     zonkQuals quals     `thenNF_Tc` \ new_quals ->
 356     returnNF_Tc (ListComp new_expr new_quals)
 357
 358 zonkExpr (ExplicitList _) = panic "zonkExpr:ExplicitList"
 359
 360 zonkExpr (ExplicitListOut ty exprs)
 361   = zonkTcTypeToType  ty        `thenNF_Tc` \ new_ty ->
 362     mapNF_Tc zonkExpr exprs     `thenNF_Tc` \ new_exprs ->
 363     returnNF_Tc (ExplicitListOut new_ty new_exprs)
 364
 365 zonkExpr (ExplicitTuple exprs)
 366   = mapNF_Tc zonkExpr exprs  `thenNF_Tc` \ new_exprs ->
 367     returnNF_Tc (ExplicitTuple new_exprs)
 368
 369 zonkExpr (RecordCon con rbinds)
 370   = panic "zonkExpr:RecordCon"
 371 zonkExpr (RecordUpd exp rbinds)
 372   = panic "zonkExpr:RecordUpd"
 373 zonkExpr (RecordUpdOut exp ids rbinds)
 374   = panic "zonkExpr:RecordUpdOut"
 375
 376 zonkExpr (ExprWithTySig _ _) = panic "zonkExpr:ExprWithTySig"
 377 zonkExpr (ArithSeqIn _) = panic "zonkExpr:ArithSeqIn"
 378
 379 zonkExpr (ArithSeqOut expr info)
 380   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 381     zonkArithSeq info   `thenNF_Tc` \ new_info ->
 382     returnNF_Tc (ArithSeqOut new_expr new_info)
 383
 384 zonkExpr (CCall fun args may_gc is_casm result_ty)
 385   = mapNF_Tc zonkExpr args      `thenNF_Tc` \ new_args ->
 386     zonkTcTypeToType result_ty  `thenNF_Tc` \ new_result_ty ->
 387     returnNF_Tc (CCall fun new_args may_gc is_casm new_result_ty)
 388
 389 zonkExpr (HsSCC label expr)
 390   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 391     returnNF_Tc (HsSCC label new_expr)
 392
 393 zonkExpr (TyLam tyvars expr)
 394   = mapNF_Tc zonkTcTyVarToTyVar tyvars  `thenNF_Tc` \ new_tyvars ->
 395     zonkExpr expr                       `thenNF_Tc` \ new_expr ->
 396     returnNF_Tc (TyLam new_tyvars new_expr)
 397
 398 zonkExpr (TyApp expr tys)
 399   = zonkExpr expr                 `thenNF_Tc` \ new_expr ->
 400     mapNF_Tc zonkTcTypeToType tys `thenNF_Tc` \ new_tys ->
 401     returnNF_Tc (TyApp new_expr new_tys)
 402
 403 zonkExpr (DictLam dicts expr)
 404   = mapNF_Tc zonkId dicts       `thenNF_Tc` \ new_dicts ->
 405     zonkExpr expr               `thenNF_Tc` \ new_expr ->
 406     returnNF_Tc (DictLam new_dicts new_expr)
 407
 408 zonkExpr (DictApp expr dicts)
 409   = zonkExpr expr               `thenNF_Tc` \ new_expr ->
 410     mapNF_Tc zonkId dicts       `thenNF_Tc` \ new_dicts ->
 411     returnNF_Tc (DictApp new_expr new_dicts)
 412
 413 zonkExpr (ClassDictLam dicts methods expr)
 414   = mapNF_Tc zonkId dicts   `thenNF_Tc` \ new_dicts ->
 415     mapNF_Tc zonkId methods `thenNF_Tc` \ new_methods ->
 416     zonkExpr expr           `thenNF_Tc` \ new_expr ->
 417     returnNF_Tc (ClassDictLam new_dicts new_methods new_expr)
 418
 419 zonkExpr (Dictionary dicts methods)
 420   = mapNF_Tc zonkId dicts   `thenNF_Tc` \ new_dicts ->
 421     mapNF_Tc zonkId methods `thenNF_Tc` \ new_methods ->
 422     returnNF_Tc (Dictionary new_dicts new_methods)
 423
 424 zonkExpr (SingleDict name)
 425   = zonkId name         `thenNF_Tc` \ new_name ->
 426     returnNF_Tc (SingleDict new_name)
 427
 428 zonkExpr (HsCon con tys vargs)
 429   = mapNF_Tc zonkTcTypeToType tys `thenNF_Tc` \ new_tys   ->
 430     mapNF_Tc zonkExpr vargs       `thenNF_Tc` \ new_vargs ->
 431     returnNF_Tc (HsCon con new_tys new_vargs)
 432
 433 -------------------------------------------------------------------------
 434 zonkArithSeq :: TcArithSeqInfo s -> NF_TcM s TypecheckedArithSeqInfo
 435
 436 zonkArithSeq (From e)
 437   = zonkExpr e          `thenNF_Tc` \ new_e ->
 438     returnNF_Tc (From new_e)
 439
 440 zonkArithSeq (FromThen e1 e2)
 441   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 442     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 443     returnNF_Tc (FromThen new_e1 new_e2)
 444
 445 zonkArithSeq (FromTo e1 e2)
 446   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 447     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 448     returnNF_Tc (FromTo new_e1 new_e2)
 449
 450 zonkArithSeq (FromThenTo e1 e2 e3)
 451   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 452     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 453     zonkExpr e3 `thenNF_Tc` \ new_e3 ->
 454     returnNF_Tc (FromThenTo new_e1 new_e2 new_e3)
 455
 456 -------------------------------------------------------------------------
 457 zonkQuals :: [TcQual s] -> NF_TcM s [TypecheckedQual]
 458
 459 zonkQuals quals
 460   = mapNF_Tc zonk_qual quals
 461   where
 462     zonk_qual (GeneratorQual pat expr)
 463       = zonkPat  pat    `thenNF_Tc` \ new_pat ->
 464         zonkExpr expr   `thenNF_Tc` \ new_expr ->
 465         returnNF_Tc (GeneratorQual new_pat new_expr)
 466
 467     zonk_qual (FilterQual expr)
 468       = zonkExpr expr    `thenNF_Tc` \ new_expr ->
 469         returnNF_Tc (FilterQual new_expr)
 470
 471     zonk_qual (LetQual binds)
 472       = zonkBinds binds  `thenNF_Tc` \ new_binds ->
 473         returnNF_Tc (LetQual new_binds)
 474
 475 -------------------------------------------------------------------------
 476 zonkStmts :: [TcStmt s] -> NF_TcM s [TypecheckedStmt]
 477
 478 zonkStmts stmts
 479   = mapNF_Tc zonk_stmt stmts
 480   where
 481     zonk_stmt (BindStmt pat expr src_loc)
 482       = zonkPat  pat    `thenNF_Tc` \ new_pat ->
 483         zonkExpr expr   `thenNF_Tc` \ new_expr ->
 484         returnNF_Tc (BindStmt new_pat new_expr src_loc)
 485
 486     zonk_stmt (ExprStmt expr src_loc)
 487       = zonkExpr expr    `thenNF_Tc` \ new_expr ->
 488         returnNF_Tc (ExprStmt new_expr src_loc)
 489
 490     zonk_stmt (LetStmt binds)
 491       = zonkBinds binds  `thenNF_Tc` \ new_binds ->
 492         returnNF_Tc (LetStmt new_binds)
 493 \end{code}
 494
 495 %************************************************************************
 496 %*                                                                      *
 497 \subsection[BackSubst-Pats]{Patterns}
 498 %*                                                                      *
 499 %************************************************************************
 500
 501 \begin{code}
 502 zonkPat :: TcPat s -> NF_TcM s TypecheckedPat
 503
 504 zonkPat (WildPat ty)
 505   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty ->
 506     returnNF_Tc (WildPat new_ty)
 507
 508 zonkPat (VarPat v)
 509   = zonkId v        `thenNF_Tc` \ new_v ->
 510     returnNF_Tc (VarPat new_v)
 511
 512 zonkPat (LazyPat pat)
 513   = zonkPat pat     `thenNF_Tc` \ new_pat ->
 514     returnNF_Tc (LazyPat new_pat)
 515
 516 zonkPat (AsPat n pat)
 517   = zonkId n        `thenNF_Tc` \ new_n ->
 518     zonkPat pat     `thenNF_Tc` \ new_pat ->
 519     returnNF_Tc (AsPat new_n new_pat)
 520
 521 zonkPat (ConPat n ty pats)
 522   = zonkTcTypeToType ty      `thenNF_Tc` \ new_ty ->
 523     mapNF_Tc zonkPat pats    `thenNF_Tc` \ new_pats ->
 524     returnNF_Tc (ConPat n new_ty new_pats)
 525
 526 zonkPat (ConOpPat pat1 op pat2 ty)
 527   = zonkPat pat1            `thenNF_Tc` \ new_pat1 ->
 528     zonkPat pat2            `thenNF_Tc` \ new_pat2 ->
 529     zonkTcTypeToType ty     `thenNF_Tc` \ new_ty ->
 530     returnNF_Tc (ConOpPat new_pat1 op new_pat2 new_ty)
 531
 532 zonkPat (ListPat ty pats)
 533   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty ->
 534     mapNF_Tc zonkPat pats   `thenNF_Tc` \ new_pats ->
 535     returnNF_Tc (ListPat new_ty new_pats)
 536
 537 zonkPat (TuplePat pats)
 538   = mapNF_Tc zonkPat pats    `thenNF_Tc` \ new_pats ->
 539     returnNF_Tc (TuplePat new_pats)
 540
 541 zonkPat (LitPat lit ty)
 542   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty  ->
 543     returnNF_Tc (LitPat lit new_ty)
 544
 545 zonkPat (NPat lit ty expr)
 546   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty   ->
 547     zonkExpr expr           `thenNF_Tc` \ new_expr ->
 548     returnNF_Tc (NPat lit new_ty new_expr)
 549
 550 zonkPat (DictPat ds ms)
 551   = mapNF_Tc zonkId ds    `thenNF_Tc` \ new_ds ->
 552     mapNF_Tc zonkId ms    `thenNF_Tc` \ new_ms ->
 553     returnNF_Tc (DictPat new_ds new_ms)
 554 \end{code}
 555
 556