Commit 18976e61 authored by simonpj's avatar simonpj

[project @ 1999-01-27 14:51:14 by simonpj]

Finally!  This commits the ongoing saga of Simon's hygiene sweep

FUNCTIONALITY
~~~~~~~~~~~~~
a) The 'unused variable' warnings from the renamer work.  
b) Better error messages here and there, esp type checker
c) Fixities for Haskell 98 (maybe I'd done that before)
d) Lazy reporting of name clashes for Haskell 98 (ditto)

HYGIENE
~~~~~~~
a) type OccName has its own module.  OccNames are represented
   by a single FastString, not three as in the last round.  This
   string is held in Z-encoded form; a decoding function decodes
   for printing in user error messages.  There's a nice tight
   encoding for (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)

b) type Module is a proper ADT, in module OccName

c) type RdrName is a proper ADT, in its own module

d) type Name has a new, somwhat tidier, representation

e) much grunting in the renamer to get Provenances right.
   This makes error messages look better (no spurious qualifiers)
parent f3bed25c
......@@ -17,7 +17,7 @@ module BasicTypes(
Version, Arity,
Unused, unused,
Fixity(..), FixityDirection(..), StrictnessMark(..),
NewOrData(..), IfaceFlavour(..), TopLevelFlag(..), RecFlag(..)
NewOrData(..), TopLevelFlag(..), RecFlag(..)
) where
#include "HsVersions.h"
......@@ -63,39 +63,6 @@ type Version = Int
\end{code}
%************************************************************************
%* *
\subsection[IfaceFlavour]{IfaceFlavour}
%* *
%************************************************************************
The IfaceFlavour type is used mainly in an imported Name's Provenance
to say whether the name comes from a regular .hi file, or whether it comes
from a hand-written .hi-boot file. This is important, because it has to be
propagated. Suppose
C.hs imports B
B.hs imports A
A.hs imports C {-# SOURCE -#} ( f )
Then in A.hi we may mention C.f, in an inlining. When compiling B we *must not*
read C.f's details from C.hi, even if the latter happens to exist from an earlier
compilation run. So we use the name "C!f" in A.hi, and when looking for an interface
file with details of C!f we look in C.hi-boot. The "!" stuff is recorded in the
IfaceFlavour in the Name of C.f in A.
Not particularly beautiful, but it works.
\begin{code}
data IfaceFlavour = HiFile -- The interface was read from a standard interface file
| HiBootFile -- ... or from a handwritten "hi-boot" interface file
instance Text IfaceFlavour where -- Just used in debug prints of lex tokens
showsPrec n HiFile s = s
showsPrec n HiBootFile s = "!" ++ s
\end{code}
%************************************************************************
%* *
\subsection[Fixity]{Fixity info}
......
......@@ -17,7 +17,7 @@ module Id (
recordSelectorFieldLabel,
-- Modifying an Id
setIdName, setIdUnique, setIdType, setIdInfo, mkIdVisible,
setIdName, setIdUnique, setIdType, setIdInfo,
-- Predicates
omitIfaceSigForId,
......@@ -70,12 +70,13 @@ import IdInfo
import Demand ( Demand )
import Name ( Name, OccName, Module,
mkSysLocalName, mkLocalName,
isWiredInName, mkNameVisible
isWiredInName
)
import Const ( Con(..) )
import PrimRep ( PrimRep )
import PrimOp ( PrimOp )
import FieldLabel ( FieldLabel(..) )
import SrcLoc ( SrcLoc )
import Unique ( Unique, mkBuiltinUnique, getBuiltinUniques )
import Outputable
......@@ -109,11 +110,11 @@ mkUserId name ty = mkVanillaId name ty
-- SysLocal: for an Id being created by the compiler out of thin air...
-- UserLocal: an Id with a name the user might recognize...
mkUserLocal :: OccName -> Unique -> Type -> Id
mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
mkSysLocal :: FAST_STRING -> Unique -> Type -> Id
mkSysLocal fs uniq ty = mkVanillaId (mkSysLocalName uniq fs) ty
mkUserLocal occ uniq ty = mkVanillaId (mkLocalName uniq occ) ty
mkSysLocal fs uniq ty = mkVanillaId (mkSysLocalName uniq fs) ty
mkUserLocal occ uniq ty loc = mkVanillaId (mkLocalName uniq occ loc) ty
\end{code}
Make some local @Ids@ for a template @CoreExpr@. These have bogus
......@@ -173,11 +174,6 @@ omitIfaceSigForId id
other -> False -- Don't omit!
\end{code}
\begin{code}
mkIdVisible :: Module -> Id -> Id
mkIdVisible mod id = setIdName id (mkNameVisible mod (idName id))
\end{code}
%************************************************************************
%* *
\subsection{Special Ids}
......
......@@ -80,8 +80,9 @@ import List ( nub )
%************************************************************************
\begin{code}
mkSpecPragmaId occ uniq ty
= mkUserLocal occ uniq ty `setInlinePragma` IAmASpecPragmaId
mkSpecPragmaId occ uniq ty loc
= mkUserLocal occ uniq ty loc `setInlinePragma` IAmASpecPragmaId
-- Maybe a SysLocal? But then we'd lose the location
mkDefaultMethodId dm_name rec_c ty
= mkVanillaId dm_name ty
......
This diff is collapsed.
This diff is collapsed.
......@@ -28,6 +28,7 @@ module SrcLoc (
#include "HsVersions.h"
import Util ( thenCmp )
import Outputable
import FastString ( unpackFS )
import GlaExts ( Int(..), (+#) )
......@@ -49,19 +50,6 @@ data SrcLoc
FAST_INT
| UnhelpfulSrcLoc FAST_STRING -- Just a general indication
instance Ord SrcLoc where
compare NoSrcLoc NoSrcLoc = EQ
compare NoSrcLoc _ = GT
compare (UnhelpfulSrcLoc _) (UnhelpfulSrcLoc _) = EQ
compare (UnhelpfulSrcLoc _) _ = GT
compare _ NoSrcLoc = LT
compare _ (UnhelpfulSrcLoc _) = LT
compare (SrcLoc _ y1) (SrcLoc _ y2) = compare IBOX(y1) IBOX(y2)
instance Eq SrcLoc where
(==) x y = compare x y == EQ
\end{code}
Note that an entity might be imported via more than one route, and
......@@ -102,6 +90,29 @@ incSrcLine loc = loc
%************************************************************************
\begin{code}
-- SrcLoc is an instance of Ord so that we can sort error messages easily
instance Eq SrcLoc where
loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
EQ -> True
other -> False
instance Ord SrcLoc where
compare = cmpSrcLoc
cmpSrcLoc NoSrcLoc NoSrcLoc = EQ
cmpSrcLoc NoSrcLoc other = LT
cmpSrcLoc (UnhelpfulSrcLoc s1) (UnhelpfulSrcLoc s2) = s1 `compare` s2
cmpSrcLoc (UnhelpfulSrcLoc s1) other = GT
cmpSrcLoc (SrcLoc s1 l1) NoSrcLoc = GT
cmpSrcLoc (SrcLoc s1 l1) (UnhelpfulSrcLoc _) = LT
cmpSrcLoc (SrcLoc s1 l1) (SrcLoc s2 l2) = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2)
where
l1 `cmpline` l2 | l1 <# l2 = LT
| l1 ==# l2 = EQ
| otherwise = GT
instance Outputable SrcLoc where
ppr (SrcLoc src_path src_line)
= getPprStyle $ \ sty ->
......
_interface_ Var 1
_exports_
Var Var Id ;
Var Var Id setIdName ;
_declarations_
-- Used by Name
1 type Id = Var ;
1 data Var ;
1 setIdName _:_ Id -> Name.Name -> Id ;;
__interface Var 1 0 where
__export Var Var Id ;
__export Var Var Id setIdName ;
-- Used by Name
1 type Id = Var;
1 data Var ;
1 setIdName :: Id -> Name.Name -> Id ;
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgCase.lhs,v 1.21 1998/12/22 18:03:27 simonm Exp $
% $Id: CgCase.lhs,v 1.22 1999/01/27 14:51:31 simonpj Exp $
%
%********************************************************
%* *
......@@ -546,7 +546,12 @@ Tag is held in a temporary.
\begin{code}
cgInlineAlts bndr (StgAlgAlts ty alts deflt)
= cgAlgAlts NoGC uniq AbsCNop{-restore_cc-} False{-no semi-tagging-}
= -- bind the default binder (it covers all the alternatives)
(if (isDeadBinder bndr)
then nopC
else bindNewToReg bndr node mkLFArgument) `thenC`
cgAlgAlts NoGC uniq AbsCNop{-restore_cc-} False{-no semi-tagging-}
False{-not poly case-} alts deflt
False{-don't emit yield-} `thenFC` \ (tagged_alts, deflt_c) ->
......
......@@ -36,7 +36,7 @@ import CmdLineOpts ( opt_SccProfilingOn, opt_EnsureSplittableC,
import CostCentre ( CostCentre, CostCentreStack )
import FiniteMap ( FiniteMap )
import Id ( Id, idName )
import Name ( Module, moduleCString, moduleString )
import Name ( Module, moduleString )
import PrimRep ( getPrimRepSize, PrimRep(..) )
import Type ( Type )
import TyCon ( TyCon )
......@@ -93,12 +93,6 @@ codeGen mod_name (local_CCs, extern_CCs, singleton_CCSs)
mkAbstractCs [ cost_centre_stuff, module_code ]
where
-----------------
grp_name = case opt_SccGroup of
Just xx -> _PK_ xx
Nothing -> _PK_ (moduleString mod_name) -- default: module name
-----------------
mkCcRegister ccs cc_stacks import_names
= let
register_ccs = mkAbstractCs (map mk_register ccs)
......@@ -108,7 +102,7 @@ codeGen mod_name (local_CCs, extern_CCs, singleton_CCSs)
in
[
CCallProfCCMacro SLIT("START_REGISTER_CCS")
[ CLitLit (_PK_ ("_reg" ++ moduleCString mod_name)) AddrRep],
[ CLitLit (_PK_ ("_reg" ++ moduleString mod_name)) AddrRep],
register_ccs,
register_cc_stacks,
register_imports,
......@@ -123,7 +117,7 @@ codeGen mod_name (local_CCs, extern_CCs, singleton_CCSs)
mk_import_register import_name
= CCallProfCCMacro SLIT("REGISTER_IMPORT")
[CLitLit (_PK_ ("_reg" ++ moduleCString import_name)) AddrRep]
[CLitLit (_PK_ ("_reg" ++ moduleString import_name)) AddrRep]
\end{code}
%************************************************************************
......
......@@ -16,6 +16,7 @@ module PprCore (
#include "HsVersions.h"
import CoreSyn
import CostCentre ( pprCostCentreCore )
import Id ( idType, idInfo, getInlinePragma, getIdDemandInfo, Id )
import Var ( isTyVar )
import IdInfo ( ppIdInfo )
......@@ -89,8 +90,8 @@ pprGenericEnv = initCoreEnv (\site -> ppr)
\begin{code}
initCoreEnv pbdr
= initPprEnv
(Just ppr) -- Constants
(Just ppr) -- Cost centres
(Just ppr) -- Constants
(Just pprCostCentreCore) -- Cost centres
(Just ppr) -- tyvar occs
(Just pprParendType) -- types
......@@ -235,8 +236,7 @@ ppr_expr pe (Let bind expr)
NonRec _ _ -> SLIT("let {")
ppr_expr pe (Note (SCC cc) expr)
= sep [hsep [ptext SLIT("__scc"), pSCC pe cc],
ppr_parend_expr pe expr ]
= sep [pSCC pe cc, ppr_expr pe expr]
#ifdef DEBUG
ppr_expr pe (Note (Coerce to_ty from_ty) expr)
......@@ -272,7 +272,7 @@ ppr_case_pat pe con args
where
ppr_bndr = pBndr pe CaseBind
ppr_arg pe (Type ty) = ptext SLIT("__a") <+> pTy pe ty
ppr_arg pe (Type ty) = ptext SLIT("@") <+> pTy pe ty
ppr_arg pe expr = ppr_parend_expr pe expr
arrow = ptext SLIT("->")
......@@ -289,7 +289,7 @@ pprCoreBinder LetBind binder
sig = pprTypedBinder binder
pragmas = ppIdInfo (idInfo binder)
-- Lambda bound type variables are preceded by "__a"
-- Lambda bound type variables are preceded by "@"
pprCoreBinder LambdaBind bndr = pprTypedBinder bndr
-- Case bound things don't get a signature or a herald
......@@ -304,7 +304,7 @@ pprUntypedBinder binder
| otherwise = pprIdBndr binder
pprTypedBinder binder
| isTyVar binder = ptext SLIT("__a") <+> pprTyVarBndr binder
| isTyVar binder = ptext SLIT("@") <+> pprTyVarBndr binder
| otherwise = pprIdBndr binder <+> dcolon <+> pprParendType (idType binder)
-- The space before the :: is important; it helps the lexer
-- when reading inferfaces. Otherwise it would lex "a::b" as one thing.
......
......@@ -22,7 +22,7 @@ import DsUtils ( EquationInfo(..),
import Id ( idType )
import DataCon ( DataCon, isTupleCon, isUnboxedTupleCon,
dataConSourceArity )
import Name ( Name, mkLocalName, getOccName, isConSymOcc, getName, varOcc )
import Name ( Name, mkLocalName, getOccName, isDataSymOcc, getName, mkSrcVarOcc )
import Type ( Type,
isUnboxedType,
splitTyConApp_maybe
......@@ -48,6 +48,7 @@ import TysWiredIn ( nilDataCon, consDataCon,
)
import Unique ( unboundKey )
import TyCon ( tyConDataCons )
import SrcLoc ( noSrcLoc )
import UniqSet
import Outputable
......@@ -390,7 +391,8 @@ make_row_vars used_lits (EqnInfo _ _ pats _ ) =
where new_var = hash_x
hash_x = mkLocalName unboundKey {- doesn't matter much -}
(varOcc SLIT("#x"))
(mkSrcVarOcc SLIT("#x"))
noSrcLoc
make_row_vars_for_constructor :: EquationInfo -> [WarningPat]
make_row_vars_for_constructor (EqnInfo _ _ pats _ ) = take (length (tail pats)) (repeat new_wild_pat)
......@@ -511,8 +513,7 @@ contructors until the [] to know taht we need to use the second case,
not the second.
\begin{code}
isInfixCon con = isConSymOcc (getOccName con)
isInfixCon con = isDataSymOcc (getOccName con)
is_nil (ConPatIn con []) = con == getName nilDataCon
is_nil _ = False
......
......@@ -22,7 +22,7 @@ import Name ( Module, moduleString )
import Bag ( isEmptyBag, unionBags )
import CmdLineOpts ( opt_SccGroup, opt_SccProfilingOn )
import CoreLint ( beginPass, endPass )
import ErrUtils ( doIfSet )
import ErrUtils ( doIfSet, pprBagOfWarnings )
import Outputable
import UniqSupply ( splitUniqSupply, UniqSupply )
\end{code}
......@@ -41,7 +41,7 @@ deSugar :: UniqSupply -- name supply
deSugar us global_val_env mod_name all_binds fo_decls = do
beginPass "Desugar"
-- Do desugaring
let (core_prs, ds_warns) = initDs us1 global_val_env module_and_group
let (core_prs, ds_warns1) = initDs us1 global_val_env module_and_group
(dsMonoBinds opt_SccProfilingOn all_binds [])
ds_binds' = [Rec core_prs]
......@@ -50,9 +50,11 @@ deSugar us global_val_env mod_name all_binds fo_decls = do
ds_binds = fi_binds ++ ds_binds' ++ fe_binds
ds_warns = ds_warns1 `unionBags` ds_warns2
-- Display any warnings
doIfSet (not (isEmptyBag (ds_warns `unionBags` ds_warns2)))
(printErrs (pprDsWarnings ds_warns))
doIfSet (not (isEmptyBag ds_warns))
(printErrs (pprBagOfWarnings ds_warns))
-- Lint result if necessary
endPass "Desugar" opt_D_dump_ds ds_binds
......
......@@ -153,7 +153,7 @@ addAutoScc auto_scc_candidate pair@(bndr, core_expr)
| auto_scc_candidate && worthSCC core_expr &&
(opt_AutoSccsOnAllToplevs || (isExported bndr && opt_AutoSccsOnExportedToplevs))
= getModuleAndGroupDs `thenDs` \ (mod,grp) ->
returnDs (bndr, Note (SCC (mkAutoCC bndr mod grp IsNotCafCC)) core_expr)
returnDs (bndr, Note (SCC (mkAutoCC bndr mod grp NotCafCC)) core_expr)
| otherwise
= returnDs pair
......
......@@ -22,11 +22,12 @@ import TcHsSyn ( TypecheckedForeignDecl )
import CoreUtils ( coreExprType )
import Const ( Con(..), mkMachInt )
import DataCon ( DataCon, dataConId )
import Id ( Id, idType, idName,
mkIdVisible, mkWildId
)
import Id ( Id, idType, idName, mkWildId, mkUserId )
import Const ( Literal(..) )
import Name ( getOccString, NamedThing(..) )
import Name ( mkGlobalName, nameModule, nameOccName, getOccString,
mkForeignExportOcc,
NamedThing(..), Provenance(..), ExportFlag(..)
)
import PrelVals ( realWorldPrimId )
import PrelInfo ( deRefStablePtr_NAME, bindIO_NAME, makeStablePtr_NAME )
import Type ( splitAlgTyConApp_maybe,
......@@ -203,6 +204,13 @@ The function that does most of the work for 'foreign export' declarations.
(see below for the boilerplate code a 'foreign export' declaration expands
into.)
For each 'foreign export foo' in a module M we generate:
* a C function 'foo', which calls
* a Haskell stub 'M.$ffoo', which calls
the user-written Haskell function 'M.foo'.
\begin{code}
dsFExport :: Id
-> Type -- Type of foreign export.
......@@ -215,7 +223,17 @@ dsFExport :: Id
, SDoc
)
dsFExport i ty ext_name cconv isDyn =
newSysLocalDs helper_ty `thenDs` \ f_helper ->
getUniqueDs `thenDs` \ uniq ->
getSrcLocDs `thenDs` \ src_loc ->
let
f_helper_glob = mkUserId helper_name helper_ty
where
name = idName i
mod = nameModule name
occ = mkForeignExportOcc (nameOccName name)
prov = LocalDef src_loc Exported
helper_name = mkGlobalName uniq mod occ prov
in
newSysLocalsDs fe_arg_tys `thenDs` \ fe_args ->
(if isDyn then
newSysLocalDs stbl_ptr_ty `thenDs` \ stbl_ptr ->
......@@ -268,7 +286,6 @@ dsFExport i ty ext_name cconv isDyn =
ExtName fs _ -> fs
Dynamic -> panic "dsFExport: Dynamic - shouldn't ever happen."
f_helper_glob = mkIdVisible mod f_helper
(h_stub, c_stub) = fexportEntry c_nm f_helper_glob wrapper_arg_tys the_result_ty cconv isDyn
in
returnDs (NonRec f_helper_glob the_body, h_stub, c_stub)
......
......@@ -20,7 +20,7 @@ module DsMonad (
ValueEnv,
dsWarn,
DsWarnings,
DsMatchContext(..), DsMatchKind(..), pprDsWarnings
DsMatchContext(..), DsMatchKind(..)
) where
#include "HsVersions.h"
......@@ -28,7 +28,7 @@ module DsMonad (
import Bag ( emptyBag, snocBag, bagToList, Bag )
import ErrUtils ( WarnMsg, pprBagOfErrors )
import HsSyn ( OutPat )
import Id ( mkUserLocal, mkSysLocal, setIdUnique, Id )
import Id ( mkSysLocal, setIdUnique, Id )
import Name ( Module, Name, maybeWiredInIdName )
import Var ( TyVar, setTyVarUnique )
import VarEnv
......@@ -234,7 +234,4 @@ data DsMatchKind
| ListCompMatch
| LetMatch
deriving ()
pprDsWarnings :: DsWarnings -> SDoc
pprDsWarnings warns = pprBagOfErrors warns
\end{code}
......@@ -95,34 +95,32 @@ dsShadowWarn ctx@(DsMatchContext kind _ _) qs = dsWarn warn
where
warn | length qs > maximum_output
= pp_context ctx (ptext SLIT("are overlapped"))
8 (\ f -> vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$
(\ f -> vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$
ptext SLIT("..."))
| otherwise
= pp_context ctx (ptext SLIT("are overlapped"))
8 (\ f -> vcat $ map (ppr_eqn f kind) qs)
(\ f -> vcat $ map (ppr_eqn f kind) qs)
dsIncompleteWarn :: DsMatchContext -> [ExhaustivePat] -> DsM ()
dsIncompleteWarn ctx@(DsMatchContext kind _ _) pats = dsWarn warn
where
warn | length pats > maximum_output
= pp_context ctx (ptext SLIT("are non-exhaustive"))
8 (\ f -> hang (ptext SLIT("Patterns not recognized:"))
4 (vcat (map (ppr_incomplete_pats kind)
(take maximum_output pats))
$$ ptext SLIT("...")))
| otherwise
= pp_context ctx (ptext SLIT("are non-exhaustive"))
8 (\ f -> hang (ptext SLIT("Patterns not recognized:"))
4 (vcat $ map (ppr_incomplete_pats kind) pats))
warn = pp_context ctx (ptext SLIT("are non-exhaustive"))
(\f -> hang (ptext SLIT("Patterns not matched:"))
4 ((vcat $ map (ppr_incomplete_pats kind)
(take maximum_output pats))
$$ dots))
dots | length pats > maximum_output = ptext SLIT("...")
| otherwise = empty
pp_context NoMatchContext msg ind rest_of_msg_fun
= dontAddErrLoc "" (ptext SLIT("Some match(es)") <+> hang msg ind (rest_of_msg_fun id))
pp_context NoMatchContext msg rest_of_msg_fun
= dontAddErrLoc "" (ptext SLIT("Some match(es)") <+> hang msg 8 (rest_of_msg_fun id))
pp_context (DsMatchContext kind pats loc) msg ind rest_of_msg_fun
pp_context (DsMatchContext kind pats loc) msg rest_of_msg_fun
= case pp_match kind pats of
(ppr_match, pref) ->
addErrLocHdrLine loc message (nest ind (rest_of_msg_fun pref))
addErrLocHdrLine loc message (nest 8 (rest_of_msg_fun pref))
where
message = ptext SLIT("Pattern match(es)") <+> msg <+> ppr_match <> char ':'
where
......
......@@ -20,7 +20,6 @@ import PprCore () -- Instances for Outputable
--others:
import Id ( Id )
import Name ( OccName, NamedThing(..) )
import BasicTypes ( RecFlag(..), Fixity )
import Outputable
import Bag
......@@ -63,7 +62,7 @@ nullBinds (MonoBind b _ _) = nullMonoBinds b
\end{code}
\begin{code}
instance (Outputable pat, NamedThing id, Outputable id) =>
instance (Outputable pat, Outputable id) =>
Outputable (HsBinds id pat) where
ppr binds = ppr_binds binds
......@@ -166,14 +165,15 @@ andMonoBindList binds = foldr AndMonoBinds EmptyMonoBinds binds
\end{code}
\begin{code}
instance (NamedThing id, Outputable id, Outputable pat) =>
instance (Outputable id, Outputable pat) =>
Outputable (MonoBinds id pat) where
ppr mbind = ppr_monobind mbind
ppr_monobind :: (Outputable id, Outputable pat) => MonoBinds id pat -> SDoc
ppr_monobind EmptyMonoBinds = empty
ppr_monobind (AndMonoBinds binds1 binds2)
= ($$) (ppr_monobind binds1) (ppr_monobind binds2)
= ppr_monobind binds1 $$ ppr_monobind binds2
ppr_monobind (PatMonoBind pat grhss locn)
= sep [ppr pat, nest 4 (pprGRHSs False grhss)]
......@@ -189,11 +189,12 @@ ppr_monobind (CoreMonoBind name expr)
= sep [ppr name <+> equals, nest 4 (ppr expr)]
ppr_monobind (AbsBinds tyvars dictvars exports val_binds)
= ($$) (sep [ptext SLIT("AbsBinds"),
brackets (interpp'SP tyvars),
brackets (interpp'SP dictvars),
brackets (interpp'SP exports)])
(nest 4 (ppr val_binds))
= sep [ptext SLIT("AbsBinds"),
brackets (interpp'SP tyvars),
brackets (interpp'SP dictvars),
brackets (interpp'SP exports)]
$$
nest 4 (ppr val_binds)
\end{code}
%************************************************************************
......@@ -260,7 +261,7 @@ nonFixitySigs sigs = filter not_fix sigs
\end{code}
\begin{code}
instance (NamedThing name, Outputable name) => Outputable (Sig name) where
instance (Outputable name) => Outputable (Sig name) where
ppr sig = ppr_sig sig
instance Outputable name => Outputable (FixitySig name) where
......@@ -271,7 +272,7 @@ ppr_sig (Sig var ty _)
= sep [ppr var <+> dcolon, nest 4 (ppr ty)]
ppr_sig (ClassOpSig var _ ty _)
= sep [ppr (getOccName var) <+> dcolon, nest 4 (ppr ty)]
= sep [ppr var <+> dcolon, nest 4 (ppr ty)]
ppr_sig (SpecSig var ty using _)
= sep [ hsep [text "{-# SPECIALIZE", ppr var, dcolon],
......
......@@ -29,7 +29,6 @@ import Demand ( Demand )
import CallConv ( CallConv, pprCallConv )
-- others:
import Name ( NamedThing )
import Outputable
import SrcLoc ( SrcLoc )
import Util
......@@ -72,7 +71,7 @@ data HsDecl name pat
\begin{code}
#ifdef DEBUG
hsDeclName :: (NamedThing name, Outputable name, Outputable pat)
hsDeclName :: (Outputable name, Outputable pat)
=> HsDecl name pat -> name
#endif
hsDeclName (TyClD decl) = tyClDeclName decl
......@@ -92,7 +91,7 @@ tyClDeclName (ClassDecl _ name _ _ _ _ _ _ _) = name
\end{code}
\begin{code}
instance (NamedThing name, Outputable name, Outputable pat)
instance (Outputable name, Outputable pat)
=> Outputable (HsDecl name pat) where
ppr (TyClD dcl) = ppr dcl
......@@ -107,11 +106,11 @@ instance (NamedThing name, Outputable name, Outputable pat)
#ifdef DEBUG
-- hsDeclName needs more context when DEBUG is on
instance (NamedThing name, Outputable name, Outputable pat, Eq name)
instance (Outputable name, Outputable pat, Eq name)
=> Eq (HsDecl name pat) where
d1 == d2 = hsDeclName d1 == hsDeclName d2
instance (NamedThing name, Outputable name, Outputable pat, Ord name)
instance (Outputable name, Outputable pat, Ord name)
=> Ord (HsDecl name pat) where
d1 `compare` d2 = hsDeclName d1 `compare` hsDeclName d2
#else
......@@ -183,7 +182,7 @@ isClassDecl other = False
\end{code}
\begin{code}
instance (NamedThing name, Outputable name, Outputable pat)
instance (Outputable name, Outputable pat)
=> Outputable (TyClDecl name pat) where
ppr (TySynonym tycon tyvars mono_ty src_loc)
......@@ -241,7 +240,7 @@ data SpecDataSig name
(HsType name)
SrcLoc
instance (NamedThing name, Outputable name)
instance (Outputable name)
=> Outputable (SpecDataSig name) where
ppr (SpecDataSig tycon ty _)
......@@ -286,7 +285,7 @@ data BangType name
\end{code}
\begin{code}