Commit 495ef8bd authored by simonpj's avatar simonpj

[project @ 2000-05-25 12:41:14 by simonpj]

~~~~~~~~~~~~
		Apr/May 2000
		~~~~~~~~~~~~

This is a pretty big commit!  It adds stuff I've been working on
over the last month or so.  DO NOT MERGE IT WITH 4.07!

Interface file formats have changed a little; you'll need
to make clean before remaking.

						Simon PJ

Recompilation checking
~~~~~~~~~~~~~~~~~~~~~~
Substantial improvement in recompilation checking.  The version management
is now entirely internal to GHC.  ghc-iface.lprl is dead!

The trick is to generate the new interface file in two steps:
  - first convert Types etc to HsTypes etc, and thereby
	build a new ParsedIface
  - then compare against the parsed (but not renamed) version of the old
	interface file
Doing this meant adding code to convert *to* HsSyn things, and to
compare HsSyn things for equality.  That is the main tedious bit.

Another improvement is that we now track version info for
fixities and rules, which was missing before.


Interface file reading
~~~~~~~~~~~~~~~~~~~~~~
Make interface files reading more robust.
  * If the old interface file is unreadable, don't fail. [bug fix]

  * If the old interface file mentions interfaces
    that are unreadable, don't fail. [bug fix]

  * When we can't find the interface file,
    print the directories we are looking in.  [feature]


Type signatures
~~~~~~~~~~~~~~~
  * New flag -ddump-types to print type signatures


Type pruning
~~~~~~~~~~~~
When importing
	data T = T1 A | T2 B | T3 C
it seems excessive to import the types A, B, C as well, unless
the constructors T1, T2 etc are used.  A,B,C might be more types,
and importing them may mean reading more interfaces, and so on.
 So the idea is that the renamer will just import the decl
	data T
unless one of the constructors is used.  This turns out to be quite
easy to implement.  The downside is that we must make sure the
constructors are always available if they are really needed, so
I regard this as an experimental feature.


Elimininate ThinAir names
~~~~~~~~~~~~~~~~~~~~~~~~~
Eliminate ThinAir.lhs and all its works.  It was always a hack, and now
the desugarer carries around an environment I think we can nuke ThinAir
altogether.

As part of this, I had to move all the Prelude RdrName defns from PrelInfo
to PrelMods --- so I renamed PrelMods as PrelNames.

I also had to move the builtinRules so that they are injected by the renamer
(rather than appearing out of the blue in SimplCore).  This is if anything simpler.

Miscellaneous
~~~~~~~~~~~~~
* Tidy up the data types involved in Rules

* Eliminate RnEnv.better_provenance; use Name.hasBetterProv instead

* Add Unique.hasKey :: Uniquable a => a -> Unique -> Bool
  It's useful in a lot of places

* Fix a bug in interface file parsing for __U[!]
parent b5c71bff
......@@ -32,14 +32,14 @@ then
then
CoreSyn
then
IdInfo (loop CoreSyn.CoreRules etc, loop CoreUnfold.Unfolding)
IdInfo (CoreSyn.Unfolding, CoreSyn.CoreRules)
then
Id (lots from IdInfo)
then
CoreFVs, PprCore
then
CoreUtils (PprCore.pprCoreExpr, CoreFVs.exprFreeVars,
loop CoreUnfold.isEvaldUnfolding CoreUnfold.maybeUnfoldingTemplate)
CoreSyn.isEvaldUnfolding CoreSyn.maybeUnfoldingTemplate)
then
OccurAnal (CoreUtils.exprIsTrivial)
then
......
......@@ -14,7 +14,7 @@ types that
\begin{code}
module BasicTypes(
Version,
Version, bumpVersion, initialVersion, bogusVersion,
Arity,
......@@ -29,7 +29,10 @@ module BasicTypes(
TopLevelFlag(..), isTopLevel, isNotTopLevel,
Boxity(..), isBoxed, tupleParens,
OccInfo(..), seqOccInfo, isFragileOccInfo, isLoopBreaker,
InsideLam, insideLam, notInsideLam,
OneBranch, oneBranch, notOneBranch
......@@ -75,6 +78,15 @@ type Arity = Int
\begin{code}
type Version = Int
bogusVersion :: Version -- Shouldn't look at these
bogusVersion = error "bogusVersion"
bumpVersion :: Version -> Version
bumpVersion v = v+1
initialVersion :: Version
initialVersion = 1
\end{code}
......@@ -144,6 +156,28 @@ isTopLevel TopLevel = True
isTopLevel NotTopLevel = False
\end{code}
%************************************************************************
%* *
\subsection[Top-level/local]{Top-level/not-top level flag}
%* *
%************************************************************************
\begin{code}
data Boxity
= Boxed
| Unboxed
deriving( Eq )
isBoxed :: Boxity -> Bool
isBoxed Boxed = True
isBoxed Unboxed = False
tupleParens :: Boxity -> SDoc -> SDoc
tupleParens Boxed p = parens p
tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)")
\end{code}
%************************************************************************
%* *
\subsection[Recursive/Non-Recursive]{Recursive/Non-Recursive flag}
......
......@@ -32,9 +32,9 @@ import TysPrim
import Type ( Type, ThetaType, TauType, ClassContext,
mkForAllTys, mkFunTys, mkTyConApp,
mkTyVarTys, mkDictTys,
splitAlgTyConApp_maybe, classesToPreds
splitTyConApp_maybe, classesToPreds
)
import TyCon ( TyCon, tyConDataCons, isDataTyCon, isProductTyCon,
import TyCon ( TyCon, tyConDataCons, tyConDataConsIfAvailable, isDataTyCon, isProductTyCon,
isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon )
import Class ( classTyCon )
import Name ( Name, NamedThing(..), nameUnique, isLocallyDefined )
......@@ -120,7 +120,7 @@ data DataCon
dcRepArgTys :: [Type], -- Final, representation argument types, after unboxing and flattening,
-- and including existential dictionaries
dcTyCon :: TyCon, -- Result tycon
dcTyCon :: TyCon, -- Result tycon
-- Now the strictness annotations and field labels of the constructor
dcUserStricts :: [StrictnessMark],
......@@ -404,6 +404,7 @@ splitProductType_maybe
[Type]) -- Its *representation* arg types
-- Returns (Just ...) for any
-- concrete (i.e. constructors visible)
-- single-constructor
-- not existentially quantified
-- type whether a data type or a new type
......@@ -413,10 +414,13 @@ splitProductType_maybe
-- it through till someone finds it's important.
splitProductType_maybe ty
= case splitAlgTyConApp_maybe ty of
Just (tycon,ty_args,[data_con])
| isProductTyCon tycon -- Includes check for non-existential
= case splitTyConApp_maybe ty of
Just (tycon,ty_args)
| isProductTyCon tycon -- Includes check for non-existential,
-- and for constructors visible
-> Just (tycon, ty_args, data_con, dataConArgTys data_con ty_args)
where
data_con = head (tyConDataConsIfAvailable tycon)
other -> Nothing
splitProductType str ty
......
......@@ -66,7 +66,8 @@ type MaybeAbsent = Bool -- True <=> not even used
wwLazy = WwLazy False
wwStrict = WwStrict
wwUnpackData xs = WwUnpack DataType False xs
wwUnpackNew x = WwUnpack NewType False [x]
wwUnpackNew x = ASSERT( isStrict x) -- Invariant
WwUnpack NewType False [x]
wwPrim = WwPrim
wwEnum = WwEnum
......@@ -87,25 +88,20 @@ seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
%************************************************************************
\begin{code}
isLazy :: Demand -> Bool
-- Even a demand of (WwUnpack NewType _ _) is strict
-- We don't create such a thing unless the demand inside is strict
isLazy (WwLazy _) = True
isLazy _ = False
isStrict :: Demand -> Bool
isStrict (WwUnpack NewType _ ds) = isStrict (head ds)
isStrict (WwUnpack other _ _) = True
isStrict WwStrict = True
isStrict WwEnum = True
isStrict WwPrim = True
isStrict _ = False
isStrict d = not (isLazy d)
isPrim :: Demand -> Bool
isPrim WwPrim = True
isPrim other = False
\end{code}
\begin{code}
isLazy :: Demand -> Bool
isLazy (WwLazy False) = True -- NB "Absent" args do *not* count!
isLazy _ = False -- (as they imply a worker)
\end{code}
%************************************************************************
%* *
......@@ -174,6 +170,7 @@ data StrictnessInfo
-- BUT NB: f = \x y. error "urk"
-- will have info SI [SS] True
-- but still (f) and (f 2) are not bot; only (f 3 2) is bot
deriving( Eq )
-- NOTA BENE: if the arg demands are, say, [S,L], this means that
-- (f bot) is not necy bot, only (f bot x) is bot
......@@ -191,8 +188,11 @@ seqStrictnessInfo other = ()
mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
mkStrictnessInfo (xs, is_bot)
| all isLazy xs && not is_bot = NoStrictnessInfo -- Uninteresting
| otherwise = StrictnessInfo xs is_bot
| all totally_boring xs && not is_bot = NoStrictnessInfo -- Uninteresting
| otherwise = StrictnessInfo xs is_bot
where
totally_boring (WwLazy False) = True
totally_boring other = False
noStrictnessInfo = NoStrictnessInfo
......@@ -203,8 +203,7 @@ isBottomingStrictness NoStrictnessInfo = False
appIsBottom (StrictnessInfo ds bot) n = bot && (n >= length ds)
appIsBottom NoStrictnessInfo n = False
ppStrictnessInfo NoStrictnessInfo = empty
ppStrictnessInfo (StrictnessInfo wrapper_args bot)
= hsep [ptext SLIT("__S"), pprDemands wrapper_args bot]
ppStrictnessInfo NoStrictnessInfo = empty
ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
\end{code}
......@@ -95,7 +95,7 @@ import OccName ( UserFS )
import PrimRep ( PrimRep )
import PrimOp ( PrimOp, primOpIsCheap )
import TysPrim ( statePrimTyCon )
import FieldLabel ( FieldLabel(..) )
import FieldLabel ( FieldLabel )
import SrcLoc ( SrcLoc )
import Unique ( Unique, mkBuiltinUnique, getBuiltinUniques )
import Outputable
......
......@@ -290,6 +290,7 @@ data ArityInfo
-- functions in the module being compiled. Their arity
-- might increase later in the compilation process, if
-- an extra lambda floats up to the binding site.
deriving( Eq )
seqArity :: ArityInfo -> ()
seqArity a = arityLowerBound a `seq` ()
......@@ -323,6 +324,7 @@ data InlinePragInfo
= NoInlinePragInfo
| IMustNotBeINLINEd Bool -- True <=> came from an INLINE prag, False <=> came from a NOINLINE prag
(Maybe Int) -- Phase number from pragma, if any
deriving( Eq )
-- The True, Nothing case doesn't need to be recorded
-- SEE COMMENTS WITH CoreUnfold.blackListed on the
......
......@@ -8,7 +8,7 @@ module Literal
( Literal(..) -- Exported to ParseIface
, mkMachInt, mkMachWord
, mkMachInt64, mkMachWord64
, isLitLitLit
, isLitLitLit, maybeLitLit
, literalType, literalPrimRep
, hashLiteral
......@@ -38,10 +38,6 @@ import Util ( thenCmp )
import Ratio ( numerator, denominator )
import FastString ( uniqueOfFS )
import Char ( ord, chr )
#if __GLASGOW_HASKELL__ >= 404
import GlaExts ( fromInt )
#endif
\end{code}
......@@ -179,6 +175,9 @@ double2FloatLit (MachDouble d) = MachFloat d
\begin{code}
isLitLitLit (MachLitLit _ _) = True
isLitLitLit _ = False
maybeLitLit (MachLitLit s t) = Just (s,t)
maybeLitLit _ = Nothing
\end{code}
Types
......
......@@ -37,7 +37,7 @@ import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy,
intPrimTy, realWorldStatePrimTy
)
import TysWiredIn ( boolTy, charTy, mkListTy )
import PrelMods ( pREL_ERR, pREL_GHC )
import PrelNames ( pREL_ERR, pREL_GHC )
import PrelRules ( primOpRule )
import Rules ( addRule )
import Type ( Type, ClassContext, mkDictTy, mkDictTys, mkTyConApp, mkTyVarTys,
......@@ -51,6 +51,7 @@ import PprType ( pprParendType )
import Module ( Module )
import CoreUtils ( exprType, mkInlineMe )
import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
import Literal ( Literal(..) )
import Subst ( mkTopTyVarSubst, substClasses )
import TyCon ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons, isDataTyCon,
tyConTheta, isProductTyCon, isUnboxedTupleTyCon )
......@@ -66,7 +67,7 @@ import PrimOp ( PrimOp(DataToTagOp, CCallOp),
primOpSig, mkPrimOpIdName,
CCall, pprCCallOp
)
import Demand ( wwStrict, wwPrim )
import Demand ( wwStrict, wwPrim, mkStrictnessInfo )
import DataCon ( DataCon, StrictnessMark(..),
dataConFieldLabels, dataConRepArity, dataConTyCon,
dataConArgTys, dataConRepType, dataConRepStrictness,
......@@ -168,7 +169,7 @@ mkDataConId work_name data_con
arity = dataConRepArity data_con
strict_info = StrictnessInfo (dataConRepStrictness data_con) False
strict_info = mkStrictnessInfo (dataConRepStrictness data_con, False)
cpr_info | isProductTyCon tycon &&
not (isUnboxedTupleTyCon tycon) &&
......@@ -373,9 +374,11 @@ Similarly for newtypes
unN = /\a -> \n:N -> coerce (a->a) n
\begin{code}
mkRecordSelId tycon field_label
-- Assumes that all fields with the same field label
-- have the same type
mkRecordSelId tycon field_label unpack_id
-- Assumes that all fields with the same field label have the same type
--
-- Annoyingly, we have to pass in the unpackCString# Id, because
-- we can't conjure it up out of thin air
= sel_id
where
sel_id = mkId (fieldLabelName field_label) selector_ty info
......@@ -441,8 +444,9 @@ mkRecordSelId tycon field_label
field_lbls = dataConFieldLabels data_con
maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_ids) field_label
error_expr = mkApps (Var rEC_SEL_ERROR_ID) [Type (unUsgTy field_tau), mkStringLit full_msg]
error_expr = mkApps (Var rEC_SEL_ERROR_ID) [Type (unUsgTy field_tau), err_string]
-- preserves invariant that type args are *not* usage-annotated on top. KSW 1999-04.
err_string = App (Var unpack_id) (Lit (MachStr (_PK_ full_msg)))
full_msg = showSDoc (sep [text "No match in record selector", ppr sel_id])
\end{code}
......@@ -459,6 +463,7 @@ there's nothing to do.
ToDo: unify with mkRecordSelId.
\begin{code}
mkDictSelId :: Name -> Class -> Id
mkDictSelId name clas
= sel_id
where
......
......@@ -5,6 +5,19 @@
Representing modules and their flavours.
Notes on DLLs
~~~~~~~~~~~~~
When compiling module A, which imports module B, we need to
know whether B will be in the same DLL as A.
If it's in the same DLL, we refer to B_f_closure
If it isn't, we refer to _imp__B_f_closure
When compiling A, we record in B's Module value whether it's
in a different DLL, by setting the DLL flag.
\begin{code}
module Module
(
......@@ -91,27 +104,6 @@ instance Show PackageInfo where -- Just used in debug prints of lex tokens
\end{code}
%************************************************************************
%* *
\subsection{System/user module}
%* *
%************************************************************************
We also track whether an imported module is from a 'system-ish' place. In this case
we don't record the fact that this module depends on it, nor usages of things
inside it.
Apr 00: We want to record dependencies on all modules other than
prelude modules else STG Hugs gets confused because it uses this
info to know what modules to link. (Compiled GHC uses command line
options to specify this.)
\begin{code}
data ModFlavour = PrelMod -- A Prelude module
| UserMod -- Not library-ish
\end{code}
%************************************************************************
%* *
\subsection{Where from}
......@@ -201,6 +193,7 @@ mkModule mod_nm pack_name
pack_info | pack_name == opt_InPackage = ThisPackage
| otherwise = AnotherPackage pack_name
mkVanillaModule :: ModuleName -> Module
mkVanillaModule name = Module name ThisPackage
-- Used temporarily when we first come across Foo.x in an interface
......
......@@ -21,7 +21,7 @@ module Name (
nameUnique, setNameUnique, setNameProvenance, getNameProvenance, setNameImportReason,
tidyTopName,
nameOccName, nameModule, setNameOcc, nameRdrName, setNameModule,
nameOccName, nameModule, setNameOcc, nameRdrName, setNameModule, toRdrName,
isUserExportedName, isUserImportedName, isUserImportedExplicitlyName,
maybeUserImportedFrom,
......@@ -29,6 +29,13 @@ module Name (
isSystemName, isLocalName, isGlobalName, isExternallyVisibleName,
-- Environment
NameEnv,
emptyNameEnv, unitNameEnv, nameEnvElts,
addToNameEnv_C, addToNameEnv, addListToNameEnv,
plusNameEnv, plusNameEnv_C, extendNameEnv,
lookupNameEnv, delFromNameEnv, elemNameEnv,
-- Provenance
Provenance(..), ImportReason(..), pprProvenance,
......@@ -51,7 +58,8 @@ import RdrName ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule )
import CmdLineOpts ( opt_Static, opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
import SrcLoc ( noSrcLoc, mkBuiltinSrcLoc, SrcLoc )
import Unique ( pprUnique, Unique, Uniquable(..), unboundKey, u2i )
import Unique ( pprUnique, Unique, Uniquable(..), hasKey, unboundKey, u2i )
import UniqFM
import Outputable
import GlaExts
\end{code}
......@@ -179,7 +187,7 @@ mkUnboundName :: RdrName -> Name
mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
isUnboundName :: Name -> Bool
isUnboundName name = getUnique name == unboundKey
isUnboundName name = name `hasKey` unboundKey
\end{code}
\begin{code}
......@@ -420,6 +428,8 @@ nameSortModule (WiredInId mod _) = mod
nameSortModule (WiredInTyCon mod _) = mod
nameRdrName :: Name -> RdrName
-- Makes a qualified name for top-level (Global) names, whether locally defined or not
-- and an unqualified name just for Locals
nameRdrName (Name { n_sort = Local, n_occ = occ }) = mkRdrUnqual occ
nameRdrName (Name { n_sort = sort, n_occ = occ }) = mkRdrQual (moduleName (nameSortModule sort)) occ
......@@ -486,13 +496,16 @@ isGlobalName other = True
isExternallyVisibleName name = isGlobalName name
hasBetterProv :: Name -> Name -> Bool
hasBetterProv name1 name2
= case n_prov name1 of
LocalDef _ _ -> True
SystemProv -> False
NonLocalDef _ _ -> case n_prov name2 of
LocalDef _ _ -> False
other -> True
-- Choose
-- a local thing over an imported thing
-- a user-imported thing over a non-user-imported thing
-- an explicitly-imported thing over an implicitly imported thing
hasBetterProv n1 n2
= case (n_prov n1, n_prov n2) of
(LocalDef _ _, _ ) -> True
(NonLocalDef (UserImport _ _ True) _, _ ) -> True
(NonLocalDef (UserImport _ _ _ ) _, NonLocalDef ImplicitImport _) -> True
other -> False
isSystemName (Name {n_prov = SystemProv}) = True
isSystemName other = False
......@@ -529,6 +542,43 @@ instance NamedThing Name where
\end{code}
%************************************************************************
%* *
\subsection{Name environment}
%* *
%************************************************************************
\begin{code}
type NameEnv a = UniqFM a -- Domain is Name
emptyNameEnv :: NameEnv a
nameEnvElts :: NameEnv a -> [a]
addToNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
addToNameEnv :: NameEnv a -> Name -> a -> NameEnv a
addListToNameEnv :: NameEnv a -> [(Name,a)] -> NameEnv a
plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
extendNameEnv :: NameEnv a -> [(Name,a)] -> NameEnv a
lookupNameEnv :: NameEnv a -> Name -> Maybe a
delFromNameEnv :: NameEnv a -> Name -> NameEnv a
elemNameEnv :: Name -> NameEnv a -> Bool
unitNameEnv :: Name -> a -> NameEnv a
emptyNameEnv = emptyUFM
nameEnvElts = eltsUFM
addToNameEnv_C = addToUFM_C
addToNameEnv = addToUFM
addListToNameEnv = addListToUFM
plusNameEnv = plusUFM
plusNameEnv_C = plusUFM_C
extendNameEnv = addListToUFM
lookupNameEnv = lookupUFM
delFromNameEnv = delFromUFM
elemNameEnv = elemUFM
unitNameEnv = unitUFM
\end{code}
%************************************************************************
%* *
\subsection{Pretty printing}
......
......@@ -69,7 +69,14 @@ pprEncodedFS :: EncodedFS -> SDoc
pprEncodedFS fs
= getPprStyle $ \ sty ->
if userStyle sty then
text (decode (_UNPK_ fs))
let
s = decode (_UNPK_ fs)
c = head s
in
if startsVarSym c || startsConSym c then
parens (text s)
else
text s
else
ptext fs
\end{code}
......@@ -614,32 +621,29 @@ isLexSym cs = isLexConSym cs || isLexVarSym cs
isLexConId cs -- Prefix type or data constructors
| _NULL_ cs = False -- e.g. "Foo", "[]", "(,)"
| cs == SLIT("[]") = True
| c == '(' = True -- (), (,), (,,), ...
| otherwise = isUpper c || isUpperISO c
where
c = _HEAD_ cs
| otherwise = startsConId (_HEAD_ cs)
isLexVarId cs -- Ordinary prefix identifiers
| _NULL_ cs = False -- e.g. "x", "_x"
| otherwise = isLower c || isLowerISO c || c == '_'
where
c = _HEAD_ cs
| otherwise = startsVarId (_HEAD_ cs)
isLexConSym cs -- Infix type or data constructors
| _NULL_ cs = False -- e.g. ":-:", ":", "->"
| otherwise = c == ':'
|| cs == SLIT("->")
where
c = _HEAD_ cs
| cs == SLIT("->") = True
| otherwise = startsConSym (_HEAD_ cs)
isLexVarSym cs -- Infix identifiers
| _NULL_ cs = False -- e.g. "+"
| otherwise = isSymbolASCII c
|| isSymbolISO c
where
c = _HEAD_ cs
| otherwise = startsVarSym (_HEAD_ cs)
-------------
startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
startsVarSym c = isSymbolASCII c || isSymbolISO c -- Infix Ids
startsConSym c = c == ':' -- Infix data constructors
startsVarId c = isLower c || isLowerISO c || c == '_' -- Ordinary Ids
startsConId c = isUpper c || isUpperISO c || c == '(' -- Ordinary type constructors and data constructors
isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
isSymbolISO c = ord c `elem` (0xd7 : 0xf7 : [0xa1 .. 0xbf])
isUpperISO (C# c#) = c# `geChar#` '\xc0'# && c# `leChar#` '\xde'# && c# `neChar#` '\xd7'#
......
......@@ -17,7 +17,15 @@ module RdrName (
-- Destruction
rdrNameModule, rdrNameOcc, setRdrNameOcc,
isRdrDataCon, isRdrTyVar, isQual, isUnqual
isRdrDataCon, isRdrTyVar, isQual, isUnqual,
-- Environment
RdrNameEnv,
emptyRdrEnv, lookupRdrEnv, addListToRdrEnv, rdrEnvElts,
extendRdrEnv, rdrEnvToList,
-- Printing; instance Outputable RdrName
pprUnqualRdrName
) where
#include "HsVersions.h"
......@@ -31,6 +39,7 @@ import OccName ( NameSpace, tcName,
import Module ( ModuleName, pprModuleName,
mkSysModuleFS, mkSrcModuleFS
)
import FiniteMap
import Outputable
import Util ( thenCmp )
\end{code}
......@@ -134,8 +143,10 @@ isQual rdr_name = not (isUnqual rdr_name)
instance Outputable RdrName where
ppr (RdrName qual occ) = pp_qual qual <> ppr occ
where
pp_qual Unqual = empty
pp_qual (Qual mod) = pprModuleName mod <> dot
pp_qual Unqual = empty
pp_qual (Qual mod) = pprModuleName mod <> dot
pprUnqualRdrName (RdrName qual occ) = ppr occ
instance Eq RdrName where
a == b = case (a `compare` b) of { EQ -> True; _ -> False }
......@@ -159,3 +170,26 @@ cmpQual (Qual m1) (Qual m2) = m1 `compare` m2
%************************************************************************
%* *