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
|
{-# LANGUAGE NamedFieldPuns #-}
-- | The CompPipeline monad and associated ops
--
-- Defined in separate module so that it can safely be imported from Hooks
module PipelineMonad (
CompPipeline(..), evalP
, PhasePlus(..)
, PipeEnv(..), PipeState(..), PipelineOutput(..)
, getPipeEnv, getPipeState, setDynFlags, setModLocation, setStubO
) where
import MonadUtils
import Outputable
import DynFlags
import DriverPhases
import HscTypes
import Module
import Control.Monad
newtype CompPipeline a = P { unP :: PipeEnv -> PipeState -> IO (PipeState, a) }
evalP :: CompPipeline a -> PipeEnv -> PipeState -> IO a
evalP f env st = liftM snd $ unP f env st
instance Functor CompPipeline where
fmap = liftM
instance Applicative CompPipeline where
pure = return
(<*>) = ap
instance Monad CompPipeline where
return a = P $ \_env state -> return (state, a)
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 {
pe_isHaskellishFile :: Bool,
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.
maybe_stub_o :: Maybe FilePath
-- ^ the stub object. This is set by the Hsc phase if a stub
-- object was created. The stub object will be joined with
-- the main compilation object using "ld -r" at the end.
}
data PipelineOutput
= Temporary
-- ^ 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 }, ())
setStubO :: FilePath -> CompPipeline ()
setStubO stub_o = P $ \_env state ->
return (state{ maybe_stub_o = Just stub_o }, ())
|
