Skip to content

Commit b5fb177

Browse files
bgamaribgamari
committed
Add support for GHC 9.10
1 parent f0ce073 commit b5fb177

File tree

4 files changed

+113
-22
lines changed

4 files changed

+113
-22
lines changed

‎.github/workflows/ci.yml

+1
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ jobs:
4141
- "9.4.8"
4242
- "9.6.4"
4343
- "9.8.2"
44+
- "9.10.1"
4445

4546
steps:
4647
- uses: actions/checkout@v3

‎cabal.project

+22
Original file line numberDiff line numberDiff line change
@@ -1 +1,23 @@
11
packages: .
2+
3+
-----------------------------------------------------------
4+
-- ClaSH compiler for GHC 9.10
5+
-----------------------------------------------------------
6+
7+
source-repository-package
8+
type: git
9+
location: https://github.com/clash-lang/clash-compiler
10+
tag: 15dc344dfa091de14c63759c0b6ea107ca0fa892
11+
subdir: clash-lib
12+
13+
source-repository-package
14+
type: git
15+
location: https://github.com/clash-lang/clash-compiler
16+
tag: 15dc344dfa091de14c63759c0b6ea107ca0fa892
17+
subdir: clash-prelude
18+
19+
source-repository-package
20+
type: git
21+
location: https://github.com/clash-lang/clash-compiler
22+
tag: 15dc344dfa091de14c63759c0b6ea107ca0fa892
23+
subdir: clash-prelude-hedgehog

‎circuit-notation.cabal

+1-1
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ library
2929
, clash-prelude >= 1.0
3030
, containers
3131
, data-default
32-
, ghc (>=8.6 && <8.8) || (>=8.10 && < 9.10)
32+
, ghc (>=8.6 && <8.8) || (>=8.10 && < 9.12)
3333
, lens
3434
, mtl
3535
, parsec

‎src/CircuitNotation.hs

+89-21
Original file line numberDiff line numberDiff line change
@@ -72,6 +72,10 @@ import HscTypes (throwOneError)
7272
import qualified GHC.Parser.Annotation as GHC
7373
#endif
7474

75+
#if __GLASGOW_HASKELL__ >= 910
76+
import GHC.Hs (EpAnn)
77+
#endif
78+
7579
#if __GLASGOW_HASKELL__ >= 900
7680
import GHC.Data.Bag
7781
import GHC.Data.FastString (mkFastString, unpackFS)
@@ -204,14 +208,22 @@ emptyComments = noExtField
204208

205209
locA :: a -> a
206210
locA = id
207-
#else
211+
#elif __GLASGOW_HASKELL__ < 910
208212
type MsgDoc = Outputable.SDoc
209213

210-
locA :: SrcSpanAnn' a -> SrcSpan
214+
locA :: SrcAnn a -> SrcSpan
211215
locA = GHC.locA
212216

213217
noAnnSortKey :: AnnSortKey
214218
noAnnSortKey = NoAnnSortKey
219+
#else
220+
type MsgDoc = Outputable.SDoc
221+
222+
locA :: EpAnn a -> SrcSpan
223+
locA = GHC.locA
224+
225+
noAnnSortKey :: AnnSortKey a
226+
noAnnSortKey = NoAnnSortKey
215227
#endif
216228

217229
#if __GLASGOW_HASKELL__ < 902
@@ -230,7 +242,13 @@ sevFatal :: Err.MessageClass
230242
sevFatal = Err.MCFatal
231243
#endif
232244

233-
#if __GLASGOW_HASKELL__ > 900
245+
#if __GLASGOW_HASKELL__ >= 910
246+
noExt :: NoAnn a => a
247+
noExt = noAnn
248+
249+
instance NoAnn NoExtField where
250+
noAnn = noExtField
251+
#elif __GLASGOW_HASKELL__ > 900
234252
noExt :: EpAnn ann
235253
noExt = EpAnnNotUsed
236254
#elif __GLASGOW_HASKELL__ > 808
@@ -252,12 +270,18 @@ pattern HsParP e <- HsPar _ e
252270

253271
pattern ParPatP :: LPat p -> Pat p
254272
pattern ParPatP p <- ParPat _ p
255-
#else
273+
#elif __GLASGOW_HASKELL__ < 910
256274
pattern HsParP :: LHsExpr p -> HsExpr p
257275
pattern HsParP e <- HsPar _ _ e _
258276

259277
pattern ParPatP :: LPat p -> Pat p
260278
pattern ParPatP p <- ParPat _ _ p _
279+
#else
280+
pattern HsParP :: LHsExpr p -> HsExpr p
281+
pattern HsParP e <- HsPar _ e
282+
283+
pattern ParPatP :: LPat p -> Pat p
284+
pattern ParPatP p <- ParPat _ p
261285
#endif
262286

263287
#if __GLASGOW_HASKELL__ < 906
@@ -430,9 +454,15 @@ conPatIn loc con = ConPat noExt loc con
430454
conPatIn loc con = ConPatIn loc con
431455
#endif
432456

433-
#if __GLASGOW_HASKELL__ >= 902
457+
#if __GLASGOW_HASKELL__ >= 910
458+
noEpAnn :: NoAnn ann => GenLocated SrcSpan e -> GenLocated (EpAnn ann) e
459+
noEpAnn (L l e) = L (EpAnn (spanAsAnchor l) noAnn emptyComments) e
460+
461+
noLoc :: NoAnn ann => e -> GenLocated (EpAnn ann) e
462+
noLoc = noEpAnn . GHC.noLoc
463+
#elif __GLASGOW_HASKELL__ >= 902
434464
noEpAnn :: GenLocated SrcSpan e -> GenLocated (SrcAnn ann) e
435-
noEpAnn (L l e) = L (SrcSpanAnn EpAnnNotUsed l) e
465+
noEpAnn (L l e) = L (SrcSpanAnn noExt l) e
436466

437467
noLoc :: e -> GenLocated (SrcAnn ann) e
438468
noLoc = noEpAnn . GHC.noLoc
@@ -451,11 +481,16 @@ vecP srcLoc = \case
451481
#if __GLASGOW_HASKELL__ < 904
452482
as -> L srcLoc $ ParPat noExt $ go as
453483
where
454-
#else
484+
#elif __GLASGOW_HASKELL__ < 910
455485
as -> L srcLoc $ ParPat noExt pL (go as) pR
456486
where
457487
pL = L (GHC.mkTokenLocation $ locA srcLoc) HsTok
458488
pR = L (GHC.mkTokenLocation $ locA srcLoc) HsTok
489+
#else
490+
as -> L srcLoc $ ParPat (pL,pR) (go as)
491+
where
492+
pL = EpTok $ spanAsAnchor $ locA srcLoc
493+
pR = EpTok $ spanAsAnchor $ locA srcLoc
459494
#endif
460495
go :: [LPat GhcPs] -> LPat GhcPs
461496
go (p@(L l0 _):pats) =
@@ -505,11 +540,16 @@ varE loc rdr = L loc (HsVar noExtField (noLoc rdr))
505540
parenE :: LHsExpr GhcPs -> LHsExpr GhcPs
506541
#if __GLASGOW_HASKELL__ < 904
507542
parenE e@(L l _) = L l (HsPar noExt e)
508-
#else
543+
#elif __GLASGOW_HASKELL__ < 910
509544
parenE e@(L l _) = L l (HsPar noExt pL e pR)
510545
where
511546
pL = L (GHC.mkTokenLocation $ locA l) HsTok
512547
pR = L (GHC.mkTokenLocation $ locA l) HsTok
548+
#else
549+
parenE e@(L l _) = L l (HsPar (pL,pR) e)
550+
where
551+
pL = EpTok $ spanAsAnchor $ locA l
552+
pR = EpTok $ spanAsAnchor $ locA l
513553
#endif
514554

515555
var :: String -> GHC.RdrName
@@ -567,8 +607,10 @@ simpleLambda :: HsExpr GhcPs -> Maybe ([LPat GhcPs], LHsExpr GhcPs)
567607
simpleLambda expr = do
568608
#if __GLASGOW_HASKELL__ < 906
569609
HsLam _ (MG _x alts _origin) <- Just expr
570-
#else
610+
#elif __GLASGOW_HASKELL__ < 910
571611
HsLam _ (MG _x alts) <- Just expr
612+
#else
613+
HsLam _ _ (MG _x alts) <- Just expr
572614
#endif
573615
L _ [L _ (Match _matchX _matchContext matchPats matchGr)] <- Just alts
574616
GRHSs _grX grHss _grLocalBinds <- Just matchGr
@@ -590,8 +632,12 @@ letE
590632
letE loc sigs binds expr =
591633
#if __GLASGOW_HASKELL__ < 904
592634
L loc (HsLet noExt localBinds expr)
593-
#else
635+
#elif __GLASGOW_HASKELL__ < 908
594636
L loc (HsLet noExt tkLet localBinds tkIn expr)
637+
#elif __GLASGOW_HASKELL__ < 910
638+
L loc (HsLet noExt tkLet localBinds tkIn expr)
639+
#else
640+
L loc (HsLet (tkLet,tkIn) localBinds expr)
595641
#endif
596642
where
597643
#if __GLASGOW_HASKELL__ >= 902
@@ -602,9 +648,12 @@ letE loc sigs binds expr =
602648
localBinds = L loc $ HsValBinds noExt valBinds
603649
#endif
604650

605-
#if __GLASGOW_HASKELL__ >= 904
651+
#if __GLASGOW_HASKELL__ >= 910
652+
tkLet = EpTok $ spanAsAnchor $ locA loc
653+
tkIn = EpTok $ spanAsAnchor $ locA loc
654+
#elif __GLASGOW_HASKELL__ >= 904
606655
tkLet = L (GHC.mkTokenLocation $ locA loc) HsTok
607-
tkIn = L (GHC.mkTokenLocation $ locA loc) HsTok
656+
tkIn = L (GHC.mkTokenLocation $ locA loc) HsTok
608657
#endif
609658

610659
valBinds :: HsValBindsLR GhcPs GhcPs
@@ -615,22 +664,33 @@ letE loc sigs binds expr =
615664

616665
-- | Simple construction of a lambda expression
617666
lamE :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
618-
lamE pats expr = noLoc $ HsLam noExtField mg
667+
lamE pats expr =
668+
#if __GLASGOW_HASKELL__ >= 910
669+
noLoc $ HsLam noExt LamSingle mg
670+
#else
671+
noLoc $ HsLam noExtField mg
672+
#endif
619673
where
620674
mg :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
621675
#if __GLASGOW_HASKELL__ < 906
622676
mg = MG noExtField matches GHC.Generated
623677
#elif __GLASGOW_HASKELL__ < 908
624678
mg = MG GHC.Generated matches
625-
#else
679+
#elif __GLASGOW_HASKELL__ < 910
626680
mg = MG (GHC.Generated GHC.DoPmc) matches
681+
#else
682+
mg = MG (GHC.Generated GHC.OtherExpansion GHC.DoPmc) matches
627683
#endif
628684

629685
matches :: GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
630686
matches = noLoc $ [singleMatch]
631687

632688
singleMatch :: GenLocated SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
689+
#if __GLASGOW_HASKELL__ >= 910
690+
singleMatch = noLoc $ Match noExt (LamAlt LamSingle) pats grHss
691+
#else
633692
singleMatch = noLoc $ Match noExt LambdaExpr pats grHss
693+
#endif
634694

635695
grHss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
636696
grHss = GRHSs emptyComments [grHs] $
@@ -988,9 +1048,13 @@ decFromBinding dflags Binding {..} = do
9881048
in patBind bindPat bod
9891049

9901050
patBind :: LPat GhcPs -> LHsExpr GhcPs -> HsBind GhcPs
991-
patBind lhs expr = PatBind noExt lhs rhs
1051+
patBind lhs expr =
9921052
#if __GLASGOW_HASKELL__ < 906
993-
([], [])
1053+
PatBind noExt lhs rhs ([], [])
1054+
#elif __GLASGOW_HASKELL__ < 910
1055+
PatBind noExt lhs rhs
1056+
#else
1057+
PatBind noExt lhs (HsNoMultAnn noExt) rhs
9941058
#endif
9951059
where
9961060
rhs :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
@@ -1037,7 +1101,8 @@ tagE :: (p ~ GhcPs, ?nms :: ExternalNames) => LHsExpr p -> LHsExpr p
10371101
tagE a = varE noSrcSpanA (tagName ?nms) `appE` a
10381102

10391103
tagTypeCon :: (p ~ GhcPs, ?nms :: ExternalNames) => LHsType GhcPs
1040-
tagTypeCon = noLoc (HsTyVar noExt NotPromoted (noLoc (tagTName ?nms)))
1104+
tagTypeCon =
1105+
noLoc (HsTyVar noExt NotPromoted (noLoc (tagTName ?nms)))
10411106

10421107
sigPat :: (p ~ GhcPs) => SrcSpanAnnA -> LHsType GhcPs -> LPat p -> LPat p
10431108
sigPat loc ty a = L loc $
@@ -1087,11 +1152,14 @@ unsnoc (x:xs) = Just (x:a, b)
10871152

10881153
hsFunTy :: (p ~ GhcPs) => LHsType p -> LHsType p -> HsType p
10891154
hsFunTy =
1090-
HsFunTy noExt
1091-
#if __GLASGOW_HASKELL__ >= 900 && __GLASGOW_HASKELL__ < 904
1092-
(HsUnrestrictedArrow GHC.NormalSyntax)
1155+
#if __GLASGOW_HASKELL__ >= 910
1156+
HsFunTy noExt (HsUnrestrictedArrow noExt)
10931157
#elif __GLASGOW_HASKELL__ >= 904
1094-
(HsUnrestrictedArrow $ L NoTokenLoc HsNormalTok)
1158+
HsFunTy noExt (HsUnrestrictedArrow $ L NoTokenLoc HsNormalTok)
1159+
#elif __GLASGOW_HASKELL__ >= 900
1160+
HsFunTy noExt (HsUnrestrictedArrow GHC.NormalSyntax)
1161+
#else
1162+
HsFunTy noExt
10951163
#endif
10961164

10971165
arrTy :: p ~ GhcPs => LHsType p -> LHsType p -> LHsType p

0 commit comments

Comments
 (0)