From bc84d4eec609c1e80564f24c4927ec2e5cab49cd Mon Sep 17 00:00:00 2001
From: Martijn Bastiaan <martijn@qbaylogic.com>
Date: Sun, 21 Jul 2024 09:44:57 +0200
Subject: [PATCH 1/3] Add GHC 9.8 support

---
 .github/workflows/ci.yml |  1 +
 .vscode/settings.json    |  6 ++++++
 cabal.project            |  6 ------
 circuit-notation.cabal   |  7 ++++---
 src/CircuitNotation.hs   | 25 +++++++++++++++----------
 5 files changed, 26 insertions(+), 19 deletions(-)
 create mode 100644 .vscode/settings.json

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index a8c24e3..daba217 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -40,6 +40,7 @@ jobs:
           - "9.2.8"
           - "9.4.8"
           - "9.6.4"
+          - "9.8.2"
 
     steps:
     - uses: actions/checkout@v3
diff --git a/.vscode/settings.json b/.vscode/settings.json
new file mode 100644
index 0000000..3c26485
--- /dev/null
+++ b/.vscode/settings.json
@@ -0,0 +1,6 @@
+{
+  "files.insertFinalNewline": true,
+  "files.trimFinalNewlines": true,
+  "files.trimTrailingWhitespace": true,
+  "editor.tabSize": 2
+}
diff --git a/cabal.project b/cabal.project
index 6d8696a..e6fdbad 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1,7 +1 @@
 packages: .
-
-source-repository-package
-    type: git
-    location: https://github.com/clash-lang/clash-compiler.git
-    tag: 5b055fb3fcdaf6e2b89cb86486d7280fc781fa84
-    subdir: clash-prelude
\ No newline at end of file
diff --git a/circuit-notation.cabal b/circuit-notation.cabal
index ec6ae68..e60c919 100644
--- a/circuit-notation.cabal
+++ b/circuit-notation.cabal
@@ -19,8 +19,9 @@ library
     other-modules:
       GHC.Types.Unique.Map
 
-  other-modules:
-    GHC.Types.Unique.Map.Extra
+  if impl(ghc < 9.10)
+    other-modules:
+      GHC.Types.Unique.Map.Extra
 
   -- other-extensions:
   build-depends:
@@ -28,7 +29,7 @@ library
     , clash-prelude >= 1.0
     , containers
     , data-default
-    , ghc (>=8.6 && <8.8) || (>=8.10 && < 9.8)
+    , ghc (>=8.6 && <8.8) || (>=8.10 && < 9.10)
     , lens
     , mtl
     , parsec
diff --git a/src/CircuitNotation.hs b/src/CircuitNotation.hs
index 67bde1f..5e36429 100644
--- a/src/CircuitNotation.hs
+++ b/src/CircuitNotation.hs
@@ -133,7 +133,9 @@ import "ghc" GHC.Types.Unique.Map
 import GHC.Types.Unique.Map
 #endif
 
+#if __GLASGOW_HASKELL__ < 908
 import GHC.Types.Unique.Map.Extra
+#endif
 
 -- clash-prelude
 import Clash.Prelude (Vec((:>), Nil))
@@ -486,7 +488,7 @@ tupT tys = noLoc $ HsTupleTy noExt hsBoxedTuple tys
 
 vecT :: SrcSpanAnnA -> [LHsType GhcPs] -> LHsType GhcPs
 vecT s [] = L s $ HsParTy noExt (conT s (thName ''Vec) `appTy` tyNum s 0 `appTy` (varT s (genLocName s "vec")))
-vecT s tys = L s $ HsParTy noExt (conT s (thName ''Vec) `appTy` tyNum s (length tys) `appTy` head tys)
+vecT s tys@(ty:_) = L s $ HsParTy noExt (conT s (thName ''Vec) `appTy` tyNum s (length tys) `appTy` ty)
 
 tyNum :: SrcSpanAnnA -> Int -> LHsType GhcPs
 tyNum s i = L s (HsTyLit noExtField (HsNumTy GHC.NoSourceText (fromIntegral i)))
@@ -618,8 +620,10 @@ lamE pats expr = noLoc $ HsLam noExtField mg
     mg :: MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 #if __GLASGOW_HASKELL__ < 906
     mg = MG noExtField matches GHC.Generated
-#else
+#elif __GLASGOW_HASKELL__ < 908
     mg = MG GHC.Generated matches
+#else
+    mg = MG (GHC.Generated GHC.DoPmc) matches
 #endif
 
     matches :: GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
@@ -874,18 +878,19 @@ checkCircuit = do
       topNames = portNames Slave slaves <> portNames Master masters
       nameMap = listToUniqMap_C mappend $ topNames <> concatMap bindingNames binds
 
-  duplicateMasters <- concat <$> forM (nonDetUniqMapToList nameMap) \(name, occ) ->
+  duplicateMasters <- concat <$> forM (nonDetUniqMapToList nameMap) \(name, occ) -> do
+    let isIgnored = case unpackFS name of {('_':_) -> True; _ -> False}
+
     case occ of
+      ([], []) -> pure []
       ([_], [_]) -> pure []
-      (ss, ms) -> do
-        unless (head (unpackFS name) == '_') $ do
-          when (null ms) $ errM (locA (head ss)) $ "Slave port " <> show name <> " has no associated master"
-          when (null ss) $ errM (locA (head ms)) $ "Master port " <> show name <> " has no associated slave"
+      (s:_, []) | not isIgnored -> errM (locA s) ("Slave port " <> show name <> " has no associated master") >> pure []
+      ([], m:_) | not isIgnored -> errM (locA m) ("Master port " <> show name <> " has no associated slave") >> pure []
+      (ss@(s:_:_), _) ->
         -- would be nice to show locations of all occurrences here, not sure how to do that while
         -- keeping ghc api
-        when (length ss > 1) $
-          errM (locA (head ss)) $ "Slave port " <> show name <> " defined " <> show (length ss) <> " times"
-
+        errM (locA s) ("Slave port " <> show name <> " defined " <> show (length ss) <> " times") >> pure []
+      (_ss, ms) -> do
         -- if master is defined multiple times, we broadcast it
         if length ms > 1
           then pure [name]

From 2b919642bed19403d96c66b839699f5a1102396e Mon Sep 17 00:00:00 2001
From: Martijn Bastiaan <martijn@qbaylogic.com>
Date: Sun, 21 Jul 2024 12:28:06 +0200
Subject: [PATCH 2/3] Bump Cabal on CI

---
 .github/workflows/ci.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index daba217..ed8ef8e 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -32,7 +32,7 @@ jobs:
       fail-fast: false
       matrix:
         os: [ubuntu-latest]
-        cabal: ["3.6"]
+        cabal: ["3.12.1.0"]
         ghc:
           - "8.6.5"
           - "8.10.7"

From 47f2460ab57415ad8379c3c5591147540a11bc12 Mon Sep 17 00:00:00 2001
From: Martijn Bastiaan <martijn@qbaylogic.com>
Date: Sun, 21 Jul 2024 12:25:13 +0200
Subject: [PATCH 3/3] Add GHC 9.10 support

---
 .github/workflows/ci.yml |  1 +
 cabal.project            |  9 ++++
 circuit-notation.cabal   |  2 +-
 src/CircuitNotation.hs   | 96 ++++++++++++++++++++++++++++++++--------
 4 files changed, 89 insertions(+), 19 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index ed8ef8e..ee572d6 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -41,6 +41,7 @@ jobs:
           - "9.4.8"
           - "9.6.4"
           - "9.8.2"
+          - "9.10.1"
 
     steps:
     - uses: actions/checkout@v3
diff --git a/cabal.project b/cabal.project
index e6fdbad..6752950 100644
--- a/cabal.project
+++ b/cabal.project
@@ -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,
diff --git a/circuit-notation.cabal b/circuit-notation.cabal
index e60c919..0fa2a75 100644
--- a/circuit-notation.cabal
+++ b/circuit-notation.cabal
@@ -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
diff --git a/src/CircuitNotation.hs b/src/CircuitNotation.hs
index 5e36429..d6b4dc1 100644
--- a/src/CircuitNotation.hs
+++ b/src/CircuitNotation.hs
@@ -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 && __GLASGOW_HASKELL__ >= 904
 import qualified GHC.Parser.PostProcess       as GHC
 #endif
 
@@ -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
@@ -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
@@ -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
 
@@ -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
@@ -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
@@ -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)
@@ -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
@@ -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
@@ -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)
@@ -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
@@ -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] $
@@ -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
@@ -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