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