1{-# LANGUAGE DeriveFunctor #-}
2{-# LANGUAGE NamedFieldPuns #-}
3-- | The CompPipeline monad and associated ops
4--
5-- Defined in separate module so that it can safely be imported from Hooks
6module PipelineMonad (
7    CompPipeline(..), evalP
8  , PhasePlus(..)
9  , PipeEnv(..), PipeState(..), PipelineOutput(..)
10  , getPipeEnv, getPipeState, setDynFlags, setModLocation, setForeignOs, setIface
11  , pipeStateDynFlags, pipeStateModIface
12  ) where
13
14import GhcPrelude
15
16import MonadUtils
17import Outputable
18import DynFlags
19import DriverPhases
20import HscTypes
21import Module
22import FileCleanup (TempFileLifetime)
23
24import Control.Monad
25
26newtype CompPipeline a = P { unP :: PipeEnv -> PipeState -> IO (PipeState, a) }
27    deriving (Functor)
28
29evalP :: CompPipeline a -> PipeEnv -> PipeState -> IO (PipeState, a)
30evalP (P f) env st = f env st
31
32instance Applicative CompPipeline where
33    pure a = P $ \_env state -> return (state, a)
34    (<*>) = ap
35
36instance Monad CompPipeline where
37  P m >>= k = P $ \env state -> do (state',a) <- m env state
38                                   unP (k a) env state'
39
40instance MonadIO CompPipeline where
41    liftIO m = P $ \_env state -> do a <- m; return (state, a)
42
43data PhasePlus = RealPhase Phase
44               | HscOut HscSource ModuleName HscStatus
45
46instance 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
54data 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
63data 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       iface :: Maybe ModIface
76         -- ^ Interface generated by HscOut phase. Only available after the
77         -- phase runs.
78  }
79
80pipeStateDynFlags :: PipeState -> DynFlags
81pipeStateDynFlags = hsc_dflags . hsc_env
82
83pipeStateModIface :: PipeState -> Maybe ModIface
84pipeStateModIface = iface
85
86data PipelineOutput
87  = Temporary TempFileLifetime
88        -- ^ Output should be to a temporary file: we're going to
89        -- run more compilation steps on this output later.
90  | Persistent
91        -- ^ We want a persistent file, i.e. a file in the current directory
92        -- derived from the input filename, but with the appropriate extension.
93        -- eg. in "ghc -c Foo.hs" the output goes into ./Foo.o.
94  | SpecificFile
95        -- ^ The output must go into the specific outputFile in DynFlags.
96        -- We don't store the filename in the constructor as it changes
97        -- when doing -dynamic-too.
98    deriving Show
99
100getPipeEnv :: CompPipeline PipeEnv
101getPipeEnv = P $ \env state -> return (state, env)
102
103getPipeState :: CompPipeline PipeState
104getPipeState = P $ \_env state -> return (state, state)
105
106instance HasDynFlags CompPipeline where
107    getDynFlags = P $ \_env state -> return (state, hsc_dflags (hsc_env state))
108
109setDynFlags :: DynFlags -> CompPipeline ()
110setDynFlags dflags = P $ \_env state ->
111  return (state{hsc_env= (hsc_env state){ hsc_dflags = dflags }}, ())
112
113setModLocation :: ModLocation -> CompPipeline ()
114setModLocation loc = P $ \_env state ->
115  return (state{ maybe_loc = Just loc }, ())
116
117setForeignOs :: [FilePath] -> CompPipeline ()
118setForeignOs os = P $ \_env state ->
119  return (state{ foreign_os = os }, ())
120
121setIface :: ModIface -> CompPipeline ()
122setIface iface = P $ \_env state -> return (state{ iface = Just iface }, ())
123