2 % (c) The AQUA Project, Glasgow University, 1996
4 \section[TcHsSyn]{Specialisations of the @HsSyn@ syntax for the typechecker}
6 This module is an extension of @HsSyn@ syntax, for use in the type
11 TcIdBndr(..), TcIdOcc(..),
13 TcMonoBinds(..), TcHsBinds(..), TcBind(..), TcPat(..),
14 TcExpr(..), TcGRHSsAndBinds(..), TcGRHS(..), TcMatch(..),
15 TcQual(..), TcStmt(..), TcArithSeqInfo(..), TcRecordBinds(..),
18 TypecheckedHsBinds(..), TypecheckedBind(..),
19 TypecheckedMonoBinds(..), TypecheckedPat(..),
20 TypecheckedHsExpr(..), TypecheckedArithSeqInfo(..),
21 TypecheckedQual(..), TypecheckedStmt(..),
22 TypecheckedMatch(..), TypecheckedHsModule(..),
23 TypecheckedGRHSsAndBinds(..), TypecheckedGRHS(..),
24 TypecheckedRecordBinds(..),
26 mkHsTyApp, mkHsDictApp,
27 mkHsTyLam, mkHsDictLam,
32 zonkId, -- TcIdBndr s -> NF_TcM s Id
33 unZonkId -- Id -> NF_TcM s (TcIdBndr s)
39 import HsSyn -- oodles of it
40 import Id ( GenId(..), IdDetails, PragmaInfo, -- Can meddle modestly with Ids
46 import TcType ( TcType(..), TcMaybe, TcTyVar(..),
47 zonkTcTypeToType, zonkTcTyVarToTyVar,
50 import Usage ( UVar(..) )
53 import PprType ( GenType, GenTyVar ) -- instances
54 import TyVar ( GenTyVar ) -- instances
55 import Unique ( Unique ) -- instances
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
66 At the end of type checking we zonk everything to @Typechecked...@ datatypes,
67 which have immutable type variables in them.
70 type TcIdBndr s = GenId (TcType s) -- Binders are all TcTypes
71 data TcIdOcc s = TcId (TcIdBndr s) -- Bindees may be either
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)
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
104 mkHsTyApp expr [] = expr
105 mkHsTyApp expr tys = TyApp expr tys
107 mkHsDictApp expr [] = expr
108 mkHsDictApp expr dict_vars = DictApp expr dict_vars
110 mkHsTyLam [] expr = expr
111 mkHsTyLam tyvars expr = TyLam tyvars expr
113 mkHsDictLam [] expr = expr
114 mkHsDictLam dicts expr = DictLam dicts expr
116 tcIdType :: TcIdOcc s -> TcType s
117 tcIdType (TcId id) = idType id
118 tcIdType other = panic "tcIdType"
124 instance Eq (TcIdOcc s) where
125 (TcId id1) == (TcId id2) = id1 == id2
126 (RealId id1) == (RealId id2) = id1 == id2
129 instance Outputable (TcIdOcc s) where
130 ppr sty (TcId id) = ppr sty id
131 ppr sty (RealId id) = ppr sty id
133 instance NamedThing (TcIdOcc s) where
134 getName (TcId id) = getName id
135 getName (RealId id) = getName id
139 %************************************************************************
141 \subsection[BackSubst-HsBinds]{Running a substitution over @HsBinds@}
143 %************************************************************************
146 zonkId :: TcIdOcc s -> NF_TcM s Id
147 unZonkId :: Id -> NF_TcM s (TcIdBndr s)
149 zonkId (RealId id) = returnNF_Tc id
151 zonkId (TcId (Id u ty details prags info))
152 = zonkTcTypeToType ty `thenNF_Tc` \ ty' ->
153 returnNF_Tc (Id u ty' details prags info)
155 unZonkId (Id u ty details prags info)
156 = tcInstType [] ty `thenNF_Tc` \ ty' ->
157 returnNF_Tc (Id u ty' details prags info)
161 zonkInst :: (TcIdOcc s, TcExpr s) -> NF_TcM s (Id, TypecheckedHsExpr)
163 = zonkId id `thenNF_Tc` \ id' ->
164 zonkExpr expr `thenNF_Tc` \ expr' ->
165 returnNF_Tc (id', expr')
169 zonkBinds :: TcHsBinds s -> NF_TcM s TypecheckedHsBinds
171 zonkBinds EmptyBinds = returnNF_Tc EmptyBinds
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)
178 zonkBinds (SingleBind bind)
179 = zonkBind bind `thenNF_Tc` \ new_bind ->
180 returnNF_Tc (SingleBind new_bind)
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)
191 = zonkId l `thenNF_Tc` \ new_l ->
192 zonkId g `thenNF_Tc` \ new_g ->
193 returnNF_Tc (new_l, new_g)
196 = zonkId v `thenNF_Tc` \ new_v ->
197 zonkExpr e `thenNF_Tc` \ new_e ->
198 returnNF_Tc (new_v, new_e)
202 -------------------------------------------------------------------------
203 zonkBind :: TcBind s -> NF_TcM s TypecheckedBind
205 zonkBind EmptyBind = returnNF_Tc EmptyBind
207 zonkBind (NonRecBind mbinds)
208 = zonkMonoBinds mbinds `thenNF_Tc` \ new_mbinds ->
209 returnNF_Tc (NonRecBind new_mbinds)
211 zonkBind (RecBind mbinds)
212 = zonkMonoBinds mbinds `thenNF_Tc` \ new_mbinds ->
213 returnNF_Tc (RecBind new_mbinds)
215 -------------------------------------------------------------------------
216 zonkMonoBinds :: TcMonoBinds s -> NF_TcM s TypecheckedMonoBinds
218 zonkMonoBinds EmptyMonoBinds = returnNF_Tc EmptyMonoBinds
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)
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)
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)
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)
241 %************************************************************************
243 \subsection[BackSubst-Match-GRHSs]{Match and GRHSsAndBinds}
245 %************************************************************************
248 zonkMatch :: TcMatch s -> NF_TcM s TypecheckedMatch
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)
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)
259 zonkMatch (SimpleMatch expr)
260 = zonkExpr expr `thenNF_Tc` \ new_expr ->
261 returnNF_Tc (SimpleMatch new_expr)
263 -------------------------------------------------------------------------
264 zonkGRHSsAndBinds :: TcGRHSsAndBinds s
265 -> NF_TcM s TypecheckedGRHSsAndBinds
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)
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)
278 zonk_grhs (OtherwiseGRHS expr locn)
279 = zonkExpr expr `thenNF_Tc` \ new_expr ->
280 returnNF_Tc (OtherwiseGRHS new_expr locn)
283 %************************************************************************
285 \subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr}
287 %************************************************************************
290 zonkExpr :: TcExpr s -> NF_TcM s TypecheckedHsExpr
292 zonkExpr (HsVar name)
293 = zonkId name `thenNF_Tc` \ new_name ->
294 returnNF_Tc (HsVar new_name)
296 zonkExpr (HsLit _) = panic "zonkExpr:HsLit"
298 zonkExpr (HsLitOut lit ty)
299 = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
300 returnNF_Tc (HsLitOut lit new_ty)
302 zonkExpr (HsLam match)
303 = zonkMatch match `thenNF_Tc` \ new_match ->
304 returnNF_Tc (HsLam new_match)
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)
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)
317 zonkExpr (NegApp _ _) = panic "zonkExpr:NegApp"
318 zonkExpr (HsPar _) = panic "zonkExpr:HsPar"
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)
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)
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)
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)
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)
346 zonkExpr (HsDo _ _) = panic "zonkExpr:HsDo"
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)
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)
359 zonkExpr (ExplicitList _) = panic "zonkExpr:ExplicitList"
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)
366 zonkExpr (ExplicitTuple exprs)
367 = mapNF_Tc zonkExpr exprs `thenNF_Tc` \ new_exprs ->
368 returnNF_Tc (ExplicitTuple new_exprs)
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)
375 zonkExpr (RecordUpd _ _) = panic "zonkExpr:RecordUpd"
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)
383 zonkExpr (ExprWithTySig _ _) = panic "zonkExpr:ExprWithTySig"
384 zonkExpr (ArithSeqIn _) = panic "zonkExpr:ArithSeqIn"
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)
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)
396 zonkExpr (HsSCC label expr)
397 = zonkExpr expr `thenNF_Tc` \ new_expr ->
398 returnNF_Tc (HsSCC label new_expr)
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)
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)
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)
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)
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)
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)
431 zonkExpr (SingleDict name)
432 = zonkId name `thenNF_Tc` \ new_name ->
433 returnNF_Tc (SingleDict new_name)
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)
440 -------------------------------------------------------------------------
441 zonkArithSeq :: TcArithSeqInfo s -> NF_TcM s TypecheckedArithSeqInfo
443 zonkArithSeq (From e)
444 = zonkExpr e `thenNF_Tc` \ new_e ->
445 returnNF_Tc (From new_e)
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)
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)
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)
463 -------------------------------------------------------------------------
464 zonkQuals :: [TcQual s] -> NF_TcM s [TypecheckedQual]
467 = mapNF_Tc zonk_qual quals
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)
474 zonk_qual (FilterQual expr)
475 = zonkExpr expr `thenNF_Tc` \ new_expr ->
476 returnNF_Tc (FilterQual new_expr)
478 zonk_qual (LetQual binds)
479 = zonkBinds binds `thenNF_Tc` \ new_binds ->
480 returnNF_Tc (LetQual new_binds)
482 -------------------------------------------------------------------------
483 zonkStmts :: [TcStmt s] -> NF_TcM s [TypecheckedStmt]
486 = mapNF_Tc zonk_stmt stmts
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)
493 zonk_stmt (ExprStmt expr src_loc)
494 = zonkExpr expr `thenNF_Tc` \ new_expr ->
495 returnNF_Tc (ExprStmt new_expr src_loc)
497 zonk_stmt (LetStmt binds)
498 = zonkBinds binds `thenNF_Tc` \ new_binds ->
499 returnNF_Tc (LetStmt new_binds)
501 -------------------------------------------------------------------------
502 zonkRbinds :: TcRecordBinds s -> NF_TcM s TypecheckedRecordBinds
505 = mapNF_Tc zonk_rbind rbinds
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)
513 %************************************************************************
515 \subsection[BackSubst-Pats]{Patterns}
517 %************************************************************************
520 zonkPat :: TcPat s -> NF_TcM s TypecheckedPat
523 = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
524 returnNF_Tc (WildPat new_ty)
527 = zonkId v `thenNF_Tc` \ new_v ->
528 returnNF_Tc (VarPat new_v)
530 zonkPat (LazyPat pat)
531 = zonkPat pat `thenNF_Tc` \ new_pat ->
532 returnNF_Tc (LazyPat new_pat)
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)
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)
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)
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)
555 zonkPat (TuplePat pats)
556 = mapNF_Tc zonkPat pats `thenNF_Tc` \ new_pats ->
557 returnNF_Tc (TuplePat new_pats)
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)
564 zonk_rpat (f, pat, pun)
565 = zonkPat pat `thenNF_Tc` \ new_pat ->
566 returnNF_Tc (f, new_pat, pun)
568 zonkPat (LitPat lit ty)
569 = zonkTcTypeToType ty `thenNF_Tc` \ new_ty ->
570 returnNF_Tc (LitPat lit new_ty)
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)
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)