diff --git a/.ci/apply_settings.sh b/.ci/apply_settings.sh new file mode 100755 index 00000000..7dbf9a70 --- /dev/null +++ b/.ci/apply_settings.sh @@ -0,0 +1,8 @@ +#!/bin/bash + +if [[ "$check_haddock" != @(True|False) ]]; then + echo "check_haddock: Expected True or False, got \"$check_haddock\"" >&2 + exit 1 +fi +sed <.ci/cabal.project.local.in >cabal.project.local " + s/__CHECK_HADDOCK__/$check_haddock/" diff --git a/.ci/build_docs.sh b/.ci/build_docs.sh index acd1ccf4..611f80d0 100755 --- a/.ci/build_docs.sh +++ b/.ci/build_docs.sh @@ -1,21 +1,8 @@ #!/bin/bash set -xeou pipefail -# Build dependencies first, so they don't end up in logs -cabal v2-build \ - --constraint=clash-prelude==$clash_version \ - --enable-documentation \ - --allow-newer=circuit-notation:ghc \ - clash-protocols - -# circuit-notation currently _compiles on 8.10, but isn't usable. The only -# other GHC version it supports is 8.6.5, but this GHC bundles a Haddock that -# cannot generate documentation for clash-prelude. Hence, we build docs with -# 8.10 and relax circuit-notation's ghc bounds cabal v2-haddock \ --constraint=clash-prelude==$clash_version \ - --enable-documentation \ - --allow-newer=circuit-notation:ghc \ clash-protocols \ |& tee haddock_log diff --git a/.ci/cabal.project.local b/.ci/cabal.project.local deleted file mode 100644 index 45955b61..00000000 --- a/.ci/cabal.project.local +++ /dev/null @@ -1,2 +0,0 @@ -package clash-protocols - ghc-options: -Werror diff --git a/.ci/cabal.project.local.in b/.ci/cabal.project.local.in new file mode 100644 index 00000000..179f79dc --- /dev/null +++ b/.ci/cabal.project.local.in @@ -0,0 +1,6 @@ +package * + documentation: __CHECK_HADDOCK__ + +package clash-protocols + documentation: False + ghc-options: -Werror diff --git a/.ci/test_cabal.sh b/.ci/test_cabal.sh index bff7362f..337c0ac5 100755 --- a/.ci/test_cabal.sh +++ b/.ci/test_cabal.sh @@ -1,7 +1,6 @@ #!/bin/bash set -xeou pipefail -cabal v2-build all --constraint=clash-prelude==$clash_version -fci cabal v2-run unittests --constraint=clash-prelude==$clash_version -fci --enable-tests cabal v2-run doctests --constraint=clash-prelude==$clash_version -fci --enable-tests cabal v2-sdist clash-protocols diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index d0432143..2ce36633 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -47,23 +47,32 @@ jobs: .ci/test_stack.sh cabal: - name: Cabal tests - ghc ${{ matrix.ghc }} / clash ${{ matrix.clash }} + name: Cabal tests - ghc ${{ matrix.ghc }} / clash ${{ matrix.clash }} / doc ${{ matrix.check_haddock }} runs-on: ${{ matrix.os }} strategy: fail-fast: false matrix: os: [ubuntu-latest] clash: - - "1.8.1" + - "1.8.2" cabal: - "3.10" ghc: - "9.0.2" - "9.2.8" - "9.4.8" - - "9.6.4" + - "9.8.4" + - "9.10.1" + include: + - check_haddock: "False" + - ghc: "9.6.4" + check_haddock: "True" + os: "ubuntu-latest" + clash: "1.8.2" + cabal: "3.10" env: + check_haddock: ${{ matrix.check_haddock }} clash_version: ${{ matrix.clash }} steps: @@ -79,7 +88,7 @@ jobs: - name: Use CI specific settings run: | - cp .ci/cabal.project.local . + .ci/apply_settings.sh - name: Setup CI run: | @@ -105,6 +114,7 @@ jobs: .ci/test_cabal.sh - name: Documentation + if: ${{ matrix.check_haddock == 'True' }} run: | .ci/build_docs.sh diff --git a/cabal.project b/cabal.project index 616dc414..7701aa7c 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ package clash-prelude source-repository-package type: git location: https://github.com/cchalmers/circuit-notation.git - tag: 19b386c4aa3ff690758ae089c7754303f3500cc9 + tag: 564769c52aa05b90f81bbc898b7af7087d96613d package clash-protocols-base -- Reduces compile times by ~20% diff --git a/clash-protocols-base/clash-protocols-base.cabal b/clash-protocols-base/clash-protocols-base.cabal index 8eabf2bd..d42c32ad 100644 --- a/clash-protocols-base/clash-protocols-base.cabal +++ b/clash-protocols-base/clash-protocols-base.cabal @@ -104,7 +104,7 @@ library , circuit-notation , deepseq , extra - , ghc >= 8.7 && < 9.7 + , ghc >= 8.7 && < 9.11 , hashable , tagged , template-haskell diff --git a/clash-protocols/clash-protocols.cabal b/clash-protocols/clash-protocols.cabal index 6143620d..c797c3d7 100644 --- a/clash-protocols/clash-protocols.cabal +++ b/clash-protocols/clash-protocols.cabal @@ -120,7 +120,6 @@ library , data-default ^>= 0.7.1.1 , deepseq , extra - , ghc >= 8.7 && < 9.7 , hashable , hedgehog >= 1.0.2 , lifted-async diff --git a/clash-protocols/src/Protocols/Avalon/Stream.hs b/clash-protocols/src/Protocols/Avalon/Stream.hs index e7b69a74..660a8189 100644 --- a/clash-protocols/src/Protocols/Avalon/Stream.hs +++ b/clash-protocols/src/Protocols/Avalon/Stream.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -140,7 +141,8 @@ Manager can only send 'AvalonStreamM2S' when '_ready' was true @readyLatency@ clock cycles ago. -} newtype AvalonStreamS2M (readyLatency :: Nat) = AvalonStreamS2M {_ready :: Bool} - deriving (Generic, C.NFDataX, C.ShowX, Eq, NFData, Show, Bundle) + deriving stock (Generic, Show, Eq) + deriving anyclass (C.NFDataX, C.ShowX, NFData, Bundle) -- | Type for Avalon Stream protocol. data AvalonStream (dom :: Domain) (conf :: AvalonStreamConfig) (dataType :: Type) diff --git a/clash-protocols/src/Protocols/Axi4/ReadAddress.hs b/clash-protocols/src/Protocols/Axi4/ReadAddress.hs index 7dde8f45..380d422e 100644 --- a/clash-protocols/src/Protocols/Axi4/ReadAddress.hs +++ b/clash-protocols/src/Protocols/Axi4/ReadAddress.hs @@ -189,7 +189,8 @@ data -- | See Table A2-5 "Read address channel signals" newtype S2M_ReadAddress = S2M_ReadAddress {_arready :: Bool} - deriving (Show, Generic, C.NFDataX) + deriving stock (Show, Generic) + deriving anyclass (C.NFDataX) {- | Shorthand for a "well-behaved" read address config, so that we don't need to write out a bunch of type constraints later. diff --git a/clash-protocols/src/Protocols/Axi4/ReadData.hs b/clash-protocols/src/Protocols/Axi4/ReadData.hs index 4d9d27d7..653a103f 100644 --- a/clash-protocols/src/Protocols/Axi4/ReadData.hs +++ b/clash-protocols/src/Protocols/Axi4/ReadData.hs @@ -111,7 +111,8 @@ data -- | See Table A2-6 "Read data channel signals" newtype M2S_ReadData = M2S_ReadData {_rready :: Bool} - deriving (Show, Generic, C.NFDataX) + deriving stock (Show, Generic) + deriving anyclass (C.NFDataX) {- | Shorthand for a "well-behaved" read data config, so that we don't need to write out a bunch of type constraints later. diff --git a/clash-protocols/src/Protocols/Axi4/Stream.hs b/clash-protocols/src/Protocols/Axi4/Stream.hs index e8214d15..2204121d 100644 --- a/clash-protocols/src/Protocols/Axi4/Stream.hs +++ b/clash-protocols/src/Protocols/Axi4/Stream.hs @@ -103,7 +103,8 @@ Manager may not decide whether or not to send 'Nothing' based on the '_tready' signal. -} newtype Axi4StreamS2M = Axi4StreamS2M {_tready :: Bool} - deriving (Generic, C.NFDataX, C.ShowX, Eq, NFData, Show, Bundle) + deriving stock (Show, Eq, Generic) + deriving anyclass (C.NFDataX, C.ShowX, NFData, Bundle) -- | Type for AXI4 Stream protocol. data Axi4Stream (dom :: Domain) (conf :: Axi4StreamConfig) (userType :: Type) diff --git a/clash-protocols/src/Protocols/Axi4/WriteAddress.hs b/clash-protocols/src/Protocols/Axi4/WriteAddress.hs index b902b17f..88616ae2 100644 --- a/clash-protocols/src/Protocols/Axi4/WriteAddress.hs +++ b/clash-protocols/src/Protocols/Axi4/WriteAddress.hs @@ -186,7 +186,8 @@ data -- | See Table A2-2 "Write address channel signals" newtype S2M_WriteAddress = S2M_WriteAddress {_awready :: Bool} - deriving (Show, Generic, C.NFDataX) + deriving stock (Show, Generic) + deriving anyclass (C.NFDataX) {- | Shorthand for a "well-behaved" write address config, so that we don't need to write out a bunch of type constraints later. diff --git a/clash-protocols/src/Protocols/Axi4/WriteData.hs b/clash-protocols/src/Protocols/Axi4/WriteData.hs index 3bfc207d..cf1b1740 100644 --- a/clash-protocols/src/Protocols/Axi4/WriteData.hs +++ b/clash-protocols/src/Protocols/Axi4/WriteData.hs @@ -105,7 +105,8 @@ data -- | See Table A2-3 "Write data channel signals" newtype S2M_WriteData = S2M_WriteData {_wready :: Bool} - deriving (Show, Generic, C.NFDataX) + deriving stock (Show, Generic) + deriving anyclass (C.NFDataX) {- | Shorthand for a "well-behaved" write data config, so that we don't need to write out a bunch of type constraints later. diff --git a/clash-protocols/src/Protocols/Axi4/WriteResponse.hs b/clash-protocols/src/Protocols/Axi4/WriteResponse.hs index 53b46c13..dc7df4b7 100644 --- a/clash-protocols/src/Protocols/Axi4/WriteResponse.hs +++ b/clash-protocols/src/Protocols/Axi4/WriteResponse.hs @@ -90,7 +90,8 @@ data -- | See Table A2-4 "Write response channel signals" newtype M2S_WriteResponse = M2S_WriteResponse {_bready :: Bool} - deriving (Show, Generic, C.NFDataX) + deriving stock (Show, Generic) + deriving anyclass (C.NFDataX) {- | Shorthand for a "well-behaved" write response config, so that we don't need to write out a bunch of type constraints later. diff --git a/clash-protocols/src/Protocols/Df.hs b/clash-protocols/src/Protocols/Df.hs index 73c14079..ea0ec040 100644 --- a/clash-protocols/src/Protocols/Df.hs +++ b/clash-protocols/src/Protocols/Df.hs @@ -114,9 +114,13 @@ import Prelude hiding ( import qualified Data.Bifunctor as B import Data.Bool (bool) import qualified Data.Coerce as Coerce +#if MIN_VERSION_base(4,19,0) +import qualified Data.Functor as Functor (unzip) +#else +import qualified Data.List.NonEmpty as Functor (unzip) +#endif import Data.Kind (Type) import Data.List ((\\)) -import qualified Data.List.NonEmpty import qualified Data.Maybe as Maybe import Data.Proxy import qualified Prelude as P @@ -862,7 +866,7 @@ roundrobinCollect Parallel = nacks = C.repeat (Ack False) acks = Maybe.fromMaybe nacks ((\i -> C.replace i ack nacks) <$> iM) dat1 = Maybe.fromMaybe NoData dat0 - (iM, dat0) = Data.List.NonEmpty.unzip dats1 + (iM, dat0) = Functor.unzip dats1 dats1 = C.fold @(n C.- 1) (<|>) (C.zipWith goDat C.indicesI dats0) goDat i dat diff --git a/clash-protocols/src/Protocols/Internal.hs b/clash-protocols/src/Protocols/Internal.hs index 34ef214e..230e38b6 100644 --- a/clash-protocols/src/Protocols/Internal.hs +++ b/clash-protocols/src/Protocols/Internal.hs @@ -6,9 +6,7 @@ {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fconstraint-solver-iterations=20 #-} -#if !MIN_VERSION_clash_prelude(1, 8, 2) {-# OPTIONS_GHC -fno-warn-orphans #-} -#endif -- TODO: Hide internal documentation -- {-# OPTIONS_HADDOCK hide #-} diff --git a/clash-protocols/src/Protocols/PacketStream/Hedgehog.hs b/clash-protocols/src/Protocols/PacketStream/Hedgehog.hs index 4e0549b7..67772f59 100644 --- a/clash-protocols/src/Protocols/PacketStream/Hedgehog.hs +++ b/clash-protocols/src/Protocols/PacketStream/Hedgehog.hs @@ -216,7 +216,12 @@ depacketizerModel toMetaOut ps = L.concat dataWidthPackets _ -> fwdF hdr = bitCoerce $ Vec.unsafeFromList @headerBytes $ _data <$> hdrF - metaOut = toMetaOut hdr (_meta $ L.head hdrF) + metaIn = case hdrF of + [] -> + -- There are @headerBytes@ packets in this list, and (1 <= headerBytes) + error "depacketizerModel: absurd" + (hdrF0 : _) -> _meta hdrF0 + metaOut = toMetaOut hdr metaIn bytePackets :: [[PacketStreamM2S 1 metaIn]] bytePackets = @@ -257,10 +262,14 @@ depacketizeToDfModel :: depacketizeToDfModel toOut ps = L.map parseHdr bytePackets where parseHdr :: [PacketStreamM2S 1 metaIn] -> a - parseHdr hdrF = + parseHdr [] = + -- There are at least @headerBytes@ packets in this list, and + -- (1 <= headerBytes) + error "depacketizeToDfModel: absurd" + parseHdr hdrF@(hdrF0 : _) = toOut (bitCoerce $ Vec.unsafeFromList $ L.map _data hdrF) - (_meta $ L.head hdrF) + (_meta hdrF0) bytePackets :: [[PacketStreamM2S 1 metaIn]] bytePackets = @@ -313,9 +322,13 @@ packetizerModel :: packetizerModel toMetaOut toHeader ps = L.concatMap (upConvert . prependHdr) bytePackets where prependHdr :: [PacketStreamM2S 1 metaIn] -> [PacketStreamM2S 1 metaOut] - prependHdr fragments = hdr L.++ L.map (\f -> f{_meta = metaOut}) fragments + prependHdr [] = + -- 'chunkBy' filters empty lists, so all elements of bytePackets are + -- guaranteed to be non-null + error "packetizerModel: Unreachable code" + prependHdr fragments@(h : _) = + hdr L.++ L.map (\f -> f{_meta = metaOut}) fragments where - h = L.head fragments metaOut = toMetaOut (_meta h) hdr = L.map go (toList $ bitCoerce (toHeader (_meta h))) go byte = PacketStreamM2S (singleton byte) Nothing metaOut (_abort h) diff --git a/clash-protocols/src/Protocols/Wishbone.hs b/clash-protocols/src/Protocols/Wishbone.hs index 689d26d1..1c49fcfc 100644 --- a/clash-protocols/src/Protocols/Wishbone.hs +++ b/clash-protocols/src/Protocols/Wishbone.hs @@ -171,7 +171,8 @@ instance (C.ShowX dat) => Show (WishboneS2M dat) where increase throughput by reducing handshake-overhead -} newtype CycleTypeIdentifier = CycleTypeIdentifier (C.BitVector 3) - deriving (NFData, C.Generic, C.NFDataX, Show, C.ShowX, Eq, C.BitPack) + deriving stock (Eq, Show, C.Generic) + deriving anyclass (NFData, C.NFDataX, C.ShowX, C.BitPack) pattern Classic diff --git a/clash-protocols/tests/Tests/Protocols/PacketStream/Padding.hs b/clash-protocols/tests/Tests/Protocols/PacketStream/Padding.hs index 43ade268..b67d290c 100644 --- a/clash-protocols/tests/Tests/Protocols/PacketStream/Padding.hs +++ b/clash-protocols/tests/Tests/Protocols/PacketStream/Padding.hs @@ -33,7 +33,12 @@ stripPaddingModel packets = L.concatMap go (chunkByPacket packets) go packet | packetBytes == expectedSize = packet | packetBytes > expectedSize = - x L.++ [(L.head padding){_last = Just 0, _abort = any _abort padding}] + case padding of + [] -> + -- There are (packetBytes - expectedSize) bytes, so more than 0 + error "stripPaddingModel: absurd" + (padding0 : _) -> + x L.++ [padding0{_last = Just 0, _abort = any _abort padding}] | otherwise = a L.++ [b{_abort = True}] where (a, b) = case L.unsnoc packet of diff --git a/clash-protocols/tests/Tests/Protocols/PacketStream/Routing.hs b/clash-protocols/tests/Tests/Protocols/PacketStream/Routing.hs index 1ddb7521..924bd758 100644 --- a/clash-protocols/tests/Tests/Protocols/PacketStream/Routing.hs +++ b/clash-protocols/tests/Tests/Protocols/PacketStream/Routing.hs @@ -62,10 +62,13 @@ makePropPacketArbiter SNat SNat mode = pure $ L.map (\pkt -> pkt{_meta = j}) pkts partitionPackets packets = - L.sortOn (_meta . L.head . L.head) + L.sortOn getMeta $ L.groupBy (\a b -> _meta a == _meta b) <$> chunkByPacket packets + getMeta ((pkt : _) : _) = _meta pkt + getMeta _ = error "makePropPacketArbiter: empty partition" + {- | Generic test function for the packet dispatcher, testing for all data widths, dispatch functions, and some meta types. diff --git a/stack.yaml b/stack.yaml index 03dae6aa..f93ba15c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,6 +6,6 @@ packages: extra-deps: - git: https://github.com/cchalmers/circuit-notation.git - commit: 19b386c4aa3ff690758ae089c7754303f3500cc9 + commit: 564769c52aa05b90f81bbc898b7af7087d96613d - clash-prelude-1.8.1 - clash-prelude-hedgehog-1.8.1