tcRnExtCore
) where
-#include "HsVersions.h"
-
import IO
#ifdef GHCI
import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
import IfaceSyn
import TcSimplify
import TcTyClsDecls
+import TcUnify ( withBox )
import LoadIface
import RnNames
import RnEnv
import CoreSyn
import ErrUtils
import Id
+import VarEnv
import Var
import Module
-import UniqFM
+import LazyUniqFM
import Name
import NameEnv
import NameSet
import TyCon
+import TysWiredIn
import SrcLoc
import HscTypes
import ListSetOps
import Outputable
+import DataCon
+import Type
+import Class
+import Data.List ( sortBy )
#ifdef GHCI
import Linker
-import DataCon
import TcHsType
import TcMType
import TcMatches
-import TcGadt
import RnTypes
import RnExpr
import IfaceEnv
import MkId
-import TysWiredIn
import IdInfo
import {- Kind parts of -} Type
import BasicTypes
import Util
import Bag
-import Control.Monad ( unless )
+import Control.Monad
import Data.Maybe ( isJust )
+#include "HsVersions.h"
\end{code}
tcRnModule hsc_env hsc_src save_rn_syntax
(L loc (HsModule maybe_mod export_ies
- import_decls local_decls mod_deprec _
+ import_decls local_decls mod_deprec
module_info maybe_doc))
= do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
tcg_env <- finishDeprecations (hsc_dflags hsc_env) mod_deprec tcg_env ;
-- Process the export list
- traceRn (text "rn4a: before exports");
+ traceRn (text "rn4a: before exports");
tcg_env <- rnExports (isJust maybe_mod) export_ies tcg_env ;
traceRn (text "rn4b: after exportss") ;
-- Check type-familily consistency
; traceRn (text "rn1: checking family instance consistency")
- ; let { dir_imp_mods = map (\ (mod, _) -> mod)
- . moduleEnvElts
+ ; let { dir_imp_mods = moduleEnvKeys
. imp_mods
$ imports }
; checkFamInstConsistency (imp_finsts imports) dir_imp_mods ;
-- (b) tcExtCoreBindings doesn't need anything
-- (in fact, it might not even need to be in the scope of
-- this tcg_env at all)
- tcg_env <- importsFromLocalDecls False (mkFakeGroup ldecls)
- emptyUFM {- no fixity decls -} ;
+ avails <- getLocalNonValBinders (mkFakeGroup ldecls) ;
+ tc_envs <- extendGlobalRdrEnvRn False avails
+ emptyFsEnv {- no fixity decls -} ;
- setGblEnv tcg_env $ do {
+ setEnvs tc_envs $ do {
- rn_decls <- rnTyClDecls ldecls ;
- failIfErrsM ;
+ rn_decls <- checkNoErrs $ rnTyClDecls ldecls ;
-- Dump trace of renaming part
rnDump (ppr rn_decls) ;
-- Typecheck them all together so that
-- any mutually recursive types are done right
- tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails rn_decls) ;
+ tcg_env <- tcTyAndClassDecls emptyModDetails rn_decls ;
-- Make the new type env available to stuff slurped from interface files
setGblEnv tcg_env $ do {
mod_guts = ModGuts { mg_module = this_mod,
mg_boot = False,
- mg_usages = [], -- ToDo: compute usage
- mg_dir_imps = [], -- ??
+ mg_used_names = emptyNameSet, -- ToDo: compute usage
+ mg_dir_imps = emptyModuleEnv, -- ??
mg_deps = noDependencies, -- ??
mg_exports = my_exports,
mg_types = final_type_env,
tcg_rules = rules, tcg_fords = fords } = tcg_env
; all_binds = binds `unionBags` inst_binds } ;
+ failIfErrsM ; -- Don't zonk if there have been errors
+ -- It's a waste of time; and we may get debug warnings
+ -- about strangely-typed TyCons!
+
(bind_ids, binds', fords', rules') <- zonkTopDecls all_binds rules fords ;
let { final_type_env = extendTypeEnvWithIds type_env bind_ids
-- If ds is [] we get ([], Nothing)
-- Deal with decls up to, but not including, the first splice
- (tcg_env, rn_decls) <- checkNoErrs $ rnTopSrcDecls first_group ;
- -- checkNoErrs: stop if renaming fails
+ (tcg_env, rn_decls) <- rnTopSrcDecls first_group ;
+ -- rnTopSrcDecls fails if there are any errors
(tcg_env, tcl_env) <- setGblEnv tcg_env $
tcTopSrcDecls boot_details rn_decls ;
-- Typecheck type/class decls
; traceTc (text "Tc2")
; let tycl_decls = hs_tyclds rn_group
- ; tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails tycl_decls)
+ ; tcg_env <- tcTyAndClassDecls emptyModDetails tycl_decls
; setGblEnv tcg_env $ do {
-- Typecheck instance decls
}}}}
spliceInHsBootErr (SpliceDecl (L loc _), _)
- = addErrAt loc (ptext SLIT("Splices are not allowed in hs-boot files"))
+ = addErrAt loc (ptext (sLit "Splices are not allowed in hs-boot files"))
\end{code}
Once we've typechecked the body of the module, we want to compare what
-- be the equivalent to the dfun bindings returned for class
-- instances? We can't easily equate tycons...
+ ; failIfErrsM
; return tcg_env' }
where
check_export boot_avail -- boot_avail is exported by the boot iface
-- Check that the actual module exports the same thing
| not (null missing_names)
- = addErrTc (missingBootThing (head missing_names) "exported by")
+ = addErrAt (nameSrcSpan (head missing_names))
+ (missingBootThing (head missing_names) "exported by")
-- If the boot module does not *define* the thing, we are done
-- (it simply re-exports it, and names match, so nothing further to do)
-- Check that the actual module also defines the thing, and
-- then compare the definitions
- | Just real_thing <- lookupTypeEnv local_type_env name
- = do { let boot_decl = tyThingToIfaceDecl (fromJust mb_boot_thing)
- real_decl = tyThingToIfaceDecl real_thing
- ; checkTc (checkBootDecl boot_decl real_decl)
- (bootMisMatch real_thing boot_decl real_decl) }
- -- The easiest way to check compatibility is to convert to
- -- iface syntax, where we already have good comparison functions
+ | Just real_thing <- lookupTypeEnv local_type_env name,
+ Just boot_thing <- mb_boot_thing
+ = when (not (checkBootDecl boot_thing real_thing))
+ $ addErrAt (nameSrcSpan (getName boot_thing))
+ (let boot_decl = tyThingToIfaceDecl
+ (fromJust mb_boot_thing)
+ real_decl = tyThingToIfaceDecl real_thing
+ in bootMisMatch real_thing boot_decl real_decl)
| otherwise
= addErrTc (missingBootThing name "defined in")
local_boot_dfun = Id.mkExportedLocalId (idName boot_dfun) boot_inst_ty
+-- This has to compare the TyThing from the .hi-boot file to the TyThing
+-- in the current source file. We must be careful to allow alpha-renaming
+-- where appropriate, and also the boot declaration is allowed to omit
+-- constructors and class methods.
+--
+-- See rnfail055 for a good test of this stuff.
+
+checkBootDecl :: TyThing -> TyThing -> Bool
+
+checkBootDecl (AnId id1) (AnId id2)
+ = ASSERT(id1 == id2)
+ (idType id1 `tcEqType` idType id2)
+
+checkBootDecl (ATyCon tc1) (ATyCon tc2)
+ | isSynTyCon tc1 && isSynTyCon tc2
+ = ASSERT(tc1 == tc2)
+ let tvs1 = tyConTyVars tc1; tvs2 = tyConTyVars tc2
+ env = rnBndrs2 env0 tvs1 tvs2
+
+ eqSynRhs (OpenSynTyCon k1 _) (OpenSynTyCon k2 _)
+ = tcEqTypeX env k1 k2
+ eqSynRhs (SynonymTyCon t1) (SynonymTyCon t2)
+ = tcEqTypeX env t1 t2
+ in
+ equalLength tvs1 tvs2 &&
+ eqSynRhs (synTyConRhs tc1) (synTyConRhs tc2)
+
+ | isAlgTyCon tc1 && isAlgTyCon tc2
+ = ASSERT(tc1 == tc2)
+ eqListBy tcEqPred (tyConStupidTheta tc1) (tyConStupidTheta tc2)
+ && eqAlgRhs (algTyConRhs tc1) (algTyConRhs tc2)
+
+ | isForeignTyCon tc1 && isForeignTyCon tc2
+ = tyConExtName tc1 == tyConExtName tc2
+ where
+ env0 = mkRnEnv2 emptyInScopeSet
+
+ eqAlgRhs AbstractTyCon _ = True
+ eqAlgRhs OpenTyCon{} OpenTyCon{} = True
+ eqAlgRhs tc1@DataTyCon{} tc2@DataTyCon{} =
+ eqListBy eqCon (data_cons tc1) (data_cons tc2)
+ eqAlgRhs tc1@NewTyCon{} tc2@NewTyCon{} =
+ eqCon (data_con tc1) (data_con tc2)
+ eqAlgRhs _ _ = False
+
+ eqCon c1 c2
+ = dataConName c1 == dataConName c2
+ && dataConIsInfix c1 == dataConIsInfix c2
+ && dataConStrictMarks c1 == dataConStrictMarks c2
+ && dataConFieldLabels c1 == dataConFieldLabels c2
+ && let tvs1 = dataConUnivTyVars c1 ++ dataConExTyVars c1
+ tvs2 = dataConUnivTyVars c2 ++ dataConExTyVars c2
+ env = rnBndrs2 env0 tvs1 tvs2
+ in
+ equalLength tvs1 tvs2 &&
+ eqListBy (tcEqPredX env)
+ (dataConEqTheta c1 ++ dataConDictTheta c1)
+ (dataConEqTheta c2 ++ dataConDictTheta c2) &&
+ eqListBy (tcEqTypeX env)
+ (dataConOrigArgTys c1)
+ (dataConOrigArgTys c2)
+
+checkBootDecl (AClass c1) (AClass c2)
+ = let
+ (clas_tyvars1, clas_fds1, sc_theta1, _, _, op_stuff1)
+ = classExtraBigSig c1
+ (clas_tyvars2, clas_fds2, sc_theta2, _, _, op_stuff2)
+ = classExtraBigSig c2
+
+ env0 = mkRnEnv2 emptyInScopeSet
+ env = rnBndrs2 env0 clas_tyvars1 clas_tyvars2
+
+ eqSig (id1, def_meth1) (id2, def_meth2)
+ = idName id1 == idName id2 &&
+ tcEqTypeX env op_ty1 op_ty2
+ where
+ (_, rho_ty1) = splitForAllTys (idType id1)
+ op_ty1 = funResultTy rho_ty1
+ (_, rho_ty2) = splitForAllTys (idType id2)
+ op_ty2 = funResultTy rho_ty2
+
+ eqFD (as1,bs1) (as2,bs2) =
+ eqListBy (tcEqTypeX env) (mkTyVarTys as1) (mkTyVarTys as2) &&
+ eqListBy (tcEqTypeX env) (mkTyVarTys bs1) (mkTyVarTys bs2)
+ in
+ equalLength clas_tyvars1 clas_tyvars2 &&
+ eqListBy eqFD clas_fds1 clas_fds2 &&
+ (null sc_theta1 && null op_stuff1
+ ||
+ eqListBy (tcEqPredX env) sc_theta1 sc_theta2 &&
+ eqListBy eqSig op_stuff1 op_stuff2)
+
+checkBootDecl (ADataCon dc1) (ADataCon dc2)
+ = pprPanic "checkBootDecl" (ppr dc1)
+
+checkBootDecl _ _ = False -- probably shouldn't happen
+
----------------
missingBootThing thing what
- = ppr thing <+> ptext SLIT("is exported by the hs-boot file, but not")
- <+> text what <+> ptext SLIT("the module")
+ = ppr thing <+> ptext (sLit "is exported by the hs-boot file, but not")
+ <+> text what <+> ptext (sLit "the module")
bootMisMatch thing boot_decl real_decl
- = vcat [ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file"),
- ptext SLIT("Main module:") <+> ppr real_decl,
- ptext SLIT("Boot file: ") <+> ppr boot_decl]
+ = vcat [ppr thing <+> ptext (sLit "has conflicting definitions in the module and its hs-boot file"),
+ ptext (sLit "Main module:") <+> ppr real_decl,
+ ptext (sLit "Boot file: ") <+> ppr boot_decl]
instMisMatch inst
= hang (ppr inst)
- 2 (ptext SLIT("is defined in the hs-boot file, but not in the module itself"))
+ 2 (ptext (sLit "is defined in the hs-boot file, but not in the module itself"))
\end{code}
\begin{code}
------------------------------------------------
rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name)
+-- Fails if there are any errors
rnTopSrcDecls group
= do { -- Rename the source decls (with no shadowing; error on duplicates)
- (tcg_env, rn_decls) <- rnSrcDecls False group ;
- failIfErrsM ;
+ (tcg_env, rn_decls) <- checkNoErrs $ rnSrcDecls False group ;
-- save the renamed syntax, if we want it
let { tcg_env'
-- The latter come in via tycl_decls
traceTc (text "Tc2") ;
- tcg_env <- checkNoErrs (tcTyAndClassDecls boot_details tycl_decls) ;
- -- tcTyAndClassDecls recovers internally, but if anything gave rise to
- -- an error we'd better stop now, to avoid a cascade
+ tcg_env <- tcTyAndClassDecls boot_details tycl_decls ;
+ -- If there are any errors, tcTyAndClassDecls fails here
-- Make these type and class decls available to stuff slurped from interface files
writeMutVar (tcg_type_env_var tcg_env) (tcg_type_env tcg_env) ;
Just main_name -> do
{ traceTc (text "checkMain found" <+> ppr main_mod <+> ppr main_fn)
- ; let { rhs = nlHsApp (nlHsVar runMainIOName) (nlHsVar main_name) }
- -- :Main.main :: IO () = runMainIO main
-
- ; (main_expr, ty) <- addErrCtxt mainCtxt $
- setSrcSpan (srcLocSpan (getSrcLoc main_name)) $
- tcInferRho rhs
+ ; let loc = srcLocSpan (getSrcLoc main_name)
+ ; ioTyCon <- tcLookupTyCon ioTyConName
+ ; (main_expr, res_ty)
+ <- addErrCtxt mainCtxt $
+ withBox liftedTypeKind $ \res_ty ->
+ tcMonoExpr (L loc (HsVar main_name)) (mkTyConApp ioTyCon [res_ty])
-- See Note [Root-main Id]
+ -- Construct the binding
+ -- :Main.main :: IO res_ty = runMainIO res_ty main
+ ; run_main_id <- tcLookupId runMainIOName
; let { root_main_name = mkExternalName rootMainKey rOOT_MAIN
- (mkVarOccFS FSLIT("main"))
+ (mkVarOccFS (fsLit "main"))
(getSrcSpan main_name)
- ; root_main_id = Id.mkExportedLocalId root_main_name ty
- ; main_bind = noLoc (VarBind root_main_id main_expr) }
+ ; root_main_id = Id.mkExportedLocalId root_main_name
+ (mkTyConApp ioTyCon [res_ty])
+ ; co = mkWpTyApps [res_ty]
+ ; rhs = nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) main_expr
+ ; main_bind = noLoc (VarBind root_main_id rhs) }
; return (tcg_env { tcg_binds = tcg_binds tcg_env
`snocBag` main_bind,
-- In other modes, fail altogether, so that we don't go on
-- and complain a second time when processing the export list.
- mainCtxt = ptext SLIT("When checking the type of the") <+> pp_main_fn
- noMainMsg = ptext SLIT("The") <+> pp_main_fn
- <+> ptext SLIT("is not defined in module") <+> quotes (ppr main_mod)
- pp_main_fn | isJust main_is_flag = ptext SLIT("main function") <+> quotes (ppr main_fn)
- | otherwise = ptext SLIT("function") <+> quotes (ppr main_fn)
+ mainCtxt = ptext (sLit "When checking the type of the") <+> pp_main_fn
+ noMainMsg = ptext (sLit "The") <+> pp_main_fn
+ <+> ptext (sLit "is not defined in module") <+> quotes (ppr main_mod)
+ pp_main_fn | isJust main_is_flag = ptext (sLit "main function") <+> quotes (ppr main_fn)
+ | otherwise = ptext (sLit "function") <+> quotes (ppr main_fn)
\end{code}
Note [Root-main Id]
-- None of the Ids should be of unboxed type, because we
-- cast them all to HValues in the end!
- mappM bad_unboxed (filter (isUnLiftedType . idType) zonked_ids) ;
+ mapM bad_unboxed (filter (isUnLiftedType . idType) zonked_ids) ;
traceTc (text "tcs 1") ;
- let { -- (a) Make all the bound ids "global" ids, now that
- -- they're notionally top-level bindings. This is
- -- important: otherwise when we come to compile an expression
- -- using these ids later, the byte code generator will consider
- -- the occurrences to be free rather than global.
- --
- -- (b) Tidy their types; this is important, because :info may
- -- ask to look at them, and :info expects the things it looks
- -- up to have tidy types
- global_ids = map globaliseAndTidy zonked_ids ;
+ let { global_ids = map globaliseAndTidy zonked_ids } ;
{- ---------------------------------------------
At one stage I removed any shadowed bindings from the type_env;
Hence this code is commented out
-------------------------------------------------- -}
- } ;
dumpOptTcRn Opt_D_dump_tc
(vcat [text "Bound Ids" <+> pprWithCommas ppr global_ids,
text "Typechecked expr" <+> ppr zonked_expr]) ;
- returnM (global_ids, zonked_expr)
+ return (global_ids, zonked_expr)
}
where
- bad_unboxed id = addErr (sep [ptext SLIT("GHCi can't bind a variable of unlifted type:"),
+ bad_unboxed id = addErr (sep [ptext (sLit "GHCi can't bind a variable of unlifted type:"),
nest 2 (ppr id <+> dcolon <+> ppr (idType id))])
globaliseAndTidy :: Id -> Id
-globaliseAndTidy id
--- Give the Id a Global Name, and tidy its type
+globaliseAndTidy id -- Note [Interactively-bound Ids in GHCi]
= Id.setIdType (globaliseId VanillaGlobal id) tidy_type
where
tidy_type = tidyTopType (idType id)
\end{code}
+Note [Interactively-bound Ids in GHCi]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The Ids bound by previous Stmts in Template Haskell are currently
+ a) GlobalIds
+ b) with an Internal Name (not External)
+ c) and a tidied type
+
+ (a) They must be GlobalIds (not LocalIds) otherwise when we come to
+ compile an expression using these ids later, the byte code
+ generator will consider the occurrences to be free rather than
+ global.
+
+ (b) They retain their Internal names becuase we don't have a suitable
+ Module to name them with. We could revisit this choice.
+
+ (c) Their types are tidied. This is important, because :info may ask
+ to look at them, and :info expects the things it looks up to have
+ tidy types
+
+
+--------------------------------------------------------------------------
+ Typechecking Stmts in GHCi
+
Here is the grand plan, implemented in tcUserStmt
What you type The IO [HValue] that hscStmt returns
; runPlans [ -- Plan A
do { stuff@([it_id], _) <- tcGhciStmts [bind_stmt, print_it]
; it_ty <- zonkTcType (idType it_id)
- ; ifM (isUnitTy it_ty) failM
+ ; when (isUnitTy it_ty) failM
; return stuff },
-- Plan B; a naked bind statment
; let print_plan = do
{ stuff@([v_id], _) <- tcGhciStmts [stmt, print_v]
; v_ty <- zonkTcType (idType v_id)
- ; ifM (isUnitTy v_ty || not (isTauTy v_ty)) failM
+ ; when (isUnitTy v_ty || not (isTauTy v_ty)) failM
; return stuff }
-- The plans are:
= do { ioTyCon <- tcLookupTyCon ioTyConName ;
ret_id <- tcLookupId returnIOName ; -- return @ IO
let {
- io_ty = mkTyConApp ioTyCon [] ;
ret_ty = mkListTy unitTy ;
io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
- tc_io_stmts stmts = tcStmts DoExpr (tcDoStmt io_ty) stmts
- (emptyRefinement, io_ret_ty) ;
+ tc_io_stmts stmts = tcStmts DoExpr tcDoStmt stmts io_ret_ty ;
names = map unLoc (collectLStmtsBinders stmts) ;
-- OK, we're ready to typecheck the stmts
traceTc (text "TcRnDriver.tcGhciStmts: tc stmts") ;
((tc_stmts, ids), lie) <- getLIE $ tc_io_stmts stmts $ \ _ ->
- mappM tcLookupId names ;
+ mapM tcLookupId names ;
-- Look up the names right in the middle,
-- where they will all be in scope
zonkTcType all_expr_ty
}
where
- smpl_doc = ptext SLIT("main expression")
+ smpl_doc = ptext (sLit "main expression")
\end{code}
tcRnType just finds the kind of a type
return kind
}
where
- doc = ptext SLIT("In GHCi input")
+ doc = ptext (sLit "In GHCi input")
#endif /* GHCi */
\end{code}
-- argument).
tcGetModuleExports :: Module -> [Module] -> TcM [AvailInfo]
tcGetModuleExports mod directlyImpMods
- = do { let doc = ptext SLIT("context for compiling statements")
+ = do { let doc = ptext (sLit "context for compiling statements")
; iface <- initIfaceTcRn $ loadSysInterface doc mod
-- Load any orphan-module and family instance-module
not (isInternalName name),
isTcOcc (nameOccName name), -- Types and classes only
unQualOK gre ] -- In scope unqualified
- doc = ptext SLIT("Need interface for module whose export(s) are in scope unqualified")
+ doc = ptext (sLit "Need interface for module whose export(s) are in scope unqualified")
#endif /* GHCI */
\end{code}
= do { dflags <- getDOpts ;
-- Dump short output if -ddump-types or -ddump-tc
- ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
- (dumpTcRn short_dump) ;
+ when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
+ (dumpTcRn short_dump) ;
-- Dump bindings if -ddump-tc
dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump)
tcCoreDump mod_guts
= do { dflags <- getDOpts ;
- ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
- (dumpTcRn (pprModGuts mod_guts)) ;
+ when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
+ (dumpTcRn (pprModGuts mod_guts)) ;
-- Dump bindings if -ddump-tc
dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump) }
, ppr_fam_insts fam_insts
, vcat (map ppr rules)
, ppr_gen_tycons (typeEnvTyCons type_env)
- , ptext SLIT("Dependent modules:") <+> ppr (eltsUFM (imp_dep_mods imports))
- , ptext SLIT("Dependent packages:") <+> ppr (imp_dep_pkgs imports)]
+ , ptext (sLit "Dependent modules:") <+>
+ ppr (sortBy cmp_mp $ eltsUFM (imp_dep_mods imports))
+ , ptext (sLit "Dependent packages:") <+>
+ ppr (sortBy stablePackageIdCmp $ imp_dep_pkgs imports)]
+ where -- The two uses of sortBy are just to reduce unnecessary
+ -- wobbling in testsuite output
+ cmp_mp (mod_name1, is_boot1) (mod_name2, is_boot2)
+ = (mod_name1 `stableModuleNameCmp` mod_name2)
+ `thenCmp`
+ (is_boot1 `compare` is_boot2)
pprModGuts :: ModGuts -> SDoc
pprModGuts (ModGuts { mg_types = type_env,
where
le_sig tycon1 tycon2 = getOccName tycon1 <= getOccName tycon2
ppr_tycon tycon
- | isCoercionTyCon tycon = ptext SLIT("coercion") <+> ppr tycon
+ | isCoercionTyCon tycon = ptext (sLit "coercion") <+> ppr tycon
| otherwise = ppr (tyThingToIfaceDecl (ATyCon tycon))
ppr_rules :: [CoreRule] -> SDoc
ppr_rules [] = empty
-ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
+ppr_rules rs = vcat [ptext (sLit "{-# RULES"),
nest 4 (pprRules rs),
- ptext SLIT("#-}")]
+ ptext (sLit "#-}")]
ppr_gen_tycons [] = empty
-ppr_gen_tycons tcs = vcat [ptext SLIT("Tycons with generics:"),
+ppr_gen_tycons tcs = vcat [ptext (sLit "Tycons with generics:"),
nest 2 (fsep (map ppr (filter tyConHasGenerics tcs)))]
\end{code}
projects / ghc-hetmet.git / blobdiff