ghc-simple 0.1.3 → 0.2
raw patch · 4 files changed
+223/−173 lines, 4 filesdep +binarydep +bytestringdep ~ghcPVP ok
version bump matches the API change (PVP)
Dependencies added: binary, bytestring
Dependency ranges changed: ghc
API changes (from Hackage documentation)
- Language.Haskell.GHC.Simple: type StgModule = CompiledModule [StgBinding]
- Language.Haskell.GHC.Simple.Impl: class Compile a
- Language.Haskell.GHC.Simple.Impl: instance Language.Haskell.GHC.Simple.Types.Compile HscTypes.CgGuts
- Language.Haskell.GHC.Simple.Impl: instance Language.Haskell.GHC.Simple.Types.Compile HscTypes.ModGuts
- Language.Haskell.GHC.Simple.Impl: instance Language.Haskell.GHC.Simple.Types.Compile [StgSyn.StgBinding]
- Language.Haskell.GHC.Simple.Impl: prepare :: GhcMonad m => DynFlags -> ModSummary -> CgGuts -> m CoreProgram
- Language.Haskell.GHC.Simple.Impl: simplify :: GhcMonad m => ModGuts -> m CgGuts
- Language.Haskell.GHC.Simple.Impl: toCode :: Compile a => ModSummary -> Ghc a
- Language.Haskell.GHC.Simple.Impl: toCompiledModule :: GhcMonad m => CompConfig a -> (ModSummary -> m a) -> ModSummary -> m (CompiledModule a)
- Language.Haskell.GHC.Simple.Impl: toModGuts :: GhcMonad m => ModSummary -> m ModGuts
- Language.Haskell.GHC.Simple.Impl: toSimplifiedCore :: GhcMonad m => ModSummary -> m CgGuts
- Language.Haskell.GHC.Simple.Impl: toStgBindings :: GhcMonad m => DynFlags -> ModSummary -> CoreProgram -> m [StgBinding]
- Language.Haskell.GHC.Simple.Impl: type StgModule = CompiledModule [StgBinding]
- Language.Haskell.GHC.Simple.Types: [modInterfaceFile] :: CompiledModule a -> FilePath
- Language.Haskell.GHC.Simple.Types: [modInterface] :: CompiledModule a -> ModIface
- Language.Haskell.GHC.Simple.Types: [modIsTarget] :: CompiledModule a -> Bool
- Language.Haskell.GHC.Simple.Types: [modName] :: CompiledModule a -> String
- Language.Haskell.GHC.Simple.Types: [modPackageKey] :: CompiledModule a -> String
- Language.Haskell.GHC.Simple.Types: [modSourceFile] :: CompiledModule a -> Maybe FilePath
- Language.Haskell.GHC.Simple.Types: [modSourceIsHsBoot] :: CompiledModule a -> Bool
- Language.Haskell.GHC.Simple.Types: [modSummary] :: CompiledModule a -> ModSummary
- Language.Haskell.GHC.Simple.Types: cfgAlwaysCreateHiFiles :: CompConfig a -> Bool
- Language.Haskell.GHC.Simple.Types: cfgGhcPipeline :: CompConfig a -> ModSummary -> Ghc a
- Language.Haskell.GHC.Simple.Types: class Compile a
- Language.Haskell.GHC.Simple.Types: toCode :: Compile a => ModSummary -> Ghc a
+ Language.Haskell.GHC.Simple.Impl: instance Language.Haskell.GHC.Simple.Types.Intermediate CoreSyn.CoreProgram
+ Language.Haskell.GHC.Simple.Impl: instance Language.Haskell.GHC.Simple.Types.Intermediate HscTypes.CgGuts
+ Language.Haskell.GHC.Simple.Impl: instance Language.Haskell.GHC.Simple.Types.Intermediate [StgSyn.StgBinding]
+ Language.Haskell.GHC.Simple.Impl: toModMetadata :: CompConfig -> Bool -> [Target] -> ModSummary -> ModMetadata
+ Language.Haskell.GHC.Simple.Types: ModMetadata :: ModSummary -> String -> String -> Bool -> Bool -> Maybe FilePath -> FilePath -> Bool -> ModMetadata
+ Language.Haskell.GHC.Simple.Types: [mmCached] :: ModMetadata -> Bool
+ Language.Haskell.GHC.Simple.Types: [mmInterfaceFile] :: ModMetadata -> FilePath
+ Language.Haskell.GHC.Simple.Types: [mmIsTarget] :: ModMetadata -> Bool
+ Language.Haskell.GHC.Simple.Types: [mmName] :: ModMetadata -> String
+ Language.Haskell.GHC.Simple.Types: [mmPackageKey] :: ModMetadata -> String
+ Language.Haskell.GHC.Simple.Types: [mmSourceFile] :: ModMetadata -> Maybe FilePath
+ Language.Haskell.GHC.Simple.Types: [mmSourceIsHsBoot] :: ModMetadata -> Bool
+ Language.Haskell.GHC.Simple.Types: [mmSummary] :: ModMetadata -> ModSummary
+ Language.Haskell.GHC.Simple.Types: [modMetaData] :: CompiledModule a -> ModMetadata
+ Language.Haskell.GHC.Simple.Types: cfgCacheDirectory :: CompConfig -> Maybe FilePath
+ Language.Haskell.GHC.Simple.Types: cfgCacheFileExt :: CompConfig -> String
+ Language.Haskell.GHC.Simple.Types: class Intermediate a
+ Language.Haskell.GHC.Simple.Types: data ModMetadata
+ Language.Haskell.GHC.Simple.Types: prepare :: Intermediate a => ModSummary -> CgGuts -> CompPipeline a
- Language.Haskell.GHC.Simple: compile :: Compile a => [String] -> IO (CompResult [CompiledModule a])
+ Language.Haskell.GHC.Simple: compile :: (Intermediate a, Binary b) => (ModMetadata -> a -> IO b) -> [String] -> IO (CompResult [CompiledModule b])
- Language.Haskell.GHC.Simple: compileFold :: CompConfig b -> (a -> CompiledModule b -> IO a) -> a -> [String] -> IO (CompResult a)
+ Language.Haskell.GHC.Simple: compileFold :: (Intermediate a, Binary b) => CompConfig -> (ModMetadata -> a -> IO b) -> (acc -> CompiledModule b -> IO acc) -> acc -> [String] -> IO (CompResult acc)
- Language.Haskell.GHC.Simple: compileWith :: Compile a => CompConfig a -> [String] -> IO (CompResult [CompiledModule a])
+ Language.Haskell.GHC.Simple: compileWith :: (Intermediate a, Binary b) => CompConfig -> (ModMetadata -> a -> IO b) -> [String] -> IO (CompResult [CompiledModule b])
- Language.Haskell.GHC.Simple: getDynFlagsForConfig :: CompConfig a -> IO (DynFlags, [String])
+ Language.Haskell.GHC.Simple: getDynFlagsForConfig :: CompConfig -> IO (DynFlags, [String])
- Language.Haskell.GHC.Simple.Impl: toSimplifiedStg :: GhcMonad m => ModSummary -> m [StgBinding]
+ Language.Haskell.GHC.Simple.Impl: toSimplifiedStg :: ModSummary -> CgGuts -> CompPipeline [StgBinding]
- Language.Haskell.GHC.Simple.Types: CompiledModule :: ModSummary -> String -> String -> Bool -> Bool -> Maybe FilePath -> ModIface -> FilePath -> a -> CompiledModule a
+ Language.Haskell.GHC.Simple.Types: CompiledModule :: a -> ModMetadata -> CompiledModule a
- Language.Haskell.GHC.Simple.Types: cfgCustomPrimIface :: CompConfig a -> Maybe (PrimOp -> PrimOpInfo, PrimOp -> Arity -> StrictSig)
+ Language.Haskell.GHC.Simple.Types: cfgCustomPrimIface :: CompConfig -> Maybe (PrimOp -> PrimOpInfo, PrimOp -> Arity -> StrictSig)
- Language.Haskell.GHC.Simple.Types: cfgGhcFlags :: CompConfig a -> [String]
+ Language.Haskell.GHC.Simple.Types: cfgGhcFlags :: CompConfig -> [String]
- Language.Haskell.GHC.Simple.Types: cfgGhcLibDir :: CompConfig a -> Maybe FilePath
+ Language.Haskell.GHC.Simple.Types: cfgGhcLibDir :: CompConfig -> Maybe FilePath
- Language.Haskell.GHC.Simple.Types: cfgStopPhases :: CompConfig a -> [Phase]
+ Language.Haskell.GHC.Simple.Types: cfgStopPhases :: CompConfig -> [Phase]
- Language.Haskell.GHC.Simple.Types: cfgUpdateDynFlags :: CompConfig a -> DynFlags -> DynFlags
+ Language.Haskell.GHC.Simple.Types: cfgUpdateDynFlags :: CompConfig -> DynFlags -> DynFlags
- Language.Haskell.GHC.Simple.Types: cfgUseGhcErrorLogger :: CompConfig a -> Bool
+ Language.Haskell.GHC.Simple.Types: cfgUseGhcErrorLogger :: CompConfig -> Bool
- Language.Haskell.GHC.Simple.Types: cfgUseTargetsFromFlags :: CompConfig a -> Bool
+ Language.Haskell.GHC.Simple.Types: cfgUseTargetsFromFlags :: CompConfig -> Bool
- Language.Haskell.GHC.Simple.Types: data CompConfig a
+ Language.Haskell.GHC.Simple.Types: data CompConfig
- Language.Haskell.GHC.Simple.Types: defaultConfig :: Compile a => CompConfig a
+ Language.Haskell.GHC.Simple.Types: defaultConfig :: CompConfig
- Language.Haskell.GHC.Simple.Types: disableCodeGen :: CompConfig a -> CompConfig a
+ Language.Haskell.GHC.Simple.Types: disableCodeGen :: CompConfig -> CompConfig
Files
- ghc-simple.cabal +8/−6
- src/Language/Haskell/GHC/Simple.hs +129/−37
- src/Language/Haskell/GHC/Simple/Impl.hs +37/−82
- src/Language/Haskell/GHC/Simple/Types.hs +49/−48
ghc-simple.cabal view
@@ -1,5 +1,5 @@ name: ghc-simple-version: 0.1.3+version: 0.2 synopsis: Simplified interface to the GHC API. description: The GHC API is a great tool for working with Haskell code. Unfortunately, it's also fairly opaque and hard to get@@ -31,11 +31,13 @@ other-extensions: CPP, PatternGuards, FlexibleInstances build-depends:- ghc >=7.8,- base >=4.7 && <4.9,- ghc-paths >=0.1 && <0.2,- directory >=1.2 && <1.3,- filepath >=1.3 && <1.5+ ghc >=7.8 && <7.11,+ base >=4.7 && <4.9,+ ghc-paths >=0.1 && <0.2,+ directory >=1.2 && <1.3,+ filepath >=1.3 && <1.5,+ bytestring >=0.10 && <0.11,+ binary >=0.6 && <0.8 hs-source-dirs: src default-language:
src/Language/Haskell/GHC/Simple.hs view
@@ -6,7 +6,6 @@ -- * Configuration, input and output types module Simple.Types,- StgModule, getDynFlagsForConfig, -- * GHC re-exports for processing STG and Core@@ -54,53 +53,76 @@ import Module -- Misc. stuff-import GHC.Paths (libdir)+import Data.Binary+import qualified Data.ByteString.Lazy as BS import Data.IORef+import Data.List (sort, sortBy) import Control.Monad+import GHC.Paths (libdir)+import System.Directory+import System.FilePath+import System.IO+import System.IO.Unsafe++-- Internals import Language.Haskell.GHC.Simple.PrimIface as Simple.PrimIface import Language.Haskell.GHC.Simple.Types as Simple.Types import Language.Haskell.GHC.Simple.Impl-import System.IO.Unsafe -- | Compile a list of targets and their dependencies into intermediate code. -- Uses settings from the the default 'CompConfig'.-compile :: Compile a- => [String]+compile :: (Intermediate a, Binary b)+ => (ModMetadata -> a -> IO b)+ -- ^ Compilation function from some intermediate language to the+ -- desired output. The output type needs to be an instance of+ -- 'Binary', as it will be cached after compilation to speed up+ -- future recompilation.+ -- This function is called once per module. Due to caching of modules+ -- which don't need to be recompiled, it will not necessarily be+ -- called once per module included in the return value of @compile@.+ -> [String] -- ^ List of compilation targets. A target can be either a module -- or a file name.- -> IO (CompResult [CompiledModule a])+ -> IO (CompResult [CompiledModule b]) compile = compileWith defaultConfig -- | Compile a list of targets and their dependencies using a custom -- configuration.-compileWith :: Compile a- => CompConfig a+compileWith :: (Intermediate a, Binary b)+ => CompConfig -- ^ GHC pipeline configuration.+ -> (ModMetadata -> a -> IO b)+ -- ^ Compilation function. -> [String] -- ^ List of compilation targets. A target can be either a module -- or a file name. Targets may also be read from the specified -- 'CompConfig', if 'cfgUseTargetsFromFlags' is set.- -> IO (CompResult [CompiledModule a])-compileWith cfg = compileFold (cfg {cfgGhcPipeline = toCode}) consMod []+ -> IO (CompResult [CompiledModule b])+compileWith cfg comp = compileFold cfg comp consMod [] consMod :: [CompiledModule a] -> CompiledModule a -> IO [CompiledModule a] consMod xs x = return (x:xs) -- | Obtain the dynamic flags and extra targets that would be used to compile -- anything with the given config.-getDynFlagsForConfig :: CompConfig a -> IO (DynFlags, [String])+getDynFlagsForConfig :: CompConfig -> IO (DynFlags, [String]) getDynFlagsForConfig cfg = initStaticFlags `seq` do ws <- newIORef [] runGhc (maybe (Just libdir) Just (cfgGhcLibDir cfg)) $ do- setDFS cfg (discardStaticFlags (cfgGhcFlags cfg)) ws+ setDFS cfg (discardStaticFlags (cfgGhcFlags cfg)) ws noComp +noComp :: FilePath -> ModSummary -> CgGuts -> CompPipeline ()+noComp _ _ _ = return ()+ -- | Set and return the appropriate dynflags and extra targets for the given -- config.-setDFS :: CompConfig a -- ^ Compilation configuration.+setDFS :: CompConfig -- ^ Compilation configuration. -> [String] -- ^ Dynamic GHC command line flags. -> IORef [Warning] -- ^ IORef to use for logging warnings.+ -> (FilePath -> ModSummary -> CgGuts -> CompPipeline ())+ -- ^ Per-module compilation function. -> Ghc (DynFlags, [String])-setDFS cfg flags warns = do+setDFS cfg flags warns comp = do -- Parse and update dynamic flags dfs <- getSessionDynFlags (dfs', files2, _dynwarns) <- parseDynamicFlags dfs (map noLoc flags)@@ -146,34 +168,71 @@ } getSession >>= liftIO . fixPrimopTypes nfo strs + -- TODO: get rid of the @runPhase@ from the HscOut phase+ phaseHook _ p@(HscOut src_flavour mod_name result) inp dfs = do+ loc <- getLocation src_flavour mod_name+ setModLocation loc+ let next = hscPostBackendPhase dfs src_flavour (hscTarget dfs)+ case result of+ HscRecomp cgguts ms -> do+ outfile <- phaseOutputFilename next+ comp (ml_hi_file loc) ms cgguts+ runPhase p inp dfs -- return (RealPhase next, outfile)+ _ ->+ runPhase p inp dfs -- return (RealPhase next, ml_obj_file loc) phaseHook stop (RealPhase p) inp _ | p `elem` stop = return (RealPhase StopLn, inp) phaseHook _ p inp dfs = runPhase p inp dfs +-- | Write a module to cache file.+writeModCache :: Binary a => CompConfig -> CompiledModule a -> IO ()+writeModCache cfg (CompiledModule m meta) = do+ createDirectoryIfMissing True (takeDirectory cachefile)+ BS.writeFile cachefile (encode m)+ where+ ext = cfgCacheFileExt cfg+ modfile = moduleNameSlashes (ms_mod_name (mmSummary meta)) <.> ext+ cachefile = maybe "" id (cfgCacheDirectory cfg) </> modfile +-- | Read a module from cache file.+readModCache :: Binary a => CompConfig -> ModMetadata -> IO (CompiledModule a)+readModCache cfg meta = do+ m <- decode <$> BS.readFile cachefile+ return $ CompiledModule m meta+ where+ ext = cfgCacheFileExt cfg+ modfile = moduleNameSlashes (ms_mod_name (mmSummary meta)) <.> ext+ cachefile = maybe "" id (cfgCacheDirectory cfg) </> modfile+ -- | Left fold over a list of compilation targets and their dependencies. -- -- Sometimes you don't just want a huge pile of intermediate code lying -- around; chances are you either want to dump it to file or combine it with -- some other intermediate code, without having to keep it all in memory at -- the same time.-compileFold :: CompConfig b+compileFold :: (Intermediate a, Binary b)+ => CompConfig -- ^ GHC pipeline configuration.- -> (a -> CompiledModule b -> IO a)- -- ^ Compilation function.- -> a+ -> (ModMetadata -> a -> IO b)+ -- ^ Per module compilation function.+ -> (acc -> CompiledModule b -> IO acc)+ -- ^ Folding function.+ -> acc -- ^ Initial accumulator. -> [String] -- ^ List of compilation targets. A target can be either a module -- or a file name. Targets may also be read from the specified -- 'CompConfig', if 'cfgUseTargetsFromFlags' is set.- -> IO (CompResult a)-compileFold cfg comp acc files = initStaticFlags `seq` do- warns <- newIORef []+ -> IO (CompResult acc)+compileFold cfg comp f acc files = initStaticFlags `seq` do+ warns <- newIORef [] -- all warnings produced by GHC+ accref <- newIORef acc -- accumulator for compilation fold function+ tgtref <- newIORef [] -- ref containing all compilation targets+ recomp <- newIORef [] -- ref containing all modules that were recompiled runGhc (maybe (Just libdir) Just (cfgGhcLibDir cfg)) $ do- (_, files2) <- setDFS cfg (discardStaticFlags (cfgGhcFlags cfg)) warns- ecode <- genCode cfg ghcPipeline comp acc (files ++ files2)+ (_, files2) <- setDFS cfg dfs warns (comp' accref recomp tgtref)+ ecode <- genCode cfg f accref tgtref recomp (files ++ files2) ws <- liftIO $ readIORef warns case ecode of Right (finaldfs, code) ->@@ -188,7 +247,20 @@ compWarnings = ws } where- ghcPipeline = toCompiledModule cfg $ cfgGhcPipeline cfg+ dfs = discardStaticFlags (cfgGhcFlags cfg)+ comp' accref recompref tgtref hifile ms cgguts = do+ source <- prepare ms cgguts+ liftIO $ do+ tgts <- readIORef tgtref+ let meta = toModMetadata cfg False tgts ms+ code <- comp meta source+ let cm = CompiledModule code meta+ writeModCache cfg cm+ -- TODO: if we already recompiled the module, we shouldn't do it+ -- again, for instance when recompilation is forced due to+ -- missing cache file+ atomicModifyIORef' recompref $ \xs -> (ms_mod ms : xs, ())+ readIORef accref >>= flip f cm >>= writeIORef accref {-# NOINLINE initStaticFlags #-} -- | Use lazy evaluation to only call 'parseStaticFlags' once.@@ -197,30 +269,50 @@ -- | Map a compilation function over each 'ModSummary' in the dependency graph -- of a list of targets.-genCode :: GhcMonad m- => CompConfig t- -> (ModSummary -> m a)- -> (b -> a -> IO b)- -> b- -> [String]- -> m (Either [Error] (DynFlags, b))-genCode cfg comp usercomp acc files = do+genCode :: (GhcMonad m, Binary b)+ => CompConfig+ -> (a -> CompiledModule b -> IO a)+ -> IORef a+ -> IORef [Target]+ -> IORef [Module]+ -> [String]+ -> m (Either [Error] (DynFlags, a))+genCode cfg f accref tgtref recompref files = do dfs <- getSessionDynFlags merrs <- handleSourceError (maybeErrors dfs) $ do ts <- mapM (flip guessTarget Nothing) files+ liftIO $ writeIORef tgtref ts setTargets ts loads <- load LoadAllTargets+ mss <- depanal [] False+ acc <- liftIO $ readIORef accref+ recompiled <- liftIO $ readIORef recompref+ let cachedmods = sortBy onModId mss \\ sort recompiled+ -- TODO: if some cached mod failed to load, recompile it+ acc' <- liftIO $ foldM (loadCachedMod ts) acc cachedmods+ liftIO $ writeIORef accref acc' return $ if succeeded loads then Nothing else Just [] case merrs of Just errs -> return $ Left errs _ -> do- mss <- depanal [] False- code <- foldM (\a x -> comp (noLog x) >>= liftIO . usercomp a) acc mss+ code <- liftIO $ readIORef accref return $ Right (dfs, code) where- -- We logged everything when we did @load@, we don't want to do it twice.- noLog m =- m {ms_hspp_opts = (ms_hspp_opts m) {log_action = \_ _ _ _ _ -> return ()}}+ onModId m n = ms_mod m `compare` ms_mod n++ loadCachedMod tgts acc ms =+ readModCache cfg (toModMetadata cfg True tgts ms) >>= f acc++ -- remove all mod summaries from msmss whose mod identities exist in mmods.+ -- both lists must be sorted.+ (\\) :: [ModSummary] -> [Module] -> [ModSummary]+ msmss@(ms:mss) \\ mmods@(m:mods)+ | ms_mod ms == m = mss \\ mmods -- ms found in mods; remove it+ | ms_mod ms < m = msmss \\ mods -- ms < m; ms may still be in mods+ | otherwise = ms : (mss \\ mmods) -- ms > m; ms is not in mods+ mss \\ [] = mss -- mods empty, keep all remaining+ [] \\ _ = [] -- no mss to keep!+ maybeErrors dfs | cfgUseGhcErrorLogger cfg = \srcerr -> liftIO $ do let msgs = srcErrorMessages srcerr
src/Language/Haskell/GHC/Simple/Impl.hs view
@@ -1,15 +1,10 @@ {-# LANGUAGE FlexibleInstances, CPP, PatternGuards #-} -- | Lower level building blocks for custom code generation. module Language.Haskell.GHC.Simple.Impl (- Compile (..),- Ghc, StgModule, PkgKey,+ Ghc, PkgKey, liftIO, toSimplifiedStg,- toSimplifiedCore,- toModGuts,- simplify,- prepare, toStgBindings,- toCompiledModule,+ toModMetadata, modulePkgKey, pkgKeyString ) where @@ -25,6 +20,7 @@ import CoreSyn import CoreToStg import SimplStg+import DriverPipeline #if __GLASGOW_HASKELL__ < 710 import qualified Module as M (modulePackageId, packageIdString, PackageId) #else@@ -37,15 +33,16 @@ import System.Directory (doesFileExist, createDirectoryIfMissing) import Language.Haskell.GHC.Simple.Types -type StgModule = CompiledModule [StgBinding]-instance Compile [StgBinding] where- toCode = toSimplifiedStg+instance Intermediate [StgBinding] where+ prepare = toSimplifiedStg -instance Compile CgGuts where- toCode = toSimplifiedCore+instance Intermediate CgGuts where+ prepare _ = pure -instance Compile ModGuts where- toCode = toModGuts+instance Intermediate CoreProgram where+ prepare ms cgguts = do+ env <- hsc_env `fmap` getPipeState+ liftIO $ prepareCore env (hsc_dflags env) ms cgguts -- | Package ID/key of a module. modulePkgKey :: Module -> PkgKey@@ -67,43 +64,22 @@ pkgKeyString = M.packageKeyString #endif --- | Compile a 'ModSummary' into a module with metadata using a custom--- compilation function.-toCompiledModule :: GhcMonad m- => CompConfig a- -> (ModSummary -> m a)- -> ModSummary- -> m (CompiledModule a)-toCompiledModule cfg comp ms = do- code <- comp ms- ts <- getTargets- dfs <- getSessionDynFlags- iface <- getModIface dfs- let hifile = ml_hi_file $ ms_location ms- when (cfgAlwaysCreateHiFiles cfg) . liftIO $ do- exists <- doesFileExist hifile- unless exists $ do- createDirectoryIfMissing True (takeDirectory hifile)- writeBinIface dfs hifile iface- return $ CompiledModule {- modSummary = ms,- modName = moduleNameString $ ms_mod_name ms,- modPackageKey = pkgKeyString . modulePkgKey $ ms_mod ms,- modIsTarget = any (`isTargetOf` ms) ts,- modSourceIsHsBoot = ms_hsc_src ms == HsBootFile,- modSourceFile = ml_hs_file $ ms_location ms,- modInterface = iface,- modInterfaceFile = hifile,- modCompiledModule = code- }- where- getModIface dfs = do- env <- getSession- pkgIfaceTbl <- eps_PIT `fmap` liftIO (readIORef (hsc_EPS env))- let homePkgTbl = hsc_HPT env- case lookupIfaceByModule dfs homePkgTbl pkgIfaceTbl (ms_mod ms) of- Just mi -> return mi- _ -> error "Module interface does not exist!"+-- | Build a 'ModMetadata' out of scattered metadata.+toModMetadata :: CompConfig+ -> Bool+ -> [Target]+ -> ModSummary+ -> ModMetadata+toModMetadata cfg cached tgts ms = ModMetadata {+ mmSummary = ms,+ mmName = moduleNameString $ ms_mod_name ms,+ mmPackageKey = pkgKeyString . modulePkgKey $ ms_mod ms,+ mmIsTarget = any (`isTargetOf` ms) tgts,+ mmSourceIsHsBoot = ms_hsc_src ms == HsBootFile,+ mmSourceFile = ml_hs_file $ ms_location ms,+ mmInterfaceFile = ml_hi_file $ ms_location ms,+ mmCached = cached+ } -- | Is @t@ the target that corresponds to @ms@?@@ -118,41 +94,20 @@ -- | Compile a 'ModSummary' into a list of simplified 'StgBinding's. -- See <https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/StgSynType> -- for more information about STG and how it relates to core and Haskell.-toSimplifiedStg :: GhcMonad m => ModSummary -> m [StgBinding]-toSimplifiedStg ms = do- dfs <- getSessionDynFlags- toSimplifiedCore ms >>= prepare dfs ms >>= toStgBindings dfs ms---- | Compile a 'ModSummary' into a 'CgGuts', containing all information about--- a core module that one could wish for.-toSimplifiedCore :: GhcMonad m => ModSummary -> m CgGuts-toSimplifiedCore = toModGuts >=> simplify---- | Parse, typecheck and desugar a module. Returned 'ModGuts' structure is not--- simplified in any way.-toModGuts :: GhcMonad m => ModSummary -> m ModGuts-toModGuts =- parseModule >=> typecheckModule >=> desugarModule >=> return . coreModule---- | Simplify a core module for code generation.-simplify :: GhcMonad m => ModGuts -> m CgGuts-simplify mg = do- env <- getSession- liftIO $ hscSimplify env mg >>= tidyProgram env >>= return . fst+toSimplifiedStg :: ModSummary -> CgGuts -> CompPipeline [StgBinding]+toSimplifiedStg ms cgguts = do+ env <- hsc_env `fmap` getPipeState+ let dfs = hsc_dflags env+ liftIO $ do+ prog <- prepareCore env dfs ms cgguts+ stg <- coreToStg dfs (ms_mod ms) prog+ fst `fmap` stg2stg dfs (ms_mod ms) stg -- | Prepare a core module for code generation.-prepare :: GhcMonad m => DynFlags -> ModSummary -> CgGuts -> m CoreProgram-prepare dfs _ms p = do- env <- getSession+prepareCore :: HscEnv -> DynFlags -> ModSummary -> CgGuts -> IO CoreProgram+prepareCore env dfs _ms p = do #if __GLASGOW_HASKELL__ < 710 liftIO $ corePrepPgm dfs env (cg_binds p) (cg_tycons p) #else liftIO $ corePrepPgm env (ms_location _ms) (cg_binds p) (cg_tycons p) #endif---- | Turn a core module into a list of simplified STG bindings.-toStgBindings :: GhcMonad m- => DynFlags -> ModSummary -> CoreProgram -> m [StgBinding]-toStgBindings dfs ms p = liftIO $ do- stg <- coreToStg dfs (ms_mod ms) p- fst `fmap` stg2stg dfs (ms_mod ms) stg
src/Language/Haskell/GHC/Simple/Types.hs view
@@ -1,17 +1,18 @@ -- | Config, input and output types for the simplified GHC API. module Language.Haskell.GHC.Simple.Types ( -- * GHC pipeline configuration- Compile (..),+ Intermediate (..), CompConfig, defaultConfig, cfgGhcFlags, cfgUseTargetsFromFlags, cfgUpdateDynFlags, cfgGhcLibDir,- cfgUseGhcErrorLogger, cfgCustomPrimIface, cfgGhcPipeline,- cfgAlwaysCreateHiFiles, cfgStopPhases,+ cfgUseGhcErrorLogger, cfgCustomPrimIface, cfgStopPhases,+ cfgCacheDirectory, cfgCacheFileExt, -- * Convenience functions for common settings combinations ncgPhases, disableCodeGen, -- * Compilation results and errors+ ModMetadata (..), CompiledModule (..), CompResult (..), Error (..),@@ -20,17 +21,20 @@ ) where import GHC+import HscTypes (CgGuts) import DriverPhases+import DriverPipeline (CompPipeline) import Language.Haskell.GHC.Simple.PrimIface+import Data.Binary (Binary) --- | Any type we can generate intermediate code for.-class Compile a where- -- | Generate some sort of code (or other output) from a Haskell module.- toCode :: ModSummary -> Ghc a+-- | An intermediate source language, usable as the the input for a+-- 'Compile' compilation function.+class Intermediate a where+ prepare :: ModSummary -> CgGuts -> CompPipeline a -- | GHC pipeline configuration, parameterized over the intermediate code -- produced by the pipeline.-data CompConfig a = CompConfig {+data CompConfig = CompConfig { -- | GHC command line dynamic flags to control the Haskell to STG -- compilation pipeline. -- For instance, passing @["-O2", "-DHELLO"]@ here is equivalent to@@ -84,6 +88,17 @@ cfgCustomPrimIface :: Maybe (PrimOp -> PrimOpInfo, PrimOp -> Arity -> StrictSig), + -- | Cache directory for compiled code. If @Nothing@, the current directory+ -- is used.+ --+ -- Default: @Nothing@+ cfgCacheDirectory :: Maybe FilePath,++ -- | File extension of cache files.+ --+ -- Default: @cache@+ cfgCacheFileExt :: String,+ -- | Stop compilation when any of these this phases are reached, -- without performing it. If you are doing custom code generation and -- don't want GHC to generate any code - for instance when writing a@@ -91,31 +106,11 @@ -- @ncgPhases@. -- -- Default: @[]@- cfgStopPhases :: [Phase],-- -- | Use a custom GHC pipeline to generate intermediate code. Useful if- -- the provided instances for @[StgBinding]@ etc. don't quite do what you- -- want them to. See "Language.Haskell.GHC.Simple.Impl" for more- -- information about custom pipelines.- --- -- Default: @toCode@- cfgGhcPipeline :: ModSummary -> Ghc a,-- -- | Always ensure that the interface file indicated by the- -- 'modInterfaceFile' field of 'CompiledModule' exists?- -- When compiling with @hscTarget = HscNothing@, GHC will not- -- automatically create module interface files.- -- This is undesirable if, for instance, one wants the compiler to- -- generate interface files as well as custom generated code, but not- -- invoke any standard GHC code generator such as the LLVM or NCG- -- generators.- --- -- Default: @True@- cfgAlwaysCreateHiFiles :: Bool+ cfgStopPhases :: [Phase] } -- | Default configuration.-defaultConfig :: Compile a => CompConfig a+defaultConfig :: CompConfig defaultConfig = CompConfig { cfgGhcFlags = [], cfgUseTargetsFromFlags = True,@@ -123,9 +118,9 @@ cfgUseGhcErrorLogger = False, cfgGhcLibDir = Nothing, cfgCustomPrimIface = Nothing,- cfgStopPhases = [],- cfgGhcPipeline = toCode,- cfgAlwaysCreateHiFiles = True+ cfgCacheDirectory = Nothing,+ cfgCacheFileExt = "cache",+ cfgStopPhases = [] } -- | Phases in which the native code generator is invoked. You want to stop@@ -134,7 +129,7 @@ ncgPhases = [CmmCpp, Cmm, As False, As True] -- | Disable any native code generation and linking.-disableCodeGen :: CompConfig a -> CompConfig a+disableCodeGen :: CompConfig -> CompConfig disableCodeGen cfg = cfg { cfgStopPhases = ncgPhases, cfgUpdateDynFlags = asmTarget . cfgUpdateDynFlags cfg@@ -143,40 +138,46 @@ asmTarget dfs = dfs {hscTarget = HscAsm, ghcLink = NoLink} -- | Compiler output and metadata for a given module.-data CompiledModule a = CompiledModule {+data CompiledModule a = CompiledModule { + -- | Module data generated by compilation; usually bindings of some kind.+ modCompiledModule :: a,++ -- | Metadata for the compiled module.+ modMetaData :: ModMetadata+ }++-- | Metadata for a module under compilation.+data ModMetadata = ModMetadata { -- | 'ModSummary' for the module, as given by GHC.- modSummary :: ModSummary,+ mmSummary :: ModSummary, -- | String representation of the module's name, not qualified with a -- package key. -- 'ModuleName' representation can be obtained from the module's -- 'stgModSummary'.- modName :: String,+ mmName :: String, -- | String representation of the module's package key. -- 'PackageKey' representation can be obtained from the module's -- 'stgModSummary'.- modPackageKey :: String,+ mmPackageKey :: String, -- | Is this module a compilation target (as opposed to a dependency of -- one)?- modIsTarget :: Bool,+ mmIsTarget :: Bool, -- | Was the module compiler from a @hs-boot@ file?- modSourceIsHsBoot :: Bool,+ mmSourceIsHsBoot :: Bool, -- | The Haskell source the module was compiled from, if any.- modSourceFile :: Maybe FilePath,-- -- | 'ModIface' structure corresponding to this module.- -- If 'modInterfaceFile' exists, it contains this structure.- modInterface :: ModIface,+ mmSourceFile :: Maybe FilePath, -- | Interface file corresponding to this module.- modInterfaceFile :: FilePath,+ mmInterfaceFile :: FilePath, - -- | Module data generated by compilation; usually bindings of some kind.- modCompiledModule :: a+ -- | Was this module loaded from cache, as opposed to recompiled from+ -- scratch?+ mmCached :: Bool } -- | A GHC error message.