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]