Have --backpack complain if multiple files are passed.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Thu, 23 Feb 2017 03:59:55 +0000 (19:59 -0800)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Thu, 23 Feb 2017 21:46:08 +0000 (13:46 -0800)
Summary:
At the moment it silently swallows the actual arguments; not good!

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate

Reviewers: rwbarton, bgamari, austin

Subscribers: thomie

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

compiler/backpack/DriverBkp.hs
ghc/Main.hs

index 25ef624..e14e2d8 100644 (file)
@@ -51,6 +51,7 @@ import Util
 
 import qualified GHC.LanguageExtensions as LangExt
 
 
 import qualified GHC.LanguageExtensions as LangExt
 
+import Panic
 import Data.List
 import System.Exit
 import Control.Monad
 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.
 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
     -- 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
                                     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 ])
 
 computeUnitId :: LHsUnit HsComponentId -> (ComponentId, [(ModuleName, Module)])
 computeUnitId (L _ unit) = (cid, [ (r, mkHoleModule r) | r <- reqs ])
index 0984bf7..29012f6 100644 (file)
@@ -162,7 +162,7 @@ main' postLoadMode dflags0 args flagWarnings = do
                DoInteractive   -> (CompManager, HscInterpreted, LinkInMemory)
                DoEval _        -> (CompManager, HscInterpreted, LinkInMemory)
                DoMake          -> (CompManager, dflt_target,    LinkBinary)
                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)
                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
        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
 
 
   liftIO $ dumpFinalStats dflags6
 
@@ -455,7 +455,7 @@ data PostLoadMode
   | StopBefore Phase        -- ghc -E | -C | -S
                             -- StopBefore StopLn is the default
   | DoMake                  -- ghc --make
   | 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
   | 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))
 
 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
 
 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 "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"))
   , defFlag "-interactive" (PassFlag (setMode doInteractiveMode))
   , defFlag "-abi-hash"    (PassFlag (setMode doAbiHashMode))
   , defFlag "e"            (SepArg   (\s -> setMode (doEvalMode s) "-e"))