[commit: ghc] master: Have --backpack complain if multiple files are passed. (0a77ced)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/0a77cedb914a67b8bd7c4af1f87714dc497fec3e/ghc

>---------------------------------------------------------------

commit 0a77cedb914a67b8bd7c4af1f87714dc497fec3e
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date:   Wed Feb 22 19:59:55 2017 -0800

    Have --backpack complain if multiple files are passed.
    
    Summary:
    At the moment it silently swallows the actual arguments; not good!
    
    Signed-off-by: Edward Z. Yang <ezyang at cs.stanford.edu>
    
    Test Plan: validate
    
    Reviewers: rwbarton, bgamari, austin
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D3173


>---------------------------------------------------------------

0a77cedb914a67b8bd7c4af1f87714dc497fec3e
 compiler/backpack/DriverBkp.hs |  7 +++++--
 ghc/Main.hs                    | 12 ++++++------
 2 files changed, 11 insertions(+), 8 deletions(-)

diff --git a/compiler/backpack/DriverBkp.hs b/compiler/backpack/DriverBkp.hs
index 25ef624..e14e2d8 100644
--- a/compiler/backpack/DriverBkp.hs
+++ b/compiler/backpack/DriverBkp.hs
@@ -51,6 +51,7 @@ import Util
 
 import qualified GHC.LanguageExtensions as LangExt
 
+import Panic
 import Data.List
 import System.Exit
 import Control.Monad
@@ -63,8 +64,8 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 
 -- | Entry point to compile a Backpack file.
-doBackpack :: FilePath -> Ghc ()
-doBackpack src_filename = do
+doBackpack :: [FilePath] -> Ghc ()
+doBackpack [src_filename] = do
     -- Apply options from file to dflags
     dflags0 <- getDynFlags
     let dflags1 = dflags0
@@ -96,6 +97,8 @@ doBackpack src_filename = do
                                     then compileExe lunit
                                     else compileUnit cid []
                             else typecheckUnit cid insts
+doBackpack _ =
+    throwGhcException (CmdLineError "--backpack can only process a single file")
 
 computeUnitId :: LHsUnit HsComponentId -> (ComponentId, [(ModuleName, Module)])
 computeUnitId (L _ unit) = (cid, [ (r, mkHoleModule r) | r <- reqs ])
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 0984bf7..29012f6 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -162,7 +162,7 @@ main' postLoadMode dflags0 args flagWarnings = do
                DoInteractive   -> (CompManager, HscInterpreted, LinkInMemory)
                DoEval _        -> (CompManager, HscInterpreted, LinkInMemory)
                DoMake          -> (CompManager, dflt_target,    LinkBinary)
-               DoBackpack _    -> (CompManager, dflt_target,    LinkBinary)
+               DoBackpack      -> (CompManager, dflt_target,    LinkBinary)
                DoMkDependHS    -> (MkDepend,    dflt_target,    LinkBinary)
                DoAbiHash       -> (OneShot,     dflt_target,    LinkBinary)
                _               -> (OneShot,     dflt_target,    LinkBinary)
@@ -253,7 +253,7 @@ main' postLoadMode dflags0 args flagWarnings = do
        DoAbiHash              -> abiHash (map fst srcs)
        ShowPackages           -> liftIO $ showPackages dflags6
        DoFrontend f           -> doFrontend f srcs
-       DoBackpack b           -> doBackpack b
+       DoBackpack             -> doBackpack (map fst srcs)
 
   liftIO $ dumpFinalStats dflags6
 
@@ -455,7 +455,7 @@ data PostLoadMode
   | StopBefore Phase        -- ghc -E | -C | -S
                             -- StopBefore StopLn is the default
   | DoMake                  -- ghc --make
-  | DoBackpack String       -- ghc --backpack foo.bkp
+  | DoBackpack              -- ghc --backpack foo.bkp
   | DoInteractive           -- ghc --interactive
   | DoEval [String]         -- ghc -e foo -e bar => DoEval ["bar", "foo"]
   | DoAbiHash               -- ghc --abi-hash
@@ -482,8 +482,8 @@ doEvalMode str = mkPostLoadMode (DoEval [str])
 doFrontendMode :: String -> Mode
 doFrontendMode str = mkPostLoadMode (DoFrontend (mkModuleName str))
 
-doBackpackMode :: String -> Mode
-doBackpackMode str = mkPostLoadMode (DoBackpack str)
+doBackpackMode :: Mode
+doBackpackMode = mkPostLoadMode DoBackpack
 
 mkPostLoadMode :: PostLoadMode -> Mode
 mkPostLoadMode = Right . Right
@@ -614,7 +614,7 @@ mode_flags =
   , defFlag "C"            (PassFlag (setMode (stopBeforeMode HCc)))
   , defFlag "S"            (PassFlag (setMode (stopBeforeMode (As False))))
   , defFlag "-make"        (PassFlag (setMode doMakeMode))
-  , defFlag "-backpack"    (SepArg   (\s -> setMode (doBackpackMode s) "-backpack"))
+  , defFlag "-backpack"    (PassFlag (setMode doBackpackMode))
   , defFlag "-interactive" (PassFlag (setMode doInteractiveMode))
   , defFlag "-abi-hash"    (PassFlag (setMode doAbiHashMode))
   , defFlag "e"            (SepArg   (\s -> setMode (doEvalMode s) "-e"))