Skip to content

Commit

Permalink
Add GHC 9.8 support (#22)
Browse files Browse the repository at this point in the history
  • Loading branch information
martijnbastiaan authored Jul 21, 2024
1 parent 19b386c commit 39eb0ec
Show file tree
Hide file tree
Showing 5 changed files with 26 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 @@ -40,6 +40,7 @@ jobs:
- "9.2.8"
- "9.4.8"
- "9.6.4"
- "9.8.2"

steps:
- uses: actions/checkout@v3
Expand Down
6 changes: 6 additions & 0 deletions .vscode/settings.json
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
{
"files.insertFinalNewline": true,
"files.trimFinalNewlines": true,
"files.trimTrailingWhitespace": true,
"editor.tabSize": 2
}
6 changes: 0 additions & 6 deletions cabal.project
Original file line number Diff line number Diff line change
@@ -1,7 +1 @@
packages: .

source-repository-package
type: git
location: https://github.com/clash-lang/clash-compiler.git
tag: 5b055fb3fcdaf6e2b89cb86486d7280fc781fa84
subdir: clash-prelude
7 changes: 4 additions & 3 deletions circuit-notation.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -19,16 +19,17 @@ 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:
base >=4.12
, 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
Expand Down
25 changes: 15 additions & 10 deletions src/CircuitNotation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down Expand Up @@ -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)))
Expand Down Expand Up @@ -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)))]
Expand Down Expand Up @@ -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]
Expand Down

0 comments on commit 39eb0ec

Please sign in to comment.