Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit 94eaa52

Browse files
mpickeringmpickering
committed
Remove CPP from artifact map
1 parent ab595a0 commit 94eaa52

File tree

2 files changed

+98
-77
lines changed

2 files changed

+98
-77
lines changed

‎hie-plugin-api/Haskell/Ide/Engine/ArtifactMap.hs‎

Lines changed: 11 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE CPP #-}
21
module Haskell.Ide.Engine.ArtifactMap where
32

43
import Data.Maybe
@@ -42,48 +41,26 @@ genLocMap tm = names
4241
renamed = fromJust $ GHC.tm_renamed_source tm
4342

4443

45-
#if __GLASGOW_HASKELL__ > 710
4644
names = IM.union names2 $ SYB.everything IM.union (IM.empty `SYB.mkQ` hsRecFieldT) typechecked
47-
#else
48-
names = names2
49-
#endif
5045
names2 = SYB.everything IM.union (IM.empty
51-
#if __GLASGOW_HASKELL__ > 710
5246
`SYB.mkQ` fieldOcc
5347
`SYB.extQ` hsRecFieldN
5448
`SYB.extQ` checker) renamed
55-
#else
56-
`SYB.mkQ` checker) renamed
57-
#endif
5849

5950
checker (GHC.L (GHC.RealSrcSpan r) x) = IM.singleton (rspToInt r) x
6051
checker _ = IM.empty
6152

62-
#if __GLASGOW_HASKELL__ >= 806
6353
fieldOcc :: GHC.FieldOcc GhcRn -> LocMap
64-
fieldOcc (GHC.FieldOcc n (GHC.L (GHC.RealSrcSpan r) _)) = IM.singleton (rspToInt r) n
54+
fieldOcc (FieldOccCompat n (GHC.L (GHC.RealSrcSpan r) _)) = IM.singleton (rspToInt r) n
6555
fieldOcc _ = IM.empty
6656

6757
hsRecFieldN :: GHC.LHsExpr GhcRn -> LocMap
68-
hsRecFieldN (GHC.L _ (GHC.HsRecFld _ (GHC.Unambiguous n (GHC.L (GHC.RealSrcSpan r) _)) )) = IM.singleton (rspToInt r) n
58+
hsRecFieldN (GHC.L _ (HsRecFldCompat (UnambiguousCompat n (GHC.L (GHC.RealSrcSpan r) _)) )) = IM.singleton (rspToInt r) n
6959
hsRecFieldN _ = IM.empty
7060

7161
hsRecFieldT :: GHC.LHsExpr GhcTc -> LocMap
72-
hsRecFieldT (GHC.L _ (GHC.HsRecFld _ (GHC.Ambiguous n (GHC.L (GHC.RealSrcSpan r) _)) )) = IM.singleton (rspToInt r) (Var.varName n)
62+
hsRecFieldT (GHC.L _ (HsRecFldCompat (AmbiguousCompat n (GHC.L (GHC.RealSrcSpan r) _)) )) = IM.singleton (rspToInt r) (Var.varName n)
7363
hsRecFieldT _ = IM.empty
74-
#elif __GLASGOW_HASKELL__ > 710
75-
fieldOcc :: GHC.FieldOcc GhcRn -> LocMap
76-
fieldOcc (GHC.FieldOcc (GHC.L (GHC.RealSrcSpan r) _) n) = IM.singleton (rspToInt r) n
77-
fieldOcc _ = IM.empty
78-
79-
hsRecFieldN :: GHC.LHsExpr GhcRn -> LocMap
80-
hsRecFieldN (GHC.L _ (GHC.HsRecFld (GHC.Unambiguous (GHC.L (GHC.RealSrcSpan r) _) n) )) = IM.singleton (rspToInt r) n
81-
hsRecFieldN _ = IM.empty
82-
83-
hsRecFieldT :: GHC.LHsExpr GhcTc -> LocMap
84-
hsRecFieldT (GHC.L _ (GHC.HsRecFld (GHC.Ambiguous (GHC.L (GHC.RealSrcSpan r) _) n) )) = IM.singleton (rspToInt r) (Var.varName n)
85-
hsRecFieldT _ = IM.empty
86-
#endif
8764

8865
-- | Generates a ModuleMap of imported and exported modules names,
8966
-- and the locations that they were imported/exported at.
@@ -92,11 +69,7 @@ genImportMap tm = moduleMap
9269
where
9370
(_, lImports, mlies, _) = fromJust $ GHC.tm_renamed_source tm
9471

95-
#if __GLASGOW_HASKELL__ > 802
9672
lies = map fst $ fromMaybe [] mlies
97-
#else
98-
lies = fromMaybe [] mlies
99-
#endif
10073

10174
moduleMap :: ModuleMap
10275
moduleMap = foldl goImp IM.empty lImports `IM.union` foldl goExp IM.empty lies
@@ -106,11 +79,7 @@ genImportMap tm = moduleMap
10679
goImp acc _ = acc
10780

10881
goExp :: ModuleMap -> GHC.LIE name -> ModuleMap
109-
#if __GLASGOW_HASKELL__ >= 806
110-
goExp acc (GHC.L (GHC.RealSrcSpan r) (GHC.IEModuleContents _ lmn)) =
111-
#else
112-
goExp acc (GHC.L (GHC.RealSrcSpan r) (GHC.IEModuleContents lmn)) =
113-
#endif
82+
goExp acc (GHC.L (GHC.RealSrcSpan r) (IEModuleContentsCompat lmn)) =
11483
IM.insert (rspToInt r) (GHC.unLoc lmn) acc
11584
goExp acc _ = acc
11685

@@ -121,43 +90,21 @@ genDefMap tm = mconcat $ map (go . GHC.unLoc) decls
12190
where
12291
go :: GHC.HsDecl GhcPs -> DefMap
12392
-- Type signatures
124-
#if __GLASGOW_HASKELL__ >= 806
125-
go (GHC.SigD _ (GHC.TypeSig _ lns _)) =
126-
#else
127-
go (GHC.SigD (GHC.TypeSig lns _)) =
128-
#endif
93+
go (SigDCompat (TypeSigCompat lns _)) =
12994
foldl IM.union mempty $ fmap go' lns
13095
where go' (GHC.L (GHC.RealSrcSpan r) n) = IM.singleton (rspToInt r) n
13196
go' _ = mempty
13297
-- Definitions
133-
#if __GLASGOW_HASKELL__ >= 806
134-
go (GHC.ValD _ (GHC.FunBind _ (GHC.L (GHC.RealSrcSpan r) n) GHC.MG { GHC.mg_alts = llms } _ _)) =
135-
#else
136-
go (GHC.ValD (GHC.FunBind (GHC.L (GHC.RealSrcSpan r) n) GHC.MG { GHC.mg_alts = llms } _ _ _)) =
137-
#endif
98+
go (ValDCompat (FunBindCompat (GHC.L (GHC.RealSrcSpan r) n) (GHC.MG { GHC.mg_alts = llms }))) =
13899
IM.insert (rspToInt r) n wheres
139100
where
140101
wheres = mconcat $ fmap (gomatch . GHC.unLoc) (GHC.unLoc llms)
141102

142-
gomatch GHC.Match { GHC.m_grhss = GHC.GRHSs { GHC.grhssLocalBinds = lbs } } =
143-
golbs (GHC.unLoc lbs)
144-
#if __GLASGOW_HASKELL__ >= 806
145-
gomatch GHC.XMatch{} = error "GHC.XMatch"
146-
gomatch (GHC.Match _ _ _ (GHC.XGRHSs _)) = error "GHC.XMatch"
147-
#endif
148-
149-
#if __GLASGOW_HASKELL__ >= 806
150-
golbs (GHC.HsValBinds _ (GHC.ValBinds _ lhsbs lsigs)) =
151-
#else
152-
golbs (GHC.HsValBinds (GHC.ValBindsIn lhsbs lsigs)) =
153-
#endif
154-
#if __GLASGOW_HASKELL__ >= 806
155-
foldl (\acc x -> IM.union acc (go $ GHC.ValD GHC.NoExt $ GHC.unLoc x)) mempty lhsbs
156-
`mappend` foldl IM.union mempty (fmap (go . GHC.SigD GHC.NoExt . GHC.unLoc) lsigs)
157-
#else
158-
foldl (\acc x -> IM.union acc (go $ GHC.ValD $ GHC.unLoc x)) mempty lhsbs
159-
`mappend` foldl IM.union mempty (fmap (go . GHC.SigD . GHC.unLoc) lsigs)
160-
#endif
103+
gomatch (MatchCompat lbs) = golbs (GHC.unLoc lbs)
104+
105+
golbs (HsValBindsCompat (ValBindsCompat lhsbs lsigs)) =
106+
foldl (\acc x -> IM.union acc (go $ ValDCompat $ GHC.unLoc x)) mempty lhsbs
107+
`mappend` foldl IM.union mempty (fmap (go . SigDCompat . GHC.unLoc) lsigs)
161108
golbs _ = mempty
162109
go _ = mempty
163110
decls = GHC.hsmodDecls $ GHC.unLoc $ GHC.pm_parsed_source $ GHC.tm_parsed_module tm

‎hie-plugin-api/Haskell/Ide/Engine/GhcCompat.hs‎

Lines changed: 87 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -305,19 +305,6 @@ needsTemplateHaskellOrQQ = needsTemplateHaskell
305305
mgModSummaries = id
306306
#endif
307307

308-
#if __GLASGOW_HASKELL__ < 806
309-
valBinds valds =
310-
case valds of
311-
ValBindsOut _ lsigs -> lsigs
312-
ValBindsIn _ lsigs ->
313-
error "should not hit ValBindsIn when accessing renamed AST"
314-
315-
316-
pattern ValBindsCompat lsigs <- (valBinds -> lsigs)
317-
#else
318-
pattern ValBindsCompat lsigs <- XValBindsLR (NValBinds _ lsigs)
319-
#endif
320-
321308
#if __GLASGOW_HASKELL__ < 806
322309
pattern HsForAllTyCompat binders <- HsForAllTy binders _
323310
#else
@@ -419,6 +406,93 @@ pattern ClsInstDeclCompat lty lbinds <-
419406
ClsInstDecl _ lty lbinds _ _ _ _
420407
#endif
421408

409+
pattern FieldOccCompat n l <-
410+
#if __GLASGOW_HASKELL__ < 806
411+
FieldOcc l n
412+
#else
413+
FieldOcc n l
414+
#endif
415+
416+
pattern UnambiguousCompat n l <-
417+
#if __GLASGOW_HASKELL__ < 806
418+
Unambiguous l n
419+
#else
420+
Unambiguous n l
421+
#endif
422+
423+
pattern AmbiguousCompat n l <-
424+
#if __GLASGOW_HASKELL__ < 806
425+
Ambiguous l n
426+
#else
427+
Ambiguous n l
428+
#endif
429+
430+
pattern HsRecFldCompat f <-
431+
#if __GLASGOW_HASKELL__ < 806
432+
HsRecFld f
433+
#else
434+
HsRecFld _ f
435+
#endif
436+
437+
pattern IEModuleContentsCompat f <-
438+
#if __GLASGOW_HASKELL__ < 806
439+
IEModuleContents f
440+
#else
441+
IEModuleContents _ f
442+
#endif
443+
444+
pattern HsValBindsCompat f <-
445+
#if __GLASGOW_HASKELL__ < 806
446+
HsValBinds f
447+
#else
448+
HsValBinds _ f
449+
#endif
450+
451+
pattern ValBindsCompat f g <-
452+
#if __GLASGOW_HASKELL__ < 806
453+
ValBinds f g
454+
#else
455+
ValBinds _ f g
456+
#endif
457+
458+
pattern ValDCompat :: HsBind (GhcPass p) -> HsDecl (GhcPass p)
459+
pattern ValDCompat f <-
460+
#if __GLASGOW_HASKELL__ < 806
461+
ValD f
462+
where
463+
ValDCompat f = ValD f
464+
#else
465+
ValD _ f
466+
where
467+
ValDCompat f = ValD NoExt f
468+
#endif
469+
470+
pattern SigDCompat :: Sig (GhcPass p) -> HsDecl (GhcPass p)
471+
pattern SigDCompat f <-
472+
#if __GLASGOW_HASKELL__ < 806
473+
SigD f
474+
where
475+
SigDCompat f = SigD f
476+
#else
477+
SigD _ f
478+
where
479+
SigDCompat f = SigD NoExt f
480+
#endif
481+
482+
483+
{-# COMPLETE MatchCompat #-}
484+
485+
pattern MatchCompat ms <-
486+
#if __GLASGOW_HASKELL__ < 806
487+
Match ({ GHC.m_grhss = GHC.GRHSs { GHC.grhssLocalBinds = ms } })
488+
#else
489+
(gomatch' -> ms)
490+
491+
gomatch' GHC.Match { GHC.m_grhss = GHC.GRHSs { GHC.grhssLocalBinds = lbs } } = lbs
492+
gomatch' GHC.XMatch{} = error "GHC.XMatch"
493+
gomatch' (GHC.Match _ _ _ (GHC.XGRHSs _)) = error "GHC.XMatch"
494+
#endif
495+
422496

423497

424498

0 commit comments

Comments
 (0)