ghc/compiler/typecheck/TcModule.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[TcModule]{Typechecking a whole module}
   5
   6 \begin{code}
   7 module TcModule (
   8         typecheckModule, typecheckIface, typecheckExpr, TcResults(..)
   9     ) where
  10
  11 #include "HsVersions.h"
  12
  13 import CmdLineOpts      ( DynFlag(..), DynFlags, opt_PprStyle_Debug )
  14 import HsSyn            ( HsBinds(..), MonoBinds(..), HsDecl(..), HsExpr(..),
  15                           isIfaceRuleDecl, nullBinds, andMonoBindList
  16                         )
  17 import HsTypes          ( toHsType )
  18 import PrelNames        ( SyntaxMap, mAIN_Name, mainName, ioTyConName, printName )
  19 import RnHsSyn          ( RenamedHsBinds, RenamedHsDecl, RenamedHsExpr )
  20 import TcHsSyn          ( TypecheckedMonoBinds, TypecheckedHsExpr,
  21                           TypecheckedForeignDecl, TypecheckedRuleDecl,
  22                           zonkTopBinds, zonkForeignExports, zonkRules, mkHsLet,
  23                           zonkExpr
  24                         )
  25
  26
  27 import TcMonad
  28 import TcType           ( newTyVarTy, zonkTcType, tcInstType )
  29 import TcUnify          ( unifyTauTy )
  30 import Inst             ( plusLIE )
  31 import VarSet           ( varSetElems )
  32 import TcBinds          ( tcTopBinds )
  33 import TcClassDcl       ( tcClassDecls2 )
  34 import TcDefaults       ( tcDefaults, defaultDefaultTys )
  35 import TcExpr           ( tcMonoExpr )
  36 import TcEnv            ( TcEnv, RecTcEnv, InstInfo, tcExtendGlobalValEnv, tcLookup_maybe,
  37                           isLocalThing, tcSetEnv, tcSetInstEnv, initTcEnv, getTcGEnv,
  38                           TcTyThing(..), tcLookupTyCon
  39                         )
  40 import TcRules          ( tcIfaceRules, tcSourceRules )
  41 import TcForeign        ( tcForeignImports, tcForeignExports )
  42 import TcIfaceSig       ( tcInterfaceSigs )
  43 import TcInstDcls       ( tcInstDecls1, tcInstDecls2 )
  44 import TcSimplify       ( tcSimplifyTop, tcSimplifyInfer )
  45 import TcTyClsDecls     ( tcTyAndClassDecls )
  46
  47 import CoreUnfold       ( unfoldingTemplate, hasUnfolding )
  48 import Type             ( funResultTy, splitForAllTys, mkForAllTys, mkFunTys,
  49                           liftedTypeKind, openTypeKind, mkTyConApp, tyVarsOfType, tidyType )
  50 import ErrUtils         ( printErrorsAndWarnings, errorsFound, dumpIfSet_dyn, showPass )
  51 import Id               ( idType, idName, isLocalId, idUnfolding )
  52 import Module           ( Module, isHomeModule, moduleName )
  53 import Name             ( Name, toRdrName, isGlobalName )
  54 import Name             ( nameEnvElts, lookupNameEnv )
  55 import TyCon            ( tyConGenInfo )
  56 import Util
  57 import BasicTypes       ( EP(..), Fixity )
  58 import Outputable
  59 import HscTypes         ( PersistentCompilerState(..), HomeSymbolTable,
  60                           PackageTypeEnv, ModIface(..),
  61                           TypeEnv, extendTypeEnvList,
  62                           TyThing(..), implicitTyThingIds,
  63                           mkTypeEnv
  64                         )
  65 \end{code}
  66
  67 Outside-world interface:
  68 \begin{code}
  69
  70 -- Convenient type synonyms first:
  71 data TcResults
  72   = TcResults {
  73         -- All these fields have info *just for this module*
  74         tc_env     :: TypeEnv,                  -- The top level TypeEnv
  75         tc_binds   :: TypecheckedMonoBinds,     -- Bindings
  76         tc_fords   :: [TypecheckedForeignDecl], -- Foreign import & exports.
  77         tc_rules   :: [TypecheckedRuleDecl]     -- Transformation rules
  78     }
  79
  80 ---------------
  81 typecheckModule
  82         :: DynFlags
  83         -> PersistentCompilerState
  84         -> HomeSymbolTable
  85         -> ModIface             -- Iface for this module (just module & fixities)
  86         -> PrintUnqualified     -- For error printing
  87         -> (SyntaxMap, [RenamedHsDecl])
  88         -> IO (Maybe (PersistentCompilerState, TcResults))
  89                         -- The new PCS is Augmented with imported information,
  90                                                 -- (but not stuff from this module)
  91
  92
  93 typecheckModule dflags pcs hst mod_iface unqual (syn_map, decls)
  94   = do  { maybe_tc_result <- typecheck dflags syn_map pcs hst unqual $
  95                              tcModule pcs hst get_fixity this_mod decls
  96         ; printTcDump dflags maybe_tc_result
  97         ; return maybe_tc_result }
  98   where
  99     this_mod   = mi_module   mod_iface
 100     fixity_env = mi_fixities mod_iface
 101
 102     get_fixity :: Name -> Maybe Fixity
 103     get_fixity nm = lookupNameEnv fixity_env nm
 104
 105 ---------------
 106 typecheckIface
 107         :: DynFlags
 108         -> PersistentCompilerState
 109         -> HomeSymbolTable
 110         -> ModIface             -- Iface for this module (just module & fixities)
 111         -> (SyntaxMap, [RenamedHsDecl])
 112         -> IO (Maybe (PersistentCompilerState, TypeEnv, [TypecheckedRuleDecl]))
 113                         -- The new PCS is Augmented with imported information,
 114                         -- (but not stuff from this module).
 115                         -- The TcResults returned contains only the environment
 116                         -- and rules.
 117
 118
 119 typecheckIface dflags pcs hst mod_iface (syn_map, decls)
 120   = do  { maybe_tc_stuff <- typecheck dflags syn_map pcs hst alwaysQualify $
 121                             tcIfaceImports pcs hst get_fixity this_mod decls
 122         ; printIfaceDump dflags maybe_tc_stuff
 123         ; return maybe_tc_stuff }
 124   where
 125     this_mod   = mi_module   mod_iface
 126     fixity_env = mi_fixities mod_iface
 127
 128     get_fixity :: Name -> Maybe Fixity
 129     get_fixity nm = lookupNameEnv fixity_env nm
 130
 131     tcIfaceImports pcs hst get_fixity this_mod decls
 132         = fixTc (\ ~(unf_env, _, _, _, _) ->
 133               tcImports unf_env pcs hst get_fixity this_mod decls
 134           )     `thenTc` \ (env, new_pcs, local_inst_info,
 135                             deriv_binds, local_rules) ->
 136           ASSERT(nullBinds deriv_binds)
 137           let
 138               local_things = filter (isLocalThing this_mod)
 139                                         (nameEnvElts (getTcGEnv env))
 140               local_type_env :: TypeEnv
 141               local_type_env = mkTypeEnv local_things
 142           in
 143
 144           -- throw away local_inst_info
 145           returnTc (new_pcs, local_type_env, local_rules)
 146
 147 ---------------
 148 typecheckExpr :: DynFlags
 149               -> Bool                   -- True <=> wrap in 'print' to get a result of IO type
 150               -> PersistentCompilerState
 151               -> HomeSymbolTable
 152               -> PrintUnqualified       -- For error printing
 153               -> Module
 154               -> (SyntaxMap,
 155                   RenamedHsExpr,        -- The expression itself
 156                   [RenamedHsDecl])      -- Plus extra decls it sucked in from interface files
 157               -> IO (Maybe (PersistentCompilerState, TypecheckedHsExpr, TcType))
 158
 159 typecheckExpr dflags wrap_io pcs hst unqual this_mod (syn_map, expr, decls)
 160   = typecheck dflags syn_map pcs hst unqual $
 161
 162          -- use the default default settings, i.e. [Integer, Double]
 163     tcSetDefaultTys defaultDefaultTys $
 164
 165         -- Typecheck the extra declarations
 166     fixTc (\ ~(unf_env, _, _, _, _) ->
 167         tcImports unf_env pcs hst get_fixity this_mod decls
 168     )                   `thenTc` \ (env, new_pcs, local_inst_info, deriv_binds, local_rules) ->
 169     ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )
 170
 171         -- Now typecheck the expression
 172     tcSetEnv env                                $
 173     tc_expr expr                                        `thenTc` \ (expr', expr_ty) ->
 174     zonkExpr expr'                                      `thenNF_Tc` \ zonked_expr ->
 175     zonkTcType expr_ty                                  `thenNF_Tc` \ zonked_ty ->
 176     ioToTc (dumpIfSet_dyn dflags
 177                 Opt_D_dump_tc "Typechecked" (ppr zonked_expr)) `thenNF_Tc_`
 178     returnTc (new_pcs, zonked_expr, zonked_ty)
 179
 180   where
 181     get_fixity :: Name -> Maybe Fixity
 182     get_fixity n = pprPanic "typecheckExpr" (ppr n)
 183
 184     smpl_doc = ptext SLIT("main expression")
 185
 186         -- Typecheck it, wrapping in 'print' if necessary to
 187         -- get a result of type IO t.  Returns the result type
 188         -- that is free in the result type
 189     tc_expr e
 190         | wrap_io   = tryTc_ (tc_io_expr (HsApp (HsVar printName) e))   -- Recovery case
 191                              (tc_io_expr e)                             -- Main case
 192         | otherwise = newTyVarTy openTypeKind   `thenTc` \ ty ->
 193                       tcMonoExpr e ty           `thenTc` \ (e', lie) ->
 194                       tcSimplifyInfer smpl_doc (varSetElems (tyVarsOfType ty)) lie
 195                                 `thenTc` \ (qtvs, lie_free, dict_binds, dict_ids) ->
 196                       tcSimplifyTop lie_free    `thenTc` \ const_binds ->
 197                       let all_expr = mkHsLet const_binds        $
 198                                      TyLam qtvs                 $
 199                                      DictLam dict_ids           $
 200                                      mkHsLet dict_binds         $
 201                                      e'
 202                           all_expr_ty = mkForAllTys qtvs        $
 203                                         mkFunTys (map idType dict_ids) $
 204                                         ty
 205                       in
 206                       returnTc (all_expr, all_expr_ty)
 207         where
 208           tc_io_expr e = newTyVarTy openTypeKind        `thenTc` \ ty ->
 209                          tcLookupTyCon ioTyConName      `thenNF_Tc` \ ioTyCon ->
 210                          let
 211                             res_ty = mkTyConApp ioTyCon [ty]
 212                          in
 213                          tcMonoExpr e res_ty    `thenTc` \ (e', lie) ->
 214                          tcSimplifyTop lie      `thenTc` \ const_binds ->
 215                          let all_expr = mkHsLet const_binds e' in
 216                          returnTc (all_expr, res_ty)
 217
 218 ---------------
 219 typecheck :: DynFlags
 220           -> SyntaxMap
 221           -> PersistentCompilerState
 222           -> HomeSymbolTable
 223           -> PrintUnqualified   -- For error printing
 224           -> TcM r
 225           -> IO (Maybe r)
 226
 227 typecheck dflags syn_map pcs hst unqual thing_inside
 228  = do   { showPass dflags "Typechecker";
 229         ; env <- initTcEnv syn_map hst (pcs_PTE pcs)
 230
 231         ; (maybe_tc_result, errs) <- initTc dflags env thing_inside
 232
 233         ; printErrorsAndWarnings unqual errs
 234
 235         ; if errorsFound errs then
 236              return Nothing
 237            else
 238              return maybe_tc_result
 239         }
 240 \end{code}
 241
 242 The internal monster:
 243 \begin{code}
 244 tcModule :: PersistentCompilerState
 245          -> HomeSymbolTable
 246          -> (Name -> Maybe Fixity)
 247          -> Module
 248          -> [RenamedHsDecl]
 249          -> TcM (PersistentCompilerState, TcResults)
 250
 251 tcModule pcs hst get_fixity this_mod decls
 252   = fixTc (\ ~(unf_env, _, _) ->
 253                 -- Loop back the final environment, including the fully zonkec
 254                 -- versions of bindings from this module.  In the presence of mutual
 255                 -- recursion, interface type signatures may mention variables defined
 256                 -- in this module, which is why the knot is so big
 257
 258                 -- Type-check the type and class decls, and all imported decls
 259         tcImports unf_env pcs hst get_fixity this_mod decls
 260                                 `thenTc` \ (env, new_pcs, local_insts, deriv_binds, local_rules) ->
 261
 262         tcSetEnv env                            $
 263
 264         -- Foreign import declarations next
 265         traceTc (text "Tc4")                    `thenNF_Tc_`
 266         tcForeignImports decls                  `thenTc`    \ (fo_ids, foi_decls) ->
 267         tcExtendGlobalValEnv fo_ids             $
 268
 269         -- Default declarations
 270         tcDefaults decls                        `thenTc` \ defaulting_tys ->
 271         tcSetDefaultTys defaulting_tys          $
 272
 273         -- Value declarations next.
 274         -- We also typecheck any extra binds that came out of the "deriving" process
 275         traceTc (text "Default types" <+> ppr defaulting_tys)   `thenNF_Tc_`
 276         traceTc (text "Tc5")                            `thenNF_Tc_`
 277         tcTopBinds (val_binds `ThenBinds` deriv_binds)  `thenTc` \ ((val_binds, env), lie_valdecls) ->
 278
 279         -- Second pass over class and instance declarations,
 280         -- plus rules and foreign exports, to generate bindings
 281         tcSetEnv env                            $
 282         tcInstDecls2  local_insts               `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
 283         tcClassDecls2 this_mod tycl_decls       `thenNF_Tc` \ (lie_clasdecls, cls_dm_binds) ->
 284         tcForeignExports decls                  `thenTc`    \ (lie_fodecls,   foe_binds, foe_decls) ->
 285         tcSourceRules source_rules              `thenNF_Tc` \ (lie_rules,     more_local_rules) ->
 286
 287              -- Deal with constant or ambiguous InstIds.  How could
 288              -- there be ambiguous ones?  They can only arise if a
 289              -- top-level decl falls under the monomorphism
 290              -- restriction, and no subsequent decl instantiates its
 291              -- type.  (Usually, ambiguous type variables are resolved
 292              -- during the generalisation step.)
 293         let
 294             lie_alldecls = lie_valdecls  `plusLIE`
 295                            lie_instdecls `plusLIE`
 296                            lie_clasdecls `plusLIE`
 297                            lie_fodecls   `plusLIE`
 298                            lie_rules
 299         in
 300         traceTc (text "Tc6")                            `thenNF_Tc_`
 301         tcSimplifyTop lie_alldecls                      `thenTc` \ const_inst_binds ->
 302
 303                 -- CHECK THAT main IS DEFINED WITH RIGHT TYPE, IF REQUIRED
 304         tcCheckMain this_mod            `thenTc_`
 305
 306             -- Backsubstitution.    This must be done last.
 307             -- Even tcSimplifyTop may do some unification.
 308         let
 309             all_binds = val_binds               `AndMonoBinds`
 310                             inst_binds          `AndMonoBinds`
 311                             cls_dm_binds        `AndMonoBinds`
 312                             const_inst_binds    `AndMonoBinds`
 313                             foe_binds
 314         in
 315         traceTc (text "Tc7")            `thenNF_Tc_`
 316         zonkTopBinds all_binds          `thenNF_Tc` \ (all_binds', final_env)  ->
 317         tcSetEnv final_env              $
 318                 -- zonkTopBinds puts all the top-level Ids into the tcGEnv
 319         traceTc (text "Tc8")            `thenNF_Tc_`
 320         zonkForeignExports foe_decls    `thenNF_Tc` \ foe_decls' ->
 321         traceTc (text "Tc9")            `thenNF_Tc_`
 322         zonkRules more_local_rules      `thenNF_Tc` \ more_local_rules' ->
 323
 324
 325         let     local_things = filter (isLocalThing this_mod) (nameEnvElts (getTcGEnv final_env))
 326
 327                 -- Create any necessary "implicit" bindings (data constructors etc)
 328                 -- Should we create bindings for dictionary constructors?
 329                 -- They are always fully applied, and the bindings are just there
 330                 -- to support partial applications. But it's easier to let them through.
 331                 implicit_binds = andMonoBindList [ CoreMonoBind id (unfoldingTemplate unf)
 332                                                  | id <- implicitTyThingIds local_things
 333                                                  , let unf = idUnfolding id
 334                                                  , hasUnfolding unf
 335                                                  ]
 336
 337                 local_type_env :: TypeEnv
 338                 local_type_env = mkTypeEnv local_things
 339
 340                 all_local_rules = local_rules ++ more_local_rules'
 341         in
 342         traceTc (text "Tc10")           `thenNF_Tc_`
 343         returnTc (final_env,
 344                   new_pcs,
 345                   TcResults { tc_env     = local_type_env,
 346                               tc_binds   = implicit_binds `AndMonoBinds` all_binds',
 347                               tc_fords   = foi_decls ++ foe_decls',
 348                               tc_rules   = all_local_rules
 349                             }
 350         )
 351     )                   `thenTc` \ (_, pcs, tc_result) ->
 352     returnTc (pcs, tc_result)
 353   where
 354     tycl_decls   = [d | TyClD d <- decls]
 355     val_binds    = foldr ThenBinds EmptyBinds [binds | ValD binds <- decls]
 356     source_rules = [d | RuleD d <- decls, not (isIfaceRuleDecl d)]
 357 \end{code}
 358
 359
 360 \begin{code}
 361 tcImports :: RecTcEnv
 362           -> PersistentCompilerState
 363           -> HomeSymbolTable
 364           -> (Name -> Maybe Fixity)
 365           -> Module
 366           -> [RenamedHsDecl]
 367           -> TcM (TcEnv, PersistentCompilerState, [InstInfo],
 368                          RenamedHsBinds, [TypecheckedRuleDecl])
 369
 370 -- tcImports is a slight mis-nomer.
 371 -- It deals with everythign that could be an import:
 372 --      type and class decls
 373 --      interface signatures
 374 --      instance decls
 375 --      rule decls
 376 -- These can occur in source code too, of course
 377
 378 tcImports unf_env pcs hst get_fixity this_mod decls
 379           -- (unf_env :: RecTcEnv) is used for type-checking interface pragmas
 380           -- which is done lazily [ie failure just drops the pragma
 381           -- without having any global-failure effect].
 382           --
 383           -- unf_env is also used to get the pragama info
 384           -- for imported dfuns and default methods
 385
 386   = checkNoErrsTc $
 387         -- tcImports recovers internally, but if anything gave rise to
 388         -- an error we'd better stop now, to avoid a cascade
 389
 390     traceTc (text "Tc1")                        `thenNF_Tc_`
 391     tcTyAndClassDecls unf_env tycl_decls        `thenTc` \ env ->
 392     tcSetEnv env                                $
 393
 394         -- Typecheck the instance decls, includes deriving
 395     traceTc (text "Tc2")        `thenNF_Tc_`
 396     tcInstDecls1 (pcs_insts pcs) (pcs_PRS pcs)
 397              hst unf_env get_fixity this_mod
 398              decls                      `thenTc` \ (new_pcs_insts, inst_env, local_insts, deriv_binds) ->
 399     tcSetInstEnv inst_env                       $
 400
 401     -- Interface type signatures
 402     -- We tie a knot so that the Ids read out of interfaces are in scope
 403     --   when we read their pragmas.
 404     -- What we rely on is that pragmas are typechecked lazily; if
 405     --   any type errors are found (ie there's an inconsistency)
 406     --   we silently discard the pragma
 407     traceTc (text "Tc3")                        `thenNF_Tc_`
 408     tcInterfaceSigs unf_env tycl_decls          `thenTc` \ sig_ids ->
 409     tcExtendGlobalValEnv sig_ids                $
 410
 411
 412     tcIfaceRules (pcs_rules pcs) this_mod iface_rules   `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
 413         -- When relinking this module from its interface-file decls
 414         -- we'll have IfaceRules that are in fact local to this module
 415         -- That's the reason we we get any local_rules out here
 416
 417     tcGetEnv                                            `thenTc` \ unf_env ->
 418     let
 419         all_things = nameEnvElts (getTcGEnv unf_env)
 420
 421          -- sometimes we're compiling in the context of a package module
 422          -- (on the GHCi command line, for example).  In this case, we
 423          -- want to treat everything we pulled in as an imported thing.
 424         imported_things
 425           | isHomeModule this_mod
 426           = filter (not . isLocalThing this_mod) all_things
 427           | otherwise
 428           = all_things
 429
 430         new_pte :: PackageTypeEnv
 431         new_pte = extendTypeEnvList (pcs_PTE pcs) imported_things
 432
 433         new_pcs :: PersistentCompilerState
 434         new_pcs = pcs { pcs_PTE   = new_pte,
 435                         pcs_insts = new_pcs_insts,
 436                         pcs_rules = new_pcs_rules
 437                   }
 438     in
 439     returnTc (unf_env, new_pcs, local_insts, deriv_binds, local_rules)
 440   where
 441     tycl_decls  = [d | TyClD d <- decls]
 442     iface_rules = [d | RuleD d <- decls, isIfaceRuleDecl d]
 443 \end{code}
 444
 445 %************************************************************************
 446 %*                                                                      *
 447 \subsection{Checking the type of main}
 448 %*                                                                      *
 449 %************************************************************************
 450
 451 We must check that in module Main,
 452         a) main is defined
 453         b) main :: forall a1...an. IO t,  for some type t
 454
 455 If we have
 456         main = error "Urk"
 457 then the type of main will be
 458         main :: forall a. a
 459 and that should pass the test too.
 460
 461 So we just instantiate the type and unify with IO t, and declare
 462 victory if doing so succeeds.
 463
 464 \begin{code}
 465 tcCheckMain :: Module -> TcM ()
 466 tcCheckMain this_mod
 467   | not (moduleName this_mod == mAIN_Name )
 468   = returnTc ()
 469
 470   | otherwise
 471   =     -- First unify the main_id with IO t, for any old t
 472     tcLookup_maybe mainName             `thenNF_Tc` \ maybe_thing ->
 473     case maybe_thing of
 474         Just (ATcId main_id) -> check_main_ty (idType main_id)
 475         other                -> addErrTc noMainErr
 476   where
 477     check_main_ty main_ty
 478       = tcInstType main_ty              `thenNF_Tc` \ (tvs, theta, main_tau) ->
 479         newTyVarTy liftedTypeKind       `thenNF_Tc` \ arg_ty ->
 480         tcLookupTyCon ioTyConName       `thenNF_Tc` \ ioTyCon ->
 481         tcAddErrCtxtM (mainTypeCtxt main_ty)    $
 482         if not (null theta) then
 483                 failWithTc empty        -- Context has the error message
 484         else
 485         unifyTauTy main_tau (mkTyConApp ioTyCon [arg_ty])
 486
 487 mainTypeCtxt main_ty tidy_env
 488   = zonkTcType main_ty          `thenNF_Tc` \ main_ty' ->
 489     returnNF_Tc (tidy_env, ptext SLIT("`main' has the illegal type") <+>
 490                                  quotes (ppr (tidyType tidy_env main_ty')))
 491
 492 noMainErr = hsep [ptext SLIT("Module") <+> quotes (ppr mAIN_Name),
 493                   ptext SLIT("must include a definition for") <+> quotes (ptext SLIT("main"))]
 494 \end{code}
 495
 496
 497 %************************************************************************
 498 %*                                                                      *
 499 \subsection{Dumping output}
 500 %*                                                                      *
 501 %************************************************************************
 502
 503 \begin{code}
 504 printTcDump dflags Nothing = return ()
 505 printTcDump dflags (Just (_, results))
 506   = do dumpIfSet_dyn dflags Opt_D_dump_types
 507                      "Type signatures" (dump_sigs (tc_env results))
 508        dumpIfSet_dyn dflags Opt_D_dump_tc
 509                      "Typechecked" (dump_tc results)
 510
 511 printIfaceDump dflags Nothing = return ()
 512 printIfaceDump dflags (Just (_, env, rules))
 513   = do dumpIfSet_dyn dflags Opt_D_dump_types
 514                      "Type signatures" (dump_sigs env)
 515        dumpIfSet_dyn dflags Opt_D_dump_tc
 516                      "Typechecked" (dump_iface env rules)
 517
 518 dump_tc results
 519   = vcat [ppr (tc_binds results),
 520           pp_rules (tc_rules results),
 521           ppr_gen_tycons [tc | ATyCon tc <- nameEnvElts (tc_env results)]
 522     ]
 523
 524 dump_iface env rules
 525   = vcat [pp_rules rules,
 526           ppr_gen_tycons [tc | ATyCon tc <- nameEnvElts env]
 527     ]
 528
 529 dump_sigs env   -- Print type signatures
 530   =     -- Convert to HsType so that we get source-language style printing
 531         -- And sort by RdrName
 532     vcat $ map ppr_sig $ sortLt lt_sig $
 533     [ (toRdrName id, toHsType (idType id))
 534     | AnId id <- nameEnvElts env,
 535       want_sig id
 536     ]
 537   where
 538     lt_sig (n1,_) (n2,_) = n1 < n2
 539     ppr_sig (n,t)        = ppr n <+> dcolon <+> ppr t
 540
 541     want_sig id | opt_PprStyle_Debug = True
 542                 | otherwise          = isLocalId id && isGlobalName (idName id)
 543         -- isLocalId ignores data constructors, records selectors etc
 544         -- The isGlobalName ignores local dictionary and method bindings
 545         -- that the type checker has invented.  User-defined things have
 546         -- Global names.
 547
 548 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
 549                            vcat (map ppr_gen_tycon tcs),
 550                            ptext SLIT("#-}")
 551                      ]
 552
 553 -- x&y are now Id's, not CoreExpr's
 554 ppr_gen_tycon tycon
 555   | Just ep <- tyConGenInfo tycon
 556   = (ppr tycon <> colon) $$ nest 4 (ppr_ep ep)
 557
 558   | otherwise = ppr tycon <> colon <+> ptext SLIT("Not derivable")
 559
 560 ppr_ep (EP from to)
 561   = vcat [ ptext SLIT("Rep type:") <+> ppr (funResultTy from_tau),
 562            ptext SLIT("From:") <+> ppr (unfoldingTemplate (idUnfolding from)),
 563            ptext SLIT("To:")   <+> ppr (unfoldingTemplate (idUnfolding to))
 564     ]
 565   where
 566     (_,from_tau) = splitForAllTys (idType from)
 567
 568 pp_rules [] = empty
 569 pp_rules rs = vcat [ptext SLIT("{-# RULES"),
 570                     nest 4 (vcat (map ppr rs)),
 571                     ptext SLIT("#-}")]
 572 \end{code}