Add dump flag for timing output
[ghc.git] / compiler / main / PipelineMonad.hs
1 {-# LANGUAGE NamedFieldPuns #-}
2 -- | The CompPipeline monad and associated ops
3 --
4 -- Defined in separate module so that it can safely be imported from Hooks
5 module PipelineMonad (
6 CompPipeline(..), evalP
7 , PhasePlus(..)
8 , PipeEnv(..), PipeState(..), PipelineOutput(..)
9 , getPipeEnv, getPipeState, setDynFlags, setModLocation, setForeignOs
10 ) where
11
12 import GhcPrelude
13
14 import MonadUtils
15 import Outputable
16 import DynFlags
17 import DriverPhases
18 import HscTypes
19 import Module
20 import FileCleanup (TempFileLifetime)
21
22 import Control.Monad
23
24 newtype CompPipeline a = P { unP :: PipeEnv -> PipeState -> IO (PipeState, a) }
25
26 evalP :: CompPipeline a -> PipeEnv -> PipeState -> IO a
27 evalP f env st = liftM snd $ unP f env st
28
29 instance Functor CompPipeline where
30 fmap = liftM
31
32 instance Applicative CompPipeline where
33 pure a = P $ \_env state -> return (state, a)
34 (<*>) = ap
35
36 instance Monad CompPipeline where
37 P m >>= k = P $ \env state -> do (state',a) <- m env state
38 unP (k a) env state'
39
40 instance MonadIO CompPipeline where
41 liftIO m = P $ \_env state -> do a <- m; return (state, a)
42
43 data PhasePlus = RealPhase Phase
44 | HscOut HscSource ModuleName HscStatus
45
46 instance Outputable PhasePlus where
47 ppr (RealPhase p) = ppr p
48 ppr (HscOut {}) = text "HscOut"
49
50 -- -----------------------------------------------------------------------------
51 -- The pipeline uses a monad to carry around various bits of information
52
53 -- PipeEnv: invariant information passed down
54 data PipeEnv = PipeEnv {
55 stop_phase :: Phase, -- ^ Stop just before this phase
56 src_filename :: String, -- ^ basename of original input source
57 src_basename :: String, -- ^ basename of original input source
58 src_suffix :: String, -- ^ its extension
59 output_spec :: PipelineOutput -- ^ says where to put the pipeline output
60 }
61
62 -- PipeState: information that might change during a pipeline run
63 data PipeState = PipeState {
64 hsc_env :: HscEnv,
65 -- ^ only the DynFlags change in the HscEnv. The DynFlags change
66 -- at various points, for example when we read the OPTIONS_GHC
67 -- pragmas in the Cpp phase.
68 maybe_loc :: Maybe ModLocation,
69 -- ^ the ModLocation. This is discovered during compilation,
70 -- in the Hsc phase where we read the module header.
71 foreign_os :: [FilePath]
72 -- ^ additional object files resulting from compiling foreign
73 -- code. They come from two sources: foreign stubs, and
74 -- add{C,Cxx,Objc,Objcxx}File from template haskell
75 }
76
77 data PipelineOutput
78 = Temporary TempFileLifetime
79 -- ^ Output should be to a temporary file: we're going to
80 -- run more compilation steps on this output later.
81 | Persistent
82 -- ^ We want a persistent file, i.e. a file in the current directory
83 -- derived from the input filename, but with the appropriate extension.
84 -- eg. in "ghc -c Foo.hs" the output goes into ./Foo.o.
85 | SpecificFile
86 -- ^ The output must go into the specific outputFile in DynFlags.
87 -- We don't store the filename in the constructor as it changes
88 -- when doing -dynamic-too.
89 deriving Show
90
91 getPipeEnv :: CompPipeline PipeEnv
92 getPipeEnv = P $ \env state -> return (state, env)
93
94 getPipeState :: CompPipeline PipeState
95 getPipeState = P $ \_env state -> return (state, state)
96
97 instance HasDynFlags CompPipeline where
98 getDynFlags = P $ \_env state -> return (state, hsc_dflags (hsc_env state))
99
100 setDynFlags :: DynFlags -> CompPipeline ()
101 setDynFlags dflags = P $ \_env state ->
102 return (state{hsc_env= (hsc_env state){ hsc_dflags = dflags }}, ())
103
104 setModLocation :: ModLocation -> CompPipeline ()
105 setModLocation loc = P $ \_env state ->
106 return (state{ maybe_loc = Just loc }, ())
107
108 setForeignOs :: [FilePath] -> CompPipeline ()
109 setForeignOs os = P $ \_env state ->
110 return (state{ foreign_os = os }, ())