git.iko.soy/ghcide
on 56d7dac help sign in
ghcide/src/Development/IDE/UtilGHC.hs
134 lines 5.0 kB history raw
1-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
4{-# OPTIONS_GHC -Wno-missing-fields #-} -- to enable prettyPrint
6-- | GHC utility functions. Importantly, code using our GHC should never:
7--
8-- * Call runGhc, use runGhcFast instead. It's faster and doesn't require config we don't have.
9--
10-- * Call setSessionDynFlags, use modifyDynFlags instead. It's faster and avoids loading packages.
11module Development.IDE.UtilGHC(
12 PackageDynFlags(..), setPackageDynFlags, getPackageDynFlags,
13 lookupPackageConfig,
14 modifyDynFlags,
15 setPackageImports,
16 setPackageDbs,
17 fakeDynFlags,
18 prettyPrint,
19 runGhcFast
20 ) where
22import Config
23import Fingerprint
24import GHC hiding (convertLit)
25import GhcMonad
26import GhcPlugins as GHC hiding (fst3, (<>))
27import HscMain
28import qualified Packages
29import Platform
30import qualified EnumSet
31import Data.IORef
32import GHC.Generics (Generic)
34----------------------------------------------------------------------
35-- GHC setup
37setPackageDbs :: [FilePath] -> DynFlags -> DynFlags
38setPackageDbs paths dflags =
39 dflags
40 { packageDBFlags =
41 [PackageDB $ PkgConfFile path | path <- paths] ++ [NoGlobalPackageDB, ClearPackageDBs]
42 , pkgDatabase = if null paths then Just [] else Nothing
43 -- if we don't load any packages set the package database to empty and loaded.
44 , settings = (settings dflags)
45 {sTopDir = case paths of p:_ -> p; _ -> error "No package db path available but used $topdir"
46 , sSystemPackageConfig = case paths of p:_ -> p; _ -> error "No package db path available but used system package config"
47 }
48 }
50setPackageImports :: Bool -> [(String, ModRenaming)] -> DynFlags -> DynFlags
51setPackageImports hideAllPkgs pkgImports dflags = dflags {
52 packageFlags = packageFlags dflags ++
53 [ExposePackage pkgName (UnitIdArg $ stringToUnitId pkgName) renaming
54 | (pkgName, renaming) <- pkgImports
55 ]
56 , generalFlags = if hideAllPkgs
57 then Opt_HideAllPackages `EnumSet.insert` generalFlags dflags
58 else generalFlags dflags
59 }
61modifyDynFlags :: GhcMonad m => (DynFlags -> DynFlags) -> m ()
62modifyDynFlags f = do
63 newFlags <- f <$> getSessionDynFlags
64 -- We do not use setSessionDynFlags here since we handle package
65 -- initialization separately.
66 modifySession $ \h ->
67 h { hsc_dflags = newFlags, hsc_IC = (hsc_IC h) {ic_dflags = newFlags} }
69-- | The subset of @DynFlags@ computed by package initialization.
70data PackageDynFlags = PackageDynFlags
71 { pdfPkgDatabase :: !(Maybe [(FilePath, [Packages.PackageConfig])])
72 , pdfPkgState :: !Packages.PackageState
73 , pdfThisUnitIdInsts :: !(Maybe [(ModuleName, Module)])
74 } deriving (Generic)
76setPackageDynFlags :: PackageDynFlags -> DynFlags -> DynFlags
77setPackageDynFlags PackageDynFlags{..} dflags = dflags
78 { pkgDatabase = pdfPkgDatabase
79 , pkgState = pdfPkgState
80 , thisUnitIdInsts_ = pdfThisUnitIdInsts
81 }
83getPackageDynFlags :: DynFlags -> PackageDynFlags
84getPackageDynFlags DynFlags{..} = PackageDynFlags
85 { pdfPkgDatabase = pkgDatabase
86 , pdfPkgState = pkgState
87 , pdfThisUnitIdInsts = thisUnitIdInsts_
88 }
90lookupPackageConfig :: UnitId -> PackageDynFlags -> Maybe PackageConfig
91lookupPackageConfig unitId PackageDynFlags {..} =
92 lookupPackage' False pkgConfigMap unitId
93 where
94 pkgConfigMap =
95 -- For some weird reason, the GHC API does not provide a way to get the PackageConfigMap
96 -- from PackageState so we have to wrap it in DynFlags first.
97 getPackageConfigMap fakeDynFlags { pkgState = pdfPkgState }
101prettyPrint :: Outputable a => a -> String
102prettyPrint = showSDoc fakeDynFlags . ppr
104-- | Like 'runGhc' but much faster (400x), with less IO and no file dependency
105runGhcFast :: Ghc a -> IO a
106-- copied from GHC with the nasty bits dropped
107runGhcFast act = do
108 ref <- newIORef (error "empty session")
109 let session = Session ref
110 flip unGhc session $ do
111 dflags <- liftIO $ initDynFlags fakeDynFlags
112 liftIO $ setUnsafeGlobalDynFlags dflags
113 env <- liftIO $ newHscEnv dflags
114 setSession env
115 withCleanupSession act
117-- Fake DynFlags which are mostly undefined, but define enough to do a little bit
118fakeDynFlags :: DynFlags
119fakeDynFlags = defaultDynFlags settings ([], [])
120 where
121 settings = Settings
122 {sTargetPlatform = Platform
123 {platformWordSize = 8
124 ,platformOS = OSUnknown
125 ,platformUnregisterised = True
126 }
127 ,sPlatformConstants = PlatformConstants
128 {pc_DYNAMIC_BY_DEFAULT = False
129 ,pc_WORD_SIZE = 8
130 }
131 ,sProjectVersion = cProjectVersion
132 ,sProgramName = "ghc"
133 ,sOpt_P_fingerprint = fingerprint0
134 }