2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[TcModule]{Typechecking a whole module}
8 typecheckModule, typecheckIface, typecheckStmt, TcResults(..)
11 #include "HsVersions.h"
13 import CmdLineOpts ( DynFlag(..), DynFlags, opt_PprStyle_Debug )
14 import HsSyn ( HsBinds(..), MonoBinds(..), HsDecl(..), HsExpr(..),
15 Stmt(..), InPat(..), HsMatchContext(..),
16 isIfaceRuleDecl, nullBinds, andMonoBindList, mkSimpleMatch
18 import HsTypes ( toHsType )
19 import PrelNames ( SyntaxMap, mAIN_Name, mainName, ioTyConName, printName,
20 returnIOName, bindIOName, failIOName,
23 import MkId ( unsafeCoerceId )
24 import RnHsSyn ( RenamedHsBinds, RenamedHsDecl, RenamedStmt )
25 import TcHsSyn ( TypecheckedMonoBinds, TypecheckedHsExpr,
26 TypecheckedForeignDecl, TypecheckedRuleDecl,
27 zonkTopBinds, zonkForeignExports, zonkRules, mkHsLet,
33 import TcType ( newTyVarTy, zonkTcType, tcInstType )
34 import TcMatches ( tcStmtsAndThen )
35 import TcUnify ( unifyTauTy )
36 import Inst ( emptyLIE, plusLIE )
37 import TcBinds ( tcTopBinds )
38 import TcClassDcl ( tcClassDecls2 )
39 import TcDefaults ( tcDefaults, defaultDefaultTys )
40 import TcEnv ( TcEnv, RecTcEnv, InstInfo, tcExtendGlobalValEnv, tcLookup_maybe,
41 isLocalThing, tcSetEnv, tcSetInstEnv, initTcEnv, getTcGEnv,
42 tcExtendGlobalTypeEnv, tcLookupGlobalId, tcLookupTyCon,
43 TcTyThing(..), tcLookupId
45 import TcRules ( tcIfaceRules, tcSourceRules )
46 import TcForeign ( tcForeignImports, tcForeignExports )
47 import TcIfaceSig ( tcInterfaceSigs )
48 import TcInstDcls ( tcInstDecls1, tcInstDecls2 )
49 import TcSimplify ( tcSimplifyTop )
50 import TcTyClsDecls ( tcTyAndClassDecls )
52 import CoreUnfold ( unfoldingTemplate, hasUnfolding )
53 import TysWiredIn ( mkListTy, unitTy )
54 import Type ( funResultTy, splitForAllTys,
55 liftedTypeKind, mkTyConApp, tidyType )
56 import ErrUtils ( printErrorsAndWarnings, errorsFound, dumpIfSet_dyn, showPass )
57 import Id ( Id, idType, idName, isLocalId, idUnfolding )
58 import Module ( Module, isHomeModule, moduleName )
59 import Name ( Name, toRdrName, isGlobalName )
60 import Name ( nameEnvElts, lookupNameEnv )
61 import TyCon ( tyConGenInfo )
63 import BasicTypes ( EP(..), Fixity, RecFlag(..) )
64 import SrcLoc ( noSrcLoc )
66 import HscTypes ( PersistentCompilerState(..), HomeSymbolTable,
67 PackageTypeEnv, ModIface(..),
68 TypeEnv, extendTypeEnvList,
69 TyThing(..), implicitTyThingIds,
72 import Rules ( ruleBaseIds )
77 %************************************************************************
79 \subsection{The stmt interface}
81 %************************************************************************
84 typecheckStmt :: DynFlags
85 -> PersistentCompilerState
87 -> TypeEnv -- The interactive context's type envt
88 -> PrintUnqualified -- For error printing
89 -> Module -- Is this really needed
90 -> [Name] -- Names bound by the Stmt (empty for expressions)
92 RenamedStmt, -- The stmt itself
93 [RenamedHsDecl]) -- Plus extra decls it sucked in from interface files
94 -> IO (Maybe (PersistentCompilerState, TypecheckedHsExpr, [Id]))
95 -- The returned [Name] is the same as the input except for
96 -- ExprStmt, in which case the returned [Name] is [itName]
98 typecheckStmt dflags pcs hst ic_type_env unqual this_mod names (syn_map, stmt, iface_decls)
99 = typecheck dflags syn_map pcs hst unqual $
101 -- use the default default settings, i.e. [Integer, Double]
102 tcSetDefaultTys defaultDefaultTys $
104 -- Typecheck the extra declarations
105 fixTc (\ ~(unf_env, _, _, _, _) ->
106 tcImports unf_env pcs hst get_fixity this_mod iface_decls
107 ) `thenTc` \ (env, new_pcs, local_inst_info, deriv_binds, local_rules) ->
108 ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )
111 tcExtendGlobalTypeEnv ic_type_env $
113 -- The real work is done here
114 tcUserStmt names stmt `thenTc` \ (expr, bound_ids) ->
116 traceTc (text "tcs 1") `thenNF_Tc_`
117 zonkExpr expr `thenNF_Tc` \ zonked_expr ->
118 mapNF_Tc zonkIdBndr bound_ids `thenNF_Tc` \ zonked_ids ->
120 ioToTc (dumpIfSet_dyn dflags Opt_D_dump_tc "Bound Ids" (vcat (map ppr zonked_ids))) `thenNF_Tc_`
121 ioToTc (dumpIfSet_dyn dflags Opt_D_dump_tc "Typechecked" (ppr zonked_expr)) `thenNF_Tc_`
123 returnTc (new_pcs, zonked_expr, zonked_ids)
126 get_fixity :: Name -> Maybe Fixity
127 get_fixity n = pprPanic "typecheckExpr" (ppr n)
130 Here is the grand plan, implemented in tcUserStmt
132 What you type The IO [HValue] that hscStmt returns
133 ------------- ------------------------------------
134 let pat = expr ==> let pat = expr in return [coerce HVal x, coerce HVal y, ...]
137 pat <- expr ==> expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
140 expr (of IO type) ==> expr >>= \ v -> return [v]
141 [NB: result not printed] bindings: [it]
144 expr (of non-IO type,
145 result showable) ==> let v = expr in print v >> return [v]
148 expr (of non-IO type,
149 result not showable) ==> error
153 tcUserStmt :: [Name] -> RenamedStmt -> TcM (TypecheckedHsExpr, [Id])
155 tcUserStmt names (ExprStmt expr loc)
156 = ASSERT( null names )
157 tryTc_ (traceTc (text "tcs 1b") `thenNF_Tc_`
158 tc_stmts [itName] [LetStmt (MonoBind the_bind [] NonRecursive),
159 ExprStmt (HsApp (HsVar printName) (HsVar itName)) loc])
160 ( traceTc (text "tcs 1a") `thenNF_Tc_`
161 tc_stmts [itName] [BindStmt (VarPatIn itName) expr loc])
163 the_bind = FunMonoBind itName False [mkSimpleMatch [] expr Nothing loc] loc
165 tcUserStmt names stmt
166 = tc_stmts names [stmt]
170 = tcLookupGlobalId returnIOName `thenNF_Tc` \ return_id ->
171 tcLookupGlobalId bindIOName `thenNF_Tc` \ bind_id ->
172 tcLookupGlobalId failIOName `thenNF_Tc` \ fail_id ->
173 tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
174 newTyVarTy liftedTypeKind `thenNF_Tc` \ res_ty ->
176 io_ty = (\ ty -> mkTyConApp ioTyCon [ty], res_ty)
178 -- mk_return builds the expression
179 -- returnIO @ [()] [coerce () x, .., coerce () z]
180 mk_return ids = HsApp (TyApp (HsVar return_id) [mkListTy unitTy])
181 (ExplicitListOut unitTy (map mk_item ids))
183 mk_item id = HsApp (TyApp (HsVar unsafeCoerceId) [idType id, unitTy])
187 traceTc (text "tcs 2") `thenNF_Tc_`
188 tcStmtsAndThen combine DoExpr io_ty stmts (
189 -- Look up the names right in the middle,
190 -- where they will all be in scope
191 mapNF_Tc tcLookupId names `thenNF_Tc` \ ids ->
192 returnTc ((ids, [ExprStmt (mk_return ids) noSrcLoc]), emptyLIE)
193 ) `thenTc` \ ((ids, tc_stmts), lie) ->
195 -- Simplify the context right here, so that we fail
196 -- if there aren't enough instances. Notably, when we see
198 -- we use tryTc_ to try it <- e
199 -- and then let it = e
200 -- It's the simplify step that rejects the first.
202 traceTc (text "tcs 3") `thenNF_Tc_`
203 tcSimplifyTop lie `thenTc` \ const_binds ->
204 traceTc (text "tcs 4") `thenNF_Tc_`
206 returnTc (mkHsLet const_binds $
207 HsDoOut DoExpr tc_stmts return_id bind_id fail_id
208 (mkTyConApp ioTyCon [mkListTy unitTy]) noSrcLoc,
211 combine stmt (ids, stmts) = (ids, stmt:stmts)
215 %************************************************************************
217 \subsection{Typechecking a module}
219 %************************************************************************
224 -> PersistentCompilerState
226 -> ModIface -- Iface for this module
227 -> PrintUnqualified -- For error printing
228 -> (SyntaxMap, [RenamedHsDecl])
229 -> IO (Maybe (PersistentCompilerState, TcResults))
230 -- The new PCS is Augmented with imported information,
231 -- (but not stuff from this module)
235 -- All these fields have info *just for this module*
236 tc_env :: TypeEnv, -- The top level TypeEnv
237 tc_binds :: TypecheckedMonoBinds, -- Bindings
238 tc_fords :: [TypecheckedForeignDecl], -- Foreign import & exports.
239 tc_rules :: [TypecheckedRuleDecl] -- Transformation rules
243 typecheckModule dflags pcs hst mod_iface unqual (syn_map, decls)
244 = do { maybe_tc_result <- typecheck dflags syn_map pcs hst unqual $
245 tcModule pcs hst get_fixity this_mod decls
246 ; printTcDump dflags maybe_tc_result
247 ; return maybe_tc_result }
249 this_mod = mi_module mod_iface
250 fixity_env = mi_fixities mod_iface
252 get_fixity :: Name -> Maybe Fixity
253 get_fixity nm = lookupNameEnv fixity_env nm
256 tcModule :: PersistentCompilerState
258 -> (Name -> Maybe Fixity)
261 -> TcM (PersistentCompilerState, TcResults)
263 tcModule pcs hst get_fixity this_mod decls
264 = fixTc (\ ~(unf_env, _, _) ->
265 -- Loop back the final environment, including the fully zonkec
266 -- versions of bindings from this module. In the presence of mutual
267 -- recursion, interface type signatures may mention variables defined
268 -- in this module, which is why the knot is so big
270 -- Type-check the type and class decls, and all imported decls
271 tcImports unf_env pcs hst get_fixity this_mod decls
272 `thenTc` \ (env, new_pcs, local_insts, deriv_binds, local_rules) ->
276 -- Foreign import declarations next
277 traceTc (text "Tc4") `thenNF_Tc_`
278 tcForeignImports decls `thenTc` \ (fo_ids, foi_decls) ->
279 tcExtendGlobalValEnv fo_ids $
281 -- Default declarations
282 tcDefaults decls `thenTc` \ defaulting_tys ->
283 tcSetDefaultTys defaulting_tys $
285 -- Value declarations next.
286 -- We also typecheck any extra binds that came out of the "deriving" process
287 traceTc (text "Default types" <+> ppr defaulting_tys) `thenNF_Tc_`
288 traceTc (text "Tc5") `thenNF_Tc_`
289 tcTopBinds (val_binds `ThenBinds` deriv_binds) `thenTc` \ ((val_binds, env), lie_valdecls) ->
291 -- Second pass over class and instance declarations,
292 -- plus rules and foreign exports, to generate bindings
294 tcInstDecls2 local_insts `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
295 tcClassDecls2 this_mod tycl_decls `thenNF_Tc` \ (lie_clasdecls, cls_dm_binds) ->
296 tcForeignExports decls `thenTc` \ (lie_fodecls, foe_binds, foe_decls) ->
297 tcSourceRules source_rules `thenNF_Tc` \ (lie_rules, more_local_rules) ->
299 -- Deal with constant or ambiguous InstIds. How could
300 -- there be ambiguous ones? They can only arise if a
301 -- top-level decl falls under the monomorphism
302 -- restriction, and no subsequent decl instantiates its
303 -- type. (Usually, ambiguous type variables are resolved
304 -- during the generalisation step.)
306 lie_alldecls = lie_valdecls `plusLIE`
307 lie_instdecls `plusLIE`
308 lie_clasdecls `plusLIE`
309 lie_fodecls `plusLIE`
312 traceTc (text "Tc6") `thenNF_Tc_`
313 tcSimplifyTop lie_alldecls `thenTc` \ const_inst_binds ->
315 -- CHECK THAT main IS DEFINED WITH RIGHT TYPE, IF REQUIRED
316 tcCheckMain this_mod `thenTc_`
318 -- Backsubstitution. This must be done last.
319 -- Even tcSimplifyTop may do some unification.
321 all_binds = val_binds `AndMonoBinds`
322 inst_binds `AndMonoBinds`
323 cls_dm_binds `AndMonoBinds`
324 const_inst_binds `AndMonoBinds`
327 traceTc (text "Tc7") `thenNF_Tc_`
328 zonkTopBinds all_binds `thenNF_Tc` \ (all_binds', final_env) ->
330 -- zonkTopBinds puts all the top-level Ids into the tcGEnv
331 traceTc (text "Tc8") `thenNF_Tc_`
332 zonkForeignExports foe_decls `thenNF_Tc` \ foe_decls' ->
333 traceTc (text "Tc9") `thenNF_Tc_`
334 zonkRules more_local_rules `thenNF_Tc` \ more_local_rules' ->
337 let local_things = filter (isLocalThing this_mod) (nameEnvElts (getTcGEnv final_env))
339 -- Create any necessary "implicit" bindings (data constructors etc)
340 -- Should we create bindings for dictionary constructors?
341 -- They are always fully applied, and the bindings are just there
342 -- to support partial applications. But it's easier to let them through.
343 implicit_binds = andMonoBindList [ CoreMonoBind id (unfoldingTemplate unf)
344 | id <- implicitTyThingIds local_things
345 , let unf = idUnfolding id
349 local_type_env :: TypeEnv
350 local_type_env = mkTypeEnv local_things
352 all_local_rules = local_rules ++ more_local_rules'
354 traceTc (text "Tc10") `thenNF_Tc_`
357 TcResults { tc_env = local_type_env,
358 tc_binds = implicit_binds `AndMonoBinds` all_binds',
359 tc_fords = foi_decls ++ foe_decls',
360 tc_rules = all_local_rules
363 ) `thenTc` \ (_, pcs, tc_result) ->
364 returnTc (pcs, tc_result)
366 tycl_decls = [d | TyClD d <- decls]
367 val_binds = foldr ThenBinds EmptyBinds [binds | ValD binds <- decls]
368 source_rules = [d | RuleD d <- decls, not (isIfaceRuleDecl d)]
372 %************************************************************************
374 \subsection{Typechecking interface decls}
376 %************************************************************************
381 -> PersistentCompilerState
383 -> ModIface -- Iface for this module (just module & fixities)
384 -> (SyntaxMap, [RenamedHsDecl])
385 -> IO (Maybe (PersistentCompilerState, TypeEnv, [TypecheckedRuleDecl]))
386 -- The new PCS is Augmented with imported information,
387 -- (but not stuff from this module).
388 -- The TcResults returned contains only the environment
392 typecheckIface dflags pcs hst mod_iface (syn_map, decls)
393 = do { maybe_tc_stuff <- typecheck dflags syn_map pcs hst alwaysQualify $
394 tcIfaceImports pcs hst get_fixity this_mod decls
395 ; printIfaceDump dflags maybe_tc_stuff
396 ; return maybe_tc_stuff }
398 this_mod = mi_module mod_iface
399 fixity_env = mi_fixities mod_iface
401 get_fixity :: Name -> Maybe Fixity
402 get_fixity nm = lookupNameEnv fixity_env nm
404 tcIfaceImports pcs hst get_fixity this_mod decls
405 = fixTc (\ ~(unf_env, _, _, _, _) ->
406 tcImports unf_env pcs hst get_fixity this_mod decls
407 ) `thenTc` \ (env, new_pcs, local_inst_info,
408 deriv_binds, local_rules) ->
409 ASSERT(nullBinds deriv_binds)
411 local_things = filter (isLocalThing this_mod)
412 (nameEnvElts (getTcGEnv env))
413 local_type_env :: TypeEnv
414 local_type_env = mkTypeEnv local_things
417 -- throw away local_inst_info
418 returnTc (new_pcs, local_type_env, local_rules)
421 tcImports :: RecTcEnv
422 -> PersistentCompilerState
424 -> (Name -> Maybe Fixity)
427 -> TcM (TcEnv, PersistentCompilerState, [InstInfo],
428 RenamedHsBinds, [TypecheckedRuleDecl])
430 -- tcImports is a slight mis-nomer.
431 -- It deals with everythign that could be an import:
432 -- type and class decls
433 -- interface signatures
436 -- These can occur in source code too, of course
438 tcImports unf_env pcs hst get_fixity this_mod decls
439 -- (unf_env :: RecTcEnv) is used for type-checking interface pragmas
440 -- which is done lazily [ie failure just drops the pragma
441 -- without having any global-failure effect].
443 -- unf_env is also used to get the pragama info
444 -- for imported dfuns and default methods
447 -- tcImports recovers internally, but if anything gave rise to
448 -- an error we'd better stop now, to avoid a cascade
450 traceTc (text "Tc1") `thenNF_Tc_`
451 tcTyAndClassDecls unf_env tycl_decls `thenTc` \ env ->
454 -- Typecheck the instance decls, includes deriving
455 traceTc (text "Tc2") `thenNF_Tc_`
456 tcInstDecls1 (pcs_insts pcs) (pcs_PRS pcs)
457 hst unf_env get_fixity this_mod
458 decls `thenTc` \ (new_pcs_insts, inst_env, local_insts, deriv_binds) ->
459 tcSetInstEnv inst_env $
461 -- Interface type signatures
462 -- We tie a knot so that the Ids read out of interfaces are in scope
463 -- when we read their pragmas.
464 -- What we rely on is that pragmas are typechecked lazily; if
465 -- any type errors are found (ie there's an inconsistency)
466 -- we silently discard the pragma
467 traceTc (text "Tc3") `thenNF_Tc_`
468 tcInterfaceSigs unf_env this_mod tycl_decls `thenTc` \ sig_ids ->
469 tcExtendGlobalValEnv sig_ids $
472 tcIfaceRules (pcs_rules pcs) this_mod iface_rules `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
473 -- When relinking this module from its interface-file decls
474 -- we'll have IfaceRules that are in fact local to this module
475 -- That's the reason we we get any local_rules out here
477 tcGetEnv `thenTc` \ unf_env ->
479 all_things = nameEnvElts (getTcGEnv unf_env)
481 -- sometimes we're compiling in the context of a package module
482 -- (on the GHCi command line, for example). In this case, we
483 -- want to treat everything we pulled in as an imported thing.
485 | isHomeModule this_mod
486 = filter (not . isLocalThing this_mod) all_things
490 new_pte :: PackageTypeEnv
491 new_pte = extendTypeEnvList (pcs_PTE pcs) imported_things
493 new_pcs :: PersistentCompilerState
494 new_pcs = pcs { pcs_PTE = new_pte,
495 pcs_insts = new_pcs_insts,
496 pcs_rules = new_pcs_rules
499 returnTc (unf_env, new_pcs, local_insts, deriv_binds, local_rules)
501 tycl_decls = [d | TyClD d <- decls]
502 iface_rules = [d | RuleD d <- decls, isIfaceRuleDecl d]
506 %************************************************************************
508 \subsection{Checking the type of main}
510 %************************************************************************
512 We must check that in module Main,
514 b) main :: forall a1...an. IO t, for some type t
518 then the type of main will be
520 and that should pass the test too.
522 So we just instantiate the type and unify with IO t, and declare
523 victory if doing so succeeds.
526 tcCheckMain :: Module -> TcM ()
528 | not (moduleName this_mod == mAIN_Name )
532 = -- First unify the main_id with IO t, for any old t
533 tcLookup_maybe mainName `thenNF_Tc` \ maybe_thing ->
535 Just (ATcId main_id) -> check_main_ty (idType main_id)
536 other -> addErrTc noMainErr
538 check_main_ty main_ty
539 = tcInstType main_ty `thenNF_Tc` \ (tvs, theta, main_tau) ->
540 newTyVarTy liftedTypeKind `thenNF_Tc` \ arg_ty ->
541 tcLookupTyCon ioTyConName `thenNF_Tc` \ ioTyCon ->
542 tcAddErrCtxtM (mainTypeCtxt main_ty) $
543 if not (null theta) then
544 failWithTc empty -- Context has the error message
546 unifyTauTy main_tau (mkTyConApp ioTyCon [arg_ty])
548 mainTypeCtxt main_ty tidy_env
549 = zonkTcType main_ty `thenNF_Tc` \ main_ty' ->
550 returnNF_Tc (tidy_env, ptext SLIT("`main' has the illegal type") <+>
551 quotes (ppr (tidyType tidy_env main_ty')))
553 noMainErr = hsep [ptext SLIT("Module") <+> quotes (ppr mAIN_Name),
554 ptext SLIT("must include a definition for") <+> quotes (ptext SLIT("main"))]
558 %************************************************************************
560 \subsection{Interfacing the Tc monad to the IO monad}
562 %************************************************************************
565 typecheck :: DynFlags
567 -> PersistentCompilerState
569 -> PrintUnqualified -- For error printing
573 typecheck dflags syn_map pcs hst unqual thing_inside
574 = do { showPass dflags "Typechecker";
575 ; env <- initTcEnv syn_map hst (pcs_PTE pcs)
577 ; (maybe_tc_result, errs) <- initTc dflags env thing_inside
579 ; printErrorsAndWarnings unqual errs
581 ; if errorsFound errs then
584 return maybe_tc_result
589 %************************************************************************
591 \subsection{Dumping output}
593 %************************************************************************
596 printTcDump dflags Nothing = return ()
597 printTcDump dflags (Just (_, results))
598 = do dumpIfSet_dyn dflags Opt_D_dump_types
599 "Type signatures" (dump_sigs (tc_env results))
600 dumpIfSet_dyn dflags Opt_D_dump_tc
601 "Typechecked" (dump_tc results)
603 printIfaceDump dflags Nothing = return ()
604 printIfaceDump dflags (Just (_, env, rules))
605 = do dumpIfSet_dyn dflags Opt_D_dump_types
606 "Type signatures" (dump_sigs env)
607 dumpIfSet_dyn dflags Opt_D_dump_tc
608 "Typechecked" (dump_iface env rules)
611 = vcat [ppr (tc_binds results),
612 pp_rules (tc_rules results),
613 ppr_gen_tycons [tc | ATyCon tc <- nameEnvElts (tc_env results)]
617 = vcat [pp_rules rules,
618 ppr_gen_tycons [tc | ATyCon tc <- nameEnvElts env]
621 dump_sigs env -- Print type signatures
622 = -- Convert to HsType so that we get source-language style printing
623 -- And sort by RdrName
624 vcat $ map ppr_sig $ sortLt lt_sig $
625 [ (toRdrName id, toHsType (idType id))
626 | AnId id <- nameEnvElts env,
630 lt_sig (n1,_) (n2,_) = n1 < n2
631 ppr_sig (n,t) = ppr n <+> dcolon <+> ppr t
633 want_sig id | opt_PprStyle_Debug = True
634 | otherwise = isLocalId id && isGlobalName (idName id)
635 -- isLocalId ignores data constructors, records selectors etc
636 -- The isGlobalName ignores local dictionary and method bindings
637 -- that the type checker has invented. User-defined things have
640 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
641 vcat (map ppr_gen_tycon tcs),
645 -- x&y are now Id's, not CoreExpr's
647 | Just ep <- tyConGenInfo tycon
648 = (ppr tycon <> colon) $$ nest 4 (ppr_ep ep)
650 | otherwise = ppr tycon <> colon <+> ptext SLIT("Not derivable")
653 = vcat [ ptext SLIT("Rep type:") <+> ppr (funResultTy from_tau),
654 ptext SLIT("From:") <+> ppr (unfoldingTemplate (idUnfolding from)),
655 ptext SLIT("To:") <+> ppr (unfoldingTemplate (idUnfolding to))
658 (_,from_tau) = splitForAllTys (idType from)
661 pp_rules rs = vcat [ptext SLIT("{-# RULES"),
662 nest 4 (vcat (map ppr rs)),