projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
bdd9123
)
warning removal
author
Simon Marlow
<simonmar@microsoft.com>
Tue, 9 Oct 2007 10:51:38 +0000
(10:51 +0000)
committer
Simon Marlow
<simonmar@microsoft.com>
Tue, 9 Oct 2007 10:51:38 +0000
(10:51 +0000)
compiler/main/HscTypes.lhs
patch
|
blob
|
history
diff --git
a/compiler/main/HscTypes.lhs
b/compiler/main/HscTypes.lhs
index
43063be
..
d0c2f13
100644
(file)
--- a/
compiler/main/HscTypes.lhs
+++ b/
compiler/main/HscTypes.lhs
@@
-4,13
+4,6
@@
\section[HscTypes]{Types for the per-module compiler}
\begin{code}
\section[HscTypes]{Types for the per-module compiler}
\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module HscTypes (
-- * Sessions and compilation state
Session(..), withSession, modifySession,
module HscTypes (
-- * Sessions and compilation state
Session(..), withSession, modifySession,
@@
-122,7
+115,6
@@
import UniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqSupply ( UniqSupply )
import FastString ( FastString )
import StringBuffer ( StringBuffer )
import UniqSupply ( UniqSupply )
import FastString ( FastString )
import StringBuffer ( StringBuffer )
-import Util
import System.Time ( ClockTime )
import Data.IORef
import System.Time ( ClockTime )
import Data.IORef
@@
-238,6
+230,7
@@
pprTarget (Target id _) = pprTargetId id
instance Outputable Target where
ppr = pprTarget
instance Outputable Target where
ppr = pprTarget
+pprTargetId :: TargetId -> SDoc
pprTargetId (TargetModule m) = ppr m
pprTargetId (TargetFile f _) = text f
pprTargetId (TargetModule m) = ppr m
pprTargetId (TargetFile f _) = text f
@@
-250,7
+243,10
@@
type HomePackageTable = ModuleNameEnv HomeModInfo
type PackageIfaceTable = ModuleEnv ModIface
-- Domain = modules in the imported packages
type PackageIfaceTable = ModuleEnv ModIface
-- Domain = modules in the imported packages
+emptyHomePackageTable :: HomePackageTable
emptyHomePackageTable = emptyUFM
emptyHomePackageTable = emptyUFM
+
+emptyPackageIfaceTable :: PackageIfaceTable
emptyPackageIfaceTable = emptyModuleEnv
data HomeModInfo
emptyPackageIfaceTable = emptyModuleEnv
data HomeModInfo
@@
-501,6
+497,7
@@
data ModDetails
md_vect_info :: !VectInfo -- Vectorisation information
}
md_vect_info :: !VectInfo -- Vectorisation information
}
+emptyModDetails :: ModDetails
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
md_exports = [],
md_insts = [],
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
md_exports = [],
md_insts = [],
@@
-679,6
+676,7
@@
data InteractiveContext
}
}
+emptyInteractiveContext :: InteractiveContext
emptyInteractiveContext
= InteractiveContext { ic_toplev_scope = [],
ic_exports = [],
emptyInteractiveContext
= InteractiveContext { ic_toplev_scope = [],
ic_exports = [],
@@
-806,7
+804,7
@@
mkPrintUnqualified dflags env = (qual_name, qual_mod)
implicitTyThings :: TyThing -> [TyThing]
-- If you change this, make sure you change LoadIface.ifaceDeclSubBndrs in sync
implicitTyThings :: TyThing -> [TyThing]
-- If you change this, make sure you change LoadIface.ifaceDeclSubBndrs in sync
-implicitTyThings (AnId id) = []
+implicitTyThings (AnId _) = []
-- For type constructors, add the data cons (and their extras),
-- and the selectors and generic-programming Ids too
-- For type constructors, add the data cons (and their extras),
-- and the selectors and generic-programming Ids too
@@
-840,10
+838,12
@@
isImplicitTyThing (AClass _) = False
isImplicitTyThing (ATyCon tc) = isImplicitTyCon tc
-- For newtypes and indexed data types, add the implicit coercion tycon
isImplicitTyThing (ATyCon tc) = isImplicitTyCon tc
-- For newtypes and indexed data types, add the implicit coercion tycon
+implicitCoTyCon :: TyCon -> [TyThing]
implicitCoTyCon tc
= map ATyCon . catMaybes $ [newTyConCo_maybe tc,
tyConFamilyCoercion_maybe tc]
implicitCoTyCon tc
= map ATyCon . catMaybes $ [newTyConCo_maybe tc,
tyConFamilyCoercion_maybe tc]
+extras_plus :: TyThing -> [TyThing]
extras_plus thing = thing : implicitTyThings thing
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
extras_plus thing = thing : implicitTyThings thing
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
@@
-907,15
+907,19
@@
lookupType dflags hpt pte name
\end{code}
\begin{code}
\end{code}
\begin{code}
+tyThingTyCon :: TyThing -> TyCon
tyThingTyCon (ATyCon tc) = tc
tyThingTyCon other = pprPanic "tyThingTyCon" (pprTyThing other)
tyThingTyCon (ATyCon tc) = tc
tyThingTyCon other = pprPanic "tyThingTyCon" (pprTyThing other)
+tyThingClass :: TyThing -> Class
tyThingClass (AClass cls) = cls
tyThingClass other = pprPanic "tyThingClass" (pprTyThing other)
tyThingClass (AClass cls) = cls
tyThingClass other = pprPanic "tyThingClass" (pprTyThing other)
+tyThingDataCon :: TyThing -> DataCon
tyThingDataCon (ADataCon dc) = dc
tyThingDataCon other = pprPanic "tyThingDataCon" (pprTyThing other)
tyThingDataCon (ADataCon dc) = dc
tyThingDataCon other = pprPanic "tyThingDataCon" (pprTyThing other)
+tyThingId :: TyThing -> Id
tyThingId (AnId id) = id
tyThingId other = pprPanic "tyThingId" (pprTyThing other)
\end{code}
tyThingId (AnId id) = id
tyThingId other = pprPanic "tyThingId" (pprTyThing other)
\end{code}
@@
-943,7
+947,7
@@
mkIfaceVerCache pairs
add_imp bndr env = extendOccEnv env bndr (decl_name, v)
emptyIfaceVerCache :: OccName -> Maybe (OccName, Version)
add_imp bndr env = extendOccEnv env bndr (decl_name, v)
emptyIfaceVerCache :: OccName -> Maybe (OccName, Version)
-emptyIfaceVerCache occ = Nothing
+emptyIfaceVerCache _occ = Nothing
------------------ Deprecations -------------------------
data Deprecs a
------------------ Deprecations -------------------------
data Deprecs a
@@
-961,18
+965,18
@@
type Deprecations = Deprecs (NameEnv (OccName,DeprecTxt))
-- deprecation appears.
mkIfaceDepCache:: IfaceDeprecs -> Name -> Maybe DeprecTxt
-- deprecation appears.
mkIfaceDepCache:: IfaceDeprecs -> Name -> Maybe DeprecTxt
-mkIfaceDepCache NoDeprecs = \n -> Nothing
-mkIfaceDepCache (DeprecAll t) = \n -> Just t
+mkIfaceDepCache NoDeprecs = \_ -> Nothing
+mkIfaceDepCache (DeprecAll t) = \_ -> Just t
mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
emptyIfaceDepCache :: Name -> Maybe DeprecTxt
mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
emptyIfaceDepCache :: Name -> Maybe DeprecTxt
-emptyIfaceDepCache n = Nothing
+emptyIfaceDepCache _ = Nothing
plusDeprecs :: Deprecations -> Deprecations -> Deprecations
plusDeprecs d NoDeprecs = d
plusDeprecs NoDeprecs d = d
plusDeprecs :: Deprecations -> Deprecations -> Deprecations
plusDeprecs d NoDeprecs = d
plusDeprecs NoDeprecs d = d
-plusDeprecs d (DeprecAll t) = DeprecAll t
-plusDeprecs (DeprecAll t) d = DeprecAll t
+plusDeprecs _ (DeprecAll t) = DeprecAll t
+plusDeprecs (DeprecAll t) _ = DeprecAll t
plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 `plusNameEnv` v2)
\end{code}
plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 `plusNameEnv` v2)
\end{code}
@@
-1008,7
+1012,7
@@
availName (AvailTC n _) = n
availNames :: GenAvailInfo name -> [name]
availNames (Avail n) = [n]
availNames :: GenAvailInfo name -> [name]
availNames (Avail n) = [n]
-availNames (AvailTC n ns) = ns
+availNames (AvailTC _ ns) = ns
instance Outputable n => Outputable (GenAvailInfo n) where
ppr = pprAvail
instance Outputable n => Outputable (GenAvailInfo n) where
ppr = pprAvail
@@
-1026,7
+1030,7
@@
mkIfaceFixCache pairs
env = mkOccEnv pairs
emptyIfaceFixCache :: OccName -> Fixity
env = mkOccEnv pairs
emptyIfaceFixCache :: OccName -> Fixity
-emptyIfaceFixCache n = defaultFixity
+emptyIfaceFixCache _ = defaultFixity
-- This fixity environment is for source code only
type FixityEnv = NameEnv FixItem
-- This fixity environment is for source code only
type FixityEnv = NameEnv FixItem
@@
-1426,7
+1430,7
@@
data Unlinked
| BCOs CompiledByteCode ModBreaks
#ifndef GHCI
| BCOs CompiledByteCode ModBreaks
#ifndef GHCI
-data CompiledByteCode = NoByteCode
+data CompiledByteCode
#endif
instance Outputable Unlinked where
#endif
instance Outputable Unlinked where
@@
-1434,23
+1438,27
@@
instance Outputable Unlinked where
ppr (DotA path) = text "DotA" <+> text path
ppr (DotDLL path) = text "DotDLL" <+> text path
#ifdef GHCI
ppr (DotA path) = text "DotA" <+> text path
ppr (DotDLL path) = text "DotDLL" <+> text path
#ifdef GHCI
- ppr (BCOs bcos _) = text "BCOs" <+> ppr bcos
+ ppr (BCOs bcos _) = text "BCOs" <+> ppr bcos
#else
#else
- ppr (BCOs bcos _) = text "No byte code"
+ ppr (BCOs _ _) = text "No byte code"
#endif
#endif
+isObject :: Unlinked -> Bool
isObject (DotO _) = True
isObject (DotA _) = True
isObject (DotDLL _) = True
isObject _ = False
isObject (DotO _) = True
isObject (DotA _) = True
isObject (DotDLL _) = True
isObject _ = False
+isInterpretable :: Unlinked -> Bool
isInterpretable = not . isObject
isInterpretable = not . isObject
+nameOfObject :: Unlinked -> FilePath
nameOfObject (DotO fn) = fn
nameOfObject (DotA fn) = fn
nameOfObject (DotDLL fn) = fn
nameOfObject other = pprPanic "nameOfObject" (ppr other)
nameOfObject (DotO fn) = fn
nameOfObject (DotA fn) = fn
nameOfObject (DotDLL fn) = fn
nameOfObject other = pprPanic "nameOfObject" (ppr other)
+byteCodeOfObject :: Unlinked -> CompiledByteCode
byteCodeOfObject (BCOs bc _) = bc
byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other)
\end{code}
byteCodeOfObject (BCOs bc _) = bc
byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other)
\end{code}