Skip to content

Commit c056b1d

Browse files
committed
fixup hls-eval-plugin
1 parent 395389a commit c056b1d

File tree

3 files changed

+33
-35
lines changed

3 files changed

+33
-35
lines changed

ghcide/src/Development/IDE/Core/Rules.hs

Lines changed: 24 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,7 @@ module Development.IDE.Core.Rules(
5050
getHieAstsRule,
5151
getBindingsRule,
5252
needsCompilationRule,
53-
computeLinkableType,
53+
computeLinkableTypeForDynFlags,
5454
generateCoreRule,
5555
getImportMapRule,
5656
regenerateHiFile,
@@ -1015,33 +1015,33 @@ needsCompilationRule file = do
10151015
pure $ computeLinkableType ms modsums (map join needsComps)
10161016

10171017
pure (Just $ encodeLinkableType res, Just res)
1018-
1019-
-- | Compute the linkable type required for the input module
1020-
computeLinkableType
1021-
:: ModSummary -- ^ module
1022-
-> [Maybe ModSummary] -- ^ direct dependencies
1023-
-> [Maybe LinkableType] -- ^ linkable requirements for the direct dependencies
1024-
-> Maybe LinkableType
1025-
computeLinkableType this deps xs
1026-
| Just ObjectLinkable `elem` xs = Just ObjectLinkable -- If any dependent needs object code, so do we
1027-
| Just BCOLinkable `elem` xs = Just this_type -- If any dependent needs bytecode, then we need to be compiled
1028-
| any (maybe False uses_th_qq) deps = Just this_type -- If any dependent needs TH, then we need to be compiled
1029-
| otherwise = Nothing -- If none of these conditions are satisfied, we don't need to compile
1030-
where
1031-
uses_th_qq (ms_hspp_opts -> dflags) =
1032-
xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
1033-
1034-
unboxed_tuples_or_sums (ms_hspp_opts -> d) =
1035-
xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d
1036-
-- How should we compile this module? (assuming we do in fact need to compile it)
1037-
-- Depends on whether it uses unboxed tuples or sums
1038-
this_type
1018+
where
1019+
uses_th_qq (ms_hspp_opts -> dflags) =
1020+
xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
1021+
1022+
computeLinkableType :: ModSummary -> [Maybe ModSummary] -> [Maybe LinkableType] -> Maybe LinkableType
1023+
computeLinkableType this deps xs
1024+
| Just ObjectLinkable `elem` xs = Just ObjectLinkable -- If any dependent needs object code, so do we
1025+
| Just BCOLinkable `elem` xs = Just this_type -- If any dependent needs bytecode, then we need to be compiled
1026+
| any (maybe False uses_th_qq) deps = Just this_type -- If any dependent needs TH, then we need to be compiled
1027+
| otherwise = Nothing -- If none of these conditions are satisfied, we don't need to compile
1028+
where
1029+
this_type = computeLinkableTypeForDynFlags (ms_hspp_opts this)
1030+
1031+
-- | How should we compile this module?
1032+
-- (assuming we do in fact need to compile it).
1033+
-- Depends on whether it uses unboxed tuples or sums
1034+
computeLinkableTypeForDynFlags :: DynFlags -> LinkableType
1035+
computeLinkableTypeForDynFlags d
10391036
#if defined(GHC_PATCHED_UNBOXED_BYTECODE)
10401037
= BCOLinkable
10411038
#else
1042-
| unboxed_tuples_or_sums this = ObjectLinkable
1043-
| otherwise = BCOLinkable
1039+
| unboxed_tuples_or_sums = ObjectLinkable
1040+
| otherwise = BCOLinkable
10441041
#endif
1042+
where
1043+
unboxed_tuples_or_sums =
1044+
xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d
10451045

10461046
-- | Tracks which linkables are current, so we don't need to unload them
10471047
newtype CompiledLinkables = CompiledLinkables { getCompiledLinkables :: Var (ModuleEnv UTCTime) }

plugins/hls-eval-plugin/hls-eval-plugin.cabal

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -62,7 +62,6 @@ library
6262
, extra
6363
, filepath
6464
, ghc
65-
, ghc-boot
6665
, ghc-boot-th
6766
, ghc-paths
6867
, ghcide >=1.2 && <1.5
@@ -86,7 +85,7 @@ library
8685
, unordered-containers
8786

8887
ghc-options:
89-
-Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors
88+
-Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors -fno-ignore-asserts
9089

9190
if flag(pedantic)
9291
ghc-options: -Werror
@@ -101,7 +100,7 @@ test-suite tests
101100
default-language: Haskell2010
102101
hs-source-dirs: test
103102
main-is: Main.hs
104-
ghc-options: -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts
103+
ghc-options: -threaded -rtsopts -with-rtsopts=-N
105104
build-depends:
106105
, aeson
107106
, base

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ import Development.IDE (GetModSummaryWithoutTimes
2424
realSrcSpanToRange,
2525
useWithStale_)
2626
import Development.IDE.Core.PositionMapping (toCurrentRange)
27-
import Development.IDE.Core.Rules (computeLinkableType,
27+
import Development.IDE.Core.Rules (computeLinkableTypeForDynFlags,
2828
needsCompilationRule)
2929
import Development.IDE.Core.Shake (IsIdeGlobal,
3030
RuleBody (RuleWithCustomNewnessCheck),
@@ -35,7 +35,6 @@ import Development.IDE.GHC.Compat
3535
import qualified Development.IDE.GHC.Compat as SrcLoc
3636
import qualified Development.IDE.GHC.Compat.Util as FastString
3737
import Development.IDE.Graph (alwaysRerun)
38-
import qualified GHC.LanguageExtensions as LangExt
3938
import Ide.Plugin.Eval.Types
4039

4140

@@ -101,18 +100,18 @@ evalParsedModuleRule = defineEarlyCutoff $ RuleNoDiagnostics $ \GetEvalComments
101100
redefinedNeedsCompilation :: Rules ()
102101
redefinedNeedsCompilation = defineEarlyCutoff $ RuleWithCustomNewnessCheck (<=) $ \NeedsCompilation f -> do
103102
alwaysRerun
104-
EvaluatingVar var <- getIdeGlobalAction
105103

104+
EvaluatingVar var <- getIdeGlobalAction
106105
isEvaluating <- liftIO $ (f `elem`) <$> readIORef var
107106

107+
108108
if not isEvaluating then needsCompilationRule f else do
109109
ms <- msrModSummary . fst <$> useWithStale_ GetModSummaryWithoutTimestamps f
110-
let ms' = ms{ms_hspp_opts = df'}
111-
df' = xopt_set (ms_hspp_opts ms) LangExt.TemplateHaskell
112-
linkableType = computeLinkableType ms' [] []
113-
fp = encodeLinkableType linkableType
110+
let df' = ms_hspp_opts ms
111+
linkableType = computeLinkableTypeForDynFlags df'
112+
fp = encodeLinkableType $ Just linkableType
114113

115114
-- remove the module from the Evaluating state
116115
liftIO $ modifyIORef var (Set.delete f)
117116

118-
pure (Just fp, Just linkableType)
117+
pure (Just fp, Just (Just linkableType))

0 commit comments

Comments
 (0)