@@ -1,10 +1,7 @@
11-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
22-- SPDX-License-Identifier: Apache-2.0
33
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE PatternSynonyms #-}
64{-# OPTIONS_GHC -Wno-missing-fields #-} -- to enable prettyPrint
7−{-# OPTIONS_GHC -Wno-orphans #-}
85
96-- | GHC utility functions. Importantly, code using our GHC should never:
107--
@@ -14,18 +11,11 @@
1411module Development.IDE.UtilGHC(
1512 PackageDynFlags(..), setPackageDynFlags, getPackageDynFlags,
1613 modifyDynFlags,
17− removeTypeableInfo,
1814 setPackageImports,
1915 setPackageDbs,
20− fakeSettings,
21− fakeLlvmConfig,
16+ fakeDynFlags,
2217 prettyPrint,
23− importGenerated,
24− mkImport,
25− runGhcFast,
26− setImports,
27− setThisInstalledUnitId,
28− modIsInternal
18+ runGhcFast
2919 ) where
3020
3121import Config
@@ -37,12 +27,8 @@ import HscMain
3727import qualified Packages
3828import Platform
3929import qualified EnumSet
40−
41−import Control.DeepSeq
4230import Data.IORef
43−import Data.List
4431import GHC.Generics (Generic)
45−import qualified StringBuffer as SB
4632
4733----------------------------------------------------------------------
4834-- GHC setup
@@ -84,10 +70,7 @@ data PackageDynFlags = PackageDynFlags
8470 { pdfPkgDatabase :: !(Maybe [(FilePath, [Packages.PackageConfig])])
8571 , pdfPkgState :: !Packages.PackageState
8672 , pdfThisUnitIdInsts :: !(Maybe [(ModuleName, Module)])
87− } deriving (Generic, Show)
88−
89−instance NFData PackageDynFlags where
90− rnf (PackageDynFlags db state insts) = db `seq` state `seq` rnf insts
73+ } deriving (Generic)
9174
9275setPackageDynFlags :: PackageDynFlags -> DynFlags -> DynFlags
9376setPackageDynFlags PackageDynFlags{..} dflags = dflags
@@ -104,48 +87,8 @@ getPackageDynFlags DynFlags{..} = PackageDynFlags
10487 }
10588
10689
107−-- | A version of `showSDoc` that uses default flags (to avoid uses of
108−-- `showSDocUnsafe`).
109−showSDocDefault :: SDoc -> String
110−showSDocDefault = showSDoc dynFlags
111− where dynFlags = defaultDynFlags fakeSettings fakeLlvmConfig
112−
11390prettyPrint :: Outputable a => a -> String
114−prettyPrint = showSDocDefault . ppr
115−
116−-- FIXME(#1203): This must move out of `haskell-ide-core` and into `damlc`.
117−internalModules :: [String]
118−internalModules =
119− [ "Data.String"
120− , "GHC.CString"
121− , "GHC.Integer.Type"
122− , "GHC.Natural"
123− , "GHC.Real"
124− , "GHC.Types"
125− ]
126−
127−-- | Checks if a given module is internal, i.e. gets removed in the Core->LF
128−-- translation. TODO where should this live?
129−modIsInternal :: Module -> Bool
130−modIsInternal m = moduleNameString (moduleName m) `elem` internalModules
131− -- TODO should we consider DA.Internal.* internal? Difference to GHC.*
132− -- modules is that these do not disappear in the LF conversion.
133−
134−-- | This import was generated, not user written, so should not produce unused import warnings
135−importGenerated :: Bool -> ImportDecl phase -> ImportDecl phase
136−importGenerated qual i = i{ideclImplicit=True, ideclQualified=qual}
137−
138−mkImport :: Located ModuleName -> ImportDecl GhcPs
139−mkImport mname = GHC.ImportDecl GHC.NoExt GHC.NoSourceText mname Nothing False False False False Nothing Nothing
140−
141−-- FIXME(#1203): This needs to move out of haskell-ide-core.
142−removeTypeableInfo :: ModGuts -> ModGuts
143−removeTypeableInfo guts =
144− guts{mg_binds = filter (not . isTypeableInfo) (mg_binds guts)}
145− where
146− isTypeableInfo = \case
147− NonRec name _ -> any (`isPrefixOf` getOccString name) ["$krep", "$tc", "$trModule"]
148− Rec _ -> False
91+prettyPrint = showSDoc fakeDynFlags . ppr
14992
15093-- | Like 'runGhc' but much faster (400x), with less IO and no file dependency
15194runGhcFast :: Ghc a -> IO a
@@ -154,61 +97,27 @@ runGhcFast act = do
15497 ref <- newIORef (error "empty session")
15598 let session = Session ref
15699 flip unGhc session $ do
157− dflags <- liftIO $ initDynFlags $ defaultDynFlags fakeSettings fakeLlvmConfig
100+ dflags <- liftIO $ initDynFlags fakeDynFlags
158101 liftIO $ setUnsafeGlobalDynFlags dflags
159102 env <- liftIO $ newHscEnv dflags
160103 setSession env
161104 withCleanupSession act
162105
163−-- These settings are mostly undefined, but define just enough for what we want to do (which isn't code gen)
164−fakeSettings :: Settings
165−fakeSettings = Settings
166− {sTargetPlatform=platform
167− ,sPlatformConstants=platformConstants
168− ,sProjectVersion=cProjectVersion
169− ,sProgramName="ghc"
170− ,sOpt_P_fingerprint=fingerprint0
171− }
172− where
173− platform = Platform{platformWordSize=8, platformOS=OSUnknown, platformUnregisterised=True}
174− platformConstants = PlatformConstants{pc_DYNAMIC_BY_DEFAULT=False,pc_WORD_SIZE=8}
175−
176−fakeLlvmConfig :: (LlvmTargets, LlvmPasses)
177−fakeLlvmConfig = ([], [])
178−
179−
180−setThisInstalledUnitId :: UnitId -> DynFlags -> DynFlags
181−setThisInstalledUnitId unitId dflags =
182− dflags {thisInstalledUnitId = toInstalledUnitId unitId}
183−
184−setImports :: [FilePath] -> DynFlags -> DynFlags
185−setImports paths dflags = dflags { importPaths = paths }
186−
187−
188−
189−-- Orphan instances for types from the GHC API.
190−instance Show CoreModule where show = prettyPrint
191−instance NFData CoreModule where rnf !_ = ()
192−
193−instance Show RdrName where show = prettyPrint
194−instance NFData RdrName where rnf !_ = ()
195−
196−instance Show InstalledUnitId where
197− show = installedUnitIdString
198−
199−instance NFData InstalledUnitId where
200− rnf = rwhnf
201−
202−instance NFData SB.StringBuffer where
203− rnf = rwhnf
204−
205−instance Show Module where
206− show = moduleNameString . moduleName
207−
208−instance Show ComponentId where show = prettyPrint
209−instance Show SourcePackageId where show = prettyPrint
210−instance Show ModuleName where show = prettyPrint
211−instance Show (GenLocated SrcSpan ModuleName) where show = prettyPrint
212−instance Show PackageName where show = prettyPrint
213−instance Show Packages.PackageState where show _ = "PackageState"
214−instance Show Name where show = prettyPrint
106+-- Fake DynFlags which are mostly undefined, but define enough to do a little bit
107+fakeDynFlags :: DynFlags
108+fakeDynFlags = defaultDynFlags settings ([], [])
109+ where
110+ settings = Settings
111+ {sTargetPlatform = Platform
112+ {platformWordSize = 8
113+ ,platformOS = OSUnknown
114+ ,platformUnregisterised = True
115+ }
116+ ,sPlatformConstants = PlatformConstants
117+ {pc_DYNAMIC_BY_DEFAULT = False
118+ ,pc_WORD_SIZE = 8
119+ }
120+ ,sProjectVersion = cProjectVersion
121+ ,sProgramName = "ghc"
122+ ,sOpt_P_fingerprint = fingerprint0
123+ }