[commit: ghc] wip/kavon-nosplit-llvm: mangInfo is at the LlvmMangler phase, now need to send some (2013b25)

[git at git.haskell.org]

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

On branch  : wip/kavon-nosplit-llvm
Link       : http://ghc.haskell.org/trac/ghc/changeset/2013b25f6040384b62fb5b6297f49d4d44ca69d5/ghc

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

commit 2013b25f6040384b62fb5b6297f49d4d44ca69d5
Author: Kavon Farvardin <kavon at farvard.in>
Date:   Mon Jun 5 11:13:44 2017 +0100

    mangInfo is at the LlvmMangler phase, now need to send some


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

2013b25f6040384b62fb5b6297f49d4d44ca69d5
 compiler/main/DriverPipeline.hs | 30 ++++++++++++++++++++++--------
 1 file changed, 22 insertions(+), 8 deletions(-)

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index d32f185..3c670fe 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1079,7 +1079,11 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do
                       mapM (uncurry (compileForeign hsc_env')) foreign_files
                     setForeignOs (maybe [] return stub_o ++ foreign_os)
 
-                    return (RealPhase next_phase, outputFilename)
+                    let kind = case next_phase of
+                                 LlvmOpt -> RealPhaseWithInfo
+                                 _       -> \ _ p -> RealPhase p
+
+                    return (kind mangInfo next_phase, outputFilename)
 
 -----------------------------------------------------------------------------
 -- Cmm phase
@@ -1417,7 +1421,7 @@ runPhase (RealPhase SplitAs) _input_fn dflags
 -----------------------------------------------------------------------------
 -- LlvmOpt phase
 
-runPhase (RealPhase LlvmOpt) input_fn dflags
+runPhase (RealPhaseWithInfo mangInfo LlvmOpt) input_fn dflags
   = do
     let opt_lvl  = max 0 (min 2 $ optLevel dflags)
         -- don't specify anything if user has specified commands. We do this
@@ -1440,7 +1444,7 @@ runPhase (RealPhase LlvmOpt) input_fn dflags
                 ++ optFlag
                 ++ [SysTools.Option tbaa])
 
-    return (RealPhase LlvmLlc, output_fn)
+    return (RealPhaseWithInfo mangInfo LlvmLlc, output_fn)
   where
         -- we always (unless -optlo specified) run Opt since we rely on it to
         -- fix up some pretty big deficiencies in the code we generate
@@ -1452,7 +1456,7 @@ runPhase (RealPhase LlvmOpt) input_fn dflags
 -----------------------------------------------------------------------------
 -- LlvmLlc phase
 
-runPhase (RealPhase LlvmLlc) input_fn dflags
+runPhase (RealPhaseWithInfo mangInfo LlvmLlc) input_fn dflags
   = do
     let opt_lvl = max 0 (min 2 $ optLevel dflags)
         -- iOS requires external references to be loaded indirectly from the
@@ -1485,7 +1489,15 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
                 ++ map SysTools.Option avx512Opts
                 ++ map SysTools.Option stackAlignOpts)
                 
-    return (RealPhase next_phase, output_fn)
+    let doNext = case (next_phase, mangInfo) of
+                      (LlvmMangle, i)       -> RealPhaseWithInfo i LlvmMangle
+                      (_, Just _)           -> panic ("after LLC: TNTC info was provided, "
+                                                     ++ "but -dno-llvm-mangler was given!")
+                                                     -- TODO(kavon) probably should just be 
+                                                     -- a warning since its a debug flag anyways
+                      (p, Nothing)          -> RealPhase p
+
+    return (doNext, output_fn)
   where
         -- Bug in LLVM at O3 on OSX.
         llvmOpts = if platformOS (targetPlatform dflags) == OSDarwin
@@ -1535,13 +1547,15 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
 -----------------------------------------------------------------------------
 -- LlvmMangle phase
 
-runPhase (RealPhase LlvmMangle) input_fn dflags
+runPhase (RealPhaseWithInfo (Just info) LlvmMangle) input_fn dflags
   = do
       let next_phase = if gopt Opt_SplitObjs dflags then Splitter else As False
       output_fn <- phaseOutputFilename next_phase
       liftIO $ llvmFixupAsm dflags input_fn output_fn
       return (RealPhase next_phase, output_fn)
       
+runPhase (RealPhaseWithInfo Nothing LlvmMangle) _ _ = panic "phase LlvmMangle needs info!"
+
 -----------------------------------------------------------------------------
 -- merge in stub objects
 
@@ -1558,10 +1572,10 @@ runPhase (RealPhase MergeForeign) input_fn dflags
 
 -- warning suppression
 runPhase (RealPhase other) _input_fn _dflags =
-   panic ("runPhase: don't know how to run phase " ++ show other)
+   panic ("runPhase: don't know how to run phase: " ++ show other)
  
 runPhase (RealPhaseWithInfo _ other) _input_fn _dflags =
-   panic ("runPhase: don't know how to run phase (with info) " ++ show other)
+   panic ("runPhase: don't know how to run phase (with mangler info): " ++ show other)
 
 maybeMergeForeign :: CompPipeline Phase
 maybeMergeForeign