From 6e33ebee2afd2fb3e7a58944e08a98de99e290f0 Mon Sep 17 00:00:00 2001 From: sof Date: Mon, 26 May 1997 04:02:36 +0000 Subject: [PATCH] [project @ 1997-05-26 04:02:36 by sof] Improved ppr; tify up --- ghc/compiler/rename/RnEnv.lhs | 74 ++++++++++------------------------------- 1 file changed, 17 insertions(+), 57 deletions(-) diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index 9f81643..b734653 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -16,13 +16,14 @@ import RdrHsSyn ( RdrName(..), SYN_IE(RdrNameIE), rdrNameOcc, ieOcc, isQual, qual ) import HsTypes ( getTyVarName, replaceTyVarName ) +import BasicTypes ( Fixity(..), FixityDirection(..) ) import RnMonad -import Name ( Name, OccName(..), Provenance(..), DefnInfo(..), ExportFlag(..), +import Name ( Name, OccName(..), Provenance(..), DefnInfo(..), ExportFlag(..), NamedThing(..), occNameString, occNameFlavour, SYN_IE(NameSet), emptyNameSet, addListToNameSet, mkLocalName, mkGlobalName, modAndOcc, isLocallyDefinedName, isWiredInName, nameOccName, setNameProvenance, isVarOcc, getNameProvenance, - pprProvenance, pprOccName, pprModule, pprNonSymOcc, pprNameProvenance + pprProvenance, pprOccName, pprModule, pprNameProvenance ) import TyCon ( TyCon ) import TysWiredIn ( tupleTyCon, listTyCon, charTyCon, intTyCon ) @@ -34,7 +35,7 @@ import Maybes ( maybeToBool ) import UniqSupply import SrcLoc ( SrcLoc, noSrcLoc ) import Pretty -import PprStyle ( PprStyle(..) ) +import Outputable ( PprStyle(..) ) import Util --( panic, removeDups, pprTrace, assertPanic ) #if __GLASGOW_HASKELL__ >= 202 import List (nub) @@ -129,7 +130,7 @@ newSysName occ export_flag loc mod_name occ (\_ -> export_flag) loc - InterfaceMode -> newGlobalName mod_name occ + InterfaceMode _ -> newGlobalName mod_name occ -- newDfunName is a variant, specially for dfuns. -- When renaming derived definitions we are in *interface* mode (because we can trip @@ -261,7 +262,7 @@ lookupRn name_env rdr_name -- Not found when processing an imported declaration, -- so we create a new name for the purpose - InterfaceMode -> + InterfaceMode _ -> case rdr_name of Qual mod_name occ -> newGlobalName mod_name occ @@ -285,7 +286,7 @@ lookupOccRn :: RdrName -> RnMS s Name lookupOccRn rdr_name = getNameEnv `thenRn` \ name_env -> lookupRn name_env rdr_name `thenRn` \ name -> - addOccurrenceName Compulsory name + addOccurrenceName name -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global -- environment. It's used for record field names only. @@ -293,15 +294,7 @@ lookupGlobalOccRn :: RdrName -> RnMS s Name lookupGlobalOccRn rdr_name = getGlobalNameEnv `thenRn` \ name_env -> lookupRn name_env rdr_name `thenRn` \ name -> - addOccurrenceName Compulsory name - --- lookupOptionalOccRn is similar, but it's used in places where --- we don't *have* to find a definition for the thing. -lookupOptionalOccRn :: RdrName -> RnMS s Name -lookupOptionalOccRn rdr_name - = getNameEnv `thenRn` \ name_env -> - lookupRn name_env rdr_name `thenRn` \ name -> - addOccurrenceName Optional name + addOccurrenceName name @@ -324,13 +317,13 @@ lookupOptionalOccRn rdr_name lookupImplicitOccRn :: RdrName -> RnMS s Name lookupImplicitOccRn (Qual mod occ) = newGlobalName mod occ `thenRn` \ name -> - addOccurrenceName Compulsory name + addOccurrenceName name -addImplicitOccRn :: Name -> RnM s d Name -addImplicitOccRn name = addOccurrenceName Compulsory name +addImplicitOccRn :: Name -> RnMS s Name +addImplicitOccRn name = addOccurrenceName name -addImplicitOccsRn :: [Name] -> RnM s d () -addImplicitOccsRn names = addOccurrenceNames Compulsory names +addImplicitOccsRn :: [Name] -> RnMS s () +addImplicitOccsRn names = addOccurrenceNames names listType_RDR = qual (modAndOcc listType_name) tupleType_RDR n = qual (modAndOcc (tupleType_name n)) @@ -485,39 +478,6 @@ filterAvail (IEThingAll _) avail@(AvailTC _ _) = avail filterAvail ie avail = NotAvailable -{- OLD to be deleted -hideAvail :: RdrNameIE -- Hide this - -> AvailInfo -- Available - -> AvailInfo -- Resulting available; --- Don't complain about hiding non-existent things; that's done elsewhere - -hideAvail ie NotAvailable - = NotAvailable - -hideAvail ie (Avail n) - | not (ieOcc ie == nameOccName n) = Avail n -- No match - | otherwise = NotAvailable -- Names match - -hideAvail ie (AvailTC n ns) - | not (ieOcc ie == nameOccName n) -- No match - = case ie of -- But in case we are faced with ...hiding( (+) ) - -- we filter the "ns" anyhow - IEVar op -> AvailTC n (filter keep ns) - where - op_occ = rdrNameOcc op - keep n = nameOccName n /= op_occ - - other -> AvailTC n ns - - | otherwise -- Names match - = case ie of - IEThingAbs _ -> AvailTC n (filter (/= n) ns) - IEThingAll _ -> NotAvailable - IEThingWith hide hides -> AvailTC n (filter keep ns) - where - keep n = nameOccName n `notElem` hide_occs - hide_occs = map rdrNameOcc (hide : hides) --} -- In interfaces, pprAvail gets given the OccName of the "host" thing pprAvail PprInterface avail = ppr_avail (pprOccName PprInterface . nameOccName) avail @@ -573,12 +533,12 @@ conflictFM bad fm key elt \begin{code} nameClashErr (rdr_name, (name1,name2)) sty - = hang (hsep [ptext SLIT("Conflicting definitions for: "), ppr sty rdr_name]) + = hang (hsep [ptext SLIT("Conflicting definitions for:"), ppr sty rdr_name]) 4 (vcat [pprNameProvenance sty name1, pprNameProvenance sty name2]) fixityClashErr (rdr_name, (fp1,fp2)) sty - = hang (hsep [ptext SLIT("Conflicting fixities for: "), ppr sty rdr_name]) + = hang (hsep [ptext SLIT("Conflicting fixities for:"), ppr sty rdr_name]) 4 (vcat [pprFixityProvenance sty fp1, pprFixityProvenance sty fp2]) @@ -594,14 +554,14 @@ unknownNameErr name sty qualNameErr descriptor (name,loc) = pushSrcLocRn loc $ - addErrRn (\sty -> hsep [ ptext SLIT("invalid use of qualified name"), + addErrRn (\sty -> hsep [ ptext SLIT("Invalid use of qualified name"), ppr sty name, ptext SLIT("in"), descriptor sty]) dupNamesErr descriptor ((name,loc) : dup_things) = pushSrcLocRn loc $ - addErrRn (\sty -> hsep [ptext SLIT("duplicate bindings of"), + addErrRn (\sty -> hsep [ptext SLIT("Conflicting definitions for"), ppr sty name, ptext SLIT("in"), descriptor sty]) \end{code} -- 1.7.10.4