Commit aa479953 authored by Edward Z. Yang's avatar Edward Z. Yang

Implementation of hsig (module signatures), per #9252

Summary:
Module signatures, like hs-boot files, are Haskell modules which omit
value definitions and contain only signatures.  This patchset implements
one particular aspect of module signature, namely compiling them against
a concrete implementation.  It works like this: when we compile an hsig
file, we must be told (via the -sig-of flag) what module this signature
is implementing.  The signature is compiled into an interface file which
reexports precisely the entities mentioned in the signature file.  We also
verify that the interface is compatible with the implementation.

This feature is useful in a few situations:

    1. Like explicit import lists, signatures can be used to reduce
    sensitivity to upstream changes.  However, a signature can be defined
    once and then reused by many modules.

    2. Signatures can be used to quickly check if a new upstream version
    is compatible, by typechecking just the signatures and not the actual
    modules.

    3. A signature can be used to mediate separate modular development,
    where the signature is used as a placeholder for functionality which
    is loaded in later.  (This is only half useful at the moment, since
    typechecking against signatures without implementations is not implemented
    in this patchset.)

Unlike hs-boot files, hsig files impose no performance overhead.

This patchset punts on the type class instances (and type families) problem:
instances simply leak from the implementation to the signature.  You can
explicitly specify what instances you expect to have, and those will be checked,
but you may get more instances than you asked for.  Our eventual plan is
to allow hiding instances, but to consider all transitively reachable instances
when considering overlap and soundness.

ToDo: signature merging: when a module is provided by multiple signatures
for the same base implementation, we should not consider this ambiguous.

ToDo: at the moment, signatures do not constitute use-sites, so if you
write a signature for a deprecated function, you won't get a warning
when you compile the signature.

Future work: The ability to feed in shaping information so that we can take
advantage of more type equalities than might be immediately evident.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate and new tests

Reviewers: simonpj, simonmar, hvr, austin

Subscribers: simonmar, relrod, ezyang, carter, goldfire

Differential Revision: https://phabricator.haskell.org/D130

GHC Trac Issues: #9252
parent 5bb73d79
......@@ -48,6 +48,7 @@ module Name (
-- ** Manipulating and deconstructing 'Name's
nameUnique, setNameUnique,
nameOccName, nameModule, nameModule_maybe,
setNameLoc,
tidyNameOcc,
localiseName,
mkLocalisedOccName,
......@@ -317,6 +318,11 @@ mkFCallName uniq str = mkInternalName uniq (mkVarOcc str) noSrcSpan
setNameUnique :: Name -> Unique -> Name
setNameUnique name uniq = name {n_uniq = getKeyFastInt uniq}
-- This is used for hsigs: we want to use the name of the originally exported
-- entity, but edit the location to refer to the reexport site
setNameLoc :: Name -> SrcSpan -> Name
setNameLoc name loc = name {n_loc = loc}
tidyNameOcc :: Name -> OccName -> Name
-- We set the OccName of a Name when tidying
-- In doing so, we change System --> Internal, so that when we print
......
......@@ -108,7 +108,7 @@ deSugar hsc_env
_ -> True)
; (binds_cvr, ds_hpc_info, modBreaks)
<- if want_ticks && not (isHsBoot hsc_src)
<- if want_ticks && not (isHsBootOrSig hsc_src)
then addTicksToBinds dflags mod mod_loc export_set
(typeEnvTyCons type_env) binds
else return (binds, hpcInfo, emptyModBreaks)
......@@ -165,7 +165,7 @@ deSugar hsc_env
; let mod_guts = ModGuts {
mg_module = mod,
mg_boot = isHsBoot hsc_src,
mg_boot = hsc_src == HsBootFile,
mg_exports = exports,
mg_deps = deps,
mg_used_names = used_names,
......
......@@ -745,6 +745,7 @@ pprModIface iface
, nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash iface))
, nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface))
, nest 2 (text "flag hash:" <+> ppr (mi_flag_hash iface))
, nest 2 (text "sig of:" <+> ppr (mi_sig_of iface))
, nest 2 (text "used TH splices:" <+> ppr (mi_used_th iface))
, nest 2 (ptext (sLit "where"))
, ptext (sLit "exports:")
......
......@@ -191,7 +191,8 @@ mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
used_th <- readIORef tc_splice_used
dep_files <- (readIORef dependent_files)
mkIface_ hsc_env maybe_old_fingerprint
this_mod (isHsBoot hsc_src) used_names used_th deps rdr_env
this_mod (hsc_src == HsBootFile) used_names
used_th deps rdr_env
fix_env warns hpc_info (imp_mods imports)
(imp_trust_own_pkg imports) dep_files safe_mode mod_details
......@@ -279,9 +280,11 @@ mkIface_ hsc_env maybe_old_fingerprint
iface_vect_info = flattenVectInfo vect_info
trust_info = setSafeMode safe_mode
annotations = map mkIfaceAnnotation anns
sig_of = getSigOf dflags (moduleName this_mod)
intermediate_iface = ModIface {
mi_module = this_mod,
mi_sig_of = sig_of,
mi_boot = is_boot,
mi_deps = deps,
mi_usages = usages,
......@@ -1259,6 +1262,9 @@ checkVersions hsc_env mod_summary iface
; recomp <- checkFlagHash hsc_env iface
; if recompileRequired recomp then return (recomp, Nothing) else do {
; if getSigOf (hsc_dflags hsc_env) (moduleName (mi_module iface))
/= mi_sig_of iface
then return (RecompBecause "sig-of changed", Nothing) else do {
; recomp <- checkDependencies hsc_env mod_summary iface
; if recompileRequired recomp then return (recomp, Just iface) else do {
......@@ -1278,7 +1284,7 @@ checkVersions hsc_env mod_summary iface
; updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
; return (recomp, Just iface)
}}}
}}}}
where
this_pkg = thisPackage (hsc_dflags hsc_env)
-- This is a bit of a hack really
......
......@@ -321,7 +321,7 @@ tcHiBootIface :: HscSource -> Module -> TcRn ModDetails
-- if it indeed exists in the transitive closure of imports
-- Return the ModDetails, empty if no hi-boot iface
tcHiBootIface hsc_src mod
| isHsBoot hsc_src -- Already compiling a hs-boot file
| HsBootFile <- hsc_src -- Already compiling a hs-boot file
= return emptyModDetails
| otherwise
= do { traceIf (text "loadHiBootInterface" <+> ppr mod)
......
......@@ -10,7 +10,7 @@
-----------------------------------------------------------------------------
module DriverPhases (
HscSource(..), isHsBoot, hscSourceString,
HscSource(..), isHsBootOrSig, hscSourceString,
Phase(..),
happensBefore, eqPhase, anyHsc, isStopLn,
startPhase,
......@@ -22,10 +22,12 @@ module DriverPhases (
isCishSuffix,
isDynLibSuffix,
isHaskellUserSrcSuffix,
isHaskellSigSuffix,
isSourceSuffix,
isHaskellishFilename,
isHaskellSrcFilename,
isHaskellSigFilename,
isObjectFilename,
isCishFilename,
isDynLibFilename,
......@@ -55,19 +57,54 @@ import System.FilePath
linker | other | - | a.out
-}
-- Note [HscSource types]
-- ~~~~~~~~~~~~~~~~~~~~~~
-- There are three types of source file for Haskell code:
--
-- * HsSrcFile is an ordinary hs file which contains code,
--
-- * HsBootFile is an hs-boot file, which is used to break
-- recursive module imports (there will always be an
-- HsSrcFile associated with it), and
--
-- * HsigFile is an hsig file, which contains only type
-- signatures and is used to specify signatures for
-- modules.
--
-- Syntactically, hs-boot files and hsig files are quite similar: they
-- only include type signatures and must be associated with an
-- actual HsSrcFile. isHsBootOrSig allows us to abstract over code
-- which is indifferent to which. However, there are some important
-- differences, mostly owing to the fact that hsigs are proper
-- modules (you `import Sig` directly) whereas HsBootFiles are
-- temporary placeholders (you `import {-# SOURCE #-} Mod).
-- When we finish compiling the true implementation of an hs-boot,
-- we replace the HomeModInfo with the real HsSrcFile. An HsigFile, on the
-- other hand, is never replaced (in particular, we *cannot* use the
-- HomeModInfo of the original HsSrcFile backing the signature, since it
-- will export too many symbols.)
--
-- Additionally, while HsSrcFile is the only Haskell file
-- which has *code*, we do generate .o files for HsigFile, because
-- this is how the recompilation checker figures out if a file
-- needs to be recompiled. These are fake object files which
-- should NOT be linked against.
data HscSource
= HsSrcFile | HsBootFile
= HsSrcFile | HsBootFile | HsigFile
deriving( Eq, Ord, Show )
-- Ord needed for the finite maps we build in CompManager
hscSourceString :: HscSource -> String
hscSourceString HsSrcFile = ""
hscSourceString HsBootFile = "[boot]"
hscSourceString HsigFile = "[sig]"
isHsBoot :: HscSource -> Bool
isHsBoot HsBootFile = True
isHsBoot _ = False
-- See Note [isHsBootOrSig]
isHsBootOrSig :: HscSource -> Bool
isHsBootOrSig HsBootFile = True
isHsBootOrSig HsigFile = True
isHsBootOrSig _ = False
data Phase
= Unlit HscSource
......@@ -170,8 +207,10 @@ nextPhase dflags p
startPhase :: String -> Phase
startPhase "lhs" = Unlit HsSrcFile
startPhase "lhs-boot" = Unlit HsBootFile
startPhase "lhsig" = Unlit HsigFile
startPhase "hs" = Cpp HsSrcFile
startPhase "hs-boot" = Cpp HsBootFile
startPhase "hsig" = Cpp HsigFile
startPhase "hscpp" = HsPp HsSrcFile
startPhase "hspp" = Hsc HsSrcFile
startPhase "hc" = HCc
......@@ -200,6 +239,7 @@ startPhase _ = StopLn -- all unknown file types
phaseInputExt :: Phase -> String
phaseInputExt (Unlit HsSrcFile) = "lhs"
phaseInputExt (Unlit HsBootFile) = "lhs-boot"
phaseInputExt (Unlit HsigFile) = "lhsig"
phaseInputExt (Cpp _) = "lpp" -- intermediate only
phaseInputExt (HsPp _) = "hscpp" -- intermediate only
phaseInputExt (Hsc _) = "hspp" -- intermediate only
......@@ -224,14 +264,16 @@ phaseInputExt MergeStub = "o"
phaseInputExt StopLn = "o"
haskellish_src_suffixes, haskellish_suffixes, cish_suffixes,
haskellish_user_src_suffixes
haskellish_user_src_suffixes, haskellish_sig_suffixes
:: [String]
haskellish_src_suffixes = haskellish_user_src_suffixes ++
[ "hspp", "hscpp", "hcr", "cmm", "cmmcpp" ]
haskellish_suffixes = haskellish_src_suffixes ++ ["hc", "raw_s"]
cish_suffixes = [ "c", "cpp", "C", "cc", "cxx", "s", "S", "ll", "bc", "lm_s", "m", "M", "mm" ]
-- Will not be deleted as temp files:
haskellish_user_src_suffixes = [ "hs", "lhs", "hs-boot", "lhs-boot" ]
haskellish_user_src_suffixes =
haskellish_sig_suffixes ++ [ "hs", "lhs", "hs-boot", "lhs-boot" ]
haskellish_sig_suffixes = [ "hsig", "lhsig" ]
objish_suffixes :: Platform -> [String]
-- Use the appropriate suffix for the system on which
......@@ -247,9 +289,10 @@ dynlib_suffixes platform = case platformOS platform of
_ -> ["so"]
isHaskellishSuffix, isHaskellSrcSuffix, isCishSuffix,
isHaskellUserSrcSuffix
isHaskellUserSrcSuffix, isHaskellSigSuffix
:: String -> Bool
isHaskellishSuffix s = s `elem` haskellish_suffixes
isHaskellSigSuffix s = s `elem` haskellish_sig_suffixes
isHaskellSrcSuffix s = s `elem` haskellish_src_suffixes
isCishSuffix s = s `elem` cish_suffixes
isHaskellUserSrcSuffix s = s `elem` haskellish_user_src_suffixes
......@@ -262,7 +305,7 @@ isSourceSuffix :: String -> Bool
isSourceSuffix suff = isHaskellishSuffix suff || isCishSuffix suff
isHaskellishFilename, isHaskellSrcFilename, isCishFilename,
isHaskellUserSrcFilename, isSourceFilename
isHaskellUserSrcFilename, isSourceFilename, isHaskellSigFilename
:: FilePath -> Bool
-- takeExtension return .foo, so we drop 1 to get rid of the .
isHaskellishFilename f = isHaskellishSuffix (drop 1 $ takeExtension f)
......@@ -270,6 +313,7 @@ isHaskellSrcFilename f = isHaskellSrcSuffix (drop 1 $ takeExtension f)
isCishFilename f = isCishSuffix (drop 1 $ takeExtension f)
isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (drop 1 $ takeExtension f)
isSourceFilename f = isSourceSuffix (drop 1 $ takeExtension f)
isHaskellSigFilename f = isHaskellSigSuffix (drop 1 $ takeExtension f)
isObjectFilename, isDynLibFilename :: Platform -> FilePath -> Bool
isObjectFilename platform f = isObjectSuffix platform (drop 1 $ takeExtension f)
......
......@@ -197,7 +197,7 @@ compileOne' m_tc_result mHscMessage
case hsc_lang of
HscInterpreted ->
case ms_hsc_src summary of
HsBootFile ->
t | isHsBootOrSig t ->
do (iface, _changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
return (HomeModInfo{ hm_details = details,
hm_iface = iface,
......@@ -231,7 +231,7 @@ compileOne' m_tc_result mHscMessage
do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
when (gopt Opt_WriteInterface dflags) $
hscWriteIface dflags iface changed summary
let linkable = if isHsBoot src_flavour
let linkable = if isHsBootOrSig src_flavour
then maybe_old_linkable
else Just (LM (ms_hs_date summary) this_mod [])
return (HomeModInfo{ hm_details = details,
......@@ -240,7 +240,7 @@ compileOne' m_tc_result mHscMessage
_ ->
case ms_hsc_src summary of
HsBootFile ->
t | isHsBootOrSig t ->
do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
hscWriteIface dflags iface changed summary
touchObjectFile dflags object_filename
......@@ -341,7 +341,11 @@ link' dflags batch_attempt_linking hpt
LinkStaticLib -> True
_ -> platformBinariesAreStaticLibs (targetPlatform dflags)
home_mod_infos = eltsUFM hpt
-- Don't attempt to link hsigs; they don't actually produce objects.
-- This is in contrast to hs-boot files, which will /eventually/
-- get objects.
home_mod_infos =
filter ((==Nothing).mi_sig_of.hm_iface) (eltsUFM hpt)
-- the packages we depend on
pkg_deps = concatMap (map fst . dep_pkgs . mi_deps . hm_iface) home_mod_infos
......@@ -1511,8 +1515,8 @@ getLocation src_flavour mod_name = do
location1 <- liftIO $ mkHomeModLocation2 dflags mod_name basename suff
-- Boot-ify it if necessary
let location2 | isHsBoot src_flavour = addBootSuffixLocn location1
| otherwise = location1
let location2 | HsBootFile <- src_flavour = addBootSuffixLocn location1
| otherwise = location1
-- Take -ohi into account if present
......@@ -2199,6 +2203,7 @@ joinObjectFiles dflags o_files output_fn = do
-- | What phase to run after one of the backend code generators has run
hscPostBackendPhase :: DynFlags -> HscSource -> HscTarget -> Phase
hscPostBackendPhase _ HsBootFile _ = StopLn
hscPostBackendPhase _ HsigFile _ = StopLn
hscPostBackendPhase dflags _ hsc_lang =
case hsc_lang of
HscC -> HCc
......
......@@ -50,6 +50,7 @@ module DynFlags (
fFlags, fWarningFlags, fLangFlags, xFlags,
dynFlagDependencies,
tablesNextToCode, mkTablesNextToCode,
SigOf(..), getSigOf,
printOutputForUser, printInfoForUser,
......@@ -591,6 +592,17 @@ data ExtensionFlag
| Opt_PatternSynonyms
deriving (Eq, Enum, Show)
data SigOf = NotSigOf
| SigOf Module
| SigOfMap (Map ModuleName Module)
getSigOf :: DynFlags -> ModuleName -> Maybe Module
getSigOf dflags n =
case sigOf dflags of
NotSigOf -> Nothing
SigOf m -> Just m
SigOfMap m -> Map.lookup n m
-- | Contains not only a collection of 'GeneralFlag's but also a plethora of
-- information relating to the compilation of a single file or GHC session
data DynFlags = DynFlags {
......@@ -598,6 +610,8 @@ data DynFlags = DynFlags {
ghcLink :: GhcLink,
hscTarget :: HscTarget,
settings :: Settings,
-- See Note [Signature parameters in TcGblEnv and DynFlags]
sigOf :: SigOf, -- ^ Compiling an hs-boot against impl.
verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels]
optLevel :: Int, -- ^ Optimisation level
simplPhases :: Int, -- ^ Number of simplifier phases
......@@ -1334,6 +1348,7 @@ defaultDynFlags mySettings =
ghcMode = CompManager,
ghcLink = LinkBinary,
hscTarget = defaultHscTarget (sTargetPlatform mySettings),
sigOf = NotSigOf,
verbosity = 0,
optLevel = 0,
simplPhases = 2,
......@@ -1831,6 +1846,29 @@ setOutputFile f d = d{ outputFile = f}
setDynOutputFile f d = d{ dynOutputFile = f}
setOutputHi f d = d{ outputHi = f}
parseSigOf :: String -> SigOf
parseSigOf str = case filter ((=="").snd) (readP_to_S parse str) of
[(r, "")] -> r
_ -> throwGhcException $ CmdLineError ("Can't parse -sig-of: " ++ str)
where parse = parseOne +++ parseMany
parseOne = SigOf `fmap` parseModule
parseMany = SigOfMap . Map.fromList <$> sepBy parseEntry (R.char ',')
parseEntry = do
n <- tok $ parseModuleName
-- ToDo: deprecate this 'is' syntax?
tok $ ((string "is" >> return ()) +++ (R.char '=' >> return ()))
m <- tok $ parseModule
return (mkModuleName n, m)
parseModule = do
pk <- munch1 (\c -> isAlphaNum c || c `elem` "-_")
_ <- R.char ':'
m <- parseModuleName
return (mkModule (stringToPackageKey pk) (mkModuleName m))
tok m = skipSpaces >> m
setSigOf :: String -> DynFlags -> DynFlags
setSigOf s d = d { sigOf = parseSigOf s }
addPluginModuleName :: String -> DynFlags -> DynFlags
addPluginModuleName name d = d { pluginModNames = (mkModuleName name) : (pluginModNames d) }
......@@ -2152,6 +2190,7 @@ dynamic_flags = [
, Flag "v" (OptIntSuffix setVerbosity)
, Flag "j" (OptIntSuffix (\n -> upd (\d -> d {parMakeCount = n})))
, Flag "sig-of" (sepArg setSigOf)
-- RTS options -------------------------------------------------------------
, Flag "H" (HasArg (\s -> upd (\d ->
......@@ -3366,6 +3405,9 @@ removeGlobalPkgConf = upd $ \s -> s { extraPkgConfs = filter isNotGlobal . extra
clearPkgConf :: DynP ()
clearPkgConf = upd $ \s -> s { extraPkgConfs = const [] }
parseModuleName :: ReadP String
parseModuleName = munch1 (\c -> isAlphaNum c || c `elem` ".")
parsePackageFlag :: (String -> PackageArg) -- type of argument
-> String -- string to parse
-> PackageFlag
......@@ -3380,11 +3422,10 @@ parsePackageFlag constr str = case filter ((=="").snd) (readP_to_S parse str) of
return (ExposePackage (constr pkg) (Just rns))
+++
return (ExposePackage (constr pkg) Nothing))
parseMod = munch1 (\c -> isAlphaNum c || c `elem` ".")
parseItem = do
orig <- tok $ parseMod
orig <- tok $ parseModuleName
(do _ <- tok $ string "as"
new <- tok $ parseMod
new <- tok $ parseModuleName
return (orig, new)
+++
return (orig, orig))
......
......@@ -247,6 +247,8 @@ findHomeModule hsc_env mod_name =
source_exts =
[ ("hs", mkHomeModLocationSearched dflags mod_name "hs")
, ("lhs", mkHomeModLocationSearched dflags mod_name "lhs")
, ("hsig", mkHomeModLocationSearched dflags mod_name "hsig")
, ("lhsig", mkHomeModLocationSearched dflags mod_name "lhsig")
]
hi_exts = [ (hisuf, mkHiOnlyModLocation dflags hisuf)
......
This diff is collapsed.
......@@ -631,7 +631,7 @@ hscCompileOneShot' hsc_env mod_summary src_changed
return HscNotGeneratingCode
_ ->
case ms_hsc_src mod_summary of
HsBootFile ->
t | isHsBootOrSig t ->
do (iface, changed, _) <- hscSimpleIface' tc_result mb_old_hash
liftIO $ hscWriteIface dflags iface changed mod_summary
return HscUpdateBoot
......
......@@ -28,7 +28,9 @@ module HscTypes (
SourceModified(..),
-- * Information about the module being compiled
HscSource(..), isHsBoot, hscSourceString, -- Re-exported from DriverPhases
-- (re-exported from DriverPhases)
HscSource(..), isHsBootOrSig, hscSourceString,
-- * State relating to modules in this package
HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
......@@ -38,7 +40,7 @@ module HscTypes (
-- * State relating to known packages
ExternalPackageState(..), EpsStats(..), addEpsInStats,
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
lookupIfaceByModule, emptyModIface,
lookupIfaceByModule, emptyModIface, lookupHptByModule,
PackageInstEnv, PackageFamInstEnv, PackageRuleBase,
......@@ -153,7 +155,7 @@ import PatSyn
import PrelNames ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule )
import Packages hiding ( Version(..) )
import DynFlags
import DriverPhases ( Phase, HscSource(..), isHsBoot, hscSourceString )
import DriverPhases ( Phase, HscSource(..), isHsBootOrSig, hscSourceString )
import BasicTypes
import IfaceSyn
import CoreSyn ( CoreRule, CoreVect )
......@@ -682,6 +684,7 @@ type ModLocationCache = ModuleEnv ModLocation
data ModIface
= ModIface {
mi_module :: !Module, -- ^ Name of the module we are for
mi_sig_of :: !(Maybe Module), -- ^ Are we a sig of another mod?
mi_iface_hash :: !Fingerprint, -- ^ Hash of the whole interface
mi_mod_hash :: !Fingerprint, -- ^ Hash of the ABI only
mi_flag_hash :: !Fingerprint, -- ^ Hash of the important flags
......@@ -790,6 +793,7 @@ data ModIface
instance Binary ModIface where
put_ bh (ModIface {
mi_module = mod,
mi_sig_of = sig_of,
mi_boot = is_boot,
mi_iface_hash= iface_hash,
mi_mod_hash = mod_hash,
......@@ -837,6 +841,7 @@ instance Binary ModIface where
put_ bh hpc_info
put_ bh trust
put_ bh trust_pkg
put_ bh sig_of
get bh = do
mod_name <- get bh
......@@ -863,8 +868,10 @@ instance Binary ModIface where
hpc_info <- get bh
trust <- get bh
trust_pkg <- get bh
sig_of <- get bh
return (ModIface {
mi_module = mod_name,
mi_sig_of = sig_of,
mi_boot = is_boot,
mi_iface_hash = iface_hash,
mi_mod_hash = mod_hash,
......@@ -901,6 +908,7 @@ type IfaceExport = AvailInfo
emptyModIface :: Module -> ModIface
emptyModIface mod
= ModIface { mi_module = mod,
mi_sig_of = Nothing,
mi_iface_hash = fingerprint0,
mi_mod_hash = fingerprint0,
mi_flag_hash = fingerprint0,
......@@ -2321,7 +2329,7 @@ msObjFilePath ms = ml_obj_file (ms_location ms)
-- | Did this 'ModSummary' originate from a hs-boot file?
isBootSummary :: ModSummary -> Bool
isBootSummary ms = isHsBoot (ms_hsc_src ms)
isBootSummary ms = ms_hsc_src ms == HsBootFile
instance Outputable ModSummary where
ppr ms
......@@ -2343,11 +2351,24 @@ showModMsg dflags target recomp mod_summary
HscInterpreted | recomp
-> text "interpreted"
HscNothing -> text "nothing"
_ -> text (normalise $ msObjFilePath mod_summary),
_ | HsigFile == ms_hsc_src mod_summary -> text "nothing"
| otherwise -> text (normalise $ msObjFilePath mod_summary),
char ')']
where
mod = moduleName (ms_mod mod_summary)
mod_str = showPpr dflags mod ++ hscSourceString (ms_hsc_src mod_summary)
mod_str = showPpr dflags mod
++ hscSourceString' dflags mod (ms_hsc_src mod_summary)
-- | Variant of hscSourceString which prints more information for signatures.
-- This can't live in DriverPhases because this would cause a module loop.
hscSourceString' :: DynFlags -> ModuleName -> HscSource -> String
hscSourceString' _ _ HsSrcFile = ""
hscSourceString' _ _ HsBootFile = "[boot]"
hscSourceString' dflags mod HsigFile =
"[" ++ (maybe "abstract sig"
(("sig of "++).showPpr dflags)
(getSigOf dflags mod)) ++ "]"
-- NB: -sig-of could be missing if we're just typechecking
\end{code}
%************************************************************************
......
......@@ -121,6 +121,9 @@ Plan A: mkBootModDetails: omit pragmas, make interfaces small
code generator needs it. And to ensure that local names have
distinct OccNames in case of object-file splitting
* If this an hsig file, drop the instances altogether too (they'll
get pulled in by the implicit module import.
\begin{code}
-- This is Plan A: make a small type env when typechecking only,
-- or when compiling a hs-boot file, or simply when not using -O
......
......@@ -173,7 +173,7 @@ rnTopBindsLHS fix_env binds
rnTopBindsRHS :: NameSet -> HsValBindsLR Name RdrName
-> RnM (HsValBinds Name, DefUses)
rnTopBindsRHS bound_names binds
= do { is_boot <- tcIsHsBoot
= do { is_boot <- tcIsHsBootOrSig
; if is_boot
then rnTopBindsBoot binds
else rnValBindsRHS (TopSigCtxt bound_names False) binds }
......
......@@ -84,6 +84,64 @@ import Constants ( mAX_TUPLE_SIZE )
%* *
%*********************************************************
Note [Signature lazy interface loading]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC's lazy interface loading can be a bit confusing, so this Note is an
empirical description of what happens in one interesting case. When
compiling a signature module against an its implementation, we do NOT
load interface files associated with its names until after the type
checking phase. For example:
module ASig where
data T
f :: T -> T
Suppose we compile this with -sig-of "A is ASig":
module B where
data T = T
f T = T
module A(module B) where
import B
During type checking, we'll load A.hi because we need to know what the
RdrEnv for the module is, but we DO NOT load the interface for B.hi!
It's wholly unnecessary: our local definition 'data T' in ASig is all
the information we need to finish type checking. This is contrast to
type checking of ordinary Haskell files, in which we would not have the
local definition "data T" and would need to consult B.hi immediately.
(Also, this situation never occurs for hs-boot files, since you're not
allowed to reexport from another module.)
After type checking, we then check that the types we provided are
consistent with the backing implementation (in checkHiBootOrHsigIface).
At this point, B.hi is loaded, because we need something to compare
against.
I discovered this behavior when trying to figure out why type class
instances for Data.Map weren't in the EPS when I was type checking a
test very much like ASig (sigof02dm): the associated interface hadn't
been loaded yet! (The larger issue is a moot point, since an instance
declared in a signature can never be a duplicate.)
This behavior might change in the future. Consider this
alternate module B:
module B where
{-# DEPRECATED T, f "Don't use" #-}
data T = T
f T = T
One might conceivably want to report deprecation warnings when compiling
ASig with -sig-of B, in which case we need to look at B.hi to find the
deprecation warnings during renaming. At the moment, you don't get any
warning until you use the identifier further downstream. This would
require adjusting addUsedRdrName so that during signature compilation,
we do not report deprecation warnings for LocalDef. See also
Note [Handling of deprecations]
\begin{code}
newTopSrcBinder :: Located RdrName -> RnM Name
newTopSrcBinder (L loc rdr_name)
......@@ -141,12 +199,36 @@ newTopSrcBinder (L loc rdr_name)
-- module name, we we get a confusing "M.T is not in scope" error later
; stage <- getStage
; env <- getGblEnv
; if isBrackStage stage then
-- We are inside a TH bracket, so make an *Internal* name
-- See Note [Top-level Names in Template Haskell decl quotes] in RnNames
do { uniq <- newUnique
; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) }
else
else case tcg_impl_rdr_env env of
Just gr ->
-- We're compiling --sig-of, so resolve with respect to this
-- module.
-- See Note [Signature parameters in TcGblEnv and DynFlags]
do { case lookupGlobalRdrEnv gr (rdrNameOcc rdr_name) of
-- Be sure to override the loc so that we get accurate
-- information later
[GRE{ gre_name = n }] -> do
-- NB: Just adding this line will not work:
-- addUsedRdrName True gre rdr_name
-- see Note [Signature lazy interface loading] for
-- more details.
return (setNameLoc n loc)
_ -> do
{ -- NB: cannot use reportUnboundName rdr_name
-- because it looks up in the wrong RdrEnv
-- ToDo: more helpful error messages
; addErr (unknownNameErr (pprNonVarNameSpace
(occNameSpace (rdrNameOcc rdr_name))) rdr_name)
; return (mkUnboundName rdr_name)
}
}
Nothing ->
-- Normal case
do { this_mod <- getModule
; newGlobalBinder this_mod (rdrNameOcc rdr_name) loc } }
......@@ -1604,13 +1686,17 @@ mapFvRnCPS f (x:xs) cont = f x $ \ x' ->
warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
warnUnusedTopBinds gres
= whenWOptM Opt_WarnUnusedBinds
$ do isBoot <- tcIsHsBoot
$ do env <- getGblEnv
let isBoot = tcg_src env == HsBootFile
let noParent gre = case gre_par gre of
NoParent -> True
ParentIs _ -> False
-- Don't warn about unused bindings with parents in
-- .hs-boot files, as you are sometimes required to give
-- unused bindings (trac #3449).
-- HOWEVER, in a signature file, you are never obligated to put a
-- definition in the main text. Thus, if you define something
-- and forget to export it, we really DO want to warn.
gres' = if isBoot then filter noParent gres
else gres
warnUnusedGREs gres'
......
This diff is collapsed.
......@@ -57,6 +57,7 @@ import Util
import Outputable
import Control.Monad( unless )
import Data.List( mapAccumL )
import Data.Maybe( isJust )
\end{code}
......@@ -441,6 +442,7 @@ addLocalInst (home_ie, my_insts) ispec
-- 'dups' are those 'matches' that are equal to the new one
; isGHCi <- getIsGHCi
; eps <- getEps
; tcg_env <- getGblEnv
; let (home_ie', my_insts')
| isGHCi = ( deleteFromInstEnv home_ie ispec
, filterOut (identicalInstHead ispec) my_insts)
......@@ -449,7 +451,15 @@ addLocalInst (home_ie, my_insts) ispec
-- silently delete it
(_tvs, cls, tys) = instanceHead ispec
inst_envs = (eps_inst_env eps, home_ie')
-- If we're compiling sig-of and there's an external duplicate
-- instance, silently ignore it (that's the instance we're
-- implementing!) NB: we still count local duplicate instances
-- as errors.
-- See Note [Signature files and type class instances]
global_ie
| isJust (tcg_sig_of tcg_env) = emptyInstEnv
| otherwise = eps_inst_env eps
inst_envs = (global_ie, home_ie')
(matches, _, _) = lookupInstEnv inst_envs cls tys
dups = filter (identicalInstHead ispec) (map fst matches)
......@@ -458,12 +468,57 @@ addLocalInst (home_ie, my_insts) ispec