Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
fd742437
Commit
fd742437
authored
Nov 10, 2011
by
dterei
Browse files
Remove cruft code from FlagChecker
parent
a77a68e7
Changes
1
Hide whitespace changes
Inline
Side-by-side
compiler/iface/FlagChecker.hs
View file @
fd742437
{-# LANGUAGE RecordWildCards #-}
-- -----------------------------------------------------------------------------
-- | This module manages storing the various GHC option flags in a modules
-- interface file as part of the recompilation checking infrastructure.
--
module
FlagChecker
(
fingerprintDynFlags
)
where
...
...
@@ -17,22 +15,6 @@ import Fingerprint
import
Data.List
(
sort
)
{-
Note [DynFlags Hash]
~~~~~~~~~~~~~~~~~~~
We only hash fields from DynFlags that are of high importance as they stop
link and build errors occurring (e.g the '--main-is' flag, see trac #437).
An alternative design would be to return two fingerprints where the first one
encodes flags that if different mean that the module itself should be
recompiled but only this module. The second fingerprint is for flags that mean
that not only the module itself should be recompiled but also modules that
depend on it. (i.e the second fingerprint affects the modules ABI).
This design hasn't been implemented as it's tricky to fit in with the current
recompilation manager and its not sure how beneficial it is.
-}
-- | Produce a fingerprint of a @DynFlags@ value. We only base
-- the finger print on important fields in @DynFlags@ so that
-- the recompilation checker can use this fingerprint.
...
...
@@ -40,13 +22,7 @@ fingerprintDynFlags :: DynFlags -> (BinHandle -> Name -> IO ())
->
IO
Fingerprint
fingerprintDynFlags
DynFlags
{
..
}
nameio
=
let
-- DriverPipeline.getLinkInfo handles this info I believe
-- rtsopts = (rtsOptsEnabled dflags, rtsOpts dflags)
-- Probably not a good idea
-- optlvl = optLevel dflags
mainis
=
(
mainModIs
,
mainFunIs
)
let
mainis
=
(
mainModIs
,
mainFunIs
)
-- pkgopts = (thisPackage dflags, sort $ packageFlags dflags)
safeHs
=
setSafeMode
safeHaskell
-- oflags = sort $ filter filterOFlags $ flags dflags
...
...
@@ -65,81 +41,3 @@ fingerprintDynFlags DynFlags{..} nameio =
in
computeFingerprint
nameio
(
mainis
,
safeHs
,
lang
,
cpp
,
paths
)
{-
-- | Should the @DynFlag@ be included in the fingerprint?
filterOFlags :: DynFlag -> Bool
filterOFlags Opt_EnableRewriteRules = True
filterOFlags Opt_Vectorise = True
filterOFlags Opt_IgnoreInterfacePragmas = True
filterOFlags Opt_OmitInterfacePragmas = True
filterOFlags Opt_ExposeAllUnfoldings = True
filterOFlags Opt_ReadUserPackageConf = True
filterOFlags Opt_NoHsMain = True
filterOFlags Opt_SSE2 = True
filterOFlags Opt_SSE4_2 = True
filterOFlags Opt_PackageTrust = True
filterOFlags _ = False
-}
-- -----------------------------------------------------------------------------
-- Instances needed for Binary
-- -----------------------------------------------------------------------------
{-
deriving instance Ord DynFlag
deriving instance Enum DynFlag
deriving instance Ord ExtensionFlag
deriving instance Enum ExtensionFlag
-- NOTE: We're converting from int to byte8 here, so be careful if we
-- ever get more DynFlag or ExtensionFlag constructors than 256.
instance Binary DynFlag where
put_ bh = (putByte bh . fromIntegral . fromEnum)
get bh = getByte bh >>= (return . toEnum . fromIntegral)
instance Binary ExtensionFlag where
put_ bh = (putByte bh . fromIntegral . fromEnum)
get bh = getByte bh >>= (return . toEnum . fromIntegral)
-- | RtsOptsEnabled Binary Instance
instance Binary RtsOptsEnabled where
put_ bh rtsopts =
case rtsopts of
RtsOptsNone -> putByte bh 0
RtsOptsSafeOnly -> putByte bh 1
RtsOptsAll -> putByte bh 2
get bh = do
x <- getByte bh
case x of
0 -> return RtsOptsNone
1 -> return RtsOptsSafeOnly
2 -> return RtsOptsAll
_ -> error "Unhandled RtsOptsEnabled serilization"
-- | PackageFlag Binary Instance
instance Binary PackageFlag where
put_ bh pflag =
case pflag of
(ExposePackage s) -> store 0 s
(ExposePackageId s) -> store 1 s
(HidePackage s) -> store 2 s
(IgnorePackage s) -> store 3 s
(TrustPackage s) -> store 4 s
(DistrustPackage s) -> store 5 s
where store n s = putByte bh n >> put_ bh s
get bh = do
n <- getByte bh
s <- get bh
return $ case n of
0 -> ExposePackage s
1 -> ExposePackageId s
2 -> HidePackage s
3 -> IgnorePackage s
4 -> TrustPackage s
5 -> DistrustPackage s
_ -> error "Unhandled PackageFlag serilization"
-}
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment