Skip to content

Commit

Permalink
Add GHC 9.10 support
Browse files Browse the repository at this point in the history
  • Loading branch information
martijnbastiaan committed Jul 21, 2024
1 parent bc84d4e commit f9dd110
Show file tree
Hide file tree
Showing 4 changed files with 89 additions and 19 deletions.
1 change: 1 addition & 0 deletions .github/workflows/ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,7 @@ jobs:
- "9.4.8"
- "9.6.4"
- "9.8.2"
- "9.10.1"

steps:
- uses: actions/checkout@v3
Expand Down
9 changes: 9 additions & 0 deletions cabal.project
Original file line number Diff line number Diff line change
@@ -1 +1,10 @@
packages: .

source-repository-package
type: git
location: https://github.com/clash-lang/clash-compiler.git
tag: c300105837fced0207963b172845186c3ae8d5f8
subdir: clash-prelude

allow-newer:
string-interpolate:template-haskell,
2 changes: 1 addition & 1 deletion circuit-notation.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ library
, clash-prelude >= 1.0
, containers
, data-default
, ghc (>=8.6 && <8.8) || (>=8.10 && < 9.10)
, ghc (>=8.6 && <8.8) || (>=8.10 && < 9.12)
, lens
, mtl
, parsec
Expand Down
96 changes: 78 additions & 18 deletions src/CircuitNotation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -103,6 +103,8 @@ import GHC.Driver.Errors.Ppr () -- instance Diagnostic GhcMessage
import qualified GHC.Driver.Config.Diagnostic as GHC
import qualified GHC.Driver.Errors.Types as GHC
import qualified GHC.Utils.Logger as GHC
#endif
#if __GLASGOW_HASKELL__ < 910
import qualified GHC.Parser.PostProcess as GHC
#endif

Expand Down Expand Up @@ -207,11 +209,20 @@ locA = id
#else
type MsgDoc = Outputable.SDoc

#if __GLASGOW_HASKELL__ < 910
locA :: SrcSpanAnn' a -> SrcSpan
#else
locA :: EpAnn ann -> SrcSpan
#endif
locA = GHC.locA

#if __GLASGOW_HASKELL__ < 910
noAnnSortKey :: AnnSortKey
noAnnSortKey = NoAnnSortKey
#else
noAnnSortKey :: AnnSortKey tag
noAnnSortKey = NoAnnSortKey
#endif
#endif

#if __GLASGOW_HASKELL__ < 902
Expand All @@ -230,7 +241,10 @@ sevFatal :: Err.MessageClass
sevFatal = Err.MCFatal
#endif

#if __GLASGOW_HASKELL__ > 900
#if __GLASGOW_HASKELL__ > 908
noExt :: NoAnn a => a
noExt = noAnn
#elif __GLASGOW_HASKELL__ > 900
noExt :: EpAnn ann
noExt = EpAnnNotUsed
#elif __GLASGOW_HASKELL__ > 808
Expand All @@ -246,7 +260,7 @@ noExtField = NoExt
type NoExtField = NoExt
#endif

#if __GLASGOW_HASKELL__ < 904
#if __GLASGOW_HASKELL__ < 904 || __GLASGOW_HASKELL__ >= 910
pattern HsParP :: LHsExpr p -> HsExpr p
pattern HsParP e <- HsPar _ e

Expand Down Expand Up @@ -430,12 +444,15 @@ conPatIn loc con = ConPat noExt loc con
conPatIn loc con = ConPatIn loc con
#endif

#if __GLASGOW_HASKELL__ >= 902
noEpAnn :: GenLocated SrcSpan e -> GenLocated (SrcAnn ann) e
noEpAnn (L l e) = L (SrcSpanAnn EpAnnNotUsed l) e

#if __GLASGOW_HASKELL__ >= 910
noLoc :: NoAnn ann => e -> GenLocated (EpAnn ann) e
noLoc = L noAnn
#elif __GLASGOW_HASKELL__ >= 902
noLoc :: e -> GenLocated (SrcAnn ann) e
noLoc = noEpAnn . GHC.noLoc
where
noEpAnn :: GenLocated SrcSpan e -> GenLocated (SrcAnn ann) e
noEpAnn (L l e) = L (SrcSpanAnn EpAnnNotUsed l) e
#else
noLoc :: e -> Located e
noLoc = GHC.noLoc
Expand All @@ -448,7 +465,7 @@ tupP pats = noLoc $ TuplePat noExt pats GHC.Boxed
vecP :: (?nms :: ExternalNames) => SrcSpanAnnA -> [LPat GhcPs] -> LPat GhcPs
vecP srcLoc = \case
[] -> go []
#if __GLASGOW_HASKELL__ < 904
#if __GLASGOW_HASKELL__ < 904 || __GLASGOW_HASKELL__ >= 910
as -> L srcLoc $ ParPat noExt $ go as
where
#else
Expand Down Expand Up @@ -497,13 +514,19 @@ appTy :: LHsType GhcPs -> LHsType GhcPs -> LHsType GhcPs
appTy a b = noLoc (HsAppTy noExtField a (parenthesizeHsType GHC.appPrec b))

appE :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
appE fun arg = L noSrcSpanA $ HsApp noExt fun (parenthesizeHsExpr GHC.appPrec arg)
appE fun arg = L noSrcSpanA $ HsApp
#if __GLASGOW_HASKELL__ >= 910
noExtField
#else
noExt
#endif
fun (parenthesizeHsExpr GHC.appPrec arg)

varE :: SrcSpanAnnA -> GHC.RdrName -> LHsExpr GhcPs
varE loc rdr = L loc (HsVar noExtField (noLoc rdr))

parenE :: LHsExpr GhcPs -> LHsExpr GhcPs
#if __GLASGOW_HASKELL__ < 904
#if __GLASGOW_HASKELL__ < 904 || __GLASGOW_HASKELL__ >= 910
parenE e@(L l _) = L l (HsPar noExt e)
#else
parenE e@(L l _) = L l (HsPar noExt pL e pR)
Expand Down Expand Up @@ -533,7 +556,9 @@ tupE :: p ~ GhcPs => SrcSpanAnnA -> [LHsExpr p] -> LHsExpr p
tupE _ [ele] = ele
tupE loc elems = L loc $ ExplicitTuple noExt tupArgs GHC.Boxed
where
#if __GLASGOW_HASKELL__ >= 902
#if __GLASGOW_HASKELL__ >= 910
tupArgs = map (Present noExtField) elems
#elif __GLASGOW_HASKELL__ >= 902
tupArgs = map (Present noExt) elems
#else
tupArgs = map (\arg@(L l _) -> L l (Present noExt arg)) elems
Expand Down Expand Up @@ -567,8 +592,10 @@ simpleLambda :: HsExpr GhcPs -> Maybe ([LPat GhcPs], LHsExpr GhcPs)
simpleLambda expr = do
#if __GLASGOW_HASKELL__ < 906
HsLam _ (MG _x alts _origin) <- Just expr
#else
#elif __GLASGOW_HASKELL__ < 910
HsLam _ (MG _x alts) <- Just expr
#else
HsLam _ _ (MG _x alts) <- Just expr
#endif
L _ [L _ (Match _matchX _matchContext matchPats matchGr)] <- Just alts
GRHSs _grX grHss _grLocalBinds <- Just matchGr
Expand All @@ -588,7 +615,7 @@ letE
-- ^ final `in` expressions
-> LHsExpr p
letE loc sigs binds expr =
#if __GLASGOW_HASKELL__ < 904
#if __GLASGOW_HASKELL__ < 904 || __GLASGOW_HASKELL__ >= 910
L loc (HsLet noExt localBinds expr)
#else
L loc (HsLet noExt tkLet localBinds tkIn expr)
Expand All @@ -602,7 +629,7 @@ letE loc sigs binds expr =
localBinds = L loc $ HsValBinds noExt valBinds
#endif

#if __GLASGOW_HASKELL__ >= 904
#if __GLASGOW_HASKELL__ >= 904 && __GLASGOW_HASKELL__ < 910
tkLet = L (GHC.mkTokenLocation $ locA loc) HsTok
tkIn = L (GHC.mkTokenLocation $ locA loc) HsTok
#endif
Expand All @@ -615,22 +642,38 @@ letE loc sigs binds expr =

-- | Simple construction of a lambda expression
lamE :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
lamE pats expr = noLoc $ HsLam noExtField mg
lamE pats expr = noLoc $ HsLam
#if __GLASGOW_HASKELL__ >= 910
noAnn
LamSingle
#else
noExtField
#endif
mg
where
mg :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
#if __GLASGOW_HASKELL__ < 906
mg = MG noExtField matches GHC.Generated
#elif __GLASGOW_HASKELL__ < 908
mg = MG GHC.Generated matches
#else
#elif __GLASGOW_HASKELL__ < 910
mg = MG (GHC.Generated GHC.DoPmc) matches
#else
-- TODO: Add explanation
mg = MG (GHC.Generated GHC.OtherExpansion GHC.DoPmc) matches
#endif

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

singleMatch :: GenLocated SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
singleMatch = noLoc $ Match noExt LambdaExpr pats grHss
singleMatch = noLoc $ Match noExt
#if __GLASGOW_HASKELL__ < 910
LambdaExpr
#else
(LamAlt LamSingle)
#endif
pats grHss

grHss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grHss = GRHSs emptyComments [grHs] $
Expand Down Expand Up @@ -988,7 +1031,17 @@ decFromBinding dflags Binding {..} = do
in patBind bindPat bod

patBind :: LPat GhcPs -> LHsExpr GhcPs -> HsBind GhcPs
patBind lhs expr = PatBind noExt lhs rhs
patBind lhs expr = PatBind
#if __GLASGOW_HASKELL__ >= 910
noExtField
#else
noExt
#endif
lhs
#if __GLASGOW_HASKELL__ >= 910
(HsNoMultAnn noExtField)
#endif
rhs
#if __GLASGOW_HASKELL__ < 906
([], [])
#endif
Expand Down Expand Up @@ -1087,9 +1140,16 @@ unsnoc (x:xs) = Just (x:a, b)

hsFunTy :: (p ~ GhcPs) => LHsType p -> LHsType p -> HsType p
hsFunTy =
HsFunTy noExt
HsFunTy
#if __GLASGOW_HASKELL__ >= 910
noExtField
#else
noExt
#endif
#if __GLASGOW_HASKELL__ >= 900 && __GLASGOW_HASKELL__ < 904
(HsUnrestrictedArrow GHC.NormalSyntax)
#elif __GLASGOW_HASKELL__ >= 910
(HsUnrestrictedArrow NoEpUniTok)
#elif __GLASGOW_HASKELL__ >= 904
(HsUnrestrictedArrow $ L NoTokenLoc HsNormalTok)
#endif
Expand Down

0 comments on commit f9dd110

Please sign in to comment.