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   _            == _            = False
 128
 129 instance Outputable (TcIdOcc s) where
 130   ppr sty (TcId id)   = ppr sty id
 131   ppr sty (RealId id) = ppr sty id
 132
 133 instance NamedThing (TcIdOcc s) where
 134   getName (TcId id)   = getName id
 135   getName (RealId id) = getName id
 136 \end{code}
 137
 138
 139 %************************************************************************
 140 %*                                                                      *
 141 \subsection[BackSubst-HsBinds]{Running a substitution over @HsBinds@}
 142 %*                                                                      *
 143 %************************************************************************
 144
 145 \begin{code}
 146 zonkId   :: TcIdOcc s -> NF_TcM s Id
 147 unZonkId :: Id        -> NF_TcM s (TcIdBndr s)
 148
 149 zonkId (RealId id) = returnNF_Tc id
 150
 151 zonkId (TcId (Id u ty details prags info))
 152   = zonkTcTypeToType ty `thenNF_Tc` \ ty' ->
 153     returnNF_Tc (Id u ty' details prags info)
 154
 155 unZonkId (Id u ty details prags info)
 156   = tcInstType [] ty    `thenNF_Tc` \ ty' ->
 157     returnNF_Tc (Id u ty' details prags info)
 158 \end{code}
 159
 160 \begin{code}
 161 zonkInst :: (TcIdOcc s, TcExpr s) -> NF_TcM s (Id, TypecheckedHsExpr)
 162 zonkInst (id, expr)
 163   = zonkId id           `thenNF_Tc` \ id' ->
 164     zonkExpr expr       `thenNF_Tc` \ expr' ->
 165     returnNF_Tc (id', expr')
 166 \end{code}
 167
 168 \begin{code}
 169 zonkBinds :: TcHsBinds s -> NF_TcM s TypecheckedHsBinds
 170
 171 zonkBinds EmptyBinds = returnNF_Tc EmptyBinds
 172
 173 zonkBinds (ThenBinds binds1 binds2)
 174   = zonkBinds binds1  `thenNF_Tc` \ new_binds1 ->
 175     zonkBinds binds2  `thenNF_Tc` \ new_binds2 ->
 176     returnNF_Tc (ThenBinds new_binds1 new_binds2)
 177
 178 zonkBinds (SingleBind bind)
 179   = zonkBind bind  `thenNF_Tc` \ new_bind ->
 180     returnNF_Tc (SingleBind new_bind)
 181
 182 zonkBinds (AbsBinds tyvars dicts locprs dict_binds val_bind)
 183   = mapNF_Tc zonkTcTyVarToTyVar tyvars  `thenNF_Tc` \ new_tyvars ->
 184     mapNF_Tc zonkId dicts               `thenNF_Tc` \ new_dicts ->
 185     mapNF_Tc subst_pair locprs          `thenNF_Tc` \ new_locprs ->
 186     mapNF_Tc subst_bind dict_binds      `thenNF_Tc` \ new_dict_binds ->
 187     zonkBind val_bind                   `thenNF_Tc` \ new_val_bind ->
 188     returnNF_Tc (AbsBinds new_tyvars new_dicts new_locprs new_dict_binds new_val_bind)
 189   where
 190     subst_pair (l, g)
 191       = zonkId l        `thenNF_Tc` \ new_l ->
 192         zonkId g        `thenNF_Tc` \ new_g ->
 193         returnNF_Tc (new_l, new_g)
 194
 195     subst_bind (v, e)
 196       = zonkId v        `thenNF_Tc` \ new_v ->
 197         zonkExpr e      `thenNF_Tc` \ new_e ->
 198         returnNF_Tc (new_v, new_e)
 199 \end{code}
 200
 201 \begin{code}
 202 -------------------------------------------------------------------------
 203 zonkBind :: TcBind s -> NF_TcM s TypecheckedBind
 204
 205 zonkBind EmptyBind = returnNF_Tc EmptyBind
 206
 207 zonkBind (NonRecBind mbinds)
 208   = zonkMonoBinds mbinds        `thenNF_Tc` \ new_mbinds ->
 209     returnNF_Tc (NonRecBind new_mbinds)
 210
 211 zonkBind (RecBind mbinds)
 212   = zonkMonoBinds mbinds        `thenNF_Tc` \ new_mbinds ->
 213     returnNF_Tc (RecBind new_mbinds)
 214
 215 -------------------------------------------------------------------------
 216 zonkMonoBinds :: TcMonoBinds s -> NF_TcM s TypecheckedMonoBinds
 217
 218 zonkMonoBinds EmptyMonoBinds = returnNF_Tc EmptyMonoBinds
 219
 220 zonkMonoBinds (AndMonoBinds mbinds1 mbinds2)
 221   = zonkMonoBinds mbinds1  `thenNF_Tc` \ new_mbinds1 ->
 222     zonkMonoBinds mbinds2  `thenNF_Tc` \ new_mbinds2 ->
 223     returnNF_Tc (AndMonoBinds new_mbinds1 new_mbinds2)
 224
 225 zonkMonoBinds (PatMonoBind pat grhss_w_binds locn)
 226   = zonkPat pat                         `thenNF_Tc` \ new_pat ->
 227     zonkGRHSsAndBinds grhss_w_binds     `thenNF_Tc` \ new_grhss_w_binds ->
 228     returnNF_Tc (PatMonoBind new_pat new_grhss_w_binds locn)
 229
 230 zonkMonoBinds (VarMonoBind var expr)
 231   = zonkId var          `thenNF_Tc` \ new_var ->
 232     zonkExpr expr       `thenNF_Tc` \ new_expr ->
 233     returnNF_Tc (VarMonoBind new_var new_expr)
 234
 235 zonkMonoBinds (FunMonoBind name inf ms locn)
 236   = zonkId name                 `thenNF_Tc` \ new_name ->
 237     mapNF_Tc zonkMatch ms       `thenNF_Tc` \ new_ms ->
 238     returnNF_Tc (FunMonoBind new_name inf new_ms locn)
 239 \end{code}
 240
 241 %************************************************************************
 242 %*                                                                      *
 243 \subsection[BackSubst-Match-GRHSs]{Match and GRHSsAndBinds}
 244 %*                                                                      *
 245 %************************************************************************
 246
 247 \begin{code}
 248 zonkMatch :: TcMatch s -> NF_TcM s TypecheckedMatch
 249
 250 zonkMatch (PatMatch pat match)
 251   = zonkPat pat         `thenNF_Tc` \ new_pat ->
 252     zonkMatch match     `thenNF_Tc` \ new_match ->
 253     returnNF_Tc (PatMatch new_pat new_match)
 254
 255 zonkMatch (GRHSMatch grhss_w_binds)
 256   = zonkGRHSsAndBinds grhss_w_binds `thenNF_Tc` \ new_grhss_w_binds ->
 257     returnNF_Tc (GRHSMatch new_grhss_w_binds)
 258
 259 zonkMatch (SimpleMatch expr)
 260   = zonkExpr expr   `thenNF_Tc` \ new_expr ->
 261     returnNF_Tc (SimpleMatch new_expr)
 262
 263 -------------------------------------------------------------------------
 264 zonkGRHSsAndBinds :: TcGRHSsAndBinds s
 265                    -> NF_TcM s TypecheckedGRHSsAndBinds
 266
 267 zonkGRHSsAndBinds (GRHSsAndBindsOut grhss binds ty)
 268   = mapNF_Tc zonk_grhs grhss    `thenNF_Tc` \ new_grhss ->
 269     zonkBinds binds             `thenNF_Tc` \ new_binds ->
 270     zonkTcTypeToType ty         `thenNF_Tc` \ new_ty ->
 271     returnNF_Tc (GRHSsAndBindsOut new_grhss new_binds new_ty)
 272   where
 273     zonk_grhs (GRHS guard expr locn)
 274       = zonkExpr guard  `thenNF_Tc` \ new_guard ->
 275         zonkExpr expr   `thenNF_Tc` \ new_expr  ->
 276         returnNF_Tc (GRHS new_guard new_expr locn)
 277
 278     zonk_grhs (OtherwiseGRHS expr locn)
 279       = zonkExpr expr   `thenNF_Tc` \ new_expr  ->
 280         returnNF_Tc (OtherwiseGRHS new_expr locn)
 281 \end{code}
 282
 283 %************************************************************************
 284 %*                                                                      *
 285 \subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr}
 286 %*                                                                      *
 287 %************************************************************************
 288
 289 \begin{code}
 290 zonkExpr :: TcExpr s -> NF_TcM s TypecheckedHsExpr
 291
 292 zonkExpr (HsVar name)
 293   = zonkId name `thenNF_Tc` \ new_name ->
 294     returnNF_Tc (HsVar new_name)
 295
 296 zonkExpr (HsLit _) = panic "zonkExpr:HsLit"
 297
 298 zonkExpr (HsLitOut lit ty)
 299   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty  ->
 300     returnNF_Tc (HsLitOut lit new_ty)
 301
 302 zonkExpr (HsLam match)
 303   = zonkMatch match     `thenNF_Tc` \ new_match ->
 304     returnNF_Tc (HsLam new_match)
 305
 306 zonkExpr (HsApp e1 e2)
 307   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 308     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 309     returnNF_Tc (HsApp new_e1 new_e2)
 310
 311 zonkExpr (OpApp e1 op e2)
 312   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 313     zonkExpr op `thenNF_Tc` \ new_op ->
 314     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 315     returnNF_Tc (OpApp new_e1 new_op new_e2)
 316
 317 zonkExpr (NegApp _ _) = panic "zonkExpr:NegApp"
 318 zonkExpr (HsPar _)    = panic "zonkExpr:HsPar"
 319
 320 zonkExpr (SectionL expr op)
 321   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 322     zonkExpr op         `thenNF_Tc` \ new_op ->
 323     returnNF_Tc (SectionL new_expr new_op)
 324
 325 zonkExpr (SectionR op expr)
 326   = zonkExpr op         `thenNF_Tc` \ new_op ->
 327     zonkExpr expr       `thenNF_Tc` \ new_expr ->
 328     returnNF_Tc (SectionR new_op new_expr)
 329
 330 zonkExpr (HsCase expr ms src_loc)
 331   = zonkExpr expr           `thenNF_Tc` \ new_expr ->
 332     mapNF_Tc zonkMatch ms   `thenNF_Tc` \ new_ms ->
 333     returnNF_Tc (HsCase new_expr new_ms src_loc)
 334
 335 zonkExpr (HsIf e1 e2 e3 src_loc)
 336   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 337     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 338     zonkExpr e3 `thenNF_Tc` \ new_e3 ->
 339     returnNF_Tc (HsIf new_e1 new_e2 new_e3 src_loc)
 340
 341 zonkExpr (HsLet binds expr)
 342   = zonkBinds binds     `thenNF_Tc` \ new_binds ->
 343     zonkExpr expr       `thenNF_Tc` \ new_expr ->
 344     returnNF_Tc (HsLet new_binds new_expr)
 345
 346 zonkExpr (HsDo _ _) = panic "zonkExpr:HsDo"
 347
 348 zonkExpr (HsDoOut stmts m_id mz_id src_loc)
 349   = zonkStmts stmts     `thenNF_Tc` \ new_stmts ->
 350     zonkId m_id         `thenNF_Tc` \ m_new ->
 351     zonkId mz_id        `thenNF_Tc` \ mz_new ->
 352     returnNF_Tc (HsDoOut new_stmts m_new mz_new src_loc)
 353
 354 zonkExpr (ListComp expr quals)
 355   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 356     zonkQuals quals     `thenNF_Tc` \ new_quals ->
 357     returnNF_Tc (ListComp new_expr new_quals)
 358
 359 zonkExpr (ExplicitList _) = panic "zonkExpr:ExplicitList"
 360
 361 zonkExpr (ExplicitListOut ty exprs)
 362   = zonkTcTypeToType  ty        `thenNF_Tc` \ new_ty ->
 363     mapNF_Tc zonkExpr exprs     `thenNF_Tc` \ new_exprs ->
 364     returnNF_Tc (ExplicitListOut new_ty new_exprs)
 365
 366 zonkExpr (ExplicitTuple exprs)
 367   = mapNF_Tc zonkExpr exprs  `thenNF_Tc` \ new_exprs ->
 368     returnNF_Tc (ExplicitTuple new_exprs)
 369
 370 zonkExpr (RecordCon con rbinds)
 371   = zonkExpr con        `thenNF_Tc` \ new_con ->
 372     zonkRbinds rbinds   `thenNF_Tc` \ new_rbinds ->
 373     returnNF_Tc (RecordCon new_con new_rbinds)
 374
 375 zonkExpr (RecordUpd _ _) = panic "zonkExpr:RecordUpd"
 376
 377 zonkExpr (RecordUpdOut expr ids rbinds)
 378   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 379     mapNF_Tc zonkId ids `thenNF_Tc` \ new_ids ->
 380     zonkRbinds rbinds   `thenNF_Tc` \ new_rbinds ->
 381     returnNF_Tc (RecordUpdOut new_expr new_ids new_rbinds)
 382
 383 zonkExpr (ExprWithTySig _ _) = panic "zonkExpr:ExprWithTySig"
 384 zonkExpr (ArithSeqIn _) = panic "zonkExpr:ArithSeqIn"
 385
 386 zonkExpr (ArithSeqOut expr info)
 387   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 388     zonkArithSeq info   `thenNF_Tc` \ new_info ->
 389     returnNF_Tc (ArithSeqOut new_expr new_info)
 390
 391 zonkExpr (CCall fun args may_gc is_casm result_ty)
 392   = mapNF_Tc zonkExpr args      `thenNF_Tc` \ new_args ->
 393     zonkTcTypeToType result_ty  `thenNF_Tc` \ new_result_ty ->
 394     returnNF_Tc (CCall fun new_args may_gc is_casm new_result_ty)
 395
 396 zonkExpr (HsSCC label expr)
 397   = zonkExpr expr       `thenNF_Tc` \ new_expr ->
 398     returnNF_Tc (HsSCC label new_expr)
 399
 400 zonkExpr (TyLam tyvars expr)
 401   = mapNF_Tc zonkTcTyVarToTyVar tyvars  `thenNF_Tc` \ new_tyvars ->
 402     zonkExpr expr                       `thenNF_Tc` \ new_expr ->
 403     returnNF_Tc (TyLam new_tyvars new_expr)
 404
 405 zonkExpr (TyApp expr tys)
 406   = zonkExpr expr                 `thenNF_Tc` \ new_expr ->
 407     mapNF_Tc zonkTcTypeToType tys `thenNF_Tc` \ new_tys ->
 408     returnNF_Tc (TyApp new_expr new_tys)
 409
 410 zonkExpr (DictLam dicts expr)
 411   = mapNF_Tc zonkId dicts       `thenNF_Tc` \ new_dicts ->
 412     zonkExpr expr               `thenNF_Tc` \ new_expr ->
 413     returnNF_Tc (DictLam new_dicts new_expr)
 414
 415 zonkExpr (DictApp expr dicts)
 416   = zonkExpr expr               `thenNF_Tc` \ new_expr ->
 417     mapNF_Tc zonkId dicts       `thenNF_Tc` \ new_dicts ->
 418     returnNF_Tc (DictApp new_expr new_dicts)
 419
 420 zonkExpr (ClassDictLam dicts methods expr)
 421   = mapNF_Tc zonkId dicts   `thenNF_Tc` \ new_dicts ->
 422     mapNF_Tc zonkId methods `thenNF_Tc` \ new_methods ->
 423     zonkExpr expr           `thenNF_Tc` \ new_expr ->
 424     returnNF_Tc (ClassDictLam new_dicts new_methods new_expr)
 425
 426 zonkExpr (Dictionary dicts methods)
 427   = mapNF_Tc zonkId dicts   `thenNF_Tc` \ new_dicts ->
 428     mapNF_Tc zonkId methods `thenNF_Tc` \ new_methods ->
 429     returnNF_Tc (Dictionary new_dicts new_methods)
 430
 431 zonkExpr (SingleDict name)
 432   = zonkId name         `thenNF_Tc` \ new_name ->
 433     returnNF_Tc (SingleDict new_name)
 434
 435 zonkExpr (HsCon con tys vargs)
 436   = mapNF_Tc zonkTcTypeToType tys `thenNF_Tc` \ new_tys   ->
 437     mapNF_Tc zonkExpr vargs       `thenNF_Tc` \ new_vargs ->
 438     returnNF_Tc (HsCon con new_tys new_vargs)
 439
 440 -------------------------------------------------------------------------
 441 zonkArithSeq :: TcArithSeqInfo s -> NF_TcM s TypecheckedArithSeqInfo
 442
 443 zonkArithSeq (From e)
 444   = zonkExpr e          `thenNF_Tc` \ new_e ->
 445     returnNF_Tc (From new_e)
 446
 447 zonkArithSeq (FromThen e1 e2)
 448   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 449     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 450     returnNF_Tc (FromThen new_e1 new_e2)
 451
 452 zonkArithSeq (FromTo e1 e2)
 453   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 454     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 455     returnNF_Tc (FromTo new_e1 new_e2)
 456
 457 zonkArithSeq (FromThenTo e1 e2 e3)
 458   = zonkExpr e1 `thenNF_Tc` \ new_e1 ->
 459     zonkExpr e2 `thenNF_Tc` \ new_e2 ->
 460     zonkExpr e3 `thenNF_Tc` \ new_e3 ->
 461     returnNF_Tc (FromThenTo new_e1 new_e2 new_e3)
 462
 463 -------------------------------------------------------------------------
 464 zonkQuals :: [TcQual s] -> NF_TcM s [TypecheckedQual]
 465
 466 zonkQuals quals
 467   = mapNF_Tc zonk_qual quals
 468   where
 469     zonk_qual (GeneratorQual pat expr)
 470       = zonkPat  pat    `thenNF_Tc` \ new_pat ->
 471         zonkExpr expr   `thenNF_Tc` \ new_expr ->
 472         returnNF_Tc (GeneratorQual new_pat new_expr)
 473
 474     zonk_qual (FilterQual expr)
 475       = zonkExpr expr    `thenNF_Tc` \ new_expr ->
 476         returnNF_Tc (FilterQual new_expr)
 477
 478     zonk_qual (LetQual binds)
 479       = zonkBinds binds  `thenNF_Tc` \ new_binds ->
 480         returnNF_Tc (LetQual new_binds)
 481
 482 -------------------------------------------------------------------------
 483 zonkStmts :: [TcStmt s] -> NF_TcM s [TypecheckedStmt]
 484
 485 zonkStmts stmts
 486   = mapNF_Tc zonk_stmt stmts
 487   where
 488     zonk_stmt (BindStmt pat expr src_loc)
 489       = zonkPat  pat    `thenNF_Tc` \ new_pat ->
 490         zonkExpr expr   `thenNF_Tc` \ new_expr ->
 491         returnNF_Tc (BindStmt new_pat new_expr src_loc)
 492
 493     zonk_stmt (ExprStmt expr src_loc)
 494       = zonkExpr expr    `thenNF_Tc` \ new_expr ->
 495         returnNF_Tc (ExprStmt new_expr src_loc)
 496
 497     zonk_stmt (LetStmt binds)
 498       = zonkBinds binds  `thenNF_Tc` \ new_binds ->
 499         returnNF_Tc (LetStmt new_binds)
 500
 501 -------------------------------------------------------------------------
 502 zonkRbinds :: TcRecordBinds s -> NF_TcM s TypecheckedRecordBinds
 503
 504 zonkRbinds rbinds
 505   = mapNF_Tc zonk_rbind rbinds
 506   where
 507     zonk_rbind (field, expr, pun)
 508       = zonkId field    `thenNF_Tc` \ new_field ->
 509         zonkExpr expr   `thenNF_Tc` \ new_expr ->
 510         returnNF_Tc (new_field, new_expr, pun)
 511 \end{code}
 512
 513 %************************************************************************
 514 %*                                                                      *
 515 \subsection[BackSubst-Pats]{Patterns}
 516 %*                                                                      *
 517 %************************************************************************
 518
 519 \begin{code}
 520 zonkPat :: TcPat s -> NF_TcM s TypecheckedPat
 521
 522 zonkPat (WildPat ty)
 523   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty ->
 524     returnNF_Tc (WildPat new_ty)
 525
 526 zonkPat (VarPat v)
 527   = zonkId v        `thenNF_Tc` \ new_v ->
 528     returnNF_Tc (VarPat new_v)
 529
 530 zonkPat (LazyPat pat)
 531   = zonkPat pat     `thenNF_Tc` \ new_pat ->
 532     returnNF_Tc (LazyPat new_pat)
 533
 534 zonkPat (AsPat n pat)
 535   = zonkId n        `thenNF_Tc` \ new_n ->
 536     zonkPat pat     `thenNF_Tc` \ new_pat ->
 537     returnNF_Tc (AsPat new_n new_pat)
 538
 539 zonkPat (ConPat n ty pats)
 540   = zonkTcTypeToType ty      `thenNF_Tc` \ new_ty ->
 541     mapNF_Tc zonkPat pats    `thenNF_Tc` \ new_pats ->
 542     returnNF_Tc (ConPat n new_ty new_pats)
 543
 544 zonkPat (ConOpPat pat1 op pat2 ty)
 545   = zonkPat pat1            `thenNF_Tc` \ new_pat1 ->
 546     zonkPat pat2            `thenNF_Tc` \ new_pat2 ->
 547     zonkTcTypeToType ty     `thenNF_Tc` \ new_ty ->
 548     returnNF_Tc (ConOpPat new_pat1 op new_pat2 new_ty)
 549
 550 zonkPat (ListPat ty pats)
 551   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty ->
 552     mapNF_Tc zonkPat pats   `thenNF_Tc` \ new_pats ->
 553     returnNF_Tc (ListPat new_ty new_pats)
 554
 555 zonkPat (TuplePat pats)
 556   = mapNF_Tc zonkPat pats   `thenNF_Tc` \ new_pats ->
 557     returnNF_Tc (TuplePat new_pats)
 558
 559 zonkPat (RecPat n ty rpats)
 560   = zonkTcTypeToType ty      `thenNF_Tc` \ new_ty ->
 561     mapNF_Tc zonk_rpat rpats `thenNF_Tc` \ new_rpats ->
 562     returnNF_Tc (RecPat n new_ty new_rpats)
 563   where
 564     zonk_rpat (f, pat, pun)
 565       = zonkPat pat          `thenNF_Tc` \ new_pat ->
 566         returnNF_Tc (f, new_pat, pun)
 567
 568 zonkPat (LitPat lit ty)
 569   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty  ->
 570     returnNF_Tc (LitPat lit new_ty)
 571
 572 zonkPat (NPat lit ty expr)
 573   = zonkTcTypeToType ty     `thenNF_Tc` \ new_ty   ->
 574     zonkExpr expr           `thenNF_Tc` \ new_expr ->
 575     returnNF_Tc (NPat lit new_ty new_expr)
 576
 577 zonkPat (DictPat ds ms)
 578   = mapNF_Tc zonkId ds    `thenNF_Tc` \ new_ds ->
 579     mapNF_Tc zonkId ms    `thenNF_Tc` \ new_ms ->
 580     returnNF_Tc (DictPat new_ds new_ms)
 581 \end{code}
 582
 583