ghc-simple (empty) → 0.1.0.0
raw patch · 6 files changed
+531/−0 lines, 6 filesdep +basedep +data-defaultdep +ghcsetup-changed
Dependencies added: base, data-default, ghc, ghc-paths
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- ghc-simple.cabal +42/−0
- src/Language/Haskell/GHC/Simple.hs +171/−0
- src/Language/Haskell/GHC/Simple/Impl.hs +140/−0
- src/Language/Haskell/GHC/Simple/Types.hs +156/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Anton Ekblad++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ghc-simple.cabal view
@@ -0,0 +1,42 @@+name: ghc-simple+version: 0.1.0.0+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+ started with. This library abstracts away the intricacies+ of working with the GHC API, giving a general, no-nonsense+ way to extract highly optimized (or not, depending on your+ use case) Core, STG, custom intermediate code, and other+ information from Haskell code.+homepage: https://github.com/valderman/ghc-simple+license: MIT+license-file: LICENSE+author: Anton Ekblad+maintainer: anton@ekblad.cc+copyright: (c) 2015 Anton Ekblad+category: Development+build-type: Simple+cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/valderman/ghc-simple.git++library+ exposed-modules:+ Language.Haskell.GHC.Simple,+ Language.Haskell.GHC.Simple.Impl+ other-modules: + Language.Haskell.GHC.Simple.Types+ other-extensions:+ CPP, PatternGuards, FlexibleInstances+ build-depends:+ ghc >=7.8,+ base >=4.7 && <4.9,+ ghc-paths >=0.1 && <0.2,+ data-default >=0.5 && <0.6+ hs-source-dirs:+ src+ default-language:+ Haskell2010+
+ src/Language/Haskell/GHC/Simple.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE CPP, PatternGuards #-}+-- | Simplified interface to the GHC API.+module Language.Haskell.GHC.Simple (+ -- Configuration, input and output types+ module Simple.Types,+ Compile,+ StgModule,++ -- GHC re-exports needed to meaningfully process STG and Core.+ module CoreSyn, module StgSyn, module Module,+ module Id, module IdInfo, module Var, module Literal, module DataCon,+ module OccName, module Name,+ module Type, module TysPrim, module TyCon,+ module ForeignCall, module PrimOp,+ module DynFlags, module SrcLoc,+ ModSummary (..), ModGuts (..),+ PkgKey,+ pkgKeyString, modulePkgKey,+ + -- Entry points+ compile, compileWith, genericCompile+ ) where++-- GHC scaffolding+import GHC hiding (Warning)+import GhcMonad (liftIO)+import DynFlags+import HscTypes+import ErrUtils+import Bag+import SrcLoc+import Outputable++-- Convenience re-exports for fiddling with STG+import StgSyn+import CoreSyn+import Name hiding (varName)+import Type+import TysPrim+import TyCon+import Literal+import Var hiding (setIdExported, setIdNotExported, lazySetIdInfo)+import Id+import IdInfo+import OccName hiding (varName)+import DataCon+import ForeignCall+import PrimOp+import Module++-- Misc. stuff+import GHC.Paths (libdir)+import Data.IORef+import Language.Haskell.GHC.Simple.Types as Simple.Types+import Language.Haskell.GHC.Simple.Impl++-- | Compile a list of targets and their dependencies into intermediate code.+-- Uses settings from the the default 'CompConfig'.+compile :: Compile a+ => [String]+ -- ^ List of compilation targets. A target can be either a module+ -- or a file name.+ -> IO (CompResult a)+compile = compileWith def++-- | Compile a list of targets and their dependencies using a custom+-- configuration.+compileWith :: Compile a+ => CompConfig+ -- ^ GHC pipeline configuration.+ -> [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)+compileWith = genericCompile toCode++-- | Compile a list of targets and their dependencies using a custom+-- configuration and compilation function in the 'Ghc' monad. See+-- "Language.Haskell.GHC.Simple.Impl" for more information about building+-- custom compilation functions.+genericCompile :: (DynFlags -> ModSummary -> Ghc a)+ -- ^ Compilation function.+ -> CompConfig+ -- ^ GHC pipeline configuration.+ -> [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)+genericCompile comp cfg files = do+ (flags, _staticwarns) <- parseStaticFlags $ map noLoc (cfgGhcFlags cfg)+ warns <- newIORef []+ runGhc (maybe (Just libdir) Just (cfgGhcLibDir cfg)) $ do+ dfs <- getSessionDynFlags+ (dfs', files2, _dynwarns) <- parseDynamicFlags dfs flags+ let dfs'' = cfgUpdateDynFlags cfg $ dfs' {+ log_action = logger (log_action dfs') warns+ }+ _ <- setSessionDynFlags dfs''+ ecode <- genCode (toCompiledModule comp) (files ++ map unLoc files2)+ ws <- liftIO $ readIORef warns+ case ecode of+ Right (finaldfs, code) ->+ return Success {+ compResult = code,+ compWarnings = ws,+ compDynFlags = finaldfs+ }+ Left es ->+ return Failure {+ compErrors = es,+ compWarnings = ws+ }+ where+ logger deflog warns dfs severity srcspan style msg+ | cfgUseGhcErrorLogger cfg = do+ logger' deflog warns dfs severity srcspan style msg+ -- Messages other than warnings and errors are already logged by GHC+ -- by default.+ case severity of+ SevWarning -> deflog dfs severity srcspan style msg+ SevError -> deflog dfs severity srcspan style msg+ _ -> return ()+ | otherwise = do+ logger' deflog warns dfs severity srcspan style msg++ -- Collect warnings and supress errors, since we're collecting those+ -- separately.+ logger' _ w dfs SevWarning srcspan _style msg = do+ liftIO $ atomicModifyIORef' w $ \ws ->+ (Warning srcspan (showSDoc dfs msg) : ws, ())+ logger' _ _ _ SevError _ _ _ = do+ return ()+ logger' output _ dfs sev srcspan style msg = do+ output dfs sev srcspan style msg++-- | Map a compilation function over each 'ModSummary' in the dependency graph+-- of a list of targets.+genCode :: GhcMonad m+ => (DynFlags -> ModSummary -> m a)+ -> [String]+ -> m (Either [Error] (DynFlags, [a]))+genCode comp files = do+ dfs <- getSessionDynFlags+ merrs <- handleSourceError (maybeErrors dfs) $ do+ ts <- mapM (flip guessTarget Nothing) files+ setTargets ts+ loads <- load LoadAllTargets+ return $ if succeeded loads then Nothing else Just []+ case merrs of+ Just errs -> return $ Left errs+ _ -> do+ mss <- depanal [] False+ code <- mapM (comp dfs . noLog) mss+ 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 ()}}+ maybeErrors dfs =+ return . Just . map (fromErrMsg dfs) . bagToList . srcErrorMessages++fromErrMsg :: DynFlags -> ErrMsg -> Error+fromErrMsg dfs e = Error {+ errorSpan = errMsgSpan e,+ errorMessage = showSDocForUser dfs ctx (errMsgShortDoc e),+ errorExtraInfo = showSDocForUser dfs ctx (errMsgExtraInfo e)+ }+ where+ ctx = errMsgContext e
+ src/Language/Haskell/GHC/Simple/Impl.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE FlexibleInstances, CPP, PatternGuards #-}+-- | Lower level building blocks for custom code generation.+module Language.Haskell.GHC.Simple.Impl (+ Compile (..),+ Ghc, StgModule, PkgKey,+ liftIO,+ toSimplifiedStg,+ toSimplifiedCore,+ toModGuts,+ simplify,+ prepare, toStgBindings,+ toCompiledModule,+ modulePkgKey, pkgKeyString+ ) where++-- GHC scaffolding+import GHC hiding (Warning)+import GhcMonad (liftIO)+import HscMain+import HscTypes+import TidyPgm+import CorePrep+import StgSyn+import CoreSyn+import CoreToStg+import SimplStg+#if __GLASGOW_HASKELL__ < 710+import qualified Module as M (modulePackageId, packageIdString, PackageId)+#else+import qualified Module as M (modulePackageKey, packageKeyString, PackageKey)+#endif++import Control.Monad+import Language.Haskell.GHC.Simple.Types++-- | 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 :: DynFlags -> ModSummary -> Ghc a++type StgModule = CompiledModule [StgBinding]+instance Compile [StgBinding] where+ toCode = toSimplifiedStg++instance Compile CgGuts where+ toCode = const toSimplifiedCore++instance Compile ModGuts where+ toCode = const toModGuts++-- | Package ID/key of a module.+modulePkgKey :: Module -> PkgKey++-- | String representation of a package ID/key.+pkgKeyString :: PkgKey -> String++#if __GLASGOW_HASKELL__ < 710+-- | Synonym for 'M.PackageId', to bridge a slight incompatibility between+-- GHC 7.8 and 7.10.+type PkgKey = M.PackageId+modulePkgKey = M.modulePackageId+pkgKeyString = M.packageIdString+#else+-- | Synonym for 'M.PackageKey', to bridge a slight incompatibility between+-- GHC 7.8 and 7.10.+type PkgKey = M.PackageKey+modulePkgKey = M.modulePackageKey+pkgKeyString = M.packageKeyString+#endif++-- | Compile a 'ModSummary' into a module with metadata using a custom+-- compilation function.+toCompiledModule :: GhcMonad m+ => (DynFlags -> ModSummary -> m a)+ -> DynFlags+ -> ModSummary+ -> m (CompiledModule a)+toCompiledModule comp dfs ms = do+ code <- comp dfs ms+ ts <- getTargets+ 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,+ modInterfaceFile = ml_hi_file $ ms_location ms,+ modCompiledModule = code+ }++-- | Is @t@ the target that corresponds to @ms@?+isTargetOf :: Target -> ModSummary -> Bool+isTargetOf t ms =+ case targetId t of+ TargetModule mn -> ms_mod_name ms == mn+ TargetFile fn _+ | ModLocation (Just f) _ _ <- ms_location ms -> f == fn+ _ -> False++-- | 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 => DynFlags -> ModSummary -> m [StgBinding]+toSimplifiedStg dfs ms =+ 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++-- | Prepare a core module for code generation.+prepare :: GhcMonad m => DynFlags -> ModSummary -> CgGuts -> m CoreProgram+prepare dfs _ms p = do+ env <- getSession+#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
@@ -0,0 +1,156 @@+-- | Config, input and output types for the simplified GHC API.+module Language.Haskell.GHC.Simple.Types (+ Default (..),+ + -- Configuration+ CompConfig,+ cfgGhcFlags, cfgUseTargetsFromFlags, cfgUpdateDynFlags, cfgGhcLibDir,+ cfgUseGhcErrorLogger,++ -- Results and errors+ CompiledModule (..),+ CompResult (..),+ Error (..),+ Warning (..),+ ghcSuccess+ ) where++-- GHC imports+import GHC++-- Misc. stuff+import Data.Default++data CompConfig = CompConfig {+ -- | GHC command line flags to control the Haskell to STG compilation+ -- pipeline. Both static and dynamic flags may be set here.+ -- For instance, passing @["-O2", "-DHELLO"]@ here is equivalent to+ -- passing @-O2 -DHELLO@ to the @ghc@ binary.+ --+ -- Note that flags set here are overridden by any changes to 'DynFlags'+ -- performed by 'cfgUpdateDynFlags', and that '--make' mode is always+ -- in effect.+ --+ -- Default: @[]@+ cfgGhcFlags :: [String],++ -- | If file or module names are found among the 'cfgGhcFlags',+ -- should they be used as targets, in addition to any targets given by+ -- other arguments to 'withStg' et al?+ --+ -- Default: @True@+ cfgUseTargetsFromFlags :: Bool,++ -- | Modify the dynamic flags governing the compilation process.+ -- Changes made here take precedence over any flags passed through+ -- 'cfgGhcFlags'.+ --+ -- Default: @id@+ cfgUpdateDynFlags :: DynFlags -> DynFlags,++ -- | Use GHC's standard logger to log errors and warnings to the command+ -- line? Errors and warnings are always collected and returned,+ -- regardless of the value of this setting.+ --+ -- Output other than errors and warnings (dumps, etc.) are logged using+ -- the standard logger by default. For finer control over logging+ -- behavior, you should override 'log_action' in 'cfgUpdateDynFlags'.+ --+ -- Default: @False@+ cfgUseGhcErrorLogger :: Bool,++ -- | Path to GHC's library directory. If 'Nothing', the library directory+ -- of the system's default GHC compiler will be used.+ --+ -- Default: @Nothing@+ cfgGhcLibDir :: Maybe FilePath+ }++instance Default CompConfig where+ def = CompConfig {+ cfgGhcFlags = [],+ cfgUseTargetsFromFlags = True,+ cfgUpdateDynFlags = id,+ cfgUseGhcErrorLogger = False,+ cfgGhcLibDir = Nothing+ }++-- | Compiler output and metadata for a given module.+data CompiledModule a = CompiledModule {+ -- | 'ModSummary' for the module, as given by GHC.+ modSummary :: 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,++ -- | String representation of the module's package key.+ -- 'PackageKey' representation can be obtained from the module's+ -- 'stgModSummary'.+ modPackageKey :: String,++ -- | Is this module a compilation target (as opposed to a dependency of+ -- one)?+ modIsTarget :: Bool,++ -- | Was the module compiler from a @hs-boot@ file?+ modSourceIsHsBoot :: Bool,++ -- | The Haskell source the module was compiled from, if any.+ modSourceFile :: Maybe FilePath,++ -- | Interface file corresponding to this module.+ modInterfaceFile :: FilePath,++ -- | Module data generated by compilation; usually bindings of some kind.+ modCompiledModule :: a+ }++-- | A GHC error message.+data Error = Error {+ -- | Where did the error occur?+ errorSpan :: SrcSpan,++ -- | Description of the error.+ errorMessage :: String,++ -- | More verbose description of the error.+ errorExtraInfo :: String+ }++-- | A GHC warning.+data Warning = Warning {+ -- | Where did the warning occur?+ warnSpan :: SrcSpan,++ -- | What was the warning about?+ warnMessage :: String+ }++-- | Result of a compilation.+data CompResult a+ = Success {+ -- | Result of the compilation.+ compResult :: [CompiledModule a],++ -- | Warnings that occurred during compilation.+ compWarnings :: [Warning],++ -- | Initial 'DynFlags' used by this compilation, collected from 'Config'+ -- data.+ compDynFlags :: DynFlags+ }+ | Failure {+ -- | Errors that occurred during compilation.+ compErrors :: [Error],++ -- | Warnings that occurred during compilation.+ compWarnings :: [Warning]+ }++-- | Does the given 'CompResult' represent a successful compilation?+ghcSuccess :: CompResult a -> Bool+ghcSuccess (Success {}) = True+ghcSuccess _ = False