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 \begin{code}
 289 zonkExpr :: TcExpr s -> NF_TcM s TypecheckedHsExpr
 290
 291 zonkExpr (HsVar name)
 292   = zonkId name `thenNF_Tc` \ new_name ->
 293     returnNF_Tc (HsVar new_name)
 294
 295 zonkExpr (HsLit _) = panic "zonkExpr:HsLit"
 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   = zonkExpr con        `thenNF_Tc` \ new_con ->
 371     zonkRbinds rbinds   `thenNF_Tc` \ new_rbinds ->
 372     returnNF_Tc (RecordCon new_con new_rbinds)
 373
 374 zonkExpr (RecordUpd _ _) = panic "zonkExpr:RecordUpd"
 375
 376 zonkExpr (RecordUpdOut expr ids rbinds)
 377   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 378     mapNF_Tc zonkId ids `thenNF_Tc` \ new_ids ->
 379     zonkRbinds rbinds   `thenNF_Tc` \ new_rbinds ->
 380     returnNF_Tc (RecordUpdOut new_expr new_ids new_rbinds)
 381
 382 zonkExpr (ExprWithTySig _ _) = panic "zonkExpr:ExprWithTySig"
 383 zonkExpr (ArithSeqIn _) = panic "zonkExpr:ArithSeqIn"
 384
 385 zonkExpr (ArithSeqOut expr info)
 386   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 387     zonkArithSeq info   `thenNF_Tc` \ new_info ->
 388     returnNF_Tc (ArithSeqOut new_expr new_info)
 389
 390 zonkExpr (CCall fun args may_gc is_casm result_ty)
 391   = mapNF_Tc zonkExpr args      `thenNF_Tc` \ new_args ->
 392     zonkTcTypeToType result_ty  `thenNF_Tc` \ new_result_ty ->
 393     returnNF_Tc (CCall fun new_args may_gc is_casm new_result_ty)
 394
 395 zonkExpr (HsSCC label expr)
 396   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 397     returnNF_Tc (HsSCC label new_expr)
 398
 399 zonkExpr (TyLam tyvars expr)
 400   = mapNF_Tc zonkTcTyVarToTyVar tyvars  `thenNF_Tc` \ new_tyvars ->
 401     zonkExpr expr                       `thenNF_Tc` \ new_expr ->
 402     returnNF_Tc (TyLam new_tyvars new_expr)
 403
 404 zonkExpr (TyApp expr tys)
 405   = zonkExpr expr                 `thenNF_Tc` \ new_expr ->
 406     mapNF_Tc zonkTcTypeToType tys `thenNF_Tc` \ new_tys ->
 407     returnNF_Tc (TyApp new_expr new_tys)
 408
 409 zonkExpr (DictLam dicts expr)
 410   = mapNF_Tc zonkId dicts       `thenNF_Tc` \ new_dicts ->
 411     zonkExpr expr               `thenNF_Tc` \ new_expr ->
 412     returnNF_Tc (DictLam new_dicts new_expr)
 413
 414 zonkExpr (DictApp expr dicts)
 415   = zonkExpr expr               `thenNF_Tc` \ new_expr ->
 416     mapNF_Tc zonkId dicts       `thenNF_Tc` \ new_dicts ->
 417     returnNF_Tc (DictApp new_expr new_dicts)
 418
 419 zonkExpr (ClassDictLam dicts methods expr)
 420   = mapNF_Tc zonkId dicts   `thenNF_Tc` \ new_dicts ->
 421     mapNF_Tc zonkId methods `thenNF_Tc` \ new_methods ->
 422     zonkExpr expr           `thenNF_Tc` \ new_expr ->
 423     returnNF_Tc (ClassDictLam new_dicts new_methods new_expr)
 424
 425 zonkExpr (Dictionary dicts methods)
 426   = mapNF_Tc zonkId dicts   `thenNF_Tc` \ new_dicts ->
 427     mapNF_Tc zonkId methods `thenNF_Tc` \ new_methods ->
 428     returnNF_Tc (Dictionary new_dicts new_methods)
 429
 430 zonkExpr (SingleDict name)
 431   = zonkId name         `thenNF_Tc` \ new_name ->
 432     returnNF_Tc (SingleDict new_name)
 433
 434 zonkExpr (HsCon con tys vargs)
 435   = mapNF_Tc zonkTcTypeToType tys `thenNF_Tc` \ new_tys   ->
 436     mapNF_Tc zonkExpr vargs       `thenNF_Tc` \ new_vargs ->
 437     returnNF_Tc (HsCon con new_tys new_vargs)
 438
 439 -------------------------------------------------------------------------
 440 zonkArithSeq :: TcArithSeqInfo s -> NF_TcM s TypecheckedArithSeqInfo
 441
 442 zonkArithSeq (From e)
 443   = zonkExpr e          `thenNF_Tc` \ new_e ->
 444     returnNF_Tc (From new_e)
 445
 446 zonkArithSeq (FromThen e1 e2)
 447   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 448     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 449     returnNF_Tc (FromThen new_e1 new_e2)
 450
 451 zonkArithSeq (FromTo e1 e2)
 452   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 453     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 454     returnNF_Tc (FromTo new_e1 new_e2)
 455
 456 zonkArithSeq (FromThenTo e1 e2 e3)
 457   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 458     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 459     zonkExpr e3 `thenNF_Tc` \ new_e3 ->
 460     returnNF_Tc (FromThenTo new_e1 new_e2 new_e3)
 461
 462 -------------------------------------------------------------------------
 463 zonkQuals :: [TcQual s] -> NF_TcM s [TypecheckedQual]
 464
 465 zonkQuals quals
 466   = mapNF_Tc zonk_qual quals
 467   where
 468     zonk_qual (GeneratorQual pat expr)
 469       = zonkPat  pat    `thenNF_Tc` \ new_pat ->
 470         zonkExpr expr   `thenNF_Tc` \ new_expr ->
 471         returnNF_Tc (GeneratorQual new_pat new_expr)
 472
 473     zonk_qual (FilterQual expr)
 474       = zonkExpr expr    `thenNF_Tc` \ new_expr ->
 475         returnNF_Tc (FilterQual new_expr)
 476
 477     zonk_qual (LetQual binds)
 478       = zonkBinds binds  `thenNF_Tc` \ new_binds ->
 479         returnNF_Tc (LetQual new_binds)
 480
 481 -------------------------------------------------------------------------
 482 zonkStmts :: [TcStmt s] -> NF_TcM s [TypecheckedStmt]
 483
 484 zonkStmts stmts
 485   = mapNF_Tc zonk_stmt stmts
 486   where
 487     zonk_stmt (BindStmt pat expr src_loc)
 488       = zonkPat  pat    `thenNF_Tc` \ new_pat ->
 489         zonkExpr expr   `thenNF_Tc` \ new_expr ->
 490         returnNF_Tc (BindStmt new_pat new_expr src_loc)
 491
 492     zonk_stmt (ExprStmt expr src_loc)
 493       = zonkExpr expr    `thenNF_Tc` \ new_expr ->
 494         returnNF_Tc (ExprStmt new_expr src_loc)
 495
 496     zonk_stmt (LetStmt binds)
 497       = zonkBinds binds  `thenNF_Tc` \ new_binds ->
 498         returnNF_Tc (LetStmt new_binds)
 499
 500 -------------------------------------------------------------------------
 501 zonkRbinds :: TcRecordBinds s -> NF_TcM s TypecheckedRecordBinds
 502
 503 zonkRbinds rbinds
 504   = mapNF_Tc zonk_rbind rbinds
 505   where
 506     zonk_rbind (field, expr, pun)
 507       = zonkId field    `thenNF_Tc` \ new_field ->
 508         zonkExpr expr   `thenNF_Tc` \ new_expr ->
 509         returnNF_Tc (new_field, new_expr, pun)
 510 \end{code}
 511
 512 %************************************************************************
 513 %*                                                                      *
 514 \subsection[BackSubst-Pats]{Patterns}
 515 %*                                                                      *
 516 %************************************************************************
 517
 518 \begin{code}
 519 zonkPat :: TcPat s -> NF_TcM s TypecheckedPat
 520
 521 zonkPat (WildPat ty)
 522   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty ->
 523     returnNF_Tc (WildPat new_ty)
 524
 525 zonkPat (VarPat v)
 526   = zonkId v        `thenNF_Tc` \ new_v ->
 527     returnNF_Tc (VarPat new_v)
 528
 529 zonkPat (LazyPat pat)
 530   = zonkPat pat     `thenNF_Tc` \ new_pat ->
 531     returnNF_Tc (LazyPat new_pat)
 532
 533 zonkPat (AsPat n pat)
 534   = zonkId n        `thenNF_Tc` \ new_n ->
 535     zonkPat pat     `thenNF_Tc` \ new_pat ->
 536     returnNF_Tc (AsPat new_n new_pat)
 537
 538 zonkPat (ConPat n ty pats)
 539   = zonkTcTypeToType ty      `thenNF_Tc` \ new_ty ->
 540     mapNF_Tc zonkPat pats    `thenNF_Tc` \ new_pats ->
 541     returnNF_Tc (ConPat n new_ty new_pats)
 542
 543 zonkPat (ConOpPat pat1 op pat2 ty)
 544   = zonkPat pat1            `thenNF_Tc` \ new_pat1 ->
 545     zonkPat pat2            `thenNF_Tc` \ new_pat2 ->
 546     zonkTcTypeToType ty     `thenNF_Tc` \ new_ty ->
 547     returnNF_Tc (ConOpPat new_pat1 op new_pat2 new_ty)
 548
 549 zonkPat (ListPat ty pats)
 550   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty ->
 551     mapNF_Tc zonkPat pats   `thenNF_Tc` \ new_pats ->
 552     returnNF_Tc (ListPat new_ty new_pats)
 553
 554 zonkPat (TuplePat pats)
 555   = mapNF_Tc zonkPat pats   `thenNF_Tc` \ new_pats ->
 556     returnNF_Tc (TuplePat new_pats)
 557
 558 zonkPat (RecPat n ty rpats)
 559   = zonkTcTypeToType ty      `thenNF_Tc` \ new_ty ->
 560     mapNF_Tc zonk_rpat rpats `thenNF_Tc` \ new_rpats ->
 561     returnNF_Tc (RecPat n new_ty new_rpats)
 562   where
 563     zonk_rpat (f, pat, pun)
 564       = zonkPat pat          `thenNF_Tc` \ new_pat ->
 565         returnNF_Tc (f, new_pat, pun)
 566
 567 zonkPat (LitPat lit ty)
 568   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty  ->
 569     returnNF_Tc (LitPat lit new_ty)
 570
 571 zonkPat (NPat lit ty expr)
 572   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty   ->
 573     zonkExpr expr           `thenNF_Tc` \ new_expr ->
 574     returnNF_Tc (NPat lit new_ty new_expr)
 575
 576 zonkPat (DictPat ds ms)
 577   = mapNF_Tc zonkId ds    `thenNF_Tc` \ new_ds ->
 578     mapNF_Tc zonkId ms    `thenNF_Tc` \ new_ms ->
 579     returnNF_Tc (DictPat new_ds new_ms)
 580 \end{code}
 581
 582