Unify hsig and hs-boot; add preliminary "hs-boot" merging.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Fri, 24 Jul 2015 22:13:49 +0000 (15:13 -0700)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Mon, 21 Sep 2015 18:53:56 +0000 (11:53 -0700)
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:
compiler/deSugar/Desugar.hs
compiler/iface/LoadIface.hs
compiler/iface/MkIface.hs
compiler/main/DriverMkDepend.hs
compiler/main/DriverPhases.hs
compiler/main/DriverPipeline.hs
compiler/main/Finder.hs
compiler/main/GHC.hs
compiler/main/GhcMake.hs
compiler/main/HscMain.hs
compiler/main/HscTypes.hs
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcInstDcls.hs
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcRnMonad.hs
ghc/Main.hs
testsuite/.gitignore
testsuite/tests/driver/dynamicToo/dynamicToo005/A005.hs-boot [moved from testsuite/tests/driver/dynamicToo/dynamicToo005/A005.hsig with 100% similarity]
testsuite/tests/driver/dynamicToo/dynamicToo005/Makefile
testsuite/tests/driver/dynamicToo/dynamicToo006/A.hs-boot [moved from testsuite/tests/driver/dynamicToo/dynamicToo006/A.hsig with 100% similarity]
testsuite/tests/driver/dynamicToo/dynamicToo006/Makefile
testsuite/tests/driver/recomp014/Makefile [new file with mode: 0644]
testsuite/tests/driver/recomp014/all.T [new file with mode: 0644]
testsuite/tests/driver/recomp014/recomp014.stdout [new file with mode: 0644]
testsuite/tests/driver/sigof01/B.hs-boot [moved from testsuite/tests/driver/sigof01/B.hsig with 100% similarity]
testsuite/tests/driver/sigof01/Makefile
testsuite/tests/driver/sigof01/all.T
testsuite/tests/driver/sigof01/sigof01i.script [new file with mode: 0644]
testsuite/tests/driver/sigof01/sigof01i.stdout [new file with mode: 0644]
testsuite/tests/driver/sigof01/sigof01i2.script [new file with mode: 0644]
testsuite/tests/driver/sigof01/sigof01i2.stdout [new file with mode: 0644]
testsuite/tests/driver/sigof01/sigof01m.stdout
testsuite/tests/driver/sigof02/Makefile
testsuite/tests/driver/sigof02/Map.hs-boot [moved from testsuite/tests/driver/sigof02/Map.hsig with 100% similarity]
testsuite/tests/driver/sigof02/MapAsSet.hs-boot [moved from testsuite/tests/driver/sigof02/MapAsSet.hsig with 100% similarity]
testsuite/tests/driver/sigof02/sigof02dm.stdout
testsuite/tests/driver/sigof02/sigof02m.stdout
testsuite/tests/driver/sigof03/ASig1.hs-boot [moved from testsuite/tests/driver/sigof03/ASig1.hsig with 100% similarity]
testsuite/tests/driver/sigof03/ASig2.hs-boot [moved from testsuite/tests/driver/sigof03/ASig2.hsig with 100% similarity]
testsuite/tests/driver/sigof03/Makefile
testsuite/tests/driver/sigof04/Makefile
testsuite/tests/driver/sigof04/Sig.hs-boot [moved from testsuite/tests/driver/sigof04/Sig.hsig with 100% similarity]
testsuite/tests/driver/sigof04/sigof04.stderr
testsuite/tests/typecheck/should_compile/all.T
testsuite/tests/typecheck/should_compile/tc264.hs-boot [moved from testsuite/tests/typecheck/should_compile/tc264.hsig with 100% similarity]
testsuite/tests/typecheck/should_compile/tc264.stderr
testsuite/tests/typecheck/should_fail/all.T
testsuite/tests/typecheck/should_fail/tcfail219.hs-boot [moved from testsuite/tests/typecheck/should_fail/tcfail219.hsig with 100% similarity]
testsuite/tests/typecheck/should_fail/tcfail219.stderr
testsuite/tests/typecheck/should_fail/tcfail220.hs-boot [moved from testsuite/tests/typecheck/should_fail/tcfail220.hsig with 100% similarity]
testsuite/tests/typecheck/should_fail/tcfail220.stderr
testsuite/tests/typecheck/should_fail/tcfail221.hs-boot [moved from testsuite/tests/typecheck/should_fail/tcfail221.hsig with 100% similarity]
testsuite/tests/typecheck/should_fail/tcfail221.stderr
testsuite/tests/typecheck/should_fail/tcfail222.hs-boot [moved from testsuite/tests/typecheck/should_fail/tcfail222.hsig with 100% similarity]
testsuite/tests/typecheck/should_fail/tcfail222.stderr
utils/ghctags/Main.hs
utils/haddock

index 94ee7fa..1508922 100644 (file)
@@ -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)
index 6ffa990..ddbd803 100644 (file)
@@ -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
 
 {-
index 757beba..99544c4 100644 (file)
@@ -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
index 4d2aadc..aae4d0e 100644 (file)
@@ -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
index ff6f8b8..f079212 100644 (file)
@@ -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)
index f8b7c30..a45507e 100644 (file)
@@ -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
index 00ba038..208475f 100644 (file)
@@ -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
index 591d569..883cd2c 100644 (file)
@@ -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
index 715b450..cc112da 100644 (file)
@@ -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
index c7cabe6..00cff28 100644 (file)
@@ -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
index 6b94998..00ceb41 100644 (file)
@@ -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)
 
 {-
 ************************************************************************
index 897828d..48abcc8 100644 (file)
@@ -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 }
index d31b7bf..d5dee95 100644 (file)
@@ -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
index fc90f31..2c2e5d7 100644 (file)
@@ -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"))
 
 {-
index 2492c55..2dbabfc 100644 (file)
@@ -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) }
index e2c7479..7ca7481 100644 (file)
@@ -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
index 14704f7..88c89de 100644 (file)
@@ -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
index 617510e..a08827a 100644 (file)
@@ -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)
index 497f2c0..6e025f8 100644 (file)
@@ -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 (file)
index 0000000..00b2035
--- /dev/null
@@ -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 (file)
index 0000000..affccd2
--- /dev/null
@@ -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 (file)
index 0000000..7d54071
--- /dev/null
@@ -0,0 +1,4 @@
+first run
+compilation IS NOT required
+second run
+False
index 84dfc33..8bed672 100644 (file)
@@ -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
index d0cdc3c..5606127 100644 (file)
@@ -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 (file)
index 0000000..ba2906d
--- /dev/null
@@ -0,0 +1 @@
+main
diff --git a/testsuite/tests/driver/sigof01/sigof01i.stdout b/testsuite/tests/driver/sigof01/sigof01i.stdout
new file mode 100644 (file)
index 0000000..bb614cd
--- /dev/null
@@ -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 (file)
index 0000000..3a91e37
--- /dev/null
@@ -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 (file)
index 0000000..1ee81c1
--- /dev/null
@@ -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!
index a7fdd82..35190ae 100644 (file)
@@ -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
index 8f153f4..aebff03 100644 (file)
@@ -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:
index 14ee837..a3a5fa8 100644 (file)
@@ -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]
index 41cc4a7..4c80fed 100644 (file)
@@ -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")]
index 03a0b9b..f39d16e 100644 (file)
@@ -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
index f013b0c..b489174 100644 (file)
@@ -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"
index 4be1bfd..2c2e0c3 100644 (file)
@@ -1,3 +1,3 @@
-\r
-<no location info>:\r
-    ‘insert’ is exported by the hsig file, but not exported by the module\r
+
+<no location info>: error:
+    ‘insert’ is exported by the signature file, but not exported by the module
index da71c1d..8f6aeae 100644 (file)
@@ -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, [''])
index 4eb1124..e3d0e17 100644 (file)
@@ -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 )
index a005bc5..1b0273b 100644 (file)
@@ -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, [''])
index 53a7ede..d364137 100644 (file)
@@ -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’
index d78fa6d..e8d3c81 100644 (file)
@@ -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
index 8781bd0..aef6c81 100644 (file)
@@ -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
index 1293b78..3f1466f 100644 (file)
@@ -1,4 +1,4 @@
-[1 of 1] Compiling ShouldFail[sig of Data.STRef] ( tcfail222.hsig, nothing )\r
-\r
-<no location info>:\r
-    ‘newSTRef’ is exported by the hsig file, but not exported by the module\r
+[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
index a377953..4062535 100644 (file)
@@ -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
index fea4277..5890a2d 160000 (submodule)
@@ -1 +1 @@
-Subproject commit fea4277692ba68cccc6c9642655289037e4b8979
+Subproject commit 5890a2d503b3200e9897ce331ad61d808a67fca3