packages feed

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 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.