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