diff options
| author | Edward Z. Yang <ezyang@cs.stanford.edu> | 2015-07-24 15:13:49 -0700 |
|---|---|---|
| committer | Edward Z. Yang <ezyang@cs.stanford.edu> | 2015-09-21 11:53:56 -0700 |
| commit | 06d46b1e4507e09eb2a7a04998a92610c8dc6277 (patch) | |
| tree | 7dc84733d3b6a8313c272c2c8fed4cc0b5d30e90 | |
| parent | 09d214dcd8e831c128c684facb7c8da1d63c58bc (diff) | |
| download | haskell-06d46b1e4507e09eb2a7a04998a92610c8dc6277.tar.gz | |
Unify hsig and hs-boot; add preliminary "hs-boot" merging.
This patch drops the file level distinction between hs-boot and hsig;
we figure out which one we are compiling based on whether or not there
is a corresponding hs file lying around.
To make the "import A" syntax continue to work for bare hs-boot
files, we also introduce hs-boot merging, which takes an A.hi-boot
and converts it to an A.hi when there is no A.hs file in scope.
This will be generalized in Backpack to merge multiple A.hi files together;
which means we can jettison the "load multiple interface files" functionality.
This works automatically for --make, but for one-shot compilation
we need a new mode: ghc --merge-requirements A will generate an A.hi/A.o
from a local A.hi-boot file; Backpack will extend this mechanism further.
Has Haddock submodule update to deal with change in msHsFilePath behavior.
- This commit drops support for the hsig extension. Can
we support it? It's annoying because the finder code is
written with the assumption that where there's an hs-boot
file, there's always an hs file too. To support hsig, you'd
have to probe two locations. Easier to just not support it.
- #10333 affects us, modifying an hs-boot still doesn't trigger
recomp.
- See compiler/main/Finder.hs: this diff is very skeevy, but
it seems to work.
- This code cunningly doesn't drop hs-boot files from the
"drop hs-boot files" module graph, if they don't have a
corresponding hs file. I have no idea if this actually is useful.
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate
Reviewers: simonpj, austin, bgamari, spinda
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1098
57 files changed, 610 insertions, 291 deletions
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index 94ee7faab3..1508922423 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -106,7 +106,7 @@ deSugar hsc_env hpcInfo = emptyHpcInfo other_hpc_info ; (binds_cvr, ds_hpc_info, modBreaks) - <- if not (isHsBootOrSig hsc_src) + <- if not (isHsBoot hsc_src) then addTicksToBinds dflags mod mod_loc export_set (typeEnvTyCons type_env) binds else return (binds, hpcInfo, emptyModBreaks) diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index 6ffa990d57..ddbd80347f 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -896,7 +896,7 @@ pprModIface iface ] where pp_hsc_src HsBootFile = ptext (sLit "[boot]") - pp_hsc_src HsigFile = ptext (sLit "[hsig]") + pp_hsc_src HsBootMerge = ptext (sLit "[merge]") pp_hsc_src HsSrcFile = Outputable.empty {- diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 757bebac93..99544c4e4f 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -15,6 +15,7 @@ module MkIface ( -- including computing version information mkIfaceTc, + mkIfaceDirect, writeIfaceFile, -- Write the interface file @@ -160,6 +161,35 @@ mkIface hsc_env maybe_old_fingerprint mod_details warns hpc_info dir_imp_mods self_trust dependent_files safe_mode mod_details +-- | Make an interface from a manually constructed 'ModIface'. We use +-- this when we are merging 'ModIface's. We assume that the 'ModIface' +-- has accurate entries but not accurate fingerprint information (so, +-- like @intermediate_iface@ in 'mkIface_'.) +mkIfaceDirect :: HscEnv + -> Maybe Fingerprint + -> ModIface + -> IO (ModIface, Bool) +mkIfaceDirect hsc_env maybe_old_fingerprint iface0 = do + -- Sort some things to make sure we're deterministic + let intermediate_iface = iface0 { + mi_exports = mkIfaceExports (mi_exports iface0), + mi_insts = sortBy cmp_inst (mi_insts iface0), + mi_fam_insts = sortBy cmp_fam_inst (mi_fam_insts iface0), + mi_rules = sortBy cmp_rule (mi_rules iface0) + } + dflags = hsc_dflags hsc_env + (final_iface, no_change_at_all) + <- {-# SCC "versioninfo" #-} + addFingerprints hsc_env maybe_old_fingerprint + intermediate_iface + (map snd (mi_decls iface0)) + + -- Debug printing + dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE" + (pprModIface final_iface) + + return (final_iface, no_change_at_all) + -- | make an interface from the results of typechecking only. Useful -- for non-optimising compilation, or where we aren't generating any -- object code at all ('HscNothing'). @@ -357,11 +387,6 @@ mkIface_ hsc_env maybe_old_fingerprint return (errs_and_warns, Just (final_iface, no_change_at_all)) where - cmp_rule = comparing ifRuleName - -- Compare these lexicographically by OccName, *not* by unique, - -- because the latter is not stable across compilations: - cmp_inst = comparing (nameOccName . ifDFun) - cmp_fam_inst = comparing (nameOccName . ifFamInstTcName) dflags = hsc_dflags hsc_env @@ -379,8 +404,6 @@ mkIface_ hsc_env maybe_old_fingerprint deliberatelyOmitted :: String -> a deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x) - ifFamInstTcName = ifFamInstFam - flattenVectInfo (VectInfo { vectInfoVar = vVar , vectInfoTyCon = vTyCon , vectInfoParallelVars = vParallelVars @@ -394,6 +417,16 @@ mkIface_ hsc_env maybe_old_fingerprint , ifaceVectInfoParallelTyCons = nameSetElems vParallelTyCons } +cmp_rule :: IfaceRule -> IfaceRule -> Ordering +cmp_rule = comparing ifRuleName +-- Compare these lexicographically by OccName, *not* by unique, +-- because the latter is not stable across compilations: +cmp_inst :: IfaceClsInst -> IfaceClsInst -> Ordering +cmp_inst = comparing (nameOccName . ifDFun) + +cmp_fam_inst :: IfaceFamInst -> IfaceFamInst -> Ordering +cmp_fam_inst = comparing (nameOccName . ifFamInstFam) + ----------------------------- writeIfaceFile :: DynFlags -> FilePath -> ModIface -> IO () writeIfaceFile dflags hi_file_path new_iface diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs index 4d2aadca90..aae4d0e7c2 100644 --- a/compiler/main/DriverMkDepend.hs +++ b/compiler/main/DriverMkDepend.hs @@ -199,9 +199,9 @@ processDeps dflags _ _ _ _ (CyclicSCC nodes) throwGhcExceptionIO (ProgramError (showSDoc dflags $ GHC.cyclicModuleErr nodes)) processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC node) + | Just src_file <- msHsFilePath node = do { let extra_suffixes = depSuffixes dflags include_pkg_deps = depIncludePkgDeps dflags - src_file = msHsFilePath node obj_file = msObjFilePath node obj_files = insertSuffixes obj_file extra_suffixes @@ -236,6 +236,10 @@ processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC node) ; do_imps False (ms_imps node) } + | otherwise + = ASSERT( ms_hsc_src node == HsBootMerge ) + panic "HsBootMerge not supported in DriverMkDepend yet" + findDependency :: HscEnv -> SrcSpan diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs index ff6f8b8ab1..f079212112 100644 --- a/compiler/main/DriverPhases.hs +++ b/compiler/main/DriverPhases.hs @@ -10,7 +10,7 @@ ----------------------------------------------------------------------------- module DriverPhases ( - HscSource(..), isHsBootOrSig, hscSourceString, + HscSource(..), isHsBoot, hscSourceString, Phase(..), happensBefore, eqPhase, anyHsc, isStopLn, startPhase, @@ -22,12 +22,10 @@ module DriverPhases ( isCishSuffix, isDynLibSuffix, isHaskellUserSrcSuffix, - isHaskellSigSuffix, isSourceSuffix, isHaskellishFilename, isHaskellSrcFilename, - isHaskellSigFilename, isObjectFilename, isCishFilename, isDynLibFilename, @@ -60,63 +58,51 @@ import Binary -- Note [HscSource types] -- ~~~~~~~~~~~~~~~~~~~~~~ --- There are three types of source file for Haskell code: +-- There are two types of source file for user-written 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 +-- * HsBootFile is an hs-boot file. Within a unit, it can +-- be used to break recursive module imports, in which case there's an +-- HsSrcFile associated with it. However, externally, it can +-- also be used to specify the *requirements* of a package, +-- in which case there is an HsBootMerge associated with it. -- --- * 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. +-- An HsBootMerge is a "fake" source file, which is constructed +-- by collecting up non-recursive HsBootFiles into a single interface. +-- HsBootMerges get an hi and o file, and are treated as "non-boot" +-- sources. data HscSource - = HsSrcFile | HsBootFile | HsigFile + = HsSrcFile | HsBootFile | HsBootMerge deriving( Eq, Ord, Show ) -- Ord needed for the finite maps we build in CompManager +instance Outputable HscSource where + ppr HsSrcFile = text "HsSrcFile" + ppr HsBootFile = text "HsBootFile" + ppr HsBootMerge = text "HsBootMerge" + instance Binary HscSource where put_ bh HsSrcFile = putByte bh 0 put_ bh HsBootFile = putByte bh 1 - put_ bh HsigFile = putByte bh 2 + put_ bh HsBootMerge = putByte bh 2 get bh = do h <- getByte bh case h of 0 -> return HsSrcFile 1 -> return HsBootFile - _ -> return HsigFile + _ -> return HsBootMerge hscSourceString :: HscSource -> String hscSourceString HsSrcFile = "" hscSourceString HsBootFile = "[boot]" -hscSourceString HsigFile = "[sig]" +hscSourceString HsBootMerge = "[merge]" --- See Note [isHsBootOrSig] -isHsBootOrSig :: HscSource -> Bool -isHsBootOrSig HsBootFile = True -isHsBootOrSig HsigFile = True -isHsBootOrSig _ = False +isHsBoot :: HscSource -> Bool +isHsBoot HsBootFile = True +isHsBoot HsSrcFile = False +isHsBoot HsBootMerge = False data Phase = Unlit HscSource @@ -232,10 +218,8 @@ 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 @@ -264,7 +248,9 @@ startPhase _ = StopLn -- all unknown file types phaseInputExt :: Phase -> String phaseInputExt (Unlit HsSrcFile) = "lhs" phaseInputExt (Unlit HsBootFile) = "lhs-boot" -phaseInputExt (Unlit HsigFile) = "lhsig" +phaseInputExt (Unlit HsBootMerge) = panic "phaseInputExt: Unlit HsBootMerge" + -- You can't Unlit an HsBootMerge, because there's no source + -- file to Unlit! phaseInputExt (Cpp _) = "lpp" -- intermediate only phaseInputExt (HsPp _) = "hscpp" -- intermediate only phaseInputExt (Hsc _) = "hspp" -- intermediate only @@ -289,7 +275,7 @@ phaseInputExt MergeStub = "o" phaseInputExt StopLn = "o" haskellish_src_suffixes, haskellish_suffixes, cish_suffixes, - haskellish_user_src_suffixes, haskellish_sig_suffixes + haskellish_user_src_suffixes :: [String] -- When a file with an extension in the haskellish_src_suffixes group is -- loaded in --make mode, its imports will be loaded too. @@ -300,9 +286,7 @@ haskellish_suffixes = haskellish_src_suffixes ++ 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 = - haskellish_sig_suffixes ++ [ "hs", "lhs", "hs-boot", "lhs-boot" ] -haskellish_sig_suffixes = [ "hsig", "lhsig" ] +haskellish_user_src_suffixes = [ "hs", "lhs", "hs-boot", "lhs-boot" ] objish_suffixes :: Platform -> [String] -- Use the appropriate suffix for the system on which @@ -318,10 +302,9 @@ dynlib_suffixes platform = case platformOS platform of _ -> ["so"] isHaskellishSuffix, isHaskellSrcSuffix, isCishSuffix, - isHaskellUserSrcSuffix, isHaskellSigSuffix + isHaskellUserSrcSuffix :: 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 @@ -334,7 +317,7 @@ isSourceSuffix :: String -> Bool isSourceSuffix suff = isHaskellishSuffix suff || isCishSuffix suff isHaskellishFilename, isHaskellSrcFilename, isCishFilename, - isHaskellUserSrcFilename, isSourceFilename, isHaskellSigFilename + isHaskellUserSrcFilename, isSourceFilename :: FilePath -> Bool -- takeExtension return .foo, so we drop 1 to get rid of the . isHaskellishFilename f = isHaskellishSuffix (drop 1 $ takeExtension f) @@ -342,7 +325,6 @@ 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) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index f8b7c30300..a45507e635 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -13,7 +13,7 @@ module DriverPipeline ( -- Run a series of compilation steps in a pipeline, for a -- collection of source files. - oneShot, compileFile, + oneShot, compileFile, mergeRequirement, -- Interfaces for the batch-mode driver linkBinary, @@ -23,6 +23,9 @@ module DriverPipeline ( compileOne, compileOne', link, + -- Misc utility + makeMergeRequirementSummary, + -- Exports for hooks to override runPhase and link PhasePlus(..), CompPipeline(..), PipeEnv(..), PipeState(..), phaseOutputFilename, getPipeState, getPipeEnv, @@ -61,6 +64,7 @@ import MonadUtils import Platform import TcRnTypes import Hooks +import MkIface import Exception import Data.IORef ( readIORef ) @@ -71,6 +75,7 @@ import Control.Monad import Data.List ( isSuffixOf ) import Data.Maybe import Data.Char +import Data.Time -- --------------------------------------------------------------------------- -- Pre-process @@ -128,56 +133,75 @@ compileOne' :: Maybe TcGblEnv compileOne' m_tc_result mHscMessage hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable source_modified0 - = do - let dflags0 = ms_hspp_opts summary - this_mod = ms_mod summary - src_flavour = ms_hsc_src summary - location = ms_location summary - input_fn = expectJust "compile:hs" (ml_hs_file location) - input_fnpp = ms_hspp_file summary - mod_graph = hsc_mod_graph hsc_env0 - needsTH = any (xopt Opt_TemplateHaskell . ms_hspp_opts) mod_graph - needsQQ = any (xopt Opt_QuasiQuotes . ms_hspp_opts) mod_graph - needsLinker = needsTH || needsQQ - isDynWay = any (== WayDyn) (ways dflags0) - isProfWay = any (== WayProf) (ways dflags0) - -- #8180 - when using TemplateHaskell, switch on -dynamic-too so - -- the linker can correctly load the object files. - let dflags1 = if needsLinker && dynamicGhc && not isDynWay && not isProfWay - then gopt_set dflags0 Opt_BuildDynamicToo - else dflags0 - - debugTraceMsg dflags1 2 (text "compile: input file" <+> text input_fnpp) + | HsBootMerge <- ms_hsc_src summary + = do -- Do a boot merge instead! For now, something very simple + output_fn <- getOutputFilename next_phase + Temporary basename dflags next_phase (Just location) + e <- genericHscMergeRequirement mHscMessage + hsc_env summary mb_old_iface (mod_index, nmods) - let basename = dropExtension input_fn + case e of + -- TODO: dedup + Left iface -> + do details <- genModDetails hsc_env iface + return (HomeModInfo{ hm_details = details, + hm_iface = iface, + hm_linkable = maybe_old_linkable }) + Right (iface0, mb_old_hash) -> + case hsc_lang of + HscInterpreted -> + do (iface, _no_change) <- mkIfaceDirect hsc_env mb_old_hash iface0 + details <- genModDetails hsc_env iface + -- Merges don't need to link in any bytecode, unlike + -- HsSrcFiles. + let linkable = LM (ms_hs_date summary) this_mod [] + return (HomeModInfo{ hm_details = details, + hm_iface = iface, + hm_linkable = Just linkable }) + + HscNothing -> + do (iface, no_change) <- mkIfaceDirect hsc_env mb_old_hash iface0 + details <- genModDetails hsc_env iface + when (gopt Opt_WriteInterface dflags) $ + hscWriteIface dflags iface no_change summary + let linkable = LM (ms_hs_date summary) this_mod [] + return (HomeModInfo{ hm_details = details, + hm_iface = iface, + hm_linkable = Just linkable }) + _ -> + do (iface, no_change) <- mkIfaceDirect hsc_env mb_old_hash iface0 + hscWriteIface dflags iface no_change summary + + -- #10660: Use the pipeline instead of calling + -- compileEmptyStub directly, so -dynamic-too gets + -- handled properly + let mod_name = ms_mod_name summary + _ <- runPipeline StopLn hsc_env + (output_fn, + Just (HscOut src_flavour + mod_name HscUpdateBootMerge)) + (Just basename) + Persistent + (Just location) + Nothing + + details <- genModDetails hsc_env iface + + o_time <- getModificationUTCTime object_filename + let linkable = + LM o_time this_mod [DotO object_filename] + return (HomeModInfo{ hm_details = details, + hm_iface = iface, + hm_linkable = Just linkable }) - -- We add the directory in which the .hs files resides) to the import path. - -- This is needed when we try to compile the .hc file later, if it - -- imports a _stub.h file that we created here. - let current_dir = takeDirectory basename - old_paths = includePaths dflags1 - dflags = dflags1 { includePaths = current_dir : old_paths } - hsc_env = hsc_env0 {hsc_dflags = dflags} + | otherwise + = do - -- Figure out what lang we're generating - let hsc_lang = hscTarget dflags - -- ... and what the next phase should be - let next_phase = hscPostBackendPhase dflags src_flavour hsc_lang - -- ... and what file to generate the output into + debugTraceMsg dflags1 2 (text "compile: input file" <+> text input_fnpp) + -- What file to generate the output into? output_fn <- getOutputFilename next_phase Temporary basename dflags next_phase (Just location) - -- -fforce-recomp should also work with --make - let force_recomp = gopt Opt_ForceRecomp dflags - source_modified - | force_recomp = SourceModified - | otherwise = source_modified0 - object_filename = ml_obj_file location - - let always_do_basic_recompilation_check = case hsc_lang of - HscInterpreted -> True - _ -> False - e <- genericHscCompileGetFrontendResult always_do_basic_recompilation_check m_tc_result mHscMessage @@ -196,7 +220,7 @@ compileOne' m_tc_result mHscMessage case hsc_lang of HscInterpreted -> case ms_hsc_src summary of - t | isHsBootOrSig t -> + HsBootFile -> do (iface, _changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash return (HomeModInfo{ hm_details = details, hm_iface = iface, @@ -230,7 +254,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 isHsBootOrSig src_flavour + let linkable = if isHsBoot src_flavour then maybe_old_linkable else Just (LM (ms_hs_date summary) this_mod []) return (HomeModInfo{ hm_details = details, @@ -239,39 +263,17 @@ compileOne' m_tc_result mHscMessage _ -> case ms_hsc_src summary of + HsBootMerge -> panic "This driver can't handle it" HsBootFile -> do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash hscWriteIface dflags iface changed summary - touchObjectFile dflags object_filename - return (HomeModInfo{ hm_details = details, - hm_iface = iface, - hm_linkable = maybe_old_linkable }) - HsigFile -> - do (iface, changed, details) <- - hscSimpleIface hsc_env tc_result mb_old_hash - hscWriteIface dflags iface changed summary - - -- #10660: Use the pipeline instead of calling - -- compileEmptyStub directly, so -dynamic-too gets - -- handled properly - let mod_name = ms_mod_name summary - _ <- runPipeline StopLn hsc_env - (output_fn, - Just (HscOut src_flavour mod_name HscUpdateSig)) - (Just basename) - Persistent - (Just location) - Nothing - - -- Same as Hs - o_time <- getModificationUTCTime object_filename - let linkable = - LM o_time this_mod [DotO object_filename] + touchObjectFile dflags object_filename - return (HomeModInfo{ hm_details = details, - hm_iface = iface, - hm_linkable = Just linkable }) + return (HomeModInfo{ + hm_details = details, + hm_iface = iface, + hm_linkable = maybe_old_linkable }) HsSrcFile -> do guts0 <- hscDesugar hsc_env summary tc_result @@ -295,6 +297,51 @@ compileOne' m_tc_result mHscMessage return (HomeModInfo{ hm_details = details, hm_iface = iface, hm_linkable = Just linkable }) + where dflags0 = ms_hspp_opts summary + this_mod = ms_mod summary + src_flavour = ms_hsc_src summary + location = ms_location summary + input_fn = expectJust "compile:hs" (ml_hs_file location) + input_fnpp = ms_hspp_file summary + mod_graph = hsc_mod_graph hsc_env0 + needsTH = any (xopt Opt_TemplateHaskell . ms_hspp_opts) mod_graph + needsQQ = any (xopt Opt_QuasiQuotes . ms_hspp_opts) mod_graph + needsLinker = needsTH || needsQQ + isDynWay = any (== WayDyn) (ways dflags0) + isProfWay = any (== WayProf) (ways dflags0) + + -- #8180 - when using TemplateHaskell, switch on -dynamic-too so + -- the linker can correctly load the object files. + + dflags1 = if needsLinker && dynamicGhc && not isDynWay && not isProfWay + then gopt_set dflags0 Opt_BuildDynamicToo + else dflags0 + + basename = dropExtension input_fn + + -- We add the directory in which the .hs files resides) to the import + -- path. This is needed when we try to compile the .hc file later, if it + -- imports a _stub.h file that we created here. + current_dir = takeDirectory basename + old_paths = includePaths dflags1 + dflags = dflags1 { includePaths = current_dir : old_paths } + hsc_env = hsc_env0 {hsc_dflags = dflags} + + -- Figure out what lang we're generating + hsc_lang = hscTarget dflags + -- ... and what the next phase should be + next_phase = hscPostBackendPhase dflags src_flavour hsc_lang + + -- -fforce-recomp should also work with --make + force_recomp = gopt Opt_ForceRecomp dflags + source_modified + | force_recomp = SourceModified + | otherwise = source_modified0 + object_filename = ml_obj_file location + + always_do_basic_recompilation_check = case hsc_lang of + HscInterpreted -> True + _ -> False ----------------------------------------------------------------------------- -- stub .h and .c files (for foreign export support) @@ -511,6 +558,50 @@ oneShot hsc_env stop_phase srcs = do o_files <- mapM (compileFile hsc_env stop_phase) srcs doLink (hsc_dflags hsc_env) stop_phase o_files +-- | Constructs a 'ModSummary' for a "signature merge" node. +-- This is a simplified construction function which only checks +-- for a local hs-boot file. +makeMergeRequirementSummary :: HscEnv -> Bool -> ModuleName -> IO ModSummary +makeMergeRequirementSummary hsc_env obj_allowed mod_name = do + let dflags = hsc_dflags hsc_env + location <- liftIO $ mkHomeModLocation2 dflags mod_name + (moduleNameSlashes mod_name) (hiSuf dflags) + obj_timestamp <- + if isObjectTarget (hscTarget dflags) || obj_allowed -- bug #1205 + then liftIO $ modificationTimeIfExists (ml_obj_file location) + else return Nothing + r <- findHomeModule hsc_env mod_name + let has_local_boot = case r of + Found _ _ -> True + _ -> False + src_timestamp <- case obj_timestamp of + Just date -> return date + Nothing -> getCurrentTime -- something fake + return ModSummary { + ms_mod = mkModule (thisPackage dflags) mod_name, + ms_hsc_src = HsBootMerge, + ms_location = location, + ms_hs_date = src_timestamp, + ms_obj_date = obj_timestamp, + ms_iface_date = Nothing, + -- TODO: fill this in with all the imports eventually + ms_srcimps = [], + ms_textual_imps = [], + ms_merge_imps = (has_local_boot, []), + ms_hspp_file = "FAKE", + ms_hspp_opts = dflags, + ms_hspp_buf = Nothing + } + +-- | Top-level entry point for @ghc -merge-requirement ModName@. +mergeRequirement :: HscEnv -> ModuleName -> IO () +mergeRequirement hsc_env mod_name = do + mod_summary <- makeMergeRequirementSummary hsc_env True mod_name + -- Based off of GhcMake handling + _ <- liftIO $ compileOne' Nothing Nothing hsc_env mod_summary 1 1 Nothing + Nothing SourceUnmodified + return () + compileFile :: HscEnv -> Phase -> (FilePath, Maybe Phase) -> IO FilePath compileFile hsc_env stop_phase (src, mb_phase) = do exists <- doesFileExist src @@ -992,7 +1083,8 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0 ms_obj_date = Nothing, ms_iface_date = Nothing, ms_textual_imps = imps, - ms_srcimps = src_imps } + ms_srcimps = src_imps, + ms_merge_imps = (False, []) } -- run the compiler! result <- liftIO $ hscCompileOneShot hsc_env' @@ -1024,7 +1116,7 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do -- stamp file for the benefit of Make liftIO $ touchObjectFile dflags o_file return (RealPhase next_phase, o_file) - HscUpdateSig -> + HscUpdateBootMerge -> do -- We need to create a REAL but empty .o file -- because we are going to attempt to put it in a library PipeState{hsc_env=hsc_env'} <- getPipeState @@ -2159,7 +2251,7 @@ writeInterfaceOnlyMode dflags = -- | 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 _ HsBootMerge _ = StopLn hscPostBackendPhase dflags _ hsc_lang = case hsc_lang of HscC -> HCc diff --git a/compiler/main/Finder.hs b/compiler/main/Finder.hs index 00ba0388dd..208475fefb 100644 --- a/compiler/main/Finder.hs +++ b/compiler/main/Finder.hs @@ -228,8 +228,11 @@ 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") + -- TODO: This is a giant hack! If we find an hs-boot file, + -- pretend that there's an hs file here too, even if there isn't. + -- GhcMake will know what to do next. + , ("hs-boot", mkHomeModLocationSearched dflags mod_name "hs") + , ("lhs-boot", mkHomeModLocationSearched dflags mod_name "lhs") ] hi_exts = [ (hisuf, mkHiOnlyModLocation dflags hisuf) @@ -250,7 +253,6 @@ findHomeModule hsc_env mod_name = then return (Found (error "GHC.Prim ModLocation") mod) else searchPathExts home_path mod exts - -- | Search for a module in external packages only. findPackageModule :: HscEnv -> Module -> IO FindResult findPackageModule hsc_env mod = do diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 591d569c41..883cd2c9d7 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -989,7 +989,7 @@ compileCore simplify fn = do _ <- load LoadAllTargets -- Then find dependencies modGraph <- depanal [] True - case find ((== fn) . msHsFilePath) modGraph of + case find ((== Just fn) . msHsFilePath) modGraph of Just modSummary -> do -- Now we have the module name; -- parse, typecheck and desugar the module diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 715b4503ef..cc112da197 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1423,7 +1423,7 @@ reachableBackwards mod summaries = [ ms | (ms,_,_) <- reachableG (transposeG graph) root ] where -- the rest just sets up the graph: (graph, lookup_node) = moduleGraphNodes False summaries - root = expectJust "reachableBackwards" (lookup_node HsBootFile mod) + root = expectJust "reachableBackwards" (lookup_node IsBoot mod) -- --------------------------------------------------------------------------- -- @@ -1462,7 +1462,8 @@ topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod -- the specified module. We do this by building a graph with -- the full set of nodes, and determining the reachable set from -- the specified node. - let root | Just node <- lookup_node HsSrcFile root_mod, graph `hasVertexG` node = node + let root | Just node <- lookup_node NotBoot root_mod + , graph `hasVertexG` node = node | otherwise = throwGhcException (ProgramError "module does not exist") in graphFromEdgedVertices (seq root (reachableG graph root)) @@ -1475,36 +1476,48 @@ summaryNodeSummary :: SummaryNode -> ModSummary summaryNodeSummary (s, _, _) = s moduleGraphNodes :: Bool -> [ModSummary] - -> (Graph SummaryNode, HscSource -> ModuleName -> Maybe SummaryNode) + -> (Graph SummaryNode, IsBoot -> ModuleName -> Maybe SummaryNode) moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, lookup_node) where numbered_summaries = zip summaries [1..] - lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode - lookup_node hs_src mod = Map.lookup (mod, hscSourceToIsBoot hs_src) node_map + lookup_node :: IsBoot -> ModuleName -> Maybe SummaryNode + lookup_node is_boot mod = Map.lookup (mod, is_boot) node_map - lookup_key :: HscSource -> ModuleName -> Maybe Int - lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod) + lookup_key :: IsBoot -> ModuleName -> Maybe Int + lookup_key is_boot mod = fmap summaryNodeKey (lookup_node is_boot mod) node_map :: NodeMap SummaryNode node_map = Map.fromList [ ((moduleName (ms_mod s), hscSourceToIsBoot (ms_hsc_src s)), node) | node@(s, _, _) <- nodes ] + hasImplSet :: Set.Set ModuleName + hasImplSet = Set.fromList [ ms_mod_name s + | s <- summaries, ms_hsc_src s == HsSrcFile ] + + hasImpl :: ModuleName -> Bool + hasImpl modname = modname `Set.member` hasImplSet + -- We use integers as the keys for the SCC algorithm nodes :: [SummaryNode] nodes = [ (s, key, out_keys) | (s, key) <- numbered_summaries -- Drop the hi-boot ones if told to do so - , not (isBootSummary s && drop_hs_boot_nodes) - , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++ - out_edge_keys HsSrcFile (map unLoc (ms_home_imps s)) ++ - (-- see [boot-edges] below - if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile - then [] - else case lookup_key HsBootFile (ms_mod_name s) of - Nothing -> [] - Just k -> [k]) ] + , not (isBootSummary s && hasImpl (ms_mod_name s) + && drop_hs_boot_nodes) + , let out_keys + = out_edge_keys IsBoot (map unLoc (ms_home_srcimps s)) ++ + out_edge_keys NotBoot (map unLoc (ms_home_imps s)) ++ + (if fst (ms_merge_imps s) + then out_edge_keys IsBoot [moduleName (ms_mod s)] + else []) ++ + (-- see [boot-edges] below + if drop_hs_boot_nodes || ms_hsc_src s /= HsSrcFile + then [] + else case lookup_key IsBoot (ms_mod_name s) of + Nothing -> [] + Just k -> [k]) ] -- [boot-edges] if this is a .hs and there is an equivalent -- .hs-boot, add a link from the former to the latter. This @@ -1514,12 +1527,13 @@ moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, l -- the .hs, and so the HomePackageTable will always have the -- most up to date information. - -- Drop hs-boot nodes by using HsSrcFile as the key - hs_boot_key | drop_hs_boot_nodes = HsSrcFile - | otherwise = HsBootFile + out_edge_keys :: IsBoot -> [ModuleName] -> [Int] + out_edge_keys hi_boot ms = mapMaybe (lookup_out_edge_key hi_boot) ms - out_edge_keys :: HscSource -> [ModuleName] -> [Int] - out_edge_keys hi_boot ms = mapMaybe (lookup_key hi_boot) ms + lookup_out_edge_key :: IsBoot -> ModuleName -> Maybe Int + lookup_out_edge_key hi_boot m + | hasImpl m, drop_hs_boot_nodes = lookup_key NotBoot m + | otherwise = lookup_key hi_boot m -- If we want keep_hi_boot_nodes, then we do lookup_key with -- IsBoot; else NotBoot @@ -1608,7 +1622,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- dependency on what-ever the signature's implementation is. -- (But not when we're type checking!) calcDeps summ - | HsigFile <- ms_hsc_src summ + | HsBootFile <- ms_hsc_src summ , Just m <- getSigOf (hsc_dflags hsc_env) (moduleName (ms_mod summ)) , modulePackageKey m == thisPackage (hsc_dflags hsc_env) = (noLoc (moduleName m), NotBoot) : msDeps summ @@ -1692,10 +1706,16 @@ mkRootMap summaries = Map.insertListWith (flip (++)) -- modules always contains B.hs if it contains B.hs-boot. -- Remember, this pass isn't doing the topological sort. It's -- just gathering the list of all relevant ModSummaries +-- +-- NB: for signatures, (m,NotBoot) is "special"; the Haskell file +-- may not exist; we just synthesize it ourselves. msDeps :: ModSummary -> [(Located ModuleName, IsBoot)] msDeps s = concat [ [(m,IsBoot), (m,NotBoot)] | m <- ms_home_srcimps s ] ++ [ (m,NotBoot) | m <- ms_home_imps s ] + ++ if fst (ms_merge_imps s) + then [ (noLoc (moduleName (ms_mod s)), IsBoot) ] + else [] home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName] home_imps imps = [ ideclName i | L _ i <- imps, @@ -1777,8 +1797,6 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf new_summary src_timestamp = do let dflags = hsc_dflags hsc_env - let hsc_src = if isHaskellSigFilename file then HsigFile else HsSrcFile - (dflags', hspp_fn, buf) <- preprocessFile hsc_env file mb_phase maybe_buf @@ -1801,12 +1819,16 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf hi_timestamp <- maybeGetIfaceDate dflags location - return (ModSummary { ms_mod = mod, ms_hsc_src = hsc_src, + return (ModSummary { ms_mod = mod, + ms_hsc_src = if "boot" `isSuffixOf` file + then HsBootFile + else HsSrcFile, ms_location = location, ms_hspp_file = hspp_fn, ms_hspp_opts = dflags', ms_hspp_buf = Just buf, ms_srcimps = srcimps, ms_textual_imps = the_imps, + ms_merge_imps = (False, []), ms_hs_date = src_timestamp, ms_iface_date = hi_timestamp, ms_obj_date = obj_timestamp }) @@ -1852,6 +1874,17 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) Left e | isDoesNotExistError e -> find_it | otherwise -> ioError e + | NotBoot <- is_boot + , Just _ <- getSigOf dflags wanted_mod + = do mod_summary0 <- makeMergeRequirementSummary hsc_env + obj_allowed + wanted_mod + hi_timestamp <- maybeGetIfaceDate dflags (ms_location mod_summary0) + let mod_summary = mod_summary0 { + ms_iface_date = hi_timestamp + } + return (Just (Right mod_summary)) + | otherwise = find_it where dflags = hsc_dflags hsc_env @@ -1914,17 +1947,10 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn - -- NB: Despite the fact that is_boot is a top-level parameter, we - -- don't actually know coming into this function what the HscSource - -- of the module in question is. This is because we may be processing - -- this module because another module in the graph imported it: in this - -- case, we know if it's a boot or not because of the {-# SOURCE #-} - -- annotation, but we don't know if it's a signature or a regular - -- module until we actually look it up on the filesystem. - let hsc_src = case is_boot of - IsBoot -> HsBootFile - _ | isHaskellSigFilename src_fn -> HsigFile - | otherwise -> HsSrcFile + let hsc_src = + case is_boot of + IsBoot -> HsBootFile + NotBoot -> HsSrcFile when (mod_name /= wanted_mod) $ throwOneError $ mkPlainErrMsg dflags' mod_loc $ @@ -1949,6 +1975,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) ms_hspp_buf = Just buf, ms_srcimps = srcimps, ms_textual_imps = the_imps, + ms_merge_imps = (False, []), ms_hs_date = src_timestamp, ms_iface_date = hi_timestamp, ms_obj_date = obj_timestamp }))) @@ -2054,4 +2081,6 @@ cyclicModuleErr mss ppr_ms :: ModSummary -> SDoc ppr_ms ms = quotes (ppr (moduleName (ms_mod ms))) <+> - (parens (text (msHsFilePath ms))) + case msHsFilePath ms of + Just path -> parens (text path) + Nothing -> empty diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index c7cabe6f9a..00cff287e0 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -41,6 +41,7 @@ module HscMain , hscCompileCore , genericHscCompileGetFrontendResult + , genericHscMergeRequirement , genModDetails , hscSimpleIface @@ -94,12 +95,12 @@ import CoreTidy ( tidyExpr ) import Type ( Type, Kind ) import CoreLint ( lintInteractiveExpr ) import VarEnv ( emptyTidyEnv ) -import Panic import ConLike import GHC.Exts #endif +import Panic import Module import Packages import RdrName @@ -113,7 +114,8 @@ import TcRnDriver import TcIface ( typecheckIface ) import TcRnMonad import IfaceEnv ( initNameCache ) -import LoadIface ( ifaceStats, initExternalPackageState ) +import LoadIface ( ifaceStats, initExternalPackageState + , findAndReadIface ) import PrelInfo import MkIface import Desugar @@ -140,6 +142,7 @@ import InstEnv import FamInstEnv import Fingerprint ( Fingerprint ) import Hooks +import Maybes import DynFlags import ErrUtils @@ -158,7 +161,6 @@ import Util import Data.List import Control.Monad -import Data.Maybe import Data.IORef import System.FilePath as FilePath import System.Directory @@ -511,6 +513,45 @@ This is the only thing that isn't caught by the type-system. type Messager = HscEnv -> (Int,Int) -> RecompileRequired -> ModSummary -> IO () +-- | Analogous to 'genericHscCompileGetFrontendResult', this function +-- calls 'hscMergeFrontEnd' if recompilation is necessary. It does +-- not write out the resulting 'ModIface' (see 'compileOne'). +-- TODO: maybe fold this 'genericHscCompileGetFrontendResult' into +-- some higher-order function +genericHscMergeRequirement :: + Maybe Messager + -> HscEnv + -> ModSummary + -> Maybe ModIface -- Old interface, if available + -> (Int,Int) -- (i,n) = module i of n (for msgs) + -> IO (Either ModIface (ModIface, Maybe Fingerprint)) +genericHscMergeRequirement mHscMessage + hsc_env mod_summary mb_old_iface mod_index = do + let msg what = case mHscMessage of + Just hscMessage -> + hscMessage hsc_env mod_index what mod_summary + Nothing -> return () + + skip iface = do + msg UpToDate + return (Left iface) + + -- TODO: hook this + compile mb_old_hash reason = do + msg reason + r <- hscMergeFrontEnd hsc_env mod_summary + return $ Right (r, mb_old_hash) + + (recomp_reqd, mb_checked_iface) + <- {-# SCC "checkOldIface" #-} + checkOldIface hsc_env mod_summary + SourceUnmodified mb_old_iface + case mb_checked_iface of + Just iface | not (recompileRequired recomp_reqd) -> skip iface + _ -> compile (fmap mi_iface_hash mb_checked_iface) recomp_reqd + +-- | This function runs 'genericHscFrontend' if recompilation is necessary. +-- It does not write out the results of typechecking (see 'compileOne'). genericHscCompileGetFrontendResult :: Bool -- always do basic recompilation check? -> Maybe TcGblEnv @@ -635,18 +676,16 @@ hscCompileOneShot' hsc_env mod_summary src_changed return HscNotGeneratingCode _ -> case ms_hsc_src mod_summary of - t | isHsBootOrSig t -> + HsBootFile -> do (iface, changed, _) <- hscSimpleIface' tc_result mb_old_hash liftIO $ hscWriteIface dflags iface changed mod_summary - return (case t of - HsBootFile -> HscUpdateBoot - HsigFile -> HscUpdateSig - HsSrcFile -> panic "hscCompileOneShot Src") - _ -> + return HscUpdateBoot + HsSrcFile -> do guts <- hscSimplify' guts0 (iface, changed, _details, cgguts) <- hscNormalIface' guts mb_old_hash liftIO $ hscWriteIface dflags iface changed mod_summary return $ HscRecomp cgguts mod_summary + HsBootMerge -> panic "hscCompileOneShot HsBootMerge" -- XXX This is always False, because in one-shot mode the -- concept of stability does not exist. The driver never @@ -727,8 +766,46 @@ batchMsg hsc_env mod_index recomp mod_summary = -- FrontEnds -------------------------------------------------------------- +-- | Given an 'HsBootMerge' 'ModSummary', merges all @hs-boot@ files +-- under this module name into a composite, publically visible 'ModIface'. +hscMergeFrontEnd :: HscEnv -> ModSummary -> IO ModIface +hscMergeFrontEnd hsc_env mod_summary = do + MASSERT( ms_hsc_src mod_summary == HsBootMerge ) + let dflags = hsc_dflags hsc_env + -- TODO: actually merge in signatures from external packages. + -- Grovel in HPT if necessary + -- TODO: replace with 'computeInterface' + let hpt = hsc_HPT hsc_env + -- TODO multiple mods + let name = moduleName (ms_mod mod_summary) + mod = mkModule (thisPackage dflags) name + is_boot = True + iface0 <- case lookupHptByModule hpt mod of + Just hm -> return (hm_iface hm) + Nothing -> do + mb_iface0 <- initIfaceCheck hsc_env + $ findAndReadIface (text "merge-requirements") + mod is_boot + case mb_iface0 of + Succeeded (i, _) -> return i + Failed err -> liftIO $ throwGhcExceptionIO + (ProgramError (showSDoc dflags err)) + let iface = iface0 { + mi_hsc_src = HsBootMerge, + -- TODO: mkDependencies doublecheck + mi_deps = (mi_deps iface0) { + dep_mods = (name, is_boot) + : dep_mods (mi_deps iface0) + } + } + return iface + +-- | Given a 'ModSummary', parses and typechecks it, returning the +-- 'TcGblEnv' resulting from type-checking. hscFileFrontEnd :: ModSummary -> Hsc TcGblEnv hscFileFrontEnd mod_summary = do + MASSERT( ms_hsc_src mod_summary == HsBootFile || + ms_hsc_src mod_summary == HsSrcFile ) hpm <- hscParse' mod_summary hsc_env <- getHscEnv tcg_env <- tcRnModule' hsc_env mod_summary False hpm diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 6b94998490..00ceb41ed9 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -29,7 +29,7 @@ module HscTypes ( -- * Information about the module being compiled -- (re-exported from DriverPhases) - HscSource(..), isHsBootOrSig, hscSourceString, + HscSource(..), isHsBoot, hscSourceString, -- * State relating to modules in this package @@ -162,7 +162,7 @@ import PatSyn import PrelNames ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule ) import Packages hiding ( Version(..) ) import DynFlags -import DriverPhases ( Phase, HscSource(..), isHsBootOrSig, hscSourceString ) +import DriverPhases ( Phase, HscSource(..), isHsBoot, hscSourceString ) import BasicTypes import IfaceSyn import CoreSyn ( CoreRule, CoreVect ) @@ -202,7 +202,7 @@ data HscStatus = HscNotGeneratingCode | HscUpToDate | HscUpdateBoot - | HscUpdateSig + | HscUpdateBootMerge | HscRecomp CgGuts ModSummary -- ----------------------------------------------------------------------------- @@ -2410,6 +2410,8 @@ data ModSummary -- ^ Source imports of the module ms_textual_imps :: [Located (ImportDecl RdrName)], -- ^ Non-source imports of the module from the module *text* + ms_merge_imps :: (Bool, [Module]), + -- ^ Non-textual imports computed for HsBootMerge ms_hspp_file :: FilePath, -- ^ Filename of preprocessed source file ms_hspp_opts :: DynFlags, @@ -2453,8 +2455,10 @@ ms_imps ms = -- The ModLocation is stable over successive up-sweeps in GHCi, wheres -- the ms_hs_date and imports can, of course, change -msHsFilePath, msHiFilePath, msObjFilePath :: ModSummary -> FilePath -msHsFilePath ms = expectJust "msHsFilePath" (ml_hs_file (ms_location ms)) +msHsFilePath :: ModSummary -> Maybe FilePath +msHsFilePath ms = ml_hs_file (ms_location ms) + +msHiFilePath, msObjFilePath :: ModSummary -> FilePath msHiFilePath ms = ml_hi_file (ms_location ms) msObjFilePath ms = ml_obj_file (ms_location ms) @@ -2469,7 +2473,10 @@ instance Outputable ModSummary where text "ms_mod =" <+> ppr (ms_mod ms) <> text (hscSourceString (ms_hsc_src ms)) <> comma, text "ms_textual_imps =" <+> ppr (ms_textual_imps ms), - text "ms_srcimps =" <+> ppr (ms_srcimps ms)]), + text "ms_srcimps =" <+> ppr (ms_srcimps ms), + if not (null (ms_merge_imps ms)) + then text "ms_merge_imps =" <+> ppr (ms_merge_imps ms) + else empty]), char '}' ] @@ -2477,29 +2484,20 @@ showModMsg :: DynFlags -> HscTarget -> Bool -> ModSummary -> String showModMsg dflags target recomp mod_summary = showSDoc dflags $ hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '), - char '(', text (normalise $ msHsFilePath mod_summary) <> comma, + char '(', + case msHsFilePath mod_summary of + Just path -> text (normalise path) <> comma + Nothing -> text "nothing" <> comma, case target of HscInterpreted | recomp -> text "interpreted" HscNothing -> text "nothing" - _ | HsigFile == ms_hsc_src mod_summary -> text "nothing" - | otherwise -> text (normalise $ msObjFilePath mod_summary), + _ -> text (normalise $ msObjFilePath mod_summary), char ')'] where mod = moduleName (ms_mod 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 + ++ hscSourceString (ms_hsc_src mod_summary) {- ************************************************************************ diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 897828d5ec..48abcc805c 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -21,7 +21,7 @@ import {-# SOURCE #-} TcExpr ( tcMonoExpr ) import {-# SOURCE #-} TcPatSyn ( tcInferPatSynDecl, tcCheckPatSynDecl, tcPatSynBuilderBind ) import DynFlags import HsSyn -import HscTypes( isHsBootOrSig ) +import HscTypes( isHsBoot ) import TcRnMonad import TcEnv import TcUnify @@ -184,7 +184,7 @@ tcRecSelBinds (ValBindsOut binds sigs) = tcExtendGlobalValEnv [sel_id | L _ (IdSig sel_id) <- sigs] $ do { (rec_sel_binds, tcg_env) <- discardWarnings (tcValBinds TopLevel binds sigs getGblEnv) ; let tcg_env' - | isHsBootOrSig (tcg_src tcg_env) = tcg_env + | isHsBoot (tcg_src tcg_env) = tcg_env | otherwise = tcg_env { tcg_binds = foldr (unionBags . snd) (tcg_binds tcg_env) rec_sel_binds } diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index d31b7bf310..d5dee95b00 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -50,7 +50,7 @@ import BasicTypes import DynFlags import ErrUtils import FastString -import HscTypes ( isHsBootOrSig ) +import HscTypes ( isHsBoot ) import Id import MkId import Name @@ -442,7 +442,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls typeable_err i = setSrcSpan (getSrcSpan (iSpec i)) $ do env <- getGblEnv - if isHsBootOrSig (tcg_src env) + if isHsBoot (tcg_src env) then do warn <- woptM Opt_WarnDerivingTypeable when warn $ addWarnTc $ vcat diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index fc90f316fe..2c2e5d71a9 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -161,8 +161,12 @@ tcRnSignature dflags hsc_src = do { tcg_env <- getGblEnv ; case tcg_sig_of tcg_env of { Just sof - | hsc_src /= HsigFile -> do - { addErr (ptext (sLit "Illegal -sig-of specified for non hsig")) + | hsc_src /= HsBootFile -> do + { modname <- fmap moduleName getModule + ; addErr (text "Found -sig-of entry for" <+> ppr modname + <+> text "which is not hs-boot." $$ + text "Try removing" <+> ppr modname <+> + text "from -sig-of") ; return tcg_env } | otherwise -> do @@ -176,15 +180,7 @@ tcRnSignature dflags hsc_src , tcg_imports = tcg_imports tcg_env `plusImportAvails` avails }) } ; - Nothing - | HsigFile <- hsc_src - , HscNothing <- hscTarget dflags -> do - { return tcg_env - } - | HsigFile <- hsc_src -> do - { addErr (ptext (sLit "Missing -sig-of for hsig")) - ; failM } - | otherwise -> return tcg_env + Nothing -> return tcg_env } } @@ -320,7 +316,7 @@ tcRnModuleTcRnM hsc_env hsc_src -- Rename and type check the declarations traceRn (text "rn1a") ; - tcg_env <- if isHsBootOrSig hsc_src then + tcg_env <- if isHsBoot hsc_src then tcRnHsBootDecls hsc_src local_decls else {-# SCC "tcRnSrcDecls" #-} @@ -667,9 +663,9 @@ tcRnHsBootDecls hsc_src decls -- are written into the interface file. ; let { type_env0 = tcg_type_env gbl_env ; type_env1 = extendTypeEnvWithIds type_env0 val_ids - -- Don't add the dictionaries for hsig, we don't actually want - -- to /define/ the instance - ; type_env2 | HsigFile <- hsc_src = type_env1 + -- Don't add the dictionaries for non-recursive case, we don't + -- actually want to /define/ the instance, just an export list + ; type_env2 | Just _ <- tcg_impl_rdr_env gbl_env = type_env1 | otherwise = extendTypeEnvWithIds type_env1 dfun_ids ; dfun_ids = map iDFunId inst_infos } @@ -679,14 +675,9 @@ tcRnHsBootDecls hsc_src decls ; traceTc "boot" (ppr lie); return gbl_env } badBootDecl :: HscSource -> String -> Located decl -> TcM () -badBootDecl hsc_src what (L loc _) +badBootDecl _hsc_src what (L loc _) = addErrAt loc (char 'A' <+> text what - <+> ptext (sLit "declaration is not (currently) allowed in a") - <+> (case hsc_src of - HsBootFile -> ptext (sLit "hs-boot") - HsigFile -> ptext (sLit "hsig") - _ -> panic "badBootDecl: should be an hsig or hs-boot file") - <+> ptext (sLit "file")) + <+> text "declaration is not (currently) allowed in a hs-boot file") {- Once we've typechecked the body of the module, we want to compare what @@ -1061,7 +1052,7 @@ emptyRnEnv2 = mkRnEnv2 emptyInScopeSet missingBootThing :: Bool -> Name -> String -> SDoc missingBootThing is_boot name what = quotes (ppr name) <+> ptext (sLit "is exported by the") - <+> (if is_boot then ptext (sLit "hs-boot") else ptext (sLit "hsig")) + <+> (if is_boot then ptext (sLit "hs-boot") else ptext (sLit "signature")) <+> ptext (sLit "file, but not") <+> text what <+> ptext (sLit "the module") @@ -1071,11 +1062,11 @@ bootMisMatch is_boot extra_info real_thing boot_thing ptext (sLit "has conflicting definitions in the module"), ptext (sLit "and its") <+> (if is_boot then ptext (sLit "hs-boot file") - else ptext (sLit "hsig file")), + else ptext (sLit "signature file")), ptext (sLit "Main module:") <+> PprTyThing.pprTyThing real_thing, (if is_boot then ptext (sLit "Boot file: ") - else ptext (sLit "Hsig file: ")) + else ptext (sLit "Signature file: ")) <+> PprTyThing.pprTyThing boot_thing, extra_info] @@ -1083,7 +1074,7 @@ instMisMatch :: Bool -> ClsInst -> SDoc instMisMatch is_boot inst = hang (ppr inst) 2 (ptext (sLit "is defined in the") <+> - (if is_boot then ptext (sLit "hs-boot") else ptext (sLit "hsig")) + (if is_boot then ptext (sLit "hs-boot") else ptext (sLit "signature")) <+> ptext (sLit "file, but not in the module itself")) {- diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 2492c5544e..2dbabfc8fd 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -609,7 +609,7 @@ getInteractivePrintName :: TcRn Name getInteractivePrintName = do { hsc <- getTopEnv; return (ic_int_print $ hsc_IC hsc) } tcIsHsBootOrSig :: TcRn Bool -tcIsHsBootOrSig = do { env <- getGblEnv; return (isHsBootOrSig (tcg_src env)) } +tcIsHsBootOrSig = do { env <- getGblEnv; return (isHsBoot (tcg_src env)) } tcSelfBootInfo :: TcRn SelfBootInfo tcSelfBootInfo = do { env <- getGblEnv; return (tcg_self_boot env) } diff --git a/ghc/Main.hs b/ghc/Main.hs index e2c7479008..7ca7481fc3 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -22,7 +22,7 @@ import CmdLineParser -- Implementations of the various modes (--show-iface, mkdependHS. etc.) import LoadIface ( showIface ) import HscMain ( newHscEnv ) -import DriverPipeline ( oneShot, compileFile ) +import DriverPipeline ( oneShot, compileFile, mergeRequirement ) import DriverMkDepend ( doMkDependHS ) #ifdef GHCI import InteractiveUI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) @@ -156,6 +156,7 @@ main' postLoadMode dflags0 args flagWarnings = do DoMake -> (CompManager, dflt_target, LinkBinary) DoMkDependHS -> (MkDepend, dflt_target, LinkBinary) DoAbiHash -> (OneShot, dflt_target, LinkBinary) + DoMergeRequirements -> (OneShot, dflt_target, LinkBinary) _ -> (OneShot, dflt_target, LinkBinary) let dflags1 = case lang of @@ -250,6 +251,7 @@ main' postLoadMode dflags0 args flagWarnings = do DoInteractive -> ghciUI srcs Nothing DoEval exprs -> ghciUI srcs $ Just $ reverse exprs DoAbiHash -> abiHash (map fst srcs) + DoMergeRequirements -> doMergeRequirements (map fst srcs) ShowPackages -> liftIO $ showPackages dflags6 liftIO $ dumpFinalStats dflags6 @@ -455,14 +457,16 @@ data PostLoadMode | DoEval [String] -- ghc -e foo -e bar => DoEval ["bar", "foo"] | DoAbiHash -- ghc --abi-hash | ShowPackages -- ghc --show-packages + | DoMergeRequirements -- ghc --merge-requirements doMkDependHSMode, doMakeMode, doInteractiveMode, - doAbiHashMode, showPackagesMode :: Mode + doAbiHashMode, showPackagesMode, doMergeRequirementsMode :: Mode doMkDependHSMode = mkPostLoadMode DoMkDependHS doMakeMode = mkPostLoadMode DoMake doInteractiveMode = mkPostLoadMode DoInteractive doAbiHashMode = mkPostLoadMode DoAbiHash showPackagesMode = mkPostLoadMode ShowPackages +doMergeRequirementsMode = mkPostLoadMode DoMergeRequirements showInterfaceMode :: FilePath -> Mode showInterfaceMode fp = mkPostLoadMode (ShowInterface fp) @@ -598,6 +602,7 @@ mode_flags = , defFlag "C" (PassFlag (setMode (stopBeforeMode HCc))) , defFlag "S" (PassFlag (setMode (stopBeforeMode (As False)))) , defFlag "-make" (PassFlag (setMode doMakeMode)) + , defFlag "-merge-requirements" (PassFlag (setMode doMergeRequirementsMode)) , defFlag "-interactive" (PassFlag (setMode doInteractiveMode)) , defFlag "-abi-hash" (PassFlag (setMode doAbiHashMode)) , defFlag "e" (SepArg (\s -> setMode (doEvalMode s) "-e")) @@ -698,6 +703,16 @@ doMake srcs = do when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1)) return () +-- ---------------------------------------------------------------------------- +-- Run --merge-requirements mode + +doMergeRequirements :: [String] -> Ghc () +doMergeRequirements srcs = mapM_ doMergeRequirement srcs + +doMergeRequirement :: String -> Ghc () +doMergeRequirement src = do + hsc_env <- getSession + liftIO $ mergeRequirement hsc_env (mkModuleName src) -- --------------------------------------------------------------------------- -- --show-iface mode diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 14704f7f58..88c89deb64 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -613,6 +613,7 @@ mk/ghcconfig*_bin_ghc*.exe.mk /tests/driver/recomp014/A.hs /tests/driver/recomp014/A1.hs /tests/driver/recomp014/B.hsig +/tests/driver/recomp014/B.hs-boot /tests/driver/recomp014/C.hs /tests/driver/recomp014/recomp014 /tests/driver/rtsOpts diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo005/A005.hsig b/testsuite/tests/driver/dynamicToo/dynamicToo005/A005.hs-boot index 75d621cfec..75d621cfec 100644 --- a/testsuite/tests/driver/dynamicToo/dynamicToo005/A005.hsig +++ b/testsuite/tests/driver/dynamicToo/dynamicToo005/A005.hs-boot diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo005/Makefile b/testsuite/tests/driver/dynamicToo/dynamicToo005/Makefile index 617510eec4..a08827a92d 100644 --- a/testsuite/tests/driver/dynamicToo/dynamicToo005/Makefile +++ b/testsuite/tests/driver/dynamicToo/dynamicToo005/Makefile @@ -5,11 +5,15 @@ include $(TOP)/mk/test.mk checkExists = [ -f $1 ] || echo $1 missing .PHONY: dynamicToo005 -# Check that "-c -dynamic-too" works with .hsig +# Check that "-c -dynamic-too" works with signatures dynamicToo005: "$(TEST_HC)" $(TEST_HC_OPTS) -dynamic-too -v0 \ -sig-of A005=base:Prelude \ - -c A005.hsig + -c A005.hs-boot + $(call checkExists,A005.o-boot) + $(call checkExists,A005.hi-boot) + "$(TEST_HC)" $(TEST_HC_OPTS) -dynamic-too -v0 \ + --merge-requirements A005 $(call checkExists,A005.o) $(call checkExists,A005.hi) $(call checkExists,A005.dyn_o) diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo006/A.hsig b/testsuite/tests/driver/dynamicToo/dynamicToo006/A.hs-boot index f79d5d334f..f79d5d334f 100644 --- a/testsuite/tests/driver/dynamicToo/dynamicToo006/A.hsig +++ b/testsuite/tests/driver/dynamicToo/dynamicToo006/A.hs-boot diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo006/Makefile b/testsuite/tests/driver/dynamicToo/dynamicToo006/Makefile index 497f2c0942..6e025f8322 100644 --- a/testsuite/tests/driver/dynamicToo/dynamicToo006/Makefile +++ b/testsuite/tests/driver/dynamicToo/dynamicToo006/Makefile @@ -11,8 +11,10 @@ dynamicToo006: -sig-of A=base:Prelude \ --make B $(call checkExists,A.o) + $(call checkExists,A.o-boot) $(call checkExists,B.o) $(call checkExists,A.hi) + $(call checkExists,A.hi-boot) $(call checkExists,B.hi) $(call checkExists,A.dyn_o) $(call checkExists,B.dyn_o) diff --git a/testsuite/tests/driver/recomp014/Makefile b/testsuite/tests/driver/recomp014/Makefile new file mode 100644 index 0000000000..00b2035206 --- /dev/null +++ b/testsuite/tests/driver/recomp014/Makefile @@ -0,0 +1,33 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# -fforce-recomp makes lots of driver tests trivially pass, so we +# filter it out from $(TEST_HC_OPTS). +TEST_HC_OPTS_NO_RECOMP = $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) + +# Recompilation tests + +clean: + rm -f *.o *.hi + +recomp014: clean + echo 'module A where a = False' > A.hs + echo 'module A1 where a = False' > A1.hs + echo 'module B where a :: Bool' > B.hs-boot + echo 'first run' + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c A.hs + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c A1.hs + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c B.hs-boot -sig-of "B is main:A" + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --merge-requirements B + echo 'import B; main = print a' > C.hs + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c C.hs + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c C.hs + echo 'second run' + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c B.hs-boot -sig-of "B is main:A1" + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --merge-requirements B + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c C.hs + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) A1.o C.o -o recomp014 + ./recomp014 + +.PHONY: clean recomp014 diff --git a/testsuite/tests/driver/recomp014/all.T b/testsuite/tests/driver/recomp014/all.T new file mode 100644 index 0000000000..affccd2f7f --- /dev/null +++ b/testsuite/tests/driver/recomp014/all.T @@ -0,0 +1,4 @@ +test('recomp014', + [ clean_cmd('$MAKE -s clean') ], + run_command, + ['$MAKE -s --no-print-directory recomp014']) diff --git a/testsuite/tests/driver/recomp014/recomp014.stdout b/testsuite/tests/driver/recomp014/recomp014.stdout new file mode 100644 index 0000000000..7d540716f0 --- /dev/null +++ b/testsuite/tests/driver/recomp014/recomp014.stdout @@ -0,0 +1,4 @@ +first run +compilation IS NOT required +second run +False diff --git a/testsuite/tests/driver/sigof01/B.hsig b/testsuite/tests/driver/sigof01/B.hs-boot index 289d3bcb18..289d3bcb18 100644 --- a/testsuite/tests/driver/sigof01/B.hsig +++ b/testsuite/tests/driver/sigof01/B.hs-boot diff --git a/testsuite/tests/driver/sigof01/Makefile b/testsuite/tests/driver/sigof01/Makefile index 84dfc33a9f..8bed672c07 100644 --- a/testsuite/tests/driver/sigof01/Makefile +++ b/testsuite/tests/driver/sigof01/Makefile @@ -11,7 +11,8 @@ sigof01: rm -rf tmp_sigof01 mkdir tmp_sigof01 '$(TEST_HC)' $(S01_OPTS) -c A.hs - '$(TEST_HC)' $(S01_OPTS) -c B.hsig -sig-of "B is main:A" + '$(TEST_HC)' $(S01_OPTS) -c B.hs-boot -sig-of "B is main:A" + '$(TEST_HC)' $(S01_OPTS) --merge-requirements B '$(TEST_HC)' $(S01_OPTS) -c Main.hs '$(TEST_HC)' $(S01_OPTS) tmp_sigof01/A.o tmp_sigof01/Main.o -o tmp_sigof01/Main tmp_sigof01/Main @@ -21,3 +22,9 @@ sigof01m: mkdir tmp_sigof01m '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -outputdir tmp_sigof01m --make Main.hs -sig-of "B is main:A" -o tmp_sigof01m/Main tmp_sigof01m/Main + +sigof01i: + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --interactive -v0 -ignore-dot-ghci Main.hs -sig-of "B is main:A" < sigof01i.script + +sigof01i2: + '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --interactive -v0 -ignore-dot-ghci -sig-of "B is main:A" < sigof01i2.script diff --git a/testsuite/tests/driver/sigof01/all.T b/testsuite/tests/driver/sigof01/all.T index d0cdc3c02c..5606127f06 100644 --- a/testsuite/tests/driver/sigof01/all.T +++ b/testsuite/tests/driver/sigof01/all.T @@ -7,3 +7,13 @@ test('sigof01m', [ clean_cmd('rm -rf tmp_sigof01m') ], run_command, ['$MAKE -s --no-print-directory sigof01m']) + +test('sigof01i', + [], + run_command, + ['$MAKE -s --no-print-directory sigof01i']) + +test('sigof01i2', + [], + run_command, + ['$MAKE -s --no-print-directory sigof01i2']) diff --git a/testsuite/tests/driver/sigof01/sigof01i.script b/testsuite/tests/driver/sigof01/sigof01i.script new file mode 100644 index 0000000000..ba2906d066 --- /dev/null +++ b/testsuite/tests/driver/sigof01/sigof01i.script @@ -0,0 +1 @@ +main diff --git a/testsuite/tests/driver/sigof01/sigof01i.stdout b/testsuite/tests/driver/sigof01/sigof01i.stdout new file mode 100644 index 0000000000..bb614cd2a0 --- /dev/null +++ b/testsuite/tests/driver/sigof01/sigof01i.stdout @@ -0,0 +1,3 @@ +False +T +True diff --git a/testsuite/tests/driver/sigof01/sigof01i2.script b/testsuite/tests/driver/sigof01/sigof01i2.script new file mode 100644 index 0000000000..3a91e377a3 --- /dev/null +++ b/testsuite/tests/driver/sigof01/sigof01i2.script @@ -0,0 +1,3 @@ +:load B +:browse B +:issafe diff --git a/testsuite/tests/driver/sigof01/sigof01i2.stdout b/testsuite/tests/driver/sigof01/sigof01i2.stdout new file mode 100644 index 0000000000..1ee81c10d2 --- /dev/null +++ b/testsuite/tests/driver/sigof01/sigof01i2.stdout @@ -0,0 +1,9 @@ +class Foo a where + foo :: a -> a + {-# MINIMAL foo #-} +data T = A.T +mkT :: T +x :: Bool +Trust type is (Module: Safe, Package: trusted) +Package Trust: Off +B is trusted! diff --git a/testsuite/tests/driver/sigof01/sigof01m.stdout b/testsuite/tests/driver/sigof01/sigof01m.stdout index a7fdd8298e..35190ae143 100644 --- a/testsuite/tests/driver/sigof01/sigof01m.stdout +++ b/testsuite/tests/driver/sigof01/sigof01m.stdout @@ -1,6 +1,7 @@ -[1 of 3] Compiling A ( A.hs, tmp_sigof01m/A.o ) -[2 of 3] Compiling B[sig of A] ( B.hsig, nothing ) -[3 of 3] Compiling Main ( Main.hs, tmp_sigof01m/Main.o ) +[1 of 4] Compiling A ( A.hs, tmp_sigof01m/A.o ) +[2 of 4] Compiling B[boot] ( B.hs-boot, tmp_sigof01m/B.o-boot ) +[3 of 4] Compiling B[merge] ( B.hi, tmp_sigof01m/B.o ) +[4 of 4] Compiling Main ( Main.hs, tmp_sigof01m/Main.o ) Linking tmp_sigof01m/Main ... False T diff --git a/testsuite/tests/driver/sigof02/Makefile b/testsuite/tests/driver/sigof02/Makefile index 8f153f44ce..aebff03151 100644 --- a/testsuite/tests/driver/sigof02/Makefile +++ b/testsuite/tests/driver/sigof02/Makefile @@ -11,11 +11,13 @@ sigof02: rm -rf tmp_sigof02 mkdir tmp_sigof02 '$(GHC_PKG)' field containers key | sed 's/^.*: *//' > tmp_sigof02/containers - '$(TEST_HC)' $(S02_OPTS) -c Map.hsig -sig-of "Map is `cat tmp_sigof02/containers`:Data.Map.Strict" + '$(TEST_HC)' $(S02_OPTS) -c Map.hs-boot -sig-of "Map is `cat tmp_sigof02/containers`:Data.Map.Strict" + '$(TEST_HC)' $(S02_OPTS) --merge-requirements Map '$(TEST_HC)' $(S02_OPTS) -c Main.hs '$(TEST_HC)' $(S02_OPTS) -package containers tmp_sigof02/Main.o -o tmp_sigof02/StrictMain ! ./tmp_sigof02/StrictMain - '$(TEST_HC)' $(S02_OPTS) -c Map.hsig -sig-of "Map is `cat tmp_sigof02/containers`:Data.Map.Lazy" + '$(TEST_HC)' $(S02_OPTS) -c Map.hs-boot -sig-of "Map is `cat tmp_sigof02/containers`:Data.Map.Lazy" + '$(TEST_HC)' $(S02_OPTS) --merge-requirements Map '$(TEST_HC)' $(S02_OPTS) -c Main.hs '$(TEST_HC)' $(S02_OPTS) -package containers tmp_sigof02/Main.o -o tmp_sigof02/LazyMain ./tmp_sigof02/LazyMain @@ -24,7 +26,8 @@ S02T_OPTS=$(TEST_HC_OPTS_NO_RECOMP) -fno-code -fwrite-interface -outputdir tmp_s sigof02t: rm -rf tmp_sigof02t mkdir tmp_sigof02t - '$(TEST_HC)' $(S02T_OPTS) -c Map.hsig + '$(TEST_HC)' $(S02T_OPTS) -c Map.hs-boot + '$(TEST_HC)' $(S02T_OPTS) --merge-requirements Map '$(TEST_HC)' $(S02T_OPTS) -c Main.hs S02M_OPTS=$(TEST_HC_OPTS_NO_RECOMP) -outputdir tmp_sigof02m @@ -47,8 +50,10 @@ sigof02d: rm -rf tmp_sigof02d mkdir tmp_sigof02d '$(GHC_PKG)' field containers key | sed 's/^.*: *//' > tmp_sigof02d/containers - '$(TEST_HC)' $(S02D_OPTS) -c Map.hsig -sig-of "Map is `cat tmp_sigof02d/containers`:Data.Map.Lazy, MapAsSet is `cat tmp_sigof02d/containers`:Data.Map.Lazy" - '$(TEST_HC)' $(S02D_OPTS) -c MapAsSet.hsig -sig-of "Map is `cat tmp_sigof02d/containers`:Data.Map.Lazy, MapAsSet is `cat tmp_sigof02d/containers`:Data.Map.Lazy" + '$(TEST_HC)' $(S02D_OPTS) -c Map.hs-boot -sig-of "Map is `cat tmp_sigof02d/containers`:Data.Map.Lazy, MapAsSet is `cat tmp_sigof02d/containers`:Data.Map.Lazy" + '$(TEST_HC)' $(S02D_OPTS) --merge-requirements Map + '$(TEST_HC)' $(S02D_OPTS) -c MapAsSet.hs-boot -sig-of "Map is `cat tmp_sigof02d/containers`:Data.Map.Lazy, MapAsSet is `cat tmp_sigof02d/containers`:Data.Map.Lazy" + '$(TEST_HC)' $(S02D_OPTS) --merge-requirements MapAsSet '$(TEST_HC)' $(S02D_OPTS) -c Double.hs '$(TEST_HC)' $(S02D_OPTS) -package containers tmp_sigof02d/Main.o -o tmp_sigof02d/Double ./tmp_sigof02d/Double @@ -57,8 +62,10 @@ S02DT_OPTS=$(TEST_HC_OPTS_NO_RECOMP) -outputdir tmp_sigof02dt -i -itmp_sigof02dt sigof02dt: rm -rf tmp_sigof02dt mkdir tmp_sigof02dt - '$(TEST_HC)' $(S02DT_OPTS) -c Map.hsig - '$(TEST_HC)' $(S02DT_OPTS) -c MapAsSet.hsig + '$(TEST_HC)' $(S02DT_OPTS) -c Map.hs-boot + '$(TEST_HC)' $(S02DT_OPTS) --merge-requirements Map + '$(TEST_HC)' $(S02DT_OPTS) -c MapAsSet.hs-boot + '$(TEST_HC)' $(S02DT_OPTS) --merge-requirements MapAsSet ! '$(TEST_HC)' $(S02DT_OPTS) -c Double.hs sigof02dm: diff --git a/testsuite/tests/driver/sigof02/Map.hsig b/testsuite/tests/driver/sigof02/Map.hs-boot index cd094df17f..cd094df17f 100644 --- a/testsuite/tests/driver/sigof02/Map.hsig +++ b/testsuite/tests/driver/sigof02/Map.hs-boot diff --git a/testsuite/tests/driver/sigof02/MapAsSet.hsig b/testsuite/tests/driver/sigof02/MapAsSet.hs-boot index 1defbc7717..1defbc7717 100644 --- a/testsuite/tests/driver/sigof02/MapAsSet.hsig +++ b/testsuite/tests/driver/sigof02/MapAsSet.hs-boot diff --git a/testsuite/tests/driver/sigof02/sigof02dm.stdout b/testsuite/tests/driver/sigof02/sigof02dm.stdout index 14ee83789b..a3a5fa8b4b 100644 --- a/testsuite/tests/driver/sigof02/sigof02dm.stdout +++ b/testsuite/tests/driver/sigof02/sigof02dm.stdout @@ -1,6 +1,8 @@ -[1 of 3] Compiling MapAsSet[sig of Data.Map.Lazy] ( MapAsSet.hsig, nothing ) -[2 of 3] Compiling Map[sig of Data.Map.Lazy] ( Map.hsig, nothing ) -[3 of 3] Compiling Main ( Double.hs, tmp_sigof02dm/Main.o ) +[1 of 5] Compiling MapAsSet[boot] ( MapAsSet.hs-boot, tmp_sigof02dm/MapAsSet.o-boot ) +[2 of 5] Compiling MapAsSet[merge] ( MapAsSet.hi, tmp_sigof02dm/MapAsSet.o ) +[3 of 5] Compiling Map[boot] ( Map.hs-boot, tmp_sigof02dm/Map.o-boot ) +[4 of 5] Compiling Map[merge] ( Map.hi, tmp_sigof02dm/Map.o ) +[5 of 5] Compiling Main ( Double.hs, tmp_sigof02dm/Main.o ) Linking tmp_sigof02dm/Double ... False fromList [0,6] diff --git a/testsuite/tests/driver/sigof02/sigof02m.stdout b/testsuite/tests/driver/sigof02/sigof02m.stdout index 41cc4a7bb3..4c80fed188 100644 --- a/testsuite/tests/driver/sigof02/sigof02m.stdout +++ b/testsuite/tests/driver/sigof02/sigof02m.stdout @@ -1,8 +1,10 @@ -[1 of 2] Compiling Map[sig of Data.Map.Strict] ( Map.hsig, nothing ) -[2 of 2] Compiling Main ( Main.hs, tmp_sigof02m/Main.o ) +[1 of 3] Compiling Map[boot] ( Map.hs-boot, tmp_sigof02m/Map.o-boot ) +[2 of 3] Compiling Map[merge] ( Map.hi, tmp_sigof02m/Map.o ) +[3 of 3] Compiling Main ( Main.hs, tmp_sigof02m/Main.o ) Linking tmp_sigof02m/StrictMain ... -[1 of 2] Compiling Map[sig of Data.Map.Lazy] ( Map.hsig, nothing ) [sig-of changed] -[2 of 2] Compiling Main ( Main.hs, tmp_sigof02m/Main.o ) [Map changed] +[1 of 3] Compiling Map[boot] ( Map.hs-boot, tmp_sigof02m/Map.o-boot ) [sig-of changed] +[2 of 3] Compiling Map[merge] ( Map.hi, tmp_sigof02m/Map.o ) [sig-of changed] +[3 of 3] Compiling Main ( Main.hs, tmp_sigof02m/Main.o ) [Map changed] Linking tmp_sigof02m/LazyMain ... False [(0,"foo"),(6,"foo")] diff --git a/testsuite/tests/driver/sigof03/ASig1.hsig b/testsuite/tests/driver/sigof03/ASig1.hs-boot index 9428e0cf04..9428e0cf04 100644 --- a/testsuite/tests/driver/sigof03/ASig1.hsig +++ b/testsuite/tests/driver/sigof03/ASig1.hs-boot diff --git a/testsuite/tests/driver/sigof03/ASig2.hsig b/testsuite/tests/driver/sigof03/ASig2.hs-boot index 6f278b0a89..6f278b0a89 100644 --- a/testsuite/tests/driver/sigof03/ASig2.hsig +++ b/testsuite/tests/driver/sigof03/ASig2.hs-boot diff --git a/testsuite/tests/driver/sigof03/Makefile b/testsuite/tests/driver/sigof03/Makefile index 03a0b9b2da..f39d16ea60 100644 --- a/testsuite/tests/driver/sigof03/Makefile +++ b/testsuite/tests/driver/sigof03/Makefile @@ -11,8 +11,9 @@ sigof03: rm -rf tmp_sigof03 mkdir tmp_sigof03 '$(TEST_HC)' $(S03_OPTS) -c A.hs - '$(TEST_HC)' $(S03_OPTS) -c ASig1.hsig -sig-of "ASig1 is main:A, ASig2 is main:A" - '$(TEST_HC)' $(S03_OPTS) -c ASig2.hsig -sig-of "ASig1 is main:A, ASig2 is main:A" + '$(TEST_HC)' $(S03_OPTS) -c ASig1.hs-boot -sig-of "ASig1 is main:A, ASig2 is main:A" + '$(TEST_HC)' $(S03_OPTS) -c ASig2.hs-boot -sig-of "ASig1 is main:A, ASig2 is main:A" + '$(TEST_HC)' $(S03_OPTS) --merge-requirements ASig1 ASig2 '$(TEST_HC)' $(S03_OPTS) -c Main.hs '$(TEST_HC)' $(S03_OPTS) tmp_sigof03/A.o tmp_sigof03/Main.o -o tmp_sigof03/Main ./tmp_sigof03/Main diff --git a/testsuite/tests/driver/sigof04/Makefile b/testsuite/tests/driver/sigof04/Makefile index f013b0c202..b489174410 100644 --- a/testsuite/tests/driver/sigof04/Makefile +++ b/testsuite/tests/driver/sigof04/Makefile @@ -11,4 +11,4 @@ clean: sigof04: '$(GHC_PKG)' field containers key | sed 's/^.*: *//' > containers - ! '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c Sig.hsig -sig-of "Sig is `cat containers`:Data.Map.Strict" + ! '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -c Sig.hs-boot -sig-of "Sig is `cat containers`:Data.Map.Strict" diff --git a/testsuite/tests/driver/sigof04/Sig.hsig b/testsuite/tests/driver/sigof04/Sig.hs-boot index 3110f28fff..3110f28fff 100644 --- a/testsuite/tests/driver/sigof04/Sig.hsig +++ b/testsuite/tests/driver/sigof04/Sig.hs-boot diff --git a/testsuite/tests/driver/sigof04/sigof04.stderr b/testsuite/tests/driver/sigof04/sigof04.stderr index 4be1bfd3e5..2c2e0c39fc 100644 --- a/testsuite/tests/driver/sigof04/sigof04.stderr +++ b/testsuite/tests/driver/sigof04/sigof04.stderr @@ -1,3 +1,3 @@ -
-<no location info>:
- ‘insert’ is exported by the hsig file, but not exported by the module
+ +<no location info>: error: + ‘insert’ is exported by the signature file, but not exported by the module diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index da71c1d742..8f6aeae9b5 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -357,7 +357,7 @@ test('tc262', normal, compile, ['']) test('tc263', extra_clean(['Tc263_Help.o','Tc263_Help.hi']), multimod_compile, ['tc263','-v0']) -test('tc264', normal, multimod_compile, ['tc264.hsig', '-sig-of "ShouldCompile is base:Data.STRef"']) +test('tc264', normal, multimod_compile, ['tc264.hs-boot', '-sig-of "ShouldCompile is base:Data.STRef"']) test('tc265', compile_timeout_multiplier(0.01), compile, ['']) test('GivenOverlapping', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_compile/tc264.hsig b/testsuite/tests/typecheck/should_compile/tc264.hs-boot index 0bfdb2b9f4..0bfdb2b9f4 100644 --- a/testsuite/tests/typecheck/should_compile/tc264.hsig +++ b/testsuite/tests/typecheck/should_compile/tc264.hs-boot diff --git a/testsuite/tests/typecheck/should_compile/tc264.stderr b/testsuite/tests/typecheck/should_compile/tc264.stderr index 4eb1124cad..e3d0e175f8 100644 --- a/testsuite/tests/typecheck/should_compile/tc264.stderr +++ b/testsuite/tests/typecheck/should_compile/tc264.stderr @@ -1 +1 @@ -[1 of 1] Compiling ShouldCompile[sig of Data.STRef] ( tc264.hsig, nothing ) +[1 of 1] Compiling ShouldCompile[boot] ( tc264.hs-boot, tc264.o ) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index a005bc5f29..1b0273bb2f 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -242,10 +242,10 @@ test('tcfail215', normal, compile_fail, ['']) test('tcfail216', normal, compile_fail, ['']) test('tcfail217', normal, compile_fail, ['']) test('tcfail218', normal, compile_fail, ['']) -test('tcfail219', normal, multimod_compile_fail, ['tcfail219.hsig', '-sig-of "ShouldFail is base:Data.Bool"']) -test('tcfail220', normal, multimod_compile_fail, ['tcfail220.hsig', '-sig-of "ShouldFail is base:Prelude"']) -test('tcfail221', normal, multimod_compile_fail, ['tcfail221.hsig', '-sig-of "ShouldFail is base:Prelude"']) -test('tcfail222', normal, multimod_compile_fail, ['tcfail222.hsig', '-sig-of "ShouldFail is base:Data.STRef"']) +test('tcfail219', normal, multimod_compile_fail, ['tcfail219.hs-boot', '-sig-of "ShouldFail is base:Data.Bool"']) +test('tcfail220', normal, multimod_compile_fail, ['tcfail220.hs-boot', '-sig-of "ShouldFail is base:Prelude"']) +test('tcfail221', normal, multimod_compile_fail, ['tcfail221.hs-boot', '-sig-of "ShouldFail is base:Prelude"']) +test('tcfail222', normal, multimod_compile_fail, ['tcfail222.hs-boot', '-sig-of "ShouldFail is base:Data.STRef"']) test('tcfail223', normal, compile_fail, ['']) test('SilentParametersOverlapping', normal, compile, ['']) diff --git a/testsuite/tests/typecheck/should_fail/tcfail219.hsig b/testsuite/tests/typecheck/should_fail/tcfail219.hs-boot index ec6d6076ab..ec6d6076ab 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail219.hsig +++ b/testsuite/tests/typecheck/should_fail/tcfail219.hs-boot diff --git a/testsuite/tests/typecheck/should_fail/tcfail219.stderr b/testsuite/tests/typecheck/should_fail/tcfail219.stderr index 53a7edebe0..d364137c08 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail219.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail219.stderr @@ -1,3 +1,4 @@ -[1 of 1] Compiling ShouldFail[sig of Data.Bool] ( tcfail219.hsig, nothing ) +[1 of 1] Compiling ShouldFail[boot] ( tcfail219.hs-boot, tcfail219.o ) -tcfail219.hsig:1:1: Not in scope: type constructor or class ‘Booly’ +tcfail219.hs-boot:1:1: error: + Not in scope: type constructor or class ‘Booly’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail220.hsig b/testsuite/tests/typecheck/should_fail/tcfail220.hs-boot index c9e80e3da2..c9e80e3da2 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail220.hsig +++ b/testsuite/tests/typecheck/should_fail/tcfail220.hs-boot diff --git a/testsuite/tests/typecheck/should_fail/tcfail220.stderr b/testsuite/tests/typecheck/should_fail/tcfail220.stderr index d78fa6d83e..e8d3c810ff 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail220.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail220.stderr @@ -1,9 +1,9 @@ -[1 of 1] Compiling ShouldFail[sig of Prelude] ( tcfail220.hsig, nothing ) +[1 of 1] Compiling ShouldFail[boot] ( tcfail220.hs-boot, tcfail220.o ) -tcfail220.hsig:4:1: error: +tcfail220.hs-boot:4:1: error: Type constructor ‘Either’ has conflicting definitions in the module - and its hsig file + and its signature file Main module: data Either a b = Left a | Right b - Hsig file: type role Either representational phantom phantom - data Either a b c = Left a + Signature file: type role Either representational phantom phantom + data Either a b c = Left a The types have different kinds diff --git a/testsuite/tests/typecheck/should_fail/tcfail221.hsig b/testsuite/tests/typecheck/should_fail/tcfail221.hs-boot index a60c1a0d80..a60c1a0d80 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail221.hsig +++ b/testsuite/tests/typecheck/should_fail/tcfail221.hs-boot diff --git a/testsuite/tests/typecheck/should_fail/tcfail221.stderr b/testsuite/tests/typecheck/should_fail/tcfail221.stderr index 8781bd056e..aef6c81a79 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail221.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail221.stderr @@ -1,6 +1,6 @@ -[1 of 1] Compiling ShouldFail[sig of Prelude] ( tcfail221.hsig, nothing ) +[1 of 1] Compiling ShouldFail[boot] ( tcfail221.hs-boot, tcfail221.o ) -tcfail221.hsig:2:10: +tcfail221.hs-boot:2:10: error: Duplicate instance declarations: - instance Show Int -- Defined at tcfail221.hsig:2:10 - instance Show Int -- Defined at tcfail221.hsig:3:10 + instance Show Int -- Defined at tcfail221.hs-boot:2:10 + instance Show Int -- Defined at tcfail221.hs-boot:3:10 diff --git a/testsuite/tests/typecheck/should_fail/tcfail222.hsig b/testsuite/tests/typecheck/should_fail/tcfail222.hs-boot index e83f4e3b83..e83f4e3b83 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail222.hsig +++ b/testsuite/tests/typecheck/should_fail/tcfail222.hs-boot diff --git a/testsuite/tests/typecheck/should_fail/tcfail222.stderr b/testsuite/tests/typecheck/should_fail/tcfail222.stderr index 1293b787a0..3f1466fede 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail222.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail222.stderr @@ -1,4 +1,4 @@ -[1 of 1] Compiling ShouldFail[sig of Data.STRef] ( tcfail222.hsig, nothing )
-
-<no location info>:
- ‘newSTRef’ is exported by the hsig file, but not exported by the module
+[1 of 1] Compiling ShouldFail[boot] ( tcfail222.hs-boot, tcfail222.o ) + +<no location info>: error: + ‘newSTRef’ is exported by the signature file, but not exported by the module diff --git a/utils/ghctags/Main.hs b/utils/ghctags/Main.hs index a377953b38..4062535c05 100644 --- a/utils/ghctags/Main.hs +++ b/utils/ghctags/Main.hs @@ -224,9 +224,9 @@ fileTarget filename = Target (TargetFile filename Nothing) True Nothing graphData :: ModuleGraph -> (Maybe Handle, Maybe Handle) -> Ghc () graphData graph handles = do mapM_ foundthings graph - where foundthings ms = - let filename = msHsFilePath ms - modname = moduleName $ ms_mod ms + where foundthings ms + | Just filename <- msHsFilePath ms = + let modname = moduleName $ ms_mod ms in handleSourceError (\e -> do printException e liftIO $ exitWith (ExitFailure 1)) $ @@ -238,6 +238,7 @@ graphData graph handles = do liftIO (writeTagsData handles =<< fileData filename modname s) _otherwise -> liftIO $ exitWith (ExitFailure 1) + | otherwise = return () fileData :: FileName -> ModuleName -> RenamedSource -> IO FileData fileData filename modname (group, _imports, _lie, _doc) = do diff --git a/utils/haddock b/utils/haddock -Subproject fea4277692ba68cccc6c9642655289037e4b897 +Subproject 5890a2d503b3200e9897ce331ad61d808a67fca |