clash-prelude 1.2.0 → 1.2.1

raw patch · 52 files changed

+1753/−968 lines, 52 filesdep ~QuickCheckdep ~basedep ~ghc-typelits-extrabuild-type:Customsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: QuickCheck, base, ghc-typelits-extra, ghc-typelits-natnormalise, time

API changes (from Hackage documentation)

Files

• CHANGELOG.md +18/−0
• Setup.hs +21/−0
• benchmarks/BenchUnsigned.hs +41/−0
• benchmarks/BenchVector.hs +46/−0
• benchmarks/benchmark-main.hs +2/−0
• clash-prelude.cabal +22/−11
• src/Clash/Annotations/BitRepresentation/Util.hs +3/−1
• src/Clash/Annotations/Primitive.hs +5/−5
• src/Clash/Annotations/SynthesisAttributes.hs +1/−1
• src/Clash/Annotations/TH.hs +4/−3
• src/Clash/Class/BitPack.hs +4/−4
• src/Clash/Class/Parity.hs +1/−0
• src/Clash/Examples.hs +3/−282
• src/Clash/Examples/Internal.hs +290/−0
• src/Clash/Explicit/BlockRam.hs +119/−117
• src/Clash/Explicit/DDR.hs +15/−4
• src/Clash/Explicit/Mealy.hs +2/−0
• src/Clash/Explicit/Moore.hs +2/−0
• src/Clash/Explicit/Prelude.hs +1/−0
• src/Clash/Explicit/Prelude/Safe.hs +3/−1
• src/Clash/Explicit/Signal.hs +6/−1
• src/Clash/Explicit/Signal/Delayed.hs +2/−0
• src/Clash/Explicit/Testbench.hs +3/−0
• src/Clash/Prelude/BitIndex.hs +2/−2
• src/Clash/Prelude/BlockRam.hs +112/−109
• src/Clash/Prelude/Mealy.hs +3/−0
• src/Clash/Prelude/Moore.hs +2/−0
• src/Clash/Prelude/Safe.hs +2/−0
• src/Clash/Prelude/Testbench.hs +17/−10
• src/Clash/Promoted/Nat.hs +31/−3
• src/Clash/Signal.hs +33/−22
• src/Clash/Signal/BiSignal.hs +16/−15
• src/Clash/Signal/Bundle.hs +1/−1
• src/Clash/Signal/Delayed.hs +2/−0
• src/Clash/Signal/Delayed/Internal.hs +3/−0
• src/Clash/Signal/Internal.hs +3/−0
• src/Clash/Signal/Trace.hs +2/−1
• src/Clash/Sized/Internal/BitVector.hs +230/−155
• src/Clash/Sized/Internal/Index.hs +28/−13
• src/Clash/Sized/Internal/Mod.hs +211/−0
• src/Clash/Sized/Internal/Signed.hs +183/−69
• src/Clash/Sized/Internal/Unsigned.hs +123/−66
• src/Clash/Sized/RTree.hs +2/−0
• src/Clash/Sized/Vector.hs +51/−9
• src/Clash/Tutorial.hs +24/−21
• src/Clash/XException.hs +5/−0
• tests/Clash/Tests/BitPack.hs +3/−0
• tests/Clash/Tests/BitVector.hs +12/−1
• tests/Clash/Tests/Signed.hs +12/−0
• tests/Clash/Tests/TopEntityGeneration.hs +6/−6
• tests/Clash/Tests/Unsigned.hs +13/−1
• tests/doctests.hs +7/−34

@@ -1,5 +1,23 @@ # Changelog for the Clash project +## 1.2.1 *April 23rd 2020*+* Changed:+ * Treat `Signed 0`, `Unsigned 0`, `Index 1`, `BitVector 0` as unit. In effect this means that 'minBound' and 'maxBound' return 0, whereas previously they might crash [#1183](https://github.com/clash-lang/clash-compiler/issues/1183)+ * Infix use of `deepseqX` is now right-associative++* Added:+  * Add 'natToInteger', 'natToNatural', and 'natToNum'. Similar to 'snatTo*', but works solely on a type argument instead of an SNat.+  * `Clash.Sized.Vector.unfoldr` and `Clash.Sized.Vector.unfoldrI` to construct vectors from a seed value+  * Added NFDataX instances for `Data.Monoid.{First,Last}`++* Fixed:+ * The Verilog backend can now deal with non-contiguous ranges in custom bit-representations.+ * Synthesizing BitPack instances for type with phantom parameter fails [#1242](https://github.com/clash-lang/clash-compiler/issues/1242)+ * Synthesis of `fromBNat (toBNat d5)` failed due to `unsafeCoerce` coercing from `Any`+ * Memory leak in register primitives [#1256](https://github.com/clash-lang/clash-compiler/issues/1256)+ * Illegal VHDL slice when projecting nested SOP type [#1254](https://github.com/clash-lang/clash-compiler/issues/1254)+ * Vivado VHDL code path (`-fclash-hdlsyn Vivado`) generates illegal VHDL [#1264](https://github.com/clash-lang/clash-compiler/issues/1264)+ ## 1.2.0 *March 5th 2020* As promised when releasing 1.0, we've tried our best to keep the API stable. We think most designs will continue to compile with this new version, although special

@@ -1,2 +1,23 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where+#ifndef MIN_VERSION_cabal_doctest+#define MIN_VERSION_cabal_doctest(x,y,z) 0+#endif+#if MIN_VERSION_cabal_doctest(1,0,0)+import Distribution.Extra.Doctest ( defaultMainWithDoctests )+main :: IO ()+main = defaultMainWithDoctests "doctests"+#else+#ifdef MIN_VERSION_Cabal+-- If the macro is defined, we have new cabal-install,+-- but for some reason we don't have cabal-doctest in package-db+--+-- Probably we are running cabal sdist, when otherwise using new-build+-- workflow+import Warning ()+#endif import Distribution.Simple+main :: IO () main = defaultMain+#endif

@@ -10,6 +10,7 @@ module BenchUnsigned (unsignedBench) where  import Data.Bits+import Data.Word import Clash.Class.Num import Clash.Class.BitPack import Clash.Sized.BitVector@@ -47,6 +48,10 @@   , orBenchL   , complementBench   , complementBenchL+  , unsigned8toWord8Bench+  , unsigned16toWord16Bench+  , unsigned32toWord32Bench+  , unsignedToWordBench   ]  smallValueI :: Integer@@ -61,6 +66,18 @@ smallValue2 = $(lift (2^(16::Int)-100 :: Unsigned WORD_SIZE_IN_BITS)) {-# INLINE smallValue2 #-} +smallValueW8 :: Unsigned 8+smallValueW8 = $(lift (2^(4::Int)-10 :: Unsigned 8))+{-# INLINE smallValueW8 #-}++smallValueW16 :: Unsigned 16+smallValueW16 = $(lift (2^(8::Int)-10 :: Unsigned 16))+{-# INLINE smallValueW16 #-}++smallValueW32 :: Unsigned 32+smallValueW32 = $(lift (2^(16::Int)-10 :: Unsigned 32))+{-# INLINE smallValueW32 #-}+ smallValueBV :: BitVector WORD_SIZE_IN_BITS smallValueBV = $(lift (2^(16::Int)-10 :: BitVector WORD_SIZE_IN_BITS)) {-# INLINE smallValueBV #-}@@ -224,3 +241,27 @@   bench "complement 3*WORD_SIZE_IN_BITS" $ nf complement m   where     setup = return largeValue1++unsigned8toWord8Bench :: Benchmark+unsigned8toWord8Bench = env setup $ \m ->+  bench "unsigned8toWord8 WORD_SIZE_IN_BITS" $ nf (bitCoerce :: Unsigned 8 -> Word8) m+  where+    setup = return smallValueW8++unsigned16toWord16Bench :: Benchmark+unsigned16toWord16Bench = env setup $ \m ->+  bench "unsigned16toWord16 WORD_SIZE_IN_BITS" $ nf (bitCoerce :: Unsigned 16 -> Word16) m+  where+    setup = return smallValueW16++unsigned32toWord32Bench :: Benchmark+unsigned32toWord32Bench = env setup $ \m ->+  bench "unsigned32toWord32 WORD_SIZE_IN_BITS" $ nf (bitCoerce :: Unsigned 32 -> Word32) m+  where+    setup = return smallValueW32++unsignedToWordBench :: Benchmark+unsignedToWordBench = env setup $ \m ->+  bench "unsignedToWord WORD_SIZE_IN_BITS" $ nf (bitCoerce :: Unsigned WORD_SIZE_IN_BITS -> Word) m+  where+    setup = return smallValue1

@@ -0,0 +1,46 @@+{-# LANGUAGE CPP, DataKinds, MagicHash, TypeOperators, TemplateHaskell #-}+#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE NoStarIsType #-}+#endif++{-# OPTIONS_GHC -ddump-simpl -ddump-splices -ddump-to-file #-}++#define WORD_SIZE_IN_BITS 64++module BenchVector (vectorBench) where++import Clash.Class.BitPack+import Clash.Promoted.Nat.Literals+import Clash.Sized.BitVector+import Clash.Sized.Vector+import Criterion                   (Benchmark, env, bench, nf, bgroup)+import Language.Haskell.TH.Syntax  (lift)+import Prelude                     hiding (replicate)++vectorBench :: Benchmark+vectorBench = bgroup "Vector"+  [ vectorPackBench+  , vectorUnpackBench+  ]++smallValue1 :: Vec 8 (BitVector 24)+smallValue1 = $(lift (replicate d8 (2^(16::Int)-10 :: BitVector 24)))+{-# INLINE smallValue1 #-}++smallValue2 :: BitVector 192+smallValue2 = $(lift (maxBound :: BitVector 192))+{-# INLINE smallValue2 #-}++vectorPackBench :: Benchmark+vectorPackBench = env setup $ \m ->+  bench "pack" $+  nf (pack :: Vec 8 (BitVector 24) -> BitVector 192) m+  where+    setup = return smallValue1++vectorUnpackBench :: Benchmark+vectorUnpackBench = env setup $ \m ->+  bench "unpack" $+  nf (unpack :: BitVector 192 -> Vec 8 (BitVector 24)) m+  where+    setup = return smallValue2

@@ -7,6 +7,7 @@ import BenchFixed import BenchSigned import BenchUnsigned+import BenchVector  main :: IO () main =@@ -16,4 +17,5 @@   , fixedBench   , signedBench   , unsignedBench+  , vectorBench   ]

@@ -1,6 +1,6 @@ Cabal-version:        2.2 Name:                 clash-prelude-Version:              1.2.0+Version:              1.2.1 Synopsis:             CAES Language for Synchronous Hardware - Prelude library Description:   Clash is a functional hardware description language that borrows both its@@ -52,7 +52,7 @@                                   2016-2017, Myrtle Software Ltd,                                   2017-2019, QBayLogic B.V., Google Inc. Category:             Hardware-Build-type:           Simple+Build-type:           Custom  Extra-source-files:   README.md                       CHANGELOG.md@@ -148,11 +148,17 @@   if impl(ghc >= 8.6)       default-extensions: NoStarIsType +custom-setup+  setup-depends:+    base          >= 4.9 && <5,+    Cabal         >= 1.10,+    cabal-doctest >= 1.0.1 && <1.1+ Library   import:             common-options   HS-Source-Dirs:     src -  ghc-options:        -Wall -fexpose-all-unfoldings -fno-worker-wrapper+  ghc-options:        -Wall -Wcompat -fexpose-all-unfoldings -fno-worker-wrapper   CPP-Options:        -DCABAL    if flag(large-tuples)@@ -263,6 +269,7 @@                        Clash.Sized.Internal.BitVector                       Clash.Sized.Internal.Index+                      Clash.Sized.Internal.Mod                       Clash.Sized.Internal.Signed                       Clash.Sized.Internal.Unsigned @@ -280,6 +287,7 @@                       Clash.Class.AutoReg.Internal                       Clash.Class.BitPack.Internal                       Clash.CPP+                      Clash.Examples.Internal                       Clash.Signal.Bundle.Internal                       Language.Haskell.TH.Compat                       Paths_clash_prelude@@ -298,7 +306,7 @@                       UndecidableInstances    Build-depends:      array                     >= 0.5.1.0 && < 0.6,-                      base                      >= 4.10    && < 5,+                      base                      >= 4.11    && < 5,                       bifunctors                >= 5.4.0   && < 6.0,                       binary                    >= 0.8.5   && < 0.11,                       bytestring                >= 0.10.8  && < 0.11,@@ -309,14 +317,14 @@                       integer-gmp               >= 0.5.1.0 && < 1.1,                       deepseq                   >= 1.4.1.0 && < 1.5,                       ghc-prim                  >= 0.5.1.0 && < 0.6,-                      ghc-typelits-extra        >= 0.3.3   && < 0.4,+                      ghc-typelits-extra        >= 0.3.3   && < 0.5,                       ghc-typelits-knownnat     >= 0.7.2   && < 0.8,-                      ghc-typelits-natnormalise >= 0.7.1   && < 0.8,-                      hashable                  >= 1.2.1.0  && < 1.4,+                      ghc-typelits-natnormalise >= 0.7.2   && < 0.8,+                      hashable                  >= 1.2.1.0 && < 1.4,                       half                      >= 0.2.2.3 && < 1.0,                       lens                      >= 4.10    && < 4.20,                       recursion-schemes         >= 5.1     && < 5.2,-                      QuickCheck                >= 2.7     && < 2.14,+                      QuickCheck                >= 2.7     && < 2.15,                       reflection                >= 2       && < 2.2,                       singletons                >= 1.0     && < 3.0,                       template-haskell          >= 2.12.0.0 && < 2.16,@@ -325,7 +333,7 @@                       th-orphans                >= 0.13.1   && < 1.0,                       text                      >= 0.11.3.1 && < 1.3,                       text-show                 >= 3.8     && < 3.9,-                      time                      >= 1.8     && < 1.10,+                      time                      >= 1.8     && < 1.11,                       transformers              >= 0.5.2.0 && < 0.6,                       type-errors               >= 0.2.0.0 && < 0.3,                       vector                    >= 0.11    && < 1.0@@ -334,9 +342,11 @@   type:             exitcode-stdio-1.0   default-language: Haskell2010   main-is:          doctests.hs-  ghc-options:      -Wall -threaded+  ghc-options:      -Wall -Wcompat -threaded   hs-source-dirs:   tests +  x-doctest-options: -fobject-code+   if !flag(doctests)     buildable: False   else@@ -352,7 +362,7 @@   import:           common-options   type:             exitcode-stdio-1.0   main-is:          unittests.hs-  ghc-options:      -Wall+  ghc-options:      -Wall -Wcompat   hs-source-dirs:   tests    if !flag(unittests)@@ -408,3 +418,4 @@                     BenchRAM                     BenchSigned                     BenchUnsigned+                    BenchVector

@@ -111,8 +111,10 @@ -- Output is ordered from least to most significant bit. -- Only outputs bits until the highest set bit. ----- >>> map bitsToBools [0..2]+-- @+-- > map bitsToBools [0..2] -- [[],[True],[False,True]])+-- @ -- -- This also works for variable sized number like Integer. -- But not for negative numbers, because negative Integers have infinite bits set.

@@ -241,27 +241,27 @@  -- | Guard primitive functions. This will help Clash generate better error -- messages. You can annotate a function like:-+-- -- @--- {-# ANN f dontTranslate #-}+-- {\-\# ANN f dontTranslate \#-\} -- @ -- -- or -- -- @--- {-# ANN f hasBlackBox #-}+-- {\-\# ANN f hasBlackBox \#-\} -- @ -- -- or -- -- @--- {-# ANN f (warnNonSynthesizable "Tread carefully, user!") #-}+-- {\-\# ANN f (warnNonSynthesizable "Tread carefully, user!") \#-\} -- @ -- -- or -- -- @--- {-# ANN f (warnAlways "Tread carefully, user!") #-}+-- {\-\# ANN f (warnAlways "Tread carefully, user!") \#-\} -- @ data PrimitiveGuard a   = DontTranslate

@@ -44,7 +44,7 @@ --     -> (Signal System Int4 \`Annotate\` 'StringAttr "chip_pin" "D1, D2, D3, D4") --     -> ... -- myFunc sel data = ...--- {-# NOINLINE myFunc #-}+-- {\-\# NOINLINE myFunc \#-\} -- @ -- -- To ensure this function will be rendered as its own module, do not forget a

@@ -253,9 +253,10 @@   -- - We only have no names from children: use split name as PortName   -- - We have children reporting names: use split name as name to PortProduct   = c >>= \case-    Complete [] -> return $ Complete [PortName name]-    Complete xs -> return $ Complete [PortProduct name xs]-    x           -> return x+    Complete []  -> return $ Complete [PortName name]+    Complete [PortName n2] -> return $ Complete [PortName (name ++ "_" ++ n2)]+    Complete xs  -> return $ Complete [PortProduct name xs]+    x            -> return x  typeTreeToPorts (ConTF name) = do   -- Only attempt to resolve a subtree for names we haven't seen before

@@ -55,7 +55,7 @@ import Clash.Class.Resize             (zeroExtend, resize) import Clash.Sized.BitVector          (Bit, BitVector, (++#)) import Clash.Sized.Internal.BitVector-  (pack#, split#, checkUnpackUndef, undefined#, unpack#, unsafeToInteger)+  (pack#, split#, checkUnpackUndef, undefined#, unpack#, unsafeToNatural) import Clash.XException  {- $setup@@ -134,7 +134,7 @@                                 (\(XException _) -> return undefined#)) {-# NOINLINE packXWith #-} -{-# INLINE bitCoerce #-}+{-# INLINE[1] bitCoerce #-} -- | Coerce a value from one type to another through its bit representation. -- -- >>> pack (-5 :: Signed 6)@@ -239,7 +239,7 @@ {-# NOINLINE packFloat# #-}  unpackFloat# :: BitVector 32 -> Float-unpackFloat# = wordToFloat . fromInteger . unsafeToInteger+unpackFloat# (unsafeToNatural -> w) = wordToFloat (fromIntegral w) {-# NOINLINE unpackFloat# #-}  instance BitPack Double where@@ -252,7 +252,7 @@ {-# NOINLINE packDouble# #-}  unpackDouble# :: BitVector 64 -> Double-unpackDouble# = wordToDouble . fromInteger . unsafeToInteger+unpackDouble# (unsafeToNatural -> w) = wordToDouble (fromIntegral w) {-# NOINLINE unpackDouble# #-}  instance BitPack CUShort where

@@ -31,6 +31,7 @@  {- $setup >>> import Clash.Prelude+>>> import Clash.Class.Parity -}  -- | Determine whether value is odd or even

@@ -5,20 +5,6 @@ Licence   : Creative Commons 4.0 (CC BY 4.0) (https://creativecommons.org/licenses/by/4.0/) -} -{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-}--{-# OPTIONS_GHC -fno-warn-unused-imports #-}-{-# OPTIONS_GHC -fno-warn-unused-binds #-}-{-# OPTIONS_GHC -fno-warn-type-defaults #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}- module Clash.Examples (   -- * Decoders and Encoders   -- $decoders_and_encoders@@ -34,278 +20,13 @@   ) where -import Clash.Prelude hiding (feedback)-import Control.Lens-import Control.Monad-import Control.Monad.Trans.State--decoderCase :: Bool -> BitVector 4 -> BitVector 16-decoderCase enable binaryIn | enable =-  case binaryIn of-    0x0 -> 0x0001-    0x1 -> 0x0002-    0x2 -> 0x0004-    0x3 -> 0x0008-    0x4 -> 0x0010-    0x5 -> 0x0020-    0x6 -> 0x0040-    0x7 -> 0x0080-    0x8 -> 0x0100-    0x9 -> 0x0200-    0xA -> 0x0400-    0xB -> 0x0800-    0xC -> 0x1000-    0xD -> 0x2000-    0xE -> 0x4000-    0xF -> 0x8000-decoderCase _ _ = 0--decoderShift :: Bool -> BitVector 4 -> BitVector 16-decoderShift enable binaryIn =-  if enable-     then 1 `shiftL` (fromIntegral binaryIn)-     else 0--encoderCase :: Bool -> BitVector 16 -> BitVector 4-encoderCase enable binaryIn | enable =-  case binaryIn of-    0x0001 -> 0x0-    0x0002 -> 0x1-    0x0004 -> 0x2-    0x0008 -> 0x3-    0x0010 -> 0x4-    0x0020 -> 0x5-    0x0040 -> 0x6-    0x0080 -> 0x7-    0x0100 -> 0x8-    0x0200 -> 0x9-    0x0400 -> 0xA-    0x0800 -> 0xB-    0x1000 -> 0xC-    0x2000 -> 0xD-    0x4000 -> 0xE-    0x8000 -> 0xF-encoderCase _ _ = 0--upCounter-  :: HiddenClockResetEnable dom-  => Signal dom Bool-  -> Signal dom (Unsigned 8)-upCounter enable = s-  where-    s = register 0 (mux enable (s + 1) s)--upCounterLdT-  :: Num a => a -> (Bool, Bool, a) -> (a,a)-upCounterLdT s (ld,en,dIn) = (s',s)-  where-    s' | ld        = dIn-       | en        = s + 1-       | otherwise = s--upCounterLd-  :: HiddenClockResetEnable dom-  => Signal dom (Bool, Bool, Unsigned 8)-  -> Signal dom (Unsigned 8)-upCounterLd = mealy upCounterLdT 0--upDownCounter-  :: HiddenClockResetEnable dom-  => Signal dom Bool-  -> Signal dom (Unsigned 8)-upDownCounter upDown = s-  where-    s = register 0 (mux upDown (s + 1) (s - 1))--lfsrF' :: BitVector 16 -> BitVector 16-lfsrF' s = pack feedback ++# slice d15 d1 s-  where-    feedback = s!5 `xor` s!3 `xor` s!2 `xor` s!0--lfsrF-  :: HiddenClockResetEnable dom-  => BitVector 16 -> Signal dom Bit-lfsrF seed = msb <$> r-  where r = register seed (lfsrF' <$> r)--lfsrGP-  :: (KnownNat (n + 1), Bits a)-  => Vec (n + 1) Bool-  -> Vec (n + 1) a-  -> Vec (n + 1) a-lfsrGP taps regs = zipWith xorM taps (fb +>> regs)-  where-    fb = last regs-    xorM i x | i         =  x `xor` fb-             | otherwise = x--lfsrG-  :: HiddenClockResetEnable dom-  => BitVector 16-  -> Signal dom Bit-lfsrG seed = last (unbundle r)-  where r = register (unpack seed) (lfsrGP (unpack 0b0011010000000000) <$> r)--grayCounter-  :: HiddenClockResetEnable dom-  => Signal dom Bool-  -> Signal dom (BitVector 8)-grayCounter en = gray <$> upCounter en-  where gray xs = pack (msb xs) ++# xor (slice d7 d1 xs) (slice d6 d0 xs)--oneHotCounter-  :: HiddenClockResetEnable dom-  => Signal dom Bool-  -> Signal dom (BitVector 8)-oneHotCounter enable = s-  where-    s = register 1 (mux enable (rotateL <$> s <*> 1) s)--crcT-  :: (Bits a, BitPack a)-  => a-  -> Bit-  -> a-crcT bv dIn = replaceBit 0  dInXor-            $ replaceBit 5  (bv!4  `xor` dInXor)-            $ replaceBit 12 (bv!11 `xor` dInXor)-              rotated-  where-    dInXor  = dIn `xor` fb-    rotated = rotateL bv 1-    fb      = msb bv--crc-  :: HiddenClockResetEnable dom-  => Signal dom Bool-  -> Signal dom Bool-  -> Signal dom Bit-  -> Signal dom (BitVector 16)-crc enable ld dIn = s-  where-    s = register 0xFFFF (mux enable (mux ld 0xFFFF (crcT <$> s <*> dIn)) s)--data RxReg-  = RxReg-  { _rx_reg        :: BitVector 8-  , _rx_data       :: BitVector 8-  , _rx_sample_cnt :: Unsigned 4-  , _rx_cnt        :: Unsigned 4-  , _rx_frame_err  :: Bool-  , _rx_over_run   :: Bool-  , _rx_empty      :: Bool-  , _rx_d1         :: Bit-  , _rx_d2         :: Bit-  , _rx_busy       :: Bool-  } deriving (Generic, NFDataX)--makeLenses ''RxReg--data TxReg-  = TxReg-  { _tx_reg      :: BitVector 8-  , _tx_empty    :: Bool-  , _tx_over_run :: Bool-  , _tx_out      :: Bit-  , _tx_cnt      :: Unsigned 4-  }-  deriving (Generic, NFDataX)--makeLenses ''TxReg--uartTX t@(TxReg {..}) ld_tx_data tx_data tx_enable = flip execState t $ do-  when ld_tx_data $ do-    if not _tx_empty then-      tx_over_run .= False-    else do-      tx_reg   .= tx_data-      tx_empty .= False-  when (tx_enable && not _tx_empty) $ do-    tx_cnt += 1-    when (_tx_cnt == 0) $-      tx_out .= 0-    when (_tx_cnt > 0 && _tx_cnt < 9) $-      tx_out .= _tx_reg ! (_tx_cnt - 1)-    when (_tx_cnt == 9) $ do-      tx_out   .= 1-      tx_cnt   .= 0-      tx_empty .= True-  unless tx_enable $-    tx_cnt .= 0--uartRX r@(RxReg {..}) rx_in uld_rx_data rx_enable = flip execState r $ do-  -- Synchronize the async signal-  rx_d1 .= rx_in-  rx_d2 .= _rx_d1-  -- Uload the rx data-  when uld_rx_data $ do-    rx_data  .= _rx_reg-    rx_empty .= True-  -- Receive data only when rx is enabled-  if rx_enable then do-    -- Check if just received start of frame-    when (not _rx_busy && _rx_d2 == 0) $ do-      rx_busy       .= True-      rx_sample_cnt .= 1-      rx_cnt        .= 0-    -- Star of frame detected, Proceed with rest of data-    when _rx_busy $ do-      rx_sample_cnt += 1-      -- Logic to sample at middle of data-      when (_rx_sample_cnt == 7) $ do-        if _rx_d1 == 1 && _rx_cnt == 0 then-          rx_busy .= False-        else do-          rx_cnt += 1-          -- start storing the rx data-          when (_rx_cnt > 0 && _rx_cnt < 9) $ do-            rx_reg %= replaceBit (_rx_cnt - 1) _rx_d2-          when (_rx_cnt == 9) $ do-            rx_busy .= False-            -- Check if End of frame received correctly-            if _rx_d2 == 0 then-              rx_frame_err .= True-            else do-              rx_empty     .= False-              rx_frame_err .= False-              -- Check if last rx data was not unloaded-              rx_over_run  .= not _rx_empty-  else do-    rx_busy .= False--uart ld_tx_data tx_data tx_enable rx_in uld_rx_data rx_enable =-    ( _tx_out   <$> txReg-    , _tx_empty <$> txReg-    , _rx_data  <$> rxReg-    , _rx_empty <$> rxReg-    )-  where-    rxReg     = register rxRegInit (uartRX <$> rxReg <*> rx_in <*> uld_rx_data-                                           <*> rx_enable)-    rxRegInit = RxReg { _rx_reg        = 0-                      , _rx_data       = 0-                      , _rx_sample_cnt = 0-                      , _rx_cnt        = 0-                      , _rx_frame_err  = False-                      , _rx_over_run   = False-                      , _rx_empty      = True-                      , _rx_d1         = 1-                      , _rx_d2         = 1-                      , _rx_busy       = False-                      }-    txReg     = register txRegInit (uartTX <$> txReg <*> ld_tx_data <*> tx_data-                                           <*> tx_enable)-    txRegInit = TxReg { _tx_reg      = 0-                      , _tx_empty    = True-                      , _tx_over_run = False-                      , _tx_out      = 1-                      , _tx_cnt      = 0-                      }- {- $setup >>> :set -XDataKinds+>>> :m -Clash.Explicit.Prelude+>>> :m -Clash.Signal.Internal >>> import Clash.Prelude >>> import Test.QuickCheck+>>> import Clash.Examples.Internal -}  {- $decoders_and_encoders

@@ -0,0 +1,290 @@+{-|+Copyright : © 2015-2016, Christiaan Baaij,+              2017     , Google Inc.+              2019     , Myrtle Software Ltd+Licence   : Creative Commons 4.0 (CC BY 4.0) (https://creativecommons.org/licenses/by/4.0/)+-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-binds #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++module Clash.Examples.Internal where++import Clash.Prelude hiding (feedback)+import Control.Lens+import Control.Monad+import Control.Monad.Trans.State++decoderCase :: Bool -> BitVector 4 -> BitVector 16+decoderCase enable binaryIn | enable =+  case binaryIn of+    0x0 -> 0x0001+    0x1 -> 0x0002+    0x2 -> 0x0004+    0x3 -> 0x0008+    0x4 -> 0x0010+    0x5 -> 0x0020+    0x6 -> 0x0040+    0x7 -> 0x0080+    0x8 -> 0x0100+    0x9 -> 0x0200+    0xA -> 0x0400+    0xB -> 0x0800+    0xC -> 0x1000+    0xD -> 0x2000+    0xE -> 0x4000+    0xF -> 0x8000+decoderCase _ _ = 0++decoderShift :: Bool -> BitVector 4 -> BitVector 16+decoderShift enable binaryIn =+  if enable+     then 1 `shiftL` (fromIntegral binaryIn)+     else 0++encoderCase :: Bool -> BitVector 16 -> BitVector 4+encoderCase enable binaryIn | enable =+  case binaryIn of+    0x0001 -> 0x0+    0x0002 -> 0x1+    0x0004 -> 0x2+    0x0008 -> 0x3+    0x0010 -> 0x4+    0x0020 -> 0x5+    0x0040 -> 0x6+    0x0080 -> 0x7+    0x0100 -> 0x8+    0x0200 -> 0x9+    0x0400 -> 0xA+    0x0800 -> 0xB+    0x1000 -> 0xC+    0x2000 -> 0xD+    0x4000 -> 0xE+    0x8000 -> 0xF+encoderCase _ _ = 0++upCounter+  :: HiddenClockResetEnable dom+  => Signal dom Bool+  -> Signal dom (Unsigned 8)+upCounter enable = s+  where+    s = register 0 (mux enable (s + 1) s)++upCounterLdT+  :: Num a => a -> (Bool, Bool, a) -> (a,a)+upCounterLdT s (ld,en,dIn) = (s',s)+  where+    s' | ld        = dIn+       | en        = s + 1+       | otherwise = s++upCounterLd+  :: HiddenClockResetEnable dom+  => Signal dom (Bool, Bool, Unsigned 8)+  -> Signal dom (Unsigned 8)+upCounterLd = mealy upCounterLdT 0++upDownCounter+  :: HiddenClockResetEnable dom+  => Signal dom Bool+  -> Signal dom (Unsigned 8)+upDownCounter upDown = s+  where+    s = register 0 (mux upDown (s + 1) (s - 1))++lfsrF' :: BitVector 16 -> BitVector 16+lfsrF' s = pack feedback ++# slice d15 d1 s+  where+    feedback = s!5 `xor` s!3 `xor` s!2 `xor` s!0++lfsrF+  :: HiddenClockResetEnable dom+  => BitVector 16 -> Signal dom Bit+lfsrF seed = msb <$> r+  where r = register seed (lfsrF' <$> r)++lfsrGP+  :: (KnownNat (n + 1), Bits a)+  => Vec (n + 1) Bool+  -> Vec (n + 1) a+  -> Vec (n + 1) a+lfsrGP taps regs = zipWith xorM taps (fb +>> regs)+  where+    fb = last regs+    xorM i x | i         =  x `xor` fb+             | otherwise = x++lfsrG+  :: HiddenClockResetEnable dom+  => BitVector 16+  -> Signal dom Bit+lfsrG seed = last (unbundle r)+  where r = register (unpack seed) (lfsrGP (unpack 0b0011010000000000) <$> r)++grayCounter+  :: HiddenClockResetEnable dom+  => Signal dom Bool+  -> Signal dom (BitVector 8)+grayCounter en = gray <$> upCounter en+  where gray xs = pack (msb xs) ++# xor (slice d7 d1 xs) (slice d6 d0 xs)++oneHotCounter+  :: HiddenClockResetEnable dom+  => Signal dom Bool+  -> Signal dom (BitVector 8)+oneHotCounter enable = s+  where+    s = register 1 (mux enable (rotateL <$> s <*> 1) s)++crcT+  :: (Bits a, BitPack a)+  => a+  -> Bit+  -> a+crcT bv dIn = replaceBit 0  dInXor+            $ replaceBit 5  (bv!4  `xor` dInXor)+            $ replaceBit 12 (bv!11 `xor` dInXor)+              rotated+  where+    dInXor  = dIn `xor` fb+    rotated = rotateL bv 1+    fb      = msb bv++crc+  :: HiddenClockResetEnable dom+  => Signal dom Bool+  -> Signal dom Bool+  -> Signal dom Bit+  -> Signal dom (BitVector 16)+crc enable ld dIn = s+  where+    s = register 0xFFFF (mux enable (mux ld 0xFFFF (crcT <$> s <*> dIn)) s)++data RxReg+  = RxReg+  { _rx_reg        :: BitVector 8+  , _rx_data       :: BitVector 8+  , _rx_sample_cnt :: Unsigned 4+  , _rx_cnt        :: Unsigned 4+  , _rx_frame_err  :: Bool+  , _rx_over_run   :: Bool+  , _rx_empty      :: Bool+  , _rx_d1         :: Bit+  , _rx_d2         :: Bit+  , _rx_busy       :: Bool+  } deriving (Generic, NFDataX)++makeLenses ''RxReg++data TxReg+  = TxReg+  { _tx_reg      :: BitVector 8+  , _tx_empty    :: Bool+  , _tx_over_run :: Bool+  , _tx_out      :: Bit+  , _tx_cnt      :: Unsigned 4+  }+  deriving (Generic, NFDataX)++makeLenses ''TxReg++uartTX t@(TxReg {..}) ld_tx_data tx_data tx_enable = flip execState t $ do+  when ld_tx_data $ do+    if not _tx_empty then+      tx_over_run .= False+    else do+      tx_reg   .= tx_data+      tx_empty .= False+  when (tx_enable && not _tx_empty) $ do+    tx_cnt += 1+    when (_tx_cnt == 0) $+      tx_out .= 0+    when (_tx_cnt > 0 && _tx_cnt < 9) $+      tx_out .= _tx_reg ! (_tx_cnt - 1)+    when (_tx_cnt == 9) $ do+      tx_out   .= 1+      tx_cnt   .= 0+      tx_empty .= True+  unless tx_enable $+    tx_cnt .= 0++uartRX r@(RxReg {..}) rx_in uld_rx_data rx_enable = flip execState r $ do+  -- Synchronize the async signal+  rx_d1 .= rx_in+  rx_d2 .= _rx_d1+  -- Uload the rx data+  when uld_rx_data $ do+    rx_data  .= _rx_reg+    rx_empty .= True+  -- Receive data only when rx is enabled+  if rx_enable then do+    -- Check if just received start of frame+    when (not _rx_busy && _rx_d2 == 0) $ do+      rx_busy       .= True+      rx_sample_cnt .= 1+      rx_cnt        .= 0+    -- Star of frame detected, Proceed with rest of data+    when _rx_busy $ do+      rx_sample_cnt += 1+      -- Logic to sample at middle of data+      when (_rx_sample_cnt == 7) $ do+        if _rx_d1 == 1 && _rx_cnt == 0 then+          rx_busy .= False+        else do+          rx_cnt += 1+          -- start storing the rx data+          when (_rx_cnt > 0 && _rx_cnt < 9) $ do+            rx_reg %= replaceBit (_rx_cnt - 1) _rx_d2+          when (_rx_cnt == 9) $ do+            rx_busy .= False+            -- Check if End of frame received correctly+            if _rx_d2 == 0 then+              rx_frame_err .= True+            else do+              rx_empty     .= False+              rx_frame_err .= False+              -- Check if last rx data was not unloaded+              rx_over_run  .= not _rx_empty+  else do+    rx_busy .= False++uart ld_tx_data tx_data tx_enable rx_in uld_rx_data rx_enable =+    ( _tx_out   <$> txReg+    , _tx_empty <$> txReg+    , _rx_data  <$> rxReg+    , _rx_empty <$> rxReg+    )+  where+    rxReg     = register rxRegInit (uartRX <$> rxReg <*> rx_in <*> uld_rx_data+                                           <*> rx_enable)+    rxRegInit = RxReg { _rx_reg        = 0+                      , _rx_data       = 0+                      , _rx_sample_cnt = 0+                      , _rx_cnt        = 0+                      , _rx_frame_err  = False+                      , _rx_over_run   = False+                      , _rx_empty      = True+                      , _rx_d1         = 1+                      , _rx_d2         = 1+                      , _rx_busy       = False+                      }+    txReg     = register txRegInit (uartTX <$> txReg <*> ld_tx_data <*> tx_data+                                           <*> tx_enable)+    txRegInit = TxReg { _tx_reg      = 0+                      , _tx_empty    = True+                      , _tx_over_run = False+                      , _tx_out      = 1+                      , _tx_cnt      = 0+                      }

@@ -421,6 +421,8 @@   (maybeIsX, seqX, NFDataX, deepErrorX, defaultSeqX, fromJustX)  {- $setup+>>> :m -Clash.Prelude+>>> :m -Clash.Prelude.Safe >>> import Clash.Explicit.Prelude as C >>> import qualified Data.List as L >>> :set -XDataKinds -XRecordWildCards -XTupleSections -XDeriveAnyClass -XDeriveGeneric@@ -485,72 +487,72 @@ :}  >>> :{-cpu :: Vec 7 Value          -- ^ Register bank-    -> (Value,Instruction)  -- ^ (Memory output, Current instruction)-    -> ( Vec 7 Value-       , (MemAddr,Maybe (MemAddr,Value),InstrAddr)-       )-cpu regbank (memOut,instr) = (regbank',(rdAddr,(,aluOut) <$> wrAddrM,fromIntegral ipntr))-  where-    -- Current instruction pointer-    ipntr = regbank C.!! PC-    -- Decoder-    (MachCode {..}) = case instr of-      Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op}-      Branch cr a          -> nullCode {inputX=cr,jmpM=Just a}-      Jump a               -> nullCode {aluCode=Incr,jmpM=Just a}-      Load a r             -> nullCode {ldReg=r,rdAddr=a}-      Store r a            -> nullCode {inputX=r,wrAddrM=Just a}-      Nop                  -> nullCode-    -- ALU-    regX   = regbank C.!! inputX-    regY   = regbank C.!! inputY-    aluOut = alu aluCode regX regY-    -- next instruction-    nextPC = case jmpM of-               Just a | aluOut /= 0 -> ipntr + a-               _                    -> ipntr + 1-    -- update registers-    regbank' = replace Zero   0-             $ replace PC     nextPC-             $ replace result aluOut-             $ replace ldReg  memOut-             $ regbank+let cpu :: Vec 7 Value          -- ^ Register bank+        -> (Value,Instruction)  -- ^ (Memory output, Current instruction)+        -> ( Vec 7 Value+           , (MemAddr,Maybe (MemAddr,Value),InstrAddr)+           )+    cpu regbank (memOut,instr) = (regbank',(rdAddr,(,aluOut) <$> wrAddrM,fromIntegral ipntr))+      where+        -- Current instruction pointer+        ipntr = regbank C.!! PC+        -- Decoder+        (MachCode {..}) = case instr of+          Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op}+          Branch cr a          -> nullCode {inputX=cr,jmpM=Just a}+          Jump a               -> nullCode {aluCode=Incr,jmpM=Just a}+          Load a r             -> nullCode {ldReg=r,rdAddr=a}+          Store r a            -> nullCode {inputX=r,wrAddrM=Just a}+          Nop                  -> nullCode+        -- ALU+        regX   = regbank C.!! inputX+        regY   = regbank C.!! inputY+        aluOut = alu aluCode regX regY+        -- next instruction+        nextPC = case jmpM of+                   Just a | aluOut /= 0 -> ipntr + a+                   _                    -> ipntr + 1+        -- update registers+        regbank' = replace Zero   0+                 $ replace PC     nextPC+                 $ replace result aluOut+                 $ replace ldReg  memOut+                 $ regbank :}  >>> :{-dataMem-  :: KnownDomain dom-  => Clock  dom-  -> Reset  dom-  -> Enable dom-  -> Signal dom MemAddr-  -> Signal dom (Maybe (MemAddr,Value))-  -> Signal dom Value-dataMem clk rst en rd wrM = mealy clk rst en dataMemT (C.replicate d32 0) (bundle (rd,wrM))-  where-    dataMemT mem (rd,wrM) = (mem',dout)+let dataMem+      :: KnownDomain dom+      => Clock  dom+      -> Reset  dom+      -> Enable dom+      -> Signal dom MemAddr+      -> Signal dom (Maybe (MemAddr,Value))+      -> Signal dom Value+    dataMem clk rst en rd wrM = mealy clk rst en dataMemT (C.replicate d32 0) (bundle (rd,wrM))       where-        dout = mem C.!! rd-        mem' = case wrM of-                 Just (wr,din) -> replace wr din mem-                 Nothing       -> mem+        dataMemT mem (rd,wrM) = (mem',dout)+          where+            dout = mem C.!! rd+            mem' = case wrM of+                     Just (wr,din) -> replace wr din mem+                     Nothing       -> mem :}  >>> :{-system-  :: ( KnownDomain dom-     , KnownNat n )-  => Vec n Instruction-  -> Clock dom-  -> Reset dom-  -> Enable dom-  -> Signal dom Value-system instrs clk rst en = memOut-  where-    memOut = dataMem clk rst en rdAddr dout-    (rdAddr,dout,ipntr) = mealyB clk rst en cpu (C.replicate d7 0) (memOut,instr)-    instr  = asyncRom instrs <$> ipntr+let system+      :: ( KnownDomain dom+         , KnownNat n )+      => Vec n Instruction+      -> Clock dom+      -> Reset dom+      -> Enable dom+      -> Signal dom Value+    system instrs clk rst en = memOut+      where+        memOut = dataMem clk rst en rdAddr dout+        (rdAddr,dout,ipntr) = mealyB clk rst en cpu (C.replicate d7 0) (memOut,instr)+        instr  = asyncRom instrs <$> ipntr :}  >>> :{@@ -586,70 +588,70 @@ :}  >>> :{-system2-  :: ( KnownDomain dom-     , KnownNat n )-  => Vec n Instruction-  -> Clock dom-  -> Reset dom-  -> Enable dom-  -> Signal dom Value-system2 instrs clk rst en = memOut-  where-    memOut = asyncRam clk clk en d32 rdAddr dout-    (rdAddr,dout,ipntr) = mealyB clk rst en cpu (C.replicate d7 0) (memOut,instr)-    instr  = asyncRom instrs <$> ipntr+let system2+      :: ( KnownDomain dom+         , KnownNat n )+      => Vec n Instruction+      -> Clock dom+      -> Reset dom+      -> Enable dom+      -> Signal dom Value+    system2 instrs clk rst en = memOut+      where+        memOut = asyncRam clk clk en d32 rdAddr dout+        (rdAddr,dout,ipntr) = mealyB clk rst en cpu (C.replicate d7 0) (memOut,instr)+        instr  = asyncRom instrs <$> ipntr :}  >>> :{-cpu2 :: (Vec 7 Value,Reg)    -- ^ (Register bank, Load reg addr)-     -> (Value,Instruction)  -- ^ (Memory output, Current instruction)-     -> ( (Vec 7 Value,Reg)-        , (MemAddr,Maybe (MemAddr,Value),InstrAddr)-        )-cpu2 (regbank,ldRegD) (memOut,instr) = ((regbank',ldRegD'),(rdAddr,(,aluOut) <$> wrAddrM,fromIntegral ipntr))-  where-    -- Current instruction pointer-    ipntr = regbank C.!! PC-    -- Decoder-    (MachCode {..}) = case instr of-      Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op}-      Branch cr a          -> nullCode {inputX=cr,jmpM=Just a}-      Jump a               -> nullCode {aluCode=Incr,jmpM=Just a}-      Load a r             -> nullCode {ldReg=r,rdAddr=a}-      Store r a            -> nullCode {inputX=r,wrAddrM=Just a}-      Nop                  -> nullCode-    -- ALU-    regX   = regbank C.!! inputX-    regY   = regbank C.!! inputY-    aluOut = alu aluCode regX regY-    -- next instruction-    nextPC = case jmpM of-               Just a | aluOut /= 0 -> ipntr + a-               _                    -> ipntr + 1-    -- update registers-    ldRegD'  = ldReg -- Delay the ldReg by 1 cycle-    regbank' = replace Zero   0-             $ replace PC     nextPC-             $ replace result aluOut-             $ replace ldRegD memOut-             $ regbank+let cpu2 :: (Vec 7 Value,Reg)    -- ^ (Register bank, Load reg addr)+         -> (Value,Instruction)  -- ^ (Memory output, Current instruction)+         -> ( (Vec 7 Value,Reg)+            , (MemAddr,Maybe (MemAddr,Value),InstrAddr)+            )+    cpu2 (regbank,ldRegD) (memOut,instr) = ((regbank',ldRegD'),(rdAddr,(,aluOut) <$> wrAddrM,fromIntegral ipntr))+      where+        -- Current instruction pointer+        ipntr = regbank C.!! PC+        -- Decoder+        (MachCode {..}) = case instr of+          Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op}+          Branch cr a          -> nullCode {inputX=cr,jmpM=Just a}+          Jump a               -> nullCode {aluCode=Incr,jmpM=Just a}+          Load a r             -> nullCode {ldReg=r,rdAddr=a}+          Store r a            -> nullCode {inputX=r,wrAddrM=Just a}+          Nop                  -> nullCode+        -- ALU+        regX   = regbank C.!! inputX+        regY   = regbank C.!! inputY+        aluOut = alu aluCode regX regY+        -- next instruction+        nextPC = case jmpM of+                   Just a | aluOut /= 0 -> ipntr + a+                   _                    -> ipntr + 1+        -- update registers+        ldRegD'  = ldReg -- Delay the ldReg by 1 cycle+        regbank' = replace Zero   0+                 $ replace PC     nextPC+                 $ replace result aluOut+                 $ replace ldRegD memOut+                 $ regbank :}  >>> :{-system3-  :: ( KnownDomain dom-     , KnownNat n )-  => Vec n Instruction-  -> Clock dom-  -> Reset dom-  -> Enable dom-  -> Signal dom Value-system3 instrs clk rst en = memOut-  where-    memOut = blockRam clk en (C.replicate d32 0) rdAddr dout-    (rdAddr,dout,ipntr) = mealyB clk rst en cpu2 ((C.replicate d7 0),Zero) (memOut,instr)-    instr  = asyncRom instrs <$> ipntr+let system3+      :: ( KnownDomain dom+         , KnownNat n )+      => Vec n Instruction+      -> Clock dom+      -> Reset dom+      -> Enable dom+      -> Signal dom Value+    system3 instrs clk rst en = memOut+      where+        memOut = blockRam clk en (C.replicate d32 0) rdAddr dout+        (rdAddr,dout,ipntr) = mealyB clk rst en cpu2 ((C.replicate d7 0),Zero) (memOut,instr)+        instr  = asyncRom instrs <$> ipntr :}  >>> :{

@@ -7,7 +7,7 @@ We simulate DDR signal by using 'Signal's which have exactly half the period (or double the speed) of our normal 'Signal's. -The primitives in this module can be used to produce of consume DDR signals.+The primitives in this module can be used to produce or consume DDR signals.  DDR signals are not meant to be used internally in a design, but only to communicate with the outside world.@@ -37,14 +37,25 @@ import Clash.Explicit.Prelude import Clash.Signal.Internal +{- $setup+>>> :set -XNoImplicitPrelude -XTypeFamilies -XFlexibleInstances+>>> import Clash.Explicit.Prelude+>>> import Clash.Explicit.DDR+>>> :{+instance KnownDomain "Fast" where+  type KnownConf "Fast" = 'DomainConfiguration "Fast" 5000 'Rising 'Asynchronous 'Defined 'ActiveHigh+  knownDomain = SDomainConfiguration SSymbol SNat SRising SAsynchronous SDefined SActiveHigh+:} +-}+ -- | DDR input primitive -- -- Consumes a DDR input signal and produces a regular signal containing a pair -- of values. ----- >>> printX $ sampleN 5 $ ddrIn systemClockGen resetGen enableGen (-1,-2,-3) (fromList [0..10])--- [(X,X),((-1),(-2)),((-3),2),(3,4),(5,6)]+-- >>> printX $ sampleN 5 $ ddrIn systemClockGen systemResetGen enableGen (-1,-2,-3) (fromList [0..10] :: Signal "Fast" Int)+-- [(-1,-2),(-1,-2),(-3,2),(3,4),(5,6)] ddrIn   :: ( HasCallStack      , NFDataX a@@ -129,7 +140,7 @@ -- -- Produces a DDR output signal from a normal signal of pairs of input. ----- >>> sampleN 7 $ ddrOut systemClockGen asyncResetGen (-1) (fromList [(0,1),(2,3),(4,5)])+-- >>> sampleN 7 (ddrOut systemClockGen systemResetGen enableGen (-1) (fromList [(0,1),(2,3),(4,5)]) :: Signal "Fast" Int) -- [-1,-1,-1,2,3,4,5] ddrOut   :: ( HasCallStack

@@ -27,6 +27,8 @@  {- $setup >>> :set -XDataKinds -XTypeApplications+>>> :m -Clash.Prelude+>>> :m -Clash.Prelude.Safe >>> import Clash.Explicit.Prelude >>> import qualified Data.List as L >>> :{

@@ -29,6 +29,8 @@  {- $setup >>> :set -XDataKinds -XTypeApplications+>>> :m -Clash.Prelude+>>> :m -Clash.Prelude.Safe >>> import Clash.Explicit.Prelude >>> let macT s (x,y) = x * y + s >>> let mac clk rst en = moore clk rst en macT id 0

@@ -176,6 +176,7 @@  {- $setup >>> :set -XDataKinds -XTypeApplications+>>> :m -Clash.Prelude >>> import Clash.Explicit.Prelude >>> let window4 = window @3 >>> let windowD3 = windowD @2

@@ -140,7 +140,9 @@  {- $setup >>> :set -XDataKinds->>> import Clash.Explicit.Prelude+>>> :m -Clash.Prelude+>>> :m -Clash.Prelude.Safe+>>> import Clash.Explicit.Prelude.Safe >>> let rP clk rst en = registerB clk rst en (8::Int,8::Int) -} 

@@ -285,6 +285,10 @@ {- $setup >>> :set -XDataKinds -XTypeApplications -XFlexibleInstances -XMultiParamTypeClasses -XTypeFamilies >>> :set -fno-warn-deprecations+>>> :m -Clash.Prelude+>>> :m -Clash.Prelude.Safe+>>> :m -Clash.Explicit.Prelude.Safe+>>> :m -Clash.Signal >>> import Clash.Explicit.Prelude >>> import Clash.Promoted.Nat (SNat(..)) >>> import qualified Data.List as L@@ -551,7 +555,8 @@  -- * Basic circuit functions --- | Merge enable signal with signal of bools+-- | Merge enable signal with signal of bools by applying the boolean AND+-- operation. enable   :: Enable dom   -> Signal dom Bool

@@ -64,6 +64,8 @@ {- $setup >>> :set -XDataKinds >>> :set -XTypeOperators+>>> :m -Clash.Prelude+>>> :m -Clash.Prelude.Safe >>> import Clash.Explicit.Prelude >>> let delay3 clk rst en = delayed clk rst en (-1 :> -1 :> -1 :> Nil) >>> let delay2 clk rst en = (delayedI clk rst en :: Int -> DSignal System n Int -> DSignal System (n + 2) Int)

@@ -63,6 +63,9 @@  {- $setup >>> :set -XTemplateHaskell -XDataKinds -XTypeFamilies+>>> :m -Clash.Prelude+>>> :m -Clash.Prelude.Safe+>>> :m -Clash.Prelude.Testbench >>> import Clash.Explicit.Prelude >>> let testInput clk rst = stimuliGenerator clk rst $(listToVecTH [(1::Int),3..21]) >>> let expectedOutput clk rst = outputVerifier' clk rst $(listToVecTH ([70,99,2,3,4,5,7,8,9,10]::[Int]))

@@ -16,7 +16,7 @@ import GHC.TypeLits                   (KnownNat, type (+), type (-))  import Clash.Class.BitPack            (BitPack (..))-import Clash.Promoted.Nat             (SNat)+import Clash.Promoted.Nat             (SNat (..)) import Clash.Sized.Internal.BitVector (BitVector, Bit, index#, lsb#, msb#,                                        replaceBit#, setSlice#, slice#, split#) @@ -117,7 +117,7 @@ --       In an equation for ‘it’: it = setSlice d6 d5 0 (- 5 :: Signed 6) setSlice :: (BitPack a, BitSize a ~ ((m + 1) + i)) => SNat m -> SNat n          -> BitVector (m + 1 - n) -> a -> a-setSlice m n w v = unpack (setSlice# (pack v) m n w)+setSlice m n w v = unpack (setSlice# SNat (pack v) m n w)  {-# INLINE msb #-} -- | Get the most significant bit.

@@ -404,6 +404,9 @@ import           Clash.XException        (NFDataX)  {- $setup+>>> :m -Clash.Explicit.Prelude+>>> :m -Clash.Explicit.Prelude.Safe+>>> :m -Clash.Prelude.Safe >>> import Clash.Prelude as C >>> import qualified Data.List as L >>> :set -XDataKinds -XRecordWildCards -XTupleSections -XTypeApplications -XFlexibleContexts@@ -469,65 +472,65 @@ :}  >>> :{-cpu :: Vec 7 Value          -- ^ Register bank-    -> (Value,Instruction)  -- ^ (Memory output, Current instruction)-    -> ( Vec 7 Value-       , (MemAddr,Maybe (MemAddr,Value),InstrAddr)-       )-cpu regbank (memOut,instr) = (regbank',(rdAddr,(,aluOut) <$> wrAddrM,fromIntegral ipntr))-  where-    -- Current instruction pointer-    ipntr = regbank C.!! PC-    -- Decoder-    (MachCode {..}) = case instr of-      Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op}-      Branch cr a          -> nullCode {inputX=cr,jmpM=Just a}-      Jump a               -> nullCode {aluCode=Incr,jmpM=Just a}-      Load a r             -> nullCode {ldReg=r,rdAddr=a}-      Store r a            -> nullCode {inputX=r,wrAddrM=Just a}-      Nop                  -> nullCode-    -- ALU-    regX   = regbank C.!! inputX-    regY   = regbank C.!! inputY-    aluOut = alu aluCode regX regY-    -- next instruction-    nextPC = case jmpM of-               Just a | aluOut /= 0 -> ipntr + a-               _                    -> ipntr + 1-    -- update registers-    regbank' = replace Zero   0-             $ replace PC     nextPC-             $ replace result aluOut-             $ replace ldReg  memOut-             $ regbank+let cpu :: Vec 7 Value          -- ^ Register bank+        -> (Value,Instruction)  -- ^ (Memory output, Current instruction)+        -> ( Vec 7 Value+           , (MemAddr,Maybe (MemAddr,Value),InstrAddr)+           )+    cpu regbank (memOut,instr) = (regbank',(rdAddr,(,aluOut) <$> wrAddrM,fromIntegral ipntr))+      where+        -- Current instruction pointer+        ipntr = regbank C.!! PC+        -- Decoder+        (MachCode {..}) = case instr of+          Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op}+          Branch cr a          -> nullCode {inputX=cr,jmpM=Just a}+          Jump a               -> nullCode {aluCode=Incr,jmpM=Just a}+          Load a r             -> nullCode {ldReg=r,rdAddr=a}+          Store r a            -> nullCode {inputX=r,wrAddrM=Just a}+          Nop                  -> nullCode+        -- ALU+        regX   = regbank C.!! inputX+        regY   = regbank C.!! inputY+        aluOut = alu aluCode regX regY+        -- next instruction+        nextPC = case jmpM of+                   Just a | aluOut /= 0 -> ipntr + a+                   _                    -> ipntr + 1+        -- update registers+        regbank' = replace Zero   0+                 $ replace PC     nextPC+                 $ replace result aluOut+                 $ replace ldReg  memOut+                 $ regbank :}  >>> :{-dataMem-  :: HiddenClockResetEnable dom-  => Signal dom MemAddr-  -> Signal dom (Maybe (MemAddr,Value))-  -> Signal dom Value-dataMem rd wrM = mealy dataMemT (C.replicate d32 0) (bundle (rd,wrM))-  where-    dataMemT mem (rd,wrM) = (mem',dout)+let dataMem+      :: HiddenClockResetEnable dom+      => Signal dom MemAddr+      -> Signal dom (Maybe (MemAddr,Value))+      -> Signal dom Value+    dataMem rd wrM = mealy dataMemT (C.replicate d32 0) (bundle (rd,wrM))       where-        dout = mem C.!! rd-        mem' = case wrM of-                 Just (wr,din) -> replace wr din mem-                 Nothing       -> mem+        dataMemT mem (rd,wrM) = (mem',dout)+          where+            dout = mem C.!! rd+            mem' = case wrM of+                     Just (wr,din) -> replace wr din mem+                     Nothing       -> mem :}  >>> :{-system-  :: (KnownNat n, HiddenClockResetEnable dom )-  => Vec n Instruction-  -> Signal dom Value-system instrs = memOut-  where-    memOut = dataMem rdAddr dout-    (rdAddr,dout,ipntr) = mealyB cpu (C.replicate d7 0) (memOut,instr)-    instr  = asyncRom instrs <$> ipntr+let system+      :: (KnownNat n, HiddenClockResetEnable dom )+      => Vec n Instruction+      -> Signal dom Value+    system instrs = memOut+      where+        memOut = dataMem rdAddr dout+        (rdAddr,dout,ipntr) = mealyB cpu (C.replicate d7 0) (memOut,instr)+        instr  = asyncRom instrs <$> ipntr :}  >>> :{@@ -563,69 +566,69 @@ :}  >>> :{-system2-  :: ( KnownNat n-     , HiddenClockResetEnable dom  )-  => Vec n Instruction-  -> Signal dom Value-system2 instrs = memOut-  where-    memOut = asyncRam d32 rdAddr dout-    (rdAddr,dout,ipntr) = mealyB cpu (C.replicate d7 0) (memOut,instr)-    instr  = asyncRom instrs <$> ipntr+let system2+      :: ( KnownNat n+         , HiddenClockResetEnable dom  )+      => Vec n Instruction+      -> Signal dom Value+    system2 instrs = memOut+      where+        memOut = asyncRam d32 rdAddr dout+        (rdAddr,dout,ipntr) = mealyB cpu (C.replicate d7 0) (memOut,instr)+        instr  = asyncRom instrs <$> ipntr :}  >>> :{-cpu2-  :: (Vec 7 Value,Reg)-  -- ^ (Register bank, Load reg addr)-  -> (Value,Instruction)-  -- ^ (Memory output, Current instruction)-  -> ( (Vec 7 Value,Reg)-     , (MemAddr, Maybe (MemAddr, Value), InstrAddr)-     )-cpu2 (regbank,ldRegD) (memOut,instr) =-  ((regbank', ldRegD'), (rdAddr, (,aluOut) <$> wrAddrM, fromIntegral ipntr))- where-  -- Current instruction pointer-  ipntr = regbank C.!! PC-  -- Decoder-  (MachCode {..}) = case instr of-    Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op}-    Branch cr a          -> nullCode {inputX=cr,jmpM=Just a}-    Jump a               -> nullCode {aluCode=Incr,jmpM=Just a}-    Load a r             -> nullCode {ldReg=r,rdAddr=a}-    Store r a            -> nullCode {inputX=r,wrAddrM=Just a}-    Nop                  -> nullCode-  -- ALU-  regX   = regbank C.!! inputX-  regY   = regbank C.!! inputY-  aluOut = alu aluCode regX regY-  -- next instruction-  nextPC =-    case jmpM of-      Just a | aluOut /= 0 -> ipntr + a-      _                    -> ipntr + 1-  -- update registers-  ldRegD'  = ldReg -- Delay the ldReg by 1 cycle-  regbank' = replace Zero   0-           $ replace PC     nextPC-           $ replace result aluOut-           $ replace ldRegD memOut-           $ regbank+let cpu2+      :: (Vec 7 Value,Reg)+      -- ^ (Register bank, Load reg addr)+      -> (Value,Instruction)+      -- ^ (Memory output, Current instruction)+      -> ( (Vec 7 Value,Reg)+         , (MemAddr, Maybe (MemAddr, Value), InstrAddr)+         )+    cpu2 (regbank,ldRegD) (memOut,instr) =+      ((regbank', ldRegD'), (rdAddr, (,aluOut) <$> wrAddrM, fromIntegral ipntr))+     where+      -- Current instruction pointer+      ipntr = regbank C.!! PC+      -- Decoder+      (MachCode {..}) = case instr of+        Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op}+        Branch cr a          -> nullCode {inputX=cr,jmpM=Just a}+        Jump a               -> nullCode {aluCode=Incr,jmpM=Just a}+        Load a r             -> nullCode {ldReg=r,rdAddr=a}+        Store r a            -> nullCode {inputX=r,wrAddrM=Just a}+        Nop                  -> nullCode+      -- ALU+      regX   = regbank C.!! inputX+      regY   = regbank C.!! inputY+      aluOut = alu aluCode regX regY+      -- next instruction+      nextPC =+        case jmpM of+          Just a | aluOut /= 0 -> ipntr + a+          _                    -> ipntr + 1+      -- update registers+      ldRegD'  = ldReg -- Delay the ldReg by 1 cycle+      regbank' = replace Zero   0+               $ replace PC     nextPC+               $ replace result aluOut+               $ replace ldRegD memOut+               $ regbank :}  >>> :{-system3-  :: ( KnownNat n-     , HiddenClockResetEnable dom  )-  => Vec n Instruction-  -> Signal dom Value-system3 instrs = memOut-  where-    memOut = blockRam (C.replicate d32 0) rdAddr dout-    (rdAddr,dout,ipntr) = mealyB cpu2 ((C.replicate d7 0),Zero) (memOut,instr)-    instr  = asyncRom instrs <$> ipntr+let system3+      :: ( KnownNat n+         , HiddenClockResetEnable dom  )+      => Vec n Instruction+      -> Signal dom Value+    system3 instrs = memOut+      where+        memOut = blockRam (C.replicate d32 0) rdAddr dout+        (rdAddr,dout,ipntr) = mealyB cpu2 ((C.replicate d7 0),Zero) (memOut,instr)+        instr  = asyncRom instrs <$> ipntr :}  >>> :{

@@ -30,6 +30,9 @@  {- $setup >>> :set -XDataKinds -XTypeApplications+>>> :m -Clash.Explicit.Prelude+>>> :m -Clash.Explicit.Prelude.Safe+>>> :m -Clash.Prelude.Safe >>> import Clash.Prelude >>> :{ let macT s (x,y) = (s',s)

@@ -31,6 +31,8 @@  {- $setup >>> :set -XDataKinds -XTypeApplications+>>> :m -Clash.Explicit.Prelude+>>> :m -Clash.Explicit.Prelude.Safe >>> import Clash.Prelude >>> :{ let macT s (x,y) = x * y + s

@@ -156,6 +156,8 @@  {- $setup >>> :set -XFlexibleContexts -XTypeApplications+>>> :m -Clash.Explicit.Prelude+>>> import Clash.Prelude.Safe >>> let rP = registerB (8,8) -} 

@@ -41,7 +41,11 @@  {- $setup >>> :set -XTemplateHaskell -XDataKinds -XTypeApplications+>>> :m -Clash.Explicit.Prelude+>>> :m -Clash.Explicit.Prelude.Safe+>>> :m -Clash.Explicit.Testbench >>> import Clash.Prelude+>>> import Clash.Prelude.Testbench >>> let testInput = stimuliGenerator $(listToVecTH [(1::Int),3..21]) >>> let expectedOutput = outputVerifier' $(listToVecTH ([70,99,2,3,4,5,7,8,9,10]::[Int])) -}@@ -95,8 +99,8 @@ -- testInput = 'stimuliGenerator' $('Clash.Sized.Vector.listToVecTH' [(1::Int),3..21]) -- @ ----- >>> sampleN 13 testInput--- [1,3,5,7,9,11,13,15,17,19,21,21,21]+-- >>> sampleN @System 13 testInput+-- [1,1,3,5,7,9,11,13,15,17,19,21,21] stimuliGenerator   :: ( KnownNat l      , HiddenClock dom@@ -120,26 +124,29 @@ -- @ -- -- >>> import qualified Data.List as List--- >>> sampleN 12 (expectedOutput (fromList ([0..10] List.++ [10,10,10])))+-- >>> sampleN @System 12 (expectedOutput (fromList (0:[0..10] List.++ [10,10,10]))) -- <BLANKLINE>--- cycle(system10000): 0, outputVerifier'+-- cycle(<Clock: System>): 0, outputVerifier -- expected value: 70, not equal to actual value: 0 -- [False--- cycle(system10000): 1, outputVerifier'+-- cycle(<Clock: System>): 1, outputVerifier+-- expected value: 70, not equal to actual value: 0+-- ,False+-- cycle(<Clock: System>): 2, outputVerifier -- expected value: 99, not equal to actual value: 1 -- ,False,False,False,False,False--- cycle(system10000): 6, outputVerifier'+-- cycle(<Clock: System>): 7, outputVerifier -- expected value: 7, not equal to actual value: 6 -- ,False--- cycle(system10000): 7, outputVerifier'+-- cycle(<Clock: System>): 8, outputVerifier -- expected value: 8, not equal to actual value: 7 -- ,False--- cycle(system10000): 8, outputVerifier'+-- cycle(<Clock: System>): 9, outputVerifier -- expected value: 9, not equal to actual value: 8 -- ,False--- cycle(system10000): 9, outputVerifier'+-- cycle(<Clock: System>): 10, outputVerifier -- expected value: 10, not equal to actual value: 9--- ,False,True,True]+-- ,False,True] -- -- If your working with 'BitVector's containing don't care bits you should use 'outputVerifierBitVector''. outputVerifier'

@@ -27,6 +27,8 @@   , withSNat     -- ** Conversion   , snatToInteger, snatToNatural, snatToNum+    -- ** Conversion (ambiguous types)+  , natToInteger, natToNatural, natToNum     -- ** Arithmetic   , addSNat, mulSNat, powSNat, minSNat, maxSNat, succSNat     -- *** Partial@@ -115,15 +117,41 @@ withSNat :: KnownNat n => (SNat n -> a) -> a withSNat f = f SNat +-- | Same as 'snatToInteger' and 'GHC.TypeLits.natVal', but doesn't take term+-- arguments. Example usage:+--+-- >>> natToInteger @5+-- 5+natToInteger :: forall n . KnownNat n => Integer+natToInteger = snatToInteger (SNat @n)+{-# INLINE natToInteger #-}+ -- | Reify the type-level 'Nat' @n@ to it's term-level 'Integer' representation. snatToInteger :: SNat n -> Integer snatToInteger p@SNat = natVal p {-# INLINE snatToInteger #-} +-- | Same as 'snatToNatural' and 'GHC.TypeNats.natVal', but doesn't take term+-- arguments. Example usage:+--+-- >>> natToNatural @5+-- 5+natToNatural :: forall n . KnownNat n => Natural+natToNatural = snatToNatural (SNat @n)+{-# INLINE natToNatural #-}++-- | Reify the type-level 'Nat' @n@ to it's term-level 'Natural'. snatToNatural :: SNat n -> Natural snatToNatural = naturalFromInteger . snatToInteger {-# INLINE snatToNatural #-} +-- | Same as 'snatToNum', but doesn't take term arguments. Example usage:+--+-- >>> natToNum @5 @Int+-- 5+natToNum :: forall n a . (Num a, KnownNat n) => a+natToNum = snatToNum (SNat @n)+{-# INLINE natToNum #-}  -- | Reify the type-level 'Nat' @n@ to it's term-level 'Num'ber. snatToNum :: forall a n . Num a => SNat n -> a@@ -358,11 +386,11 @@ toBNat :: SNat n -> BNat n toBNat s@SNat = toBNat' (snatToInteger s)   where-    toBNat' :: Integer -> BNat m+    toBNat' :: forall m . Integer -> BNat m     toBNat' 0 = unsafeCoerce BT     toBNat' n = case n `divMod` 2 of-      (n',1) -> unsafeCoerce (B1 (toBNat' n'))-      (n',_) -> unsafeCoerce (B0 (toBNat' n'))+      (n',1) -> unsafeCoerce (B1 (toBNat' @(Div (m-1) 2) n'))+      (n',_) -> unsafeCoerce (B0 (toBNat' @(Div m 2) n'))  -- | Convert a base-2 encoded natural number to its singleton representation --

@@ -278,22 +278,25 @@  {- $setup >>> :set -XFlexibleContexts -XTypeApplications+>>> :m -Clash.Explicit.Prelude+>>> :m -Clash.Explicit.Prelude.Safe+>>> import Clash.Prelude >>> import Clash.Promoted.Nat (SNat(..)) >>> import Clash.XException (printX) >>> import Control.Applicative (liftA2) >>> let oscillate = register False (not <$> oscillate) >>> let count = regEn 0 oscillate (count + 1) >>> :{-sometimes1 = s where-  s = register Nothing (switch <$> s)-  switch Nothing = Just 1-  switch _       = Nothing+let sometimes1 = s where+      s = register Nothing (switch <$> s)+      switch Nothing = Just 1+      switch _       = Nothing :}  >>> :{-countSometimes = s where-  s     = regMaybe 0 (plusM (pure <$> s) sometimes1)-  plusM = liftA2 (liftA2 (+))+let countSometimes = s where+      s     = regMaybe 0 (plusM (pure <$> s) sometimes1)+      plusM = liftA2 (liftA2 (+)) :}  -}@@ -521,6 +524,7 @@ -- -- <Clash-Signal.html#hiddenclockandreset Click here to read more about hidden clocks, resets, and enables> --+#ifdef CLASH_MULTIPLE_HIDDEN -- === __Example__ -- 'exposeSpecificClock' can only be used when it can find the specified domain -- in /r/:@@ -536,6 +540,7 @@ -- reg = 'register' @@dom 5 (reg + 1) -- sig = exposeSpecificClock @@dom reg 'clockGen' -- @+#endif -- exposeSpecificClock    :: forall dom  r@@ -716,6 +721,7 @@ -- -- <Clash-Signal.html#hiddenclockandreset Click here to read more about hidden clocks, resets, and enables> --+#ifdef CLASH_MULTIPLE_HIDDEN -- === __Example__ -- 'exposeSpecificReset' can only be used when it can find the specified domain -- in /r/:@@ -731,6 +737,7 @@ -- reg = 'register' @@dom 5 (reg + 1) -- sig = exposeSpecificReset @@dom reg 'resetGen' -- @+#endif -- exposeSpecificReset   :: forall dom r@@ -910,6 +917,7 @@ -- -- <Clash-Signal.html#hiddenclockandreset Click here to read more about hidden clocks, resets, and enables> --+#ifdef CLASH_MULTIPLE_HIDDEN -- === __Example__ -- 'exposeSpecificEnable' can only be used when it can find the specified domain -- in /r/:@@ -925,6 +933,7 @@ -- reg = 'register' @@dom 5 (reg + 1) -- sig = exposeSpecificEnable @@dom reg 'enableGen' -- @+#endif -- exposeSpecificEnable   :: forall dom r@@ -1284,8 +1293,8 @@   E.dflipflop (fromLabel @(HiddenClockName dom)) {-# INLINE dflipflop #-} --- | 'delay' @s@ delays the values in 'Signal' @s@ for once cycle, the value--- at time 0 is /dflt/.+-- | 'delay' @dflt@ @s@ delays the values in 'Signal' @s@ for once cycle, the+-- value at time 0 is /dflt/. -- -- >>> sampleN @System 3 (delay 0 (fromList [1,2,3,4])) -- [0,1,2]@@ -1366,9 +1375,9 @@    . ( HiddenClockResetEnable dom      , NFDataX a )   => a-  -- ^ Reset value-  ---  -- 'register' outputs the reset value when the reset value is active+  -- ^ Reset value. 'register' outputs the reset value when the reset is active.+  -- If the domain has initial values enabled, the reset value will also be the+  -- initial value.   -> Signal dom a   -> Signal dom a register i s =@@ -1408,6 +1417,8 @@      , NFDataX a )   => a   -- ^ Reset value. 'regMaybe' outputs the reset value when the reset is active.+  -- If the domain has initial values enabled, the reset value will also be the+  -- initial value.   -> Signal dom (Maybe a)   -> Signal dom a regMaybe initial iM =@@ -1439,9 +1450,9 @@    . ( HiddenClockResetEnable dom      , NFDataX a )   => a-  -- ^ Reset value-  ---  -- 'regEn' outputs the reset value when the reset value is active+  -- ^ Reset value. 'regEn' outputs the reset value when the reset is active.+  -- If the domain has initial values enabled, the reset value will also be the+  -- initial value.   -> Signal dom Bool   -> Signal dom a   -> Signal dom a@@ -1457,7 +1468,7 @@  -- * Signal -> List conversion --- | Get an infinite list of samples from a 'Clash.Signal.Signal'+-- | Get an infinite list of samples from a 'Signal' -- -- The elements in the list correspond to the values of the 'Signal' -- at consecutive clock cycles@@ -1512,9 +1523,9 @@   S.sampleN n s1 {-# NOINLINE sampleN #-} --- | Get a list of samples from a 'Signal', while asserting the reset line--- for /n/ clock cycles. 'sampleWithReset' does not return the first /n/ cycles,--- i.e., when the reset is asserted.+-- | Get an infinite list of samples from a 'Signal', while asserting the reset+-- line for /m/ clock cycles. 'sampleWithReset' does not return the first /m/+-- cycles, i.e., when the reset is asserted. -- -- __NB__: This function is not synthesizable sampleWithReset@@ -1533,8 +1544,8 @@   drop (snatToNum nReset) (S.sample f1) {-# NOINLINE sampleWithReset #-} --- | Get a fine list of /m/ samples from a 'Signal', while asserting the reset line--- for /n/ clock cycles. 'sampleWithReset' does not return the first /n/ cycles,+-- | Get a list of /n/ samples from a 'Signal', while asserting the reset line+-- for /m/ clock cycles. 'sampleWithReset' does not return the first /m/ cycles, -- i.e., while the reset is asserted. -- -- __NB__: This function is not synthesizable@@ -1554,7 +1565,7 @@ sampleWithResetN nReset nSamples f =   take nSamples (sampleWithReset nReset f) --- | /Lazily/ get an infinite list of samples from a 'Clash.Signal.Signal'+-- | /Lazily/ get an infinite list of samples from a 'Signal' -- -- The elements in the list correspond to the values of the 'Signal' -- at consecutive clock cycles

@@ -43,7 +43,10 @@ cycle.  @--- | Alternatively read / increment+write+import Clash.Explicit.Prelude+import Clash.Signal.BiSignal++-- | Alternatingly read / increment+write counter   :: (Bool, Int)   -- ^ Internal flip + previous read@@ -59,26 +62,29 @@ -- | Write on odd cyles f :: Clock System   -> Reset System-  -> BiSignalIn  Floating System (BitSize Int)-  -> BiSignalOut Floating System (BitSize Int)-f clk rst s = writeToBiSignal s (mealy clk rst counter (False, 0) (readFromBiSignal s))+  -> Enable System+  -> BiSignalIn  'Floating System (BitSize Int)+  -> BiSignalOut 'Floating System (BitSize Int)+f clk rst en s = writeToBiSignal s (mealy clk rst en counter (False, 0) (readFromBiSignal s))  -- | Write on even cyles g :: Clock System   -> Reset System-  -> BiSignalIn  Floating System (BitSize Int)-  -> BiSignalOut Floating System (BitSize Int)-g clk rst s = writeToBiSignal s (mealy clk rst counter (True, 0) (readFromBiSignal s))+  -> Enable System+  -> BiSignalIn  'Floating System (BitSize Int)+  -> BiSignalOut 'Floating System (BitSize Int)+g clk rst en s = writeToBiSignal s (mealy clk rst en counter (True, 0) (readFromBiSignal s))   -- | Connect the /f/ and /g/ circuits to the same bus topEntity   :: Clock System   -> Reset System+  -> Enable System   -> Signal System Int-topEntity clk rst = readFromBiSignal bus'+topEntity clk rst en = readFromBiSignal bus'   where-    bus  = mergeBiSignalOuts $ f clk rst bus' :> g clk rst bus' :> Nil+    bus  = mergeBiSignalOuts $ f clk rst en bus' :> g clk rst en bus' :> Nil     bus' = veryUnsafeToBiSignalIn bus @ -}@@ -167,19 +173,14 @@ type instance HasDomain dom1 (BiSignalOut ds dom2 n) = DomEq dom1 dom2 type instance TryDomain t (BiSignalOut ds dom n) = 'Found dom -#if MIN_VERSION_base(4,11,0) instance Semigroup (BiSignalOut defaultState dom n) where   (BiSignalOut b1) <> (BiSignalOut b2) = BiSignalOut (b1 ++ b2)-#endif  -- | Monoid instance to support concatenating -- -- __NB__ Not synthesizable instance Monoid (BiSignalOut defaultState dom n) where-  mempty                                    = BiSignalOut []-#if !MIN_VERSION_base(4,11,0)-  mappend (BiSignalOut b1) (BiSignalOut b2) = BiSignalOut $ b1 ++ b2-#endif+  mempty = BiSignalOut []  -- /Lazily/ prepend a value to a 'BiSignalIn'. --

@@ -48,7 +48,7 @@ import Clash.Sized.RTree            (RTree, lazyT)  -- | Isomorphism between a 'Clash.Signal.Signal' of a product type (e.g. a tuple) and a--- product type of 'Clash.Signal.Signal''s.+-- product type of 'Clash.Signal.Signal's. -- -- Instances of 'Bundle' must satisfy the following laws: --

@@ -58,6 +58,8 @@  {- $setup >>> :set -XDataKinds -XTypeOperators -XTypeApplications -XFlexibleContexts+>>> :m -Clash.Explicit.Prelude+>>> :m -Clash.Explicit.Prelude.Safe >>> import Clash.Prelude >>> let delay3 = delayed (-1 :> -1 :> -1 :> Nil) >>> let delay2 = delayedI :: HiddenClockResetEnable dom  => Int -> DSignal dom n Int -> DSignal dom (n + 2) Int

@@ -48,6 +48,9 @@ {- $setup >>> :set -XDataKinds >>> :set -XTypeOperators+>>> :m -Clash.Prelude+>>> :m -Clash.Prelude.Safe+>>> :m -Clash.Signal >>> import Clash.Explicit.Prelude >>> :{ let mac :: Clock System

@@ -161,6 +161,9 @@ >>> :set -XDataKinds >>> :set -XMagicHash >>> :set -XTypeApplications+>>> :m -Clash.Prelude+>>> :m -Clash.Signal+>>> import Clash.Signal.Internal >>> import Clash.Promoted.Nat >>> import Clash.XException >>> type System = "System"

@@ -113,6 +113,7 @@ import qualified Data.Text             as Text import           Data.Time.Clock       (UTCTime, getCurrentTime) import           Data.Time.Format      (formatTime, defaultTimeLocale)+import           GHC.Natural           (Natural) import           GHC.Stack             (HasCallStack) import           GHC.TypeLits          (KnownNat, type (+)) import           System.IO.Unsafe      (unsafePerformIO)@@ -125,7 +126,7 @@  type Period   = Int type Changed  = Bool-type Value    = (Integer, Integer) -- (Mask, Value)+type Value    = (Natural, Natural) -- (Mask, Value) type Width    = Int  -- | Serialized TypeRep we need to store for dumpReplayable / replay

@@ -6,7 +6,9 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}@@ -131,7 +133,15 @@ import Data.Typeable              (Typeable, typeOf) import GHC.Generics               (Generic) import Data.Maybe                 (fromMaybe)-import GHC.Integer                (smallInteger)+import GHC.Exts+  (Word#, Word (W#), eqWord#, int2Word#, uncheckedShiftRL#)+import qualified GHC.Exts+import GHC.Integer.GMP.Internals  (Integer (..), bigNatToWord, shiftRBigNat)+import GHC.Natural+  (Natural (..), naturalFromInteger, wordToNatural)+#if MIN_VERSION_base(4,12,0)+import GHC.Natural                (naturalToInteger)+#endif import GHC.Prim                   (dataToTag#) import GHC.Stack                  (HasCallStack, withFrozenCallStack) import GHC.TypeLits               (KnownNat, Nat, type (+), type (-), natVal)@@ -146,10 +156,12 @@                                    SaturationMode (..)) import Clash.Class.Resize         (Resize (..)) import Clash.Promoted.Nat-  (SNat (..), SNatLE (..), compareSNat, snatToInteger, snatToNum)+  (SNat (..), SNatLE (..), compareSNat, snatToInteger, snatToNum, natToNum) import Clash.XException   (ShowX (..), NFDataX (..), errorX, isX, showsPrecXWith, rwhnfX) +import Clash.Sized.Internal.Mod+ import {-# SOURCE #-} qualified Clash.Sized.Vector         as V import {-# SOURCE #-} qualified Clash.Sized.Internal.Index as I import                qualified Data.List                  as L@@ -157,6 +169,7 @@ {- $setup >>> :set -XTemplateHaskell >>> :set -XBinaryLiterals+>>> import Clash.Sized.Internal.BitVector -}  -- * Type definitions@@ -168,8 +181,8 @@ data BitVector (n :: Nat) =     -- | The constructor, 'BV', and  the field, 'unsafeToInteger', are not     -- synthesizable.-    BV { unsafeMask      :: !Integer-       , unsafeToInteger :: !Integer+    BV { unsafeMask      :: !Natural+       , unsafeToNatural :: !Natural        }   deriving (Data, Generic) @@ -179,8 +192,8 @@ data Bit =   -- | The constructor, 'Bit', and  the field, 'unsafeToInteger#', are not   -- synthesizable.-  Bit { unsafeMask#      :: !Integer-      , unsafeToInteger# :: !Integer+  Bit { unsafeMask#      :: {-# unpack #-} !Word+      , unsafeToInteger# :: {-# unpack #-} !Word       }   deriving (Data, Generic) @@ -217,7 +230,7 @@   hasUndefined bv = isLeft (isX bv) || unsafeMask# bv /= 0  instance Lift Bit where-  lift (Bit m i) = [| fromInteger## m i |]+  lift (Bit m i) = [| fromInteger## $(litE (WordPrimL (toInteger m))) i |]   {-# NOINLINE lift #-}  instance Eq Bit where@@ -249,7 +262,7 @@ {-# NOINLINE le## #-}  instance Enum Bit where-  toEnum     = fromInteger## 0 . toInteger+  toEnum     = fromInteger## 0## . toInteger   fromEnum b = if eq## b low then 0 else 1  instance Bounded Bit where@@ -266,10 +279,10 @@   negate      = complement##   abs         = id   signum b    = b-  fromInteger = fromInteger## 0+  fromInteger = fromInteger## 0## -fromInteger## :: Integer -> Integer -> Bit-fromInteger## m i = Bit (m `mod` 2) (i `mod` 2)+fromInteger## :: Word# -> Integer -> Bit+fromInteger## m# i = Bit ((W# m#) `mod` 2) (fromInteger i `mod` 2) {-# NOINLINE fromInteger## #-}  instance Real Bit where@@ -310,26 +323,33 @@   countTrailingZeros b = if eq## b low then 1 else 0  and##, or##, xor## :: Bit -> Bit -> Bit-and## b1 b2 = unpack# $ and# (pack# b1) (pack# b2)+and## (Bit m1 v1) (Bit m2 v2) = Bit mask (v1 .&. v2 .&. complement mask)+  where mask = (m1.&.v2 .|. m1.&.m2 .|. m2.&.v1) {-# NOINLINE and## #-} -or## b1 b2 = unpack# $ or# (pack# b1) (pack# b2)+or## (Bit m1 v1) (Bit m2 v2) = Bit mask ((v1 .|. v2) .&. complement mask)+  where mask = m1 .&. complement v2 .|.  m1.&.m2  .|.  m2 .&. complement v1 {-# NOINLINE or## #-} -xor## b1 b2 = unpack# $ xor# (pack# b1) (pack# b2)+xor## (Bit m1 v1) (Bit m2 v2) = Bit mask ((v1 `xor` v2) .&. complement mask)+  where mask = m1 .|. m2 {-# NOINLINE xor## #-}  complement## :: Bit -> Bit-complement## = unpack# . complement# . pack#+complement## (Bit m v) = Bit m (complementB v .&. complementB m)+  where complementB (W# b#) = W# (int2Word# (eqWord# b# 0##)) {-# NOINLINE complement## #-}  -- *** BitPack pack# :: Bit -> BitVector 1-pack# (Bit m b) = BV m b+pack# (Bit (W# m) (W# b)) = BV (NatS# m) (NatS# b) {-# NOINLINE pack# #-}  unpack# :: BitVector 1 -> Bit-unpack# (BV m b) = Bit m b+unpack# (BV m b) = Bit (go m) (go b)+ where+  go (NatS# w) = W# w+  go (NatJ# w) = W# (bigNatToWord w) {-# NOINLINE unpack# #-}  -- * Instances@@ -387,14 +407,17 @@ -- >>> $$(bLit "1.0.") :: BitVector 4 -- 1.0. bLit :: forall n. KnownNat n => String -> Q (TExp (BitVector n))-bLit s = [|| fromInteger# m i ||]+bLit s = [|| fromInteger# m i1 ||]   where     bv :: BitVector n     bv = read# s -    m,i :: Integer+    m,i :: Natural     BV m i = bv +    i1 :: Integer+    i1 = toInteger i+ read# :: KnownNat n => String -> BitVector n read# cs = BV m v   where@@ -455,44 +478,62 @@   enumFromTo     = enumFromTo#   enumFromThenTo = enumFromThenTo# +enumFrom# :: forall n. KnownNat n => BitVector n -> [BitVector n]+enumFrom# (BV 0 x) = map (BV 0 . (`mod` m)) [x .. unsafeToNatural (maxBound :: BitVector n)]+  where m = 1 `shiftL` fromInteger (natVal (Proxy @n))+enumFrom# bv = undefErrorU "enumFrom" bv {-# NOINLINE enumFrom# #-}-{-# NOINLINE enumFromThen# #-}-{-# NOINLINE enumFromTo# #-}-{-# NOINLINE enumFromThenTo# #-}-enumFrom#       :: forall n. KnownNat n => BitVector n -> [BitVector n]-enumFromThen#   :: forall n. KnownNat n => BitVector n -> BitVector n -> [BitVector n]-enumFromTo#     :: KnownNat n => BitVector n -> BitVector n -> [BitVector n]-enumFromThenTo# :: KnownNat n => BitVector n -> BitVector n -> BitVector n -> [BitVector n] -enumFrom# (BV 0 x)                           = map (fromInteger_INLINE 0) [x .. unsafeToInteger (maxBound :: BitVector n)]-enumFrom# bv-  = undefErrorU "enumFrom" bv--enumFromThen# (BV 0 x) (BV 0 y)              = map (fromInteger_INLINE 0) [x, y .. unsafeToInteger (maxBound :: BitVector n)]-enumFromThen# bv1 bv2-  = undefErrorP "enumFromThen" bv1 bv2+enumFromThen#+  :: forall n+   . KnownNat n+  => BitVector n+  -> BitVector n+  -> [BitVector n]+enumFromThen# (BV 0 x) (BV 0 y) =+  toBvs [x, y .. unsafeToNatural bound]+ where+  bound = if x <= y then maxBound else minBound :: BitVector n+  toBvs = map (BV 0 . (`mod` m))+  m = 1 `shiftL` fromInteger (natVal (Proxy @n))+enumFromThen# bv1 bv2 = undefErrorP "enumFromThen" bv1 bv2+{-# NOINLINE enumFromThen# #-} -enumFromTo# (BV 0 x) (BV 0 y)                = map (BV 0) [x .. y]-enumFromTo# bv1 bv2-  = undefErrorP "enumFromTo" bv1 bv2+enumFromTo#+  :: forall n+   . KnownNat n+  => BitVector n+  -> BitVector n+  -> [BitVector n]+enumFromTo# (BV 0 x) (BV 0 y) = map (BV 0 . (`mod` m)) [x .. y]+  where m = 1 `shiftL` fromInteger (natVal (Proxy @n))+enumFromTo# bv1 bv2 = undefErrorP "enumFromTo" bv1 bv2+{-# NOINLINE enumFromTo# #-} -enumFromThenTo# (BV 0 x1) (BV 0 x2) (BV 0 y) = map (BV 0) [x1, x2 .. y]-enumFromThenTo# bv1 bv2 bv3-  = undefErrorP3 "enumFromTo" bv1 bv2 bv3+enumFromThenTo#+  :: forall n+   . KnownNat n+  => BitVector n+  -> BitVector n+  -> BitVector n+  -> [BitVector n]+enumFromThenTo# (BV 0 x1) (BV 0 x2) (BV 0 y) = map (BV 0 . (`mod` m)) [x1, x2 .. y]+  where m = 1 `shiftL` fromInteger (natVal (Proxy @n))+enumFromThenTo# bv1 bv2 bv3 = undefErrorP3 "enumFromTo" bv1 bv2 bv3+{-# NOINLINE enumFromThenTo# #-}   instance KnownNat n => Bounded (BitVector n) where   minBound = minBound#   maxBound = maxBound# -{-# NOINLINE minBound# #-} minBound# :: BitVector n minBound# = BV 0 0+{-# NOINLINE minBound# #-} +maxBound# :: forall n. KnownNat n => BitVector n+maxBound# = let m = 1 `shiftL` natToNum @n in BV 0 (m-1) {-# NOINLINE maxBound# #-}-maxBound# :: forall n . KnownNat n => BitVector n-maxBound# = let m = 1 `shiftL` fromInteger (natVal (Proxy @n))-            in  BV 0 (m-1)  instance KnownNat n => Num (BitVector n) where   (+)         = (+#)@@ -505,40 +546,45 @@  (+#),(-#),(*#) :: forall n . KnownNat n => BitVector n -> BitVector n -> BitVector n {-# NOINLINE (+#) #-}-(+#) (BV 0 i) (BV 0 j) =-  let m = 1 `shiftL` fromInteger (natVal (Proxy @n))-      z = i + j-  in  if z >= m then BV 0 (z - m) else BV 0 z-(+#) bv1 bv2 = undefErrorI "+" bv1 bv2+(+#) = go+  where+    go (BV 0 i) (BV 0 j) = BV 0 (addMod m i j)+    go bv1 bv2 = undefErrorI "+" bv1 bv2 +    m = 1 `shiftL` fromInteger (natVal (Proxy @n))+ {-# NOINLINE (-#) #-}-(-#) (BV 0 i) (BV 0 j) =-  let m = 1 `shiftL` fromInteger (natVal (Proxy @n))-      z = i - j-  in  if z < 0 then BV 0 (m + z) else BV 0 z-(-#) bv1 bv2 = undefErrorI "-" bv1 bv2+(-#) = go+  where+    go (BV 0 i) (BV 0 j) = BV 0 (subMod m i j)+    go bv1 bv2 = undefErrorI "-" bv1 bv2 +    m = 1 `shiftL` fromInteger (natVal (Proxy @n))+ {-# NOINLINE (*#) #-}-(*#) (BV 0 i) (BV 0 j) = fromInteger_INLINE 0 (i * j)-(*#) bv1 bv2 = undefErrorI "*" bv1 bv2+(*#) = go+ where+  go (BV 0 i) (BV 0 j) = BV 0 (mulMod2 m i j)+  go bv1 bv2 = undefErrorI "*" bv1 bv2 +  m = (1 `shiftL` fromInteger (natVal (Proxy @n))) - 1+ {-# NOINLINE negate# #-} negate# :: forall n . KnownNat n => BitVector n -> BitVector n-negate# (BV 0 0) = BV 0 0-negate# (BV 0 i) = BV 0 (sz - i)-  where-    sz = 1 `shiftL` fromInteger (natVal (Proxy @n))-negate# bv = undefErrorU "negate" bv+negate# = go+ where+  go (BV 0 i) = BV 0 (negateMod m i)+  go bv = undefErrorU "negate" bv -{-# NOINLINE fromInteger# #-}-fromInteger# :: KnownNat n => Integer -> Integer -> BitVector n-fromInteger# = fromInteger_INLINE+  m = 1 `shiftL` fromInteger (natVal (Proxy @n)) -{-# INLINE fromInteger_INLINE #-}-fromInteger_INLINE :: forall n . KnownNat n => Integer -> Integer -> BitVector n-fromInteger_INLINE m i = sz `seq` BV (m `mod` sz) (i `mod` sz)+{-# NOINLINE fromInteger# #-}+fromInteger# :: KnownNat n => Natural -> Integer -> BitVector n+fromInteger# m i = sz `seq` mx   where-    sz = 1 `shiftL` fromInteger (natVal (Proxy @n))+    mx = BV (m `mod` naturalFromInteger sz)+            (naturalFromInteger (i `mod` sz))+    sz  = 1 `shiftL` fromInteger (natVal mx) :: Integer  instance (KnownNat m, KnownNat n) => ExtendingNum (BitVector m) (BitVector n) where   type AResult (BitVector m) (BitVector n) = BitVector (Max m n + 1)@@ -550,22 +596,22 @@ {-# NOINLINE plus# #-} plus# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (Max m n + 1) plus# (BV 0 a) (BV 0 b) = BV 0 (a + b)-plus# bv1 bv2 = undefErrorP "plus" bv1 bv2+plus# bv1 bv2 = undefErrorP "add" bv1 bv2  {-# NOINLINE minus# #-} minus# :: forall m n . (KnownNat m, KnownNat n) => BitVector m -> BitVector n                                                 -> BitVector (Max m n + 1)-minus# (BV 0 a) (BV 0 b) =-  let sz   = fromInteger (natVal (Proxy @(Max m n + 1)))-      mask = 1 `shiftL` sz-      z    = a - b-  in  if z < 0 then BV 0 (mask + z) else BV 0 z-minus# bv1 bv2 = undefErrorP "minus" bv1 bv2+minus# = go+ where+  go (BV 0 a) (BV 0 b) = BV 0 (subMod m a b)+  go bv1 bv2 = undefErrorP "sub" bv1 bv2 +  m = 1 `shiftL` fromInteger (natVal (Proxy @(Max m n + 1)))+ {-# NOINLINE times# #-} times# :: (KnownNat m, KnownNat n) => BitVector m -> BitVector n -> BitVector (m + n) times# (BV 0 a) (BV 0 b) = BV 0 (a * b)-times# bv1 bv2 = undefErrorP "times" bv1 bv2+times# bv1 bv2 = undefErrorP "mul" bv1 bv2  instance KnownNat n => Real (BitVector n) where   toRational = toRational . toInteger#@@ -589,7 +635,7 @@  {-# NOINLINE toInteger# #-} toInteger# :: KnownNat n => BitVector n -> Integer-toInteger# (BV 0 i) = i+toInteger# (BV 0 i) = naturalToInteger i toInteger# bv = undefErrorU "toInteger" bv  instance KnownNat n => Bits (BitVector n) where@@ -627,7 +673,7 @@  {-# NOINLINE reduceAnd# #-} reduceAnd# :: KnownNat n => BitVector n -> Bit-reduceAnd# bv@(BV 0 i) = Bit 0 (smallInteger (dataToTag# check))+reduceAnd# bv@(BV 0 i) = Bit 0 (W# (int2Word# (dataToTag# check)))   where     check = i == maxI @@ -637,14 +683,14 @@  {-# NOINLINE reduceOr# #-} reduceOr# :: KnownNat n => BitVector n -> Bit-reduceOr# (BV 0 i) = Bit 0 (smallInteger (dataToTag# check))+reduceOr# (BV 0 i) = Bit 0 (W# (int2Word# (dataToTag# check)))   where     check = i /= 0 reduceOr# bv = V.foldl (.|.) 0 (V.bv2v bv)  {-# NOINLINE reduceXor# #-} reduceXor# :: KnownNat n => BitVector n -> Bit-reduceXor# (BV 0 i) = Bit 0 (toInteger (popCount i `mod` 2))+reduceXor# (BV 0 i) = Bit 0 (fromIntegral (popCount i `mod` 2)) reduceXor# bv = undefErrorU "reduceXor" bv  instance Default (BitVector n) where@@ -664,8 +710,8 @@ {-# NOINLINE index# #-} index# :: KnownNat n => BitVector n -> Int -> Bit index# bv@(BV m v) i-    | i >= 0 && i < sz = Bit (smallInteger (dataToTag# (testBit m i)))-                             (smallInteger (dataToTag# (testBit v i)))+    | i >= 0 && i < sz = Bit (W# (int2Word# (dataToTag# (testBit m i))))+                             (W# (int2Word# (dataToTag# (testBit v i))))     | otherwise        = err   where     sz  = fromInteger (natVal bv)@@ -680,15 +726,18 @@ -- | MSB msb# :: forall n . KnownNat n => BitVector n -> Bit msb# (BV m v)-  = let i = fromInteger (natVal (Proxy @n) - 1)-    in  Bit (smallInteger (dataToTag# (testBit m i)))-            (smallInteger (dataToTag# (testBit v i)))+  = Bit (msbN m)+        (msbN v)+ where+  !(S# i#) = natVal (Proxy @n)+  msbN (NatS# w)  = W# (w `uncheckedShiftRL#` (i# GHC.Exts.-# 1#))+  msbN (NatJ# bn) = W# (bigNatToWord (shiftRBigNat bn (i# GHC.Exts.-# 1#)))  {-# NOINLINE lsb# #-} -- | LSB lsb# :: BitVector n -> Bit-lsb# (BV m v) = Bit (smallInteger (dataToTag# (testBit m 0)))-                    (smallInteger (dataToTag# (testBit v 0)))+lsb# (BV m v) = Bit (W# (int2Word# (dataToTag# (testBit m 0))))+                    (W# (int2Word# (dataToTag# (testBit v 0))))  {-# NOINLINE slice# #-} slice# :: BitVector (m + 1 + i) -> SNat m -> SNat n -> BitVector (m + 1 - n)@@ -716,7 +765,7 @@ {-# NOINLINE replaceBit# #-} replaceBit# :: KnownNat n => BitVector n -> Int -> Bit -> BitVector n replaceBit# bv@(BV m v) i (Bit mb b)-    | i >= 0 && i < sz = BV (clearBit m i  .|. (mb `shiftL` i))+    | i >= 0 && i < sz = BV (clearBit m i  .|. (wordToNatural mb `shiftL` i))                             (if testBit b 0 && mb == 0 then setBit v i else clearBit v i)     | otherwise        = err   where@@ -730,20 +779,24 @@  {-# NOINLINE setSlice# #-} setSlice#-  :: BitVector (m + 1 + i)+  :: forall m i n+   . SNat (m + 1 + i)+  -> BitVector (m + 1 + i)   -> SNat m   -> SNat n   -> BitVector (m + 1 - n)   -> BitVector (m + 1 + i)-setSlice# (BV iMask i) m n (BV jMask j) = BV ((iMask .&. mask) .|. jMask')-                                             ((i     .&. mask) .|. j')-  where-    m' = snatToInteger m-    n' = snatToInteger n+setSlice# SNat =+  \(BV iMask i) m@SNat n (BV jMask j) ->+    let m' = snatToInteger m+        n' = snatToInteger n -    j'     = shiftL j     (fromInteger n')-    jMask' = shiftL jMask (fromInteger n')-    mask = complement ((2 ^ (m' + 1) - 1) `xor` (2 ^ n' - 1))+        j'     = shiftL j     (fromInteger n')+        jMask' = shiftL jMask (fromInteger n')+        mask   = complementN ((2 ^ (m' + 1) - 1) `xor` (2 ^ n' - 1))+    in  BV ((iMask .&. mask) .|. jMask') ((i .&. mask) .|. j')+ where+  complementN = complementMod (natVal (Proxy @(m + 1 + i)))  {-# NOINLINE split# #-} split#@@ -751,47 +804,57 @@    . KnownNat n   => BitVector (m + n)   -> (BitVector m, BitVector n)-split# (BV m i) = (BV lMask l, BV rMask r)-  where-    n     = fromInteger (natVal (Proxy @n))-    mask  = 1 `shiftL` n-    -- The code below is faster than:-    -- > (l,r) = i `divMod` mask-    r     = i `mod` mask-    rMask = m `mod` mask-    l     = i `shiftR` n-    lMask = m `shiftR` n-+split# (BV m i) =+  let n     = fromInteger (natVal (Proxy @n))+      mask  = maskMod (natVal (Proxy @n))+      r     = mask i+      rMask = mask m+      l     = i `shiftR` n+      lMask = m `shiftR` n+  in  (BV lMask l, BV rMask r) -and#, or#, xor# :: BitVector n -> BitVector n -> BitVector n+and#, or#, xor# :: forall n . KnownNat n => BitVector n -> BitVector n -> BitVector n {-# NOINLINE and# #-}-and# (BV m1 v1) (BV m2 v2) = BV mask (v1 .&. v2  .&. complement mask)+and# =+  \(BV m1 v1) (BV m2 v2) ->+    let mask = (m1.&.v2 .|. m1.&.m2 .|. m2.&.v1)+    in  BV mask (v1 .&. v2  .&. complementN mask)   where-    mask = (m1.&.v2 .|. m1.&.m2 .|. m2.&.v1)+    complementN = complementMod (natVal (Proxy @n))  {-# NOINLINE or# #-}-or# (BV m1 v1) (BV m2 v2) = BV mask ((v1.|.v2) .&. complement mask)+or# =+  \(BV m1 v1) (BV m2 v2) ->+    let mask = m1 .&. complementN v2  .|.  m1.&.m2  .|.  m2 .&. complementN v1+    in  BV mask ((v1.|.v2) .&. complementN mask)   where-    mask = m1 .&. complement v2  .|.  m1.&.m2  .|.  m2 .&. complement v1+    complementN = complementMod (natVal (Proxy @n))  {-# NOINLINE xor# #-}-xor# (BV m1 v1) (BV m2 v2) = BV mask ((v1 `xor` v2) .&. complement mask)+xor# =+  \(BV m1 v1) (BV m2 v2) ->+    let mask  = m1 .|. m2+    in  BV mask ((v1 `xor` v2) .&. complementN mask)   where-    mask = m1 .|. m2-+    complementN = complementMod (natVal (Proxy @n))  {-# NOINLINE complement# #-}-complement# :: KnownNat n => BitVector n -> BitVector n-complement# (BV m v) = fromInteger_INLINE m (complement v .&. complement m)+complement# :: forall n . KnownNat n => BitVector n -> BitVector n+complement# = \(BV m v) -> BV m (complementN v .&. complementN m)+  where complementN = complementMod (natVal (Proxy @n))  shiftL#, shiftR#, rotateL#, rotateR#-  :: KnownNat n => BitVector n -> Int -> BitVector n+  :: forall n . KnownNat n => BitVector n -> Int -> BitVector n  {-# NOINLINE shiftL# #-}-shiftL# (BV m v) i-  | i < 0     = error-              $ "'shiftL undefined for negative number: " ++ show i-  | otherwise = fromInteger_INLINE (shiftL m i) (shiftL v i)+shiftL# =+  \(BV msk v) i ->+    if i >= 0 then+      BV ((shiftL msk i) `mod` m) ((shiftL v i) `mod` m)+    else+      error ("'shiftL' undefined for negative number: " ++ show i)+ where+  m = 1 `shiftL` fromInteger (natVal (Proxy @n))  {-# NOINLINE shiftR# #-} shiftR# (BV m v) i@@ -800,31 +863,40 @@   | otherwise = BV (shiftR m i) (shiftR v i)  {-# NOINLINE rotateL# #-}-rotateL# _ b | b < 0   = error "'shiftL undefined for negative numbers"-rotateL# bv@(BV m v) b = fromInteger_INLINE (ml .|. mr) (vl .|. vr)-  where-    vl    = shiftL v b'-    vr    = shiftR v b''+rotateL# =+  \(BV msk v) b ->+    if b >= 0 then+      let vl    = shiftL v b'+          vr    = shiftR v b'' -    ml    = shiftL m b'-    mr    = shiftR m b''+          ml    = shiftL msk b'+          mr    = shiftR msk b'' -    b'   = b `mod` sz-    b''  = sz - b'-    sz   = fromInteger (natVal bv)+          b'   = b `mod` sz+          b''  = sz - b'+      in  BV ((ml .|. mr) `mod` m) ((vl .|. vr) `mod` m)+    else+      error "'rotateL' undefined for negative numbers"+ where+  sz = fromInteger (natVal (Proxy @n)) :: Int+  m  = 1 `shiftL` sz  {-# NOINLINE rotateR# #-}-rotateR# _ b | b < 0   = error "'shiftR undefined for negative numbers"-rotateR# bv@(BV m v) b = fromInteger_INLINE (ml .|. mr) (vl .|. vr)-  where-    vl   = shiftR v b'-    vr   = shiftL v b''-    ml   = shiftR m b'-    mr   = shiftL m b''--    b'  = b `mod` sz-    b'' = sz - b'-    sz  = fromInteger (natVal bv)+rotateR# =+  \(BV msk v) b ->+    if b >= 0 then+      let vl   = shiftR v b'+          vr   = shiftL v b''+          ml   = shiftR msk b'+          mr   = shiftL msk b''+          b'   = b `mod` sz+          b''  = sz - b'+      in  BV ((ml .|. mr) `mod` m) ((vl .|. vr) `mod` m)+    else+      error "'rotateR' undefined for negative numbers"+ where+  sz = fromInteger (natVal (Proxy @n)) :: Int+  m  = 1 `shiftL` sz  popCountBV :: forall n . KnownNat n => BitVector (n+1) -> I.Index (n+2) popCountBV bv =@@ -845,11 +917,12 @@ {-# INLINE resizeBV #-}  truncateB# :: forall a b . KnownNat a => BitVector (a + b) -> BitVector a-truncateB# (BV msk i) = fromInteger_INLINE msk i+truncateB# = \(BV msk i) -> BV (msk `mod` m) (i `mod` m)+  where m = 1 `shiftL` fromInteger (natVal (Proxy @a)) {-# NOINLINE truncateB# #-}  instance KnownNat n => Lift (BitVector n) where-  lift bv@(BV m i) = sigE [| fromInteger# m i |] (decBitVector (natVal bv))+  lift bv@(BV m i) = sigE [| fromInteger# m $(litE (IntegerL (toInteger i))) |] (decBitVector (natVal bv))   {-# NOINLINE lift #-}  decBitVector :: Integer -> TypeQ@@ -979,16 +1052,18 @@ -- False -- -- __NB__: Not synthesizable-isLike :: BitVector n -> BitVector n -> Bool-isLike (BV cMask c) (BV eMask e) = e' == c' && e' == c''-  where-    -- | set don't care bits to 0-    e' = e .&. complement eMask--    -- | checked with undefined bits set to 0-    c' = (c .&. complement cMask) .&. complement eMask-    -- | checked with undefined bits set to 1-    c'' = (c .|. cMask) .&. complement eMask+isLike :: forall n . KnownNat n => BitVector n -> BitVector n -> Bool+isLike =+  \(BV cMask c) (BV eMask e) ->+        -- set don't care bits to 0+    let e' = e .&. complementN eMask+        -- checked with undefined bits set to 0+        c' = (c .&. complementN cMask) .&. complementN eMask+        -- checked with undefined bits set to 1+        c'' = (c .|. cMask) .&. complementN eMask+    in  e' == c' && e' == c''+ where+  complementN = complementMod (natVal (Proxy @n)) {-# NOINLINE isLike #-}  fromBits :: [Bit] -> Integer

@@ -75,8 +75,13 @@ import Text.Read                  (Read (..), ReadPrec) import Language.Haskell.TH        (TypeQ, appT, conT, litT, numTyLit, sigE) import Language.Haskell.TH.Syntax (Lift(..))-import Numeric.Natural            (Natural) import GHC.Generics               (Generic)+import GHC.Natural                (Natural, naturalFromInteger)+#if MIN_VERSION_base(4,12,0)+import GHC.Natural                (naturalToInteger)+#else+import Clash.Sized.Internal.Mod   (naturalToInteger)+#endif import GHC.Stack                  (HasCallStack) import GHC.TypeLits               (KnownNat, Nat, type (+), type (-),                                    type (*), type (<=), natVal)@@ -93,10 +98,14 @@ import Clash.Prelude.BitIndex     (replaceBit) import {-# SOURCE #-} Clash.Sized.Internal.BitVector (BitVector (BV), high, low, undefError) import qualified Clash.Sized.Internal.BitVector as BV-import Clash.Promoted.Nat         (SNat(..), snatToNum, leToPlusKN)+import Clash.Promoted.Nat         (SNat(..), snatToNum, natToInteger, leToPlusKN) import Clash.XException   (ShowX (..), NFDataX (..), errorX, showsPrecXWith, rwhnfX) +{- $setup+>>> import Clash.Sized.Internal.Index+-}+ -- | Arbitrary-bounded unsigned integer represented by @ceil(log_2(n))@ bits. -- -- Given an upper bound @n@, an 'Index' @n@ number has a range of: [0 .. @n@-1]@@ -147,11 +156,11 @@  {-# NOINLINE pack# #-} pack# :: Index n -> BitVector (CLog 2 n)-pack# (I i) = BV 0 i+pack# (I i) = BV 0 (naturalFromInteger i)  {-# NOINLINE unpack# #-} unpack# :: (KnownNat n, 1 <= n) => BitVector (CLog 2 n) -> Index n-unpack# (BV 0 i) = fromInteger_INLINE i+unpack# (BV 0 i) = fromInteger_INLINE (naturalToInteger i) unpack# bv = undefError "Index.unpack" [bv]  instance Eq (Index n) where@@ -194,26 +203,32 @@   enumFromTo     = enumFromTo#   enumFromThenTo = enumFromThenTo# +enumFrom# :: forall n. KnownNat n => Index n -> [Index n]+enumFrom# x = [x .. maxBound] {-# NOINLINE enumFrom# #-}++enumFromThen# :: forall n. KnownNat n => Index n -> Index n -> [Index n]+enumFromThen# x y = if x <= y then [x, y .. maxBound] else [x, y .. minBound] {-# NOINLINE enumFromThen# #-}++enumFromTo# :: Index n -> Index n -> [Index n]+enumFromTo# x y = map I [unsafeToInteger x .. unsafeToInteger y] {-# NOINLINE enumFromTo# #-}-{-# NOINLINE enumFromThenTo# #-}-enumFrom#       :: forall n. KnownNat n => Index n -> [Index n]-enumFromThen#   :: forall n. KnownNat n => Index n -> Index n -> [Index n]-enumFromTo#     :: Index n -> Index n -> [Index n]+ enumFromThenTo# :: Index n -> Index n -> Index n -> [Index n]-enumFrom# x             = map fromInteger_INLINE [unsafeToInteger x .. unsafeToInteger (maxBound :: Index n)]-enumFromThen# x y       = map fromInteger_INLINE [unsafeToInteger x, unsafeToInteger y .. unsafeToInteger (maxBound :: Index n)]-enumFromTo# x y         = map I [unsafeToInteger x .. unsafeToInteger y] enumFromThenTo# x1 x2 y = map I [unsafeToInteger x1, unsafeToInteger x2 .. unsafeToInteger y]+{-# NOINLINE enumFromThenTo# #-}  instance KnownNat n => Bounded (Index n) where   minBound = fromInteger# 0   maxBound = maxBound# +maxBound# :: forall n. KnownNat n => Index n+maxBound# =+  case natToInteger @n of+    0 -> errorX "maxBound of 'Index 0' is undefined"+    n -> fromInteger_INLINE (n - 1) {-# NOINLINE maxBound# #-}-maxBound# :: KnownNat n => Index n-maxBound# = let res = fromInteger_INLINE (natVal res - 1) in res  -- | Operators report an error on overflow and underflow instance KnownNat n => Num (Index n) where

@@ -0,0 +1,211 @@+{-|+Copyright  :  (C) 2019, Andrew Lelechenko+License    :  MIT+Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>++This module contains code from: https://hackage.haskell.org/package/mod and has+the following license:++Copyright (c) 2019 Andrew Lelechenko++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and+associated documentation files (the "Software"), to deal in the Software without restriction,+including without limitation the rights to use, copy, modify, merge, publish, distribute,+sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or+substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT+LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE UnboxedTuples #-}++module Clash.Sized.Internal.Mod where++import GHC.Exts+  ((==#), (<=#), geWord#, isTrue#, minusWord#, plusWord#, uncheckedShiftL#, xor#,+   timesWord2#, quotRemWord2#, and#)+#if MIN_VERSION_base(4,12,0)+import GHC.Exts (addWordC#)+#endif+#if !MIN_VERSION_base(4,12,0)+import GHC.Exts (Int#, Word#, plusWord2#, word2Int#)+#endif+import GHC.Natural (Natural (..))+import GHC.Integer.GMP.Internals+  (BigNat, Integer (..), bigNatToWord, compareBigNat, minusBigNat, minusBigNatWord,+   plusBigNat, plusBigNatWord, sizeofBigNat#, bitBigNat, wordToBigNat2,+   remBigNat, timesBigNat, timesBigNatWord, xorBigNat, wordToBigNat, andBigNat)+#if !MIN_VERSION_base(4,12,0)+import GHC.Integer.GMP.Internals (wordToInteger)+#endif++#include "MachDeps.h"++-- | modular subtraction+subMod :: Natural -> Natural -> Natural -> Natural+subMod (NatS# m#) (NatS# x#) (NatS# y#) =+  if isTrue# (x# `geWord#` y#) then NatS# z# else NatS# (z# `plusWord#` m#)+  where+    z# = x# `minusWord#` y#+subMod NatS#{} _ _ = brokenInvariant+subMod (NatJ# m#) (NatS# x#) (NatS# y#) =+  if isTrue# (x# `geWord#` y#)+    then NatS# (x# `minusWord#` y#)+    else bigNatToNat $ m# `minusBigNatWord` (y# `minusWord#` x#)+subMod (NatJ# m#) (NatS# x#) (NatJ# y#) =+  bigNatToNat $ (m# `minusBigNat` y#) `plusBigNatWord` x#+subMod NatJ#{} (NatJ# x#) (NatS# y#) =+  bigNatToNat $ x# `minusBigNatWord` y#+subMod (NatJ# m#) (NatJ# x#) (NatJ# y#) = case x# `compareBigNat` y# of+  LT -> bigNatToNat $ (m# `minusBigNat` y#) `plusBigNat` x#+  EQ -> NatS# 0##+  GT -> bigNatToNat $ x# `minusBigNat` y#++-- | modular addition+addMod :: Natural -> Natural -> Natural -> Natural+addMod (NatS# m#) (NatS# x#) (NatS# y#) =+  if isTrue# c# || isTrue# (z# `geWord#` m#) then NatS# (z# `minusWord#` m#) else NatS# z#+  where+    !(# z#, c# #) = x# `addWordC#` y#+addMod NatS#{} _ _ = brokenInvariant+addMod (NatJ# m#) (NatS# x#) (NatS# y#) =+  if isTrue# c# then subIfGe (wordToBigNat2 1## z#) m# else NatS# z#+  where+    !(# z#, c# #) = x# `addWordC#` y#+addMod (NatJ# m#) (NatS# x#) (NatJ# y#) = subIfGe (y# `plusBigNatWord` x#) m#+addMod (NatJ# m#) (NatJ# x#) (NatS# y#) = subIfGe (x# `plusBigNatWord` y#) m#+addMod (NatJ# m#) (NatJ# x#) (NatJ# y#) = subIfGe (x# `plusBigNat`     y#) m#++-- | modular multiplication+mulMod :: Natural -> Natural -> Natural -> Natural+mulMod (NatS# m#) (NatS# x#) (NatS# y#) = NatS# r#+  where+    !(# z1#, z2# #) = timesWord2# x# y#+    !(# _, r# #) = quotRemWord2# z1# z2# m#+mulMod NatS#{} _ _ = brokenInvariant+mulMod (NatJ# m#) (NatS# x#) (NatS# y#) =+  bigNatToNat $ wordToBigNat2 z1# z2# `remBigNat` m#+  where+    !(# z1#, z2# #) = timesWord2# x# y#+mulMod (NatJ# m#) (NatS# x#) (NatJ# y#) =+  bigNatToNat $ (y# `timesBigNatWord` x#) `remBigNat` m#+mulMod (NatJ# m#) (NatJ# x#) (NatS# y#) =+  bigNatToNat $ (x# `timesBigNatWord` y#) `remBigNat` m#+mulMod (NatJ# m#) (NatJ# x#) (NatJ# y#) =+  bigNatToNat $ (x# `timesBigNat` y#) `remBigNat` m#++-- | modular multiplication for powers of 2, takes a mask instead of a+-- wrap-around point+mulMod2 :: Natural -> Natural -> Natural -> Natural+mulMod2 (NatS# m#) (NatS# x#) (NatS# y#) = NatS# (z2# `and#` m#)+  where+    !(# _, z2# #) = timesWord2# x# y#+mulMod2 NatS#{} _ _ = brokenInvariant+mulMod2 (NatJ# m#) (NatS# x#) (NatS# y#) =+  bigNatToNat $ wordToBigNat2 z1# z2# `andBigNat` m#+  where+    !(# z1#, z2# #) = timesWord2# x# y#+mulMod2 (NatJ# m#) (NatS# x#) (NatJ# y#) =+  bigNatToNat $ (y# `timesBigNatWord` x#) `andBigNat` m#+mulMod2 (NatJ# m#) (NatJ# x#) (NatS# y#) =+  bigNatToNat $ (x# `timesBigNatWord` y#) `andBigNat` m#+mulMod2 (NatJ# m#) (NatJ# x#) (NatJ# y#) =+  bigNatToNat $ (x# `timesBigNat` y#) `andBigNat` m#++-- | modular negations+negateMod :: Natural -> Natural -> Natural+negateMod _ (NatS# 0##) = NatS# 0##+negateMod (NatS# m#) (NatS# x#) = NatS# (m# `minusWord#` x#)+negateMod NatS#{} _ = brokenInvariant+negateMod (NatJ# m#) (NatS# x#) = bigNatToNat $ m# `minusBigNatWord` x#+negateMod (NatJ# m#) (NatJ# x#) = bigNatToNat $ m# `minusBigNat`     x#++-- | Given a size in bits, return a function that complements the bits in a+-- 'Natural' up to that size.+complementMod+  :: Integer+  -> (Natural -> Natural)+complementMod (S# sz#) =+  if isTrue# (sz# <=# WORD_SIZE_IN_BITS#) then+    let m# = if isTrue# (sz# ==# WORD_SIZE_IN_BITS#) then+#if WORD_SIZE_IN_BITS == 64+                0xFFFFFFFFFFFFFFFF##+#elif WORD_SIZE_IN_BITS == 32+                0xFFFFFFFF##+#else+#error Unhandled value for WORD_SIZE_IN_BITS+#endif+             else+               (1## `uncheckedShiftL#` sz#) `minusWord#` 1##+        go (NatS# x#) = NatS# (x# `xor#` m#)+        go (NatJ# r#) = NatS# (bigNatToWord r# `xor#` m#)+    in  go+  else+    let m# = bitBigNat sz# `minusBigNatWord` 1##++        go (NatS# x#) = bigNatToNat (xorBigNat (wordToBigNat x#) m#)+        go (NatJ# x#) = bigNatToNat (xorBigNat x# m#)+    in  go+complementMod _ = error "size too large"++-- | Keep all the bits up to a certain size+maskMod+  :: Integer+  -> (Natural -> Natural)+maskMod (S# sz#) =+  if isTrue# (sz# <=# WORD_SIZE_IN_BITS#) then+    if isTrue# (sz# ==# WORD_SIZE_IN_BITS#) then+       -- Mask equal to the word size+       let go (NatJ# x#) = NatS# (bigNatToWord x#)+           go n          = n+       in  go+    else+       let m# = (1## `uncheckedShiftL#` sz#) `minusWord#` 1##++           go (NatS# x#) = NatS# (x# `and#` m#)+           go (NatJ# x#) = NatS# (bigNatToWord x# `and#` m#)+       in  go+  else+    let m# = bitBigNat sz#++        -- faster than `andBigNat (m# `minuxBigNatWord` 1##)`+        go (NatJ# x#) = bigNatToNat (remBigNat x# m#)+        -- The mask is larger than the word size, so we can keep all the bits+        go x = x+    in  go+maskMod _ = error "size too large"++bigNatToNat :: BigNat -> Natural+bigNatToNat r# =+  if isTrue# (sizeofBigNat# r# ==# 1#) then+    NatS# (bigNatToWord r#)+  else+    NatJ# r#++subIfGe :: BigNat -> BigNat -> Natural+subIfGe z# m# = case z# `compareBigNat` m# of+  LT -> NatJ# z#+  EQ -> NatS# 0##+  GT -> bigNatToNat $ z# `minusBigNat` m#++#if !MIN_VERSION_base(4,12,0)+addWordC# :: Word# -> Word# -> (# Word#, Int# #)+addWordC# x# y# = (# z#, word2Int# c# #)+  where+    !(# c#, z# #) = x# `plusWord2#` y#++naturalToInteger :: Natural -> Integer+naturalToInteger (NatS# w)  = wordToInteger w+naturalToInteger (NatJ# bn) = Jp# bn+#endif++brokenInvariant :: a+brokenInvariant = error "argument is larger than modulo"

@@ -5,6 +5,7 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-}@@ -87,6 +88,13 @@ import Data.Proxy                     (Proxy (..)) import Text.Read                      (Read (..), ReadPrec) import GHC.Generics                   (Generic)+import GHC.Natural                    (naturalFromInteger)+#if MIN_VERSION_base(4,12,0)+import GHC.Natural                    (naturalToInteger)+#else+import Clash.Sized.Internal.Mod       (naturalToInteger)+#endif+ import GHC.TypeLits                   (KnownNat, Nat, type (+), natVal) import GHC.TypeLits.Extra             (Max) import Language.Haskell.TH            (TypeQ, appT, conT, litT, numTyLit, sigE)@@ -102,6 +110,7 @@ import Clash.Class.Resize             (Resize (..)) import Clash.Prelude.BitIndex         ((!), msb, replaceBit, split) import Clash.Prelude.BitReduction     (reduceAnd, reduceOr)+import Clash.Promoted.Nat             (natToNatural) import Clash.Sized.Internal.BitVector (BitVector (BV), Bit, (++#), high, low, undefError) import qualified Clash.Sized.Internal.BitVector as BV import Clash.XException@@ -111,7 +120,8 @@ -- bit. -- -- Uses standard 2-complements representation. Meaning that, given @n@ bits,--- a 'Signed' @n@ number has a range of: [-(2^(@n@-1)) .. 2^(@n@-1)-1]+-- a 'Signed' @n@ number has a range of: [-(2^(@n@-1)) .. 2^(@n@-1)-1] for+-- @n > 0@. When @n = 0@, both the min and max bound are 0. -- -- __NB__: The 'Num' operators perform @wrap-around@ on overflow. If you want -- saturation on overflow, check out the 'SaturatingNum' class.@@ -181,13 +191,14 @@ {-# NOINLINE pack# #-} pack# :: forall n . KnownNat n => Signed n -> BitVector n pack# (S i) = let m = 1 `shiftL` fromInteger (natVal (Proxy @n))-              in  if i < 0 then BV 0 (m + i) else BV 0 i+              in  if i < 0 then BV 0 (naturalFromInteger (m + i)) else BV 0 (naturalFromInteger i)  {-# NOINLINE unpack# #-} unpack# :: forall n . KnownNat n => BitVector n -> Signed n unpack# (BV 0 i) =   let m = 1 `shiftL` fromInteger (natVal (Proxy @n) - 1)-  in  if i >= m then S (i-2*m) else S i+      n = naturalToInteger i+  in  if n >= m then S (n-2*m) else S n unpack# bv = undefError "Signed.unpack" [bv]  instance Eq (Signed n) where@@ -230,29 +241,57 @@   enumFromTo     = enumFromTo#   enumFromThenTo = enumFromThenTo# ++enumFrom# :: forall n. KnownNat n => Signed n -> [Signed n]+enumFrom# x = map (fromInteger_INLINE sz mB mask) [unsafeToInteger x .. unsafeToInteger (maxBound :: Signed n)]+  where sz   = fromInteger (natVal (Proxy @n)) - 1+        mB   = 1 `shiftL` sz+        mask = mB - 1 {-# NOINLINE enumFrom# #-}++enumFromThen# :: forall n. KnownNat n => Signed n -> Signed n -> [Signed n]+enumFromThen# x y =+  toSigneds [unsafeToInteger x, unsafeToInteger y .. unsafeToInteger bound]+ where+  bound = if x <= y then maxBound else minBound :: Signed n+  toSigneds = map (fromInteger_INLINE sz mB mask)+  sz = fromInteger (natVal (Proxy @n)) - 1+  mB = 1 `shiftL` sz+  mask = mB - 1 {-# NOINLINE enumFromThen# #-}++enumFromTo# :: forall n. KnownNat n => Signed n -> Signed n -> [Signed n]+enumFromTo# x y = map (fromInteger_INLINE sz mB mask) [unsafeToInteger x .. unsafeToInteger y]+  where sz   = fromInteger (natVal (Proxy @n)) - 1+        mB   = 1 `shiftL` sz+        mask = mB - 1 {-# NOINLINE enumFromTo# #-}++enumFromThenTo# :: forall n. KnownNat n => Signed n -> Signed n -> Signed n -> [Signed n]+enumFromThenTo# x1 x2 y = map (fromInteger_INLINE sz mB mask) [unsafeToInteger x1, unsafeToInteger x2 .. unsafeToInteger y]+  where sz   = fromInteger (natVal (Proxy @n)) - 1+        mB   = 1 `shiftL` sz+        mask = mB - 1 {-# NOINLINE enumFromThenTo# #-}-enumFrom#       :: forall n. KnownNat n => Signed n -> [Signed n]-enumFromThen#   :: forall n. KnownNat n => Signed n -> Signed n -> [Signed n]-enumFromTo#     :: Signed n -> Signed n -> [Signed n]-enumFromThenTo# :: Signed n -> Signed n -> Signed n -> [Signed n]-enumFrom# x             = map fromInteger_INLINE [unsafeToInteger x .. unsafeToInteger (maxBound :: Signed n)]-enumFromThen# x y       = map fromInteger_INLINE [unsafeToInteger x, unsafeToInteger y .. unsafeToInteger (maxBound :: Signed n)]-enumFromTo# x y         = map S [unsafeToInteger x .. unsafeToInteger y]-enumFromThenTo# x1 x2 y = map S [unsafeToInteger x1, unsafeToInteger x2 .. unsafeToInteger y]   instance KnownNat n => Bounded (Signed n) where   minBound = minBound#   maxBound = maxBound# -minBound#,maxBound# :: KnownNat n => Signed n+minBound# :: forall n. KnownNat n => Signed n+minBound# =+  case natToNatural @n of+    0 -> 0+    n -> S (negate $ 2 ^ (n - 1)) {-# NOINLINE minBound# #-}-minBound# = let res = S $ negate $ 2 ^ (natVal res - 1) in res++maxBound# :: forall n. KnownNat n => Signed n+maxBound# =+  case natToNatural @n of+    0 -> 0+    n -> S (2 ^ (n - 1) - 1) {-# NOINLINE maxBound# #-}-maxBound# = let res = S $ 2 ^ (natVal res - 1) - 1 in res  -- | Operators do @wrap-around@ on overflow instance KnownNat n => Num (Signed n) where@@ -267,43 +306,69 @@  (+#), (-#), (*#) :: forall n . KnownNat n => Signed n -> Signed n -> Signed n {-# NOINLINE (+#) #-}-(S a) +# (S b) = let m  = 1 `shiftL` fromInteger (natVal (Proxy @n) -1)-                     z  = a + b-                 in  if z >= m then S (z - 2*m) else-                        if z < negate m then S (z + 2*m) else S z+(+#) =+  \(S a) (S b) ->+    let z = a + b+    in  if z >= m then+          S (z - 2*m)+        else if z < negate m then+          S (z + 2*m)+        else+          S z+ where+  m = 1 `shiftL` fromInteger (natVal (Proxy @n) -1)  {-# NOINLINE (-#) #-}-(S a) -# (S b) = let m  = 1 `shiftL` fromInteger (natVal (Proxy @n) -1)-                     z  = a - b-                 in  if z < negate m then S (z + 2*m) else-                        if z >= m then S (z - 2*m) else S z+(-#) =+  \(S a) (S b) ->+    let z = a - b+    in  if z < negate m then+          S (z + 2*m)+        else if z >= m then+          S (z - 2*m)+        else+          S z+ where+  m  = 1 `shiftL` fromInteger (natVal (Proxy @n) -1)  {-# NOINLINE (*#) #-}-(S a) *# (S b) = fromInteger_INLINE (a * b)+(*#) = \(S a) (S b) -> fromInteger_INLINE sz mB mask (a * b)+  where sz   = fromInteger (natVal (Proxy @n)) - 1+        mB   = 1 `shiftL` sz+        mask = mB - 1  negate#,abs# :: forall n . KnownNat n => Signed n -> Signed n {-# NOINLINE negate# #-}-negate# (S n) = let m = 1 `shiftL` fromInteger (natVal (Proxy @n) -1)-                    z = negate n-                in  if z == m then S n else S z+negate# =+  \(S n) ->+    let z = negate n+    in  if z == m then S n else S z+ where+  m = 1 `shiftL` fromInteger (natVal (Proxy @n) -1)  {-# NOINLINE abs# #-}-abs# (S n) = let m = 1 `shiftL` fromInteger (natVal (Proxy @n) -1)-                 z = abs n-             in  if z == m then S n else S z+abs# =+  \(S n) ->+    let z = abs n+    in  if z == m then S n else S z+ where+  m = 1 `shiftL` fromInteger (natVal (Proxy @n) -1)  {-# NOINLINE fromInteger# #-}-fromInteger# :: KnownNat n => Integer -> Signed (n :: Nat)-fromInteger# = fromInteger_INLINE+fromInteger# :: forall n . KnownNat n => Integer -> Signed (n :: Nat)+fromInteger# = fromInteger_INLINE sz mB mask+  where sz   = fromInteger (natVal (Proxy @n)) - 1+        mB   = 1 `shiftL` sz+        mask = mB - 1  {-# INLINE fromInteger_INLINE #-}-fromInteger_INLINE :: forall n . KnownNat n => Integer -> Signed n-fromInteger_INLINE i = if mask == 0 then S 0 else S res-  where-    mask = 1 `shiftL` fromInteger (natVal (Proxy @n) -1)-    res  = case divMod i mask of-             (s,i') | even s    -> i'-                    | otherwise -> i' - mask+fromInteger_INLINE :: Int -> Integer -> Integer -> Integer -> Signed n+fromInteger_INLINE sz mb mask =+  \i -> let i1 = i .&. mask+            i2 = case i `shiftR` sz of+                   q | q .&. 1 == 0 -> i1+                     | otherwise    -> i1 - mb+        in  if mb == 0 then S 0 else S i2  instance ExtendingNum (Signed m) (Signed n) where   type AResult (Signed m) (Signed n) = Signed (Max m n + 1)@@ -375,48 +440,94 @@   rotateR v i       = rotateR# v i   popCount s        = popCount (pack# s) -and#,or#,xor# :: KnownNat n => Signed n -> Signed n -> Signed n+and#,or#,xor# :: forall n . KnownNat n => Signed n -> Signed n -> Signed n {-# NOINLINE and# #-}-and# (S a) (S b) = fromInteger_INLINE (a .&. b)+and# = \(S a) (S b) -> fromInteger_INLINE sz mB mask (a .&. b)+  where sz   = fromInteger (natVal (Proxy @n)) - 1+        mB   = 1 `shiftL` sz+        mask = mB - 1+ {-# NOINLINE or# #-}-or# (S a) (S b)  = fromInteger_INLINE (a .|. b)+or# = \(S a) (S b) -> fromInteger_INLINE sz mB mask (a .|. b)+  where sz   = fromInteger (natVal (Proxy @n)) - 1+        mB   = 1 `shiftL` sz+        mask = mB - 1+ {-# NOINLINE xor# #-}-xor# (S a) (S b) = fromInteger_INLINE (xor a b)+xor# = \(S a) (S b) -> fromInteger_INLINE sz mB mask (xor a b)+  where sz   = fromInteger (natVal (Proxy @n)) - 1+        mB   = 1 `shiftL` sz+        mask = mB - 1  {-# NOINLINE complement# #-}-complement# :: KnownNat n => Signed n -> Signed n-complement# (S a) = fromInteger_INLINE (complement a)+complement# :: forall n . KnownNat n => Signed n -> Signed n+complement# = \(S a) -> fromInteger_INLINE sz mB mask (complement a)+  where sz   = fromInteger (natVal (Proxy @n)) - 1+        mB   = 1 `shiftL` sz+        mask = mB - 1 -shiftL#,shiftR#,rotateL#,rotateR# :: KnownNat n => Signed n -> Int -> Signed n+shiftL#,shiftR#,rotateL#,rotateR# :: forall n . KnownNat n => Signed n -> Int -> Signed n {-# NOINLINE shiftL# #-}-shiftL# _ b | b < 0  = error "'shiftL undefined for negative numbers"-shiftL# (S n) b      = fromInteger_INLINE (shiftL n b)+shiftL# =+  \(S n) b ->+    if b >= 0 then+      fromInteger_INLINE sz mB mask (shiftL n b)+    else+      error "'shiftL' undefined for negative numbers"+ where+  sz   = fromInteger (natVal (Proxy @n)) - 1+  mB   = 1 `shiftL` sz+  mask = mB - 1+ {-# NOINLINE shiftR# #-}-shiftR# _ b | b < 0  = error "'shiftR undefined for negative numbers"-shiftR# (S n) b      = fromInteger_INLINE (shiftR n b)+shiftR# =+  \(S n) b ->+    if b >= 0 then+      fromInteger_INLINE sz mB mask (shiftR n b)+    else+      error "'shiftR' undefined for negative numbers"+ where+  sz   = fromInteger (natVal (Proxy @n)) - 1+  mB   = 1 `shiftL` sz+  mask = mB - 1+ {-# NOINLINE rotateL# #-}-rotateL# _ b | b < 0 = error "'shiftL undefined for negative numbers"-rotateL# s@(S n) b   = fromInteger_INLINE (l .|. r)-  where-    l    = shiftL n b'-    r    = shiftR n b'' .&. mask-    mask = 2 ^ b' - 1+rotateL# =+  \(S n) b ->+    if b >= 0 then+      let l    = shiftL n b'+          r    = shiftR n b'' .&. mask+          mask = 2 ^ b' - 1 -    b'   = b `mod` sz-    b''  = sz - b'-    sz   = fromInteger (natVal s)+          b'   = b `mod` sz+          b''  = sz - b'+      in  fromInteger_INLINE sz1 mB maskM (l .|. r)+    else+      error "'rotateL undefined for negative numbers"+ where+  sz    = fromInteger (natVal (Proxy @n))+  sz1   = sz-1+  mB    = 1 `shiftL` sz1+  maskM = mB - 1  {-# NOINLINE rotateR# #-}-rotateR# _ b | b < 0 = error "'shiftR undefined for negative numbers"-rotateR# s@(S n) b   = fromInteger_INLINE (l .|. r)-  where-    l    = shiftR n b' .&. mask-    r    = shiftL n b''-    mask = 2 ^ b'' - 1+rotateR# =+  \(S n) b ->+    if b >= 0 then+      let l    = shiftR n b' .&. mask+          r    = shiftL n b''+          mask = 2 ^ b'' - 1 -    b'  = b `mod` sz-    b'' = sz - b'-    sz  = fromInteger (natVal s)+          b'  = b `mod` sz+          b'' = sz - b'+      in  fromInteger_INLINE sz1 mB maskM (l .|. r)+    else+      error "'rotateR' undefined for negative numbers"+ where+  sz    = fromInteger (natVal (Proxy @n))+  sz1   = sz - 1+  mB    = 1 `shiftL` sz1+  maskM = mB - 1  instance KnownNat n => FiniteBits (Signed n) where   finiteBitSize        = size#@@ -445,8 +556,11 @@                    else S i'  {-# NOINLINE truncateB# #-}-truncateB# :: KnownNat m => Signed (m + n) -> Signed m-truncateB# (S n) = fromInteger_INLINE n+truncateB# :: forall m n . KnownNat m => Signed (m + n) -> Signed m+truncateB# = \(S n) -> fromInteger_INLINE sz mB mask n+  where sz   = fromInteger (natVal (Proxy @m)) - 1+        mB   = 1 `shiftL` sz+        mask = mB - 1  instance KnownNat n => Default (Signed n) where   def = fromInteger# 0

@@ -5,6 +5,7 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com> -} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-}@@ -67,6 +68,11 @@   , rotateR#     -- ** Resize   , resize#+    -- ** Conversions+  , unsignedToWord+  , unsigned8toWord8+  , unsigned16toWord16+  , unsigned32toWord32   ) where @@ -79,28 +85,38 @@ import Data.Default.Class             (Default (..)) import Data.Proxy                     (Proxy (..)) import Text.Read                      (Read (..), ReadPrec)+import GHC.Exts                       (narrow8Word#, narrow16Word#, narrow32Word#) import GHC.Generics                   (Generic)+import GHC.Integer.GMP.Internals      (bigNatToWord)+import GHC.Natural                    (Natural (..), naturalFromInteger)+#if MIN_VERSION_base(4,12,0)+import GHC.Natural                    (naturalToInteger)+#endif import GHC.TypeLits                   (KnownNat, Nat, type (+), natVal) import GHC.TypeLits.Extra             (Max)+import GHC.Word                       (Word (..), Word8 (..), Word16 (..), Word32 (..)) import Language.Haskell.TH            (TypeQ, appT, conT, litT, numTyLit, sigE) import Language.Haskell.TH.Syntax     (Lift(..))-import Numeric.Natural                (Natural) import Test.QuickCheck.Arbitrary      (Arbitrary (..), CoArbitrary (..),                                        arbitraryBoundedIntegral,                                        coarbitraryIntegral) -import Clash.Class.BitPack            (BitPack (..), packXWith)+import Clash.Class.BitPack            (BitPack (..), packXWith, bitCoerce) import Clash.Class.Num                (ExtendingNum (..), SaturatingNum (..),                                        SaturationMode (..)) import Clash.Class.Parity             (Parity (..)) import Clash.Class.Resize             (Resize (..)) import Clash.Prelude.BitIndex         ((!), msb, replaceBit, split) import Clash.Prelude.BitReduction     (reduceOr)+import Clash.Promoted.Nat             (natToNum) import Clash.Sized.Internal.BitVector (BitVector (BV), Bit, high, low, undefError) import qualified Clash.Sized.Internal.BitVector as BV+import Clash.Sized.Internal.Mod import Clash.XException   (ShowX (..), NFDataX (..), errorX, showsPrecXWith, rwhnfX) +#include "MachDeps.h"+ -- | Arbitrary-width unsigned integer represented by @n@ bits -- -- Given @n@ bits, an 'Unsigned' @n@ number has a range of: [0 .. 2^@n@-1]@@ -135,7 +151,7 @@ newtype Unsigned (n :: Nat) =     -- | The constructor, 'U', and the field, 'unsafeToInteger', are not     -- synthesizable.-    U { unsafeToInteger :: Integer }+    U { unsafeToNatural :: Natural }   deriving (Data, Generic)  {-# NOINLINE size# #-}@@ -145,7 +161,7 @@ instance NFData (Unsigned n) where   rnf (U i) = rnf i `seq` ()   {-# NOINLINE rnf #-}-  -- NOINLINE is needed so that Clash doesn't trip on the "Unsigned ~# Integer"+  -- NOINLINE is needed so that Clash doesn't trip on the "Unsigned ~# Natural"   -- coercion  instance Show (Unsigned n) where@@ -217,31 +233,40 @@   enumFromTo     = enumFromTo#   enumFromThenTo = enumFromThenTo# +enumFrom# :: forall n. KnownNat n => Unsigned n -> [Unsigned n]+enumFrom# = \x -> map (U . (`mod` m)) [unsafeToNatural x .. unsafeToNatural (maxBound :: Unsigned n)]+  where m = 1 `shiftL` fromInteger (natVal (Proxy @n)) {-# NOINLINE enumFrom# #-}++enumFromThen# :: forall n. KnownNat n => Unsigned n -> Unsigned n -> [Unsigned n]+enumFromThen# = \x y -> toUnsigneds [unsafeToNatural x, unsafeToNatural y .. bound x y]+ where+  toUnsigneds = map (U . (`mod` m))+  bound x y = unsafeToNatural (if x <= y then maxBound else minBound :: Unsigned n)+  m = 1 `shiftL` fromInteger (natVal (Proxy @n)) {-# NOINLINE enumFromThen# #-}++enumFromTo# :: forall n. KnownNat n => Unsigned n -> Unsigned n -> [Unsigned n]+enumFromTo# = \x y -> map (U . (`mod` m)) [unsafeToNatural x .. unsafeToNatural y]+  where m = 1 `shiftL` fromInteger (natVal (Proxy @n)) {-# NOINLINE enumFromTo# #-}++enumFromThenTo# :: forall n. KnownNat n => Unsigned n -> Unsigned n -> Unsigned n -> [Unsigned n]+enumFromThenTo# = \x1 x2 y -> map (U . (`mod` m)) [unsafeToNatural x1, unsafeToNatural x2 .. unsafeToNatural y]+  where m = 1 `shiftL` fromInteger (natVal (Proxy @n)) {-# NOINLINE enumFromThenTo# #-}-enumFrom#       :: forall n. KnownNat n => Unsigned n -> [Unsigned n]-enumFromThen#   :: forall n. KnownNat n => Unsigned n -> Unsigned n -> [Unsigned n]-enumFromTo#     :: Unsigned n -> Unsigned n -> [Unsigned n]-enumFromThenTo# :: Unsigned n -> Unsigned n -> Unsigned n -> [Unsigned n]-enumFrom# x             = map fromInteger_INLINE [unsafeToInteger x .. unsafeToInteger (maxBound :: Unsigned n)]-enumFromThen# x y       = map fromInteger_INLINE [unsafeToInteger x, unsafeToInteger y .. unsafeToInteger (maxBound :: Unsigned n)]-enumFromTo# x y         = map U [unsafeToInteger x .. unsafeToInteger y]-enumFromThenTo# x1 x2 y = map U [unsafeToInteger x1, unsafeToInteger x2 .. unsafeToInteger y]  instance KnownNat n => Bounded (Unsigned n) where   minBound = minBound#   maxBound = maxBound# -{-# NOINLINE minBound# #-} minBound# :: Unsigned n minBound# = U 0+{-# NOINLINE minBound# #-} +maxBound# :: forall n. KnownNat n => Unsigned n+maxBound# = let m = 1 `shiftL` (natToNum @n) in  U (m - 1) {-# NOINLINE maxBound# #-}-maxBound# :: forall n .KnownNat n => Unsigned n-maxBound# = let m = 1 `shiftL` fromInteger (natVal (Proxy @n))-            in  U (m - 1)  instance KnownNat n => Num (Unsigned n) where   (+)         = (+#)@@ -254,34 +279,27 @@  (+#),(-#),(*#) :: forall n . KnownNat n => Unsigned n -> Unsigned n -> Unsigned n {-# NOINLINE (+#) #-}-(+#) (U i) (U j) = let m = 1 `shiftL` fromInteger (natVal (Proxy @n))-                       z = i + j-                   in  if z >= m then U (z - m) else U z+(+#) = \(U i) (U j) -> U (addMod m i j)+  where m = 1 `shiftL` fromInteger (natVal (Proxy @n))  {-# NOINLINE (-#) #-}-(-#) (U i) (U j) = let m = 1 `shiftL` fromInteger (natVal (Proxy @n))-                       z = i - j-                   in  if z < 0 then U (m + z) else U z+(-#) = \(U i) (U j) -> U (subMod m i j)+  where m = 1 `shiftL` fromInteger (natVal (Proxy @n))  {-# NOINLINE (*#) #-}-(*#) (U i) (U j) = fromInteger_INLINE (i * j)+(*#) = \(U i) (U j) -> U (mulMod2 m i j)+  where m = (1 `shiftL` fromInteger (natVal (Proxy @n))) - 1  {-# NOINLINE negate# #-} negate# :: forall n . KnownNat n => Unsigned n -> Unsigned n-negate# (U 0) = U 0-negate# (U i) = sz `seq` U (sz - i)-  where-    sz = 1 `shiftL` fromInteger (natVal (Proxy @n))+negate# = \(U i) -> U (negateMod m i)+  where m = 1 `shiftL` fromInteger (natVal (Proxy @n))  {-# NOINLINE fromInteger# #-}-fromInteger# :: KnownNat n => Integer -> Unsigned n-fromInteger# = fromInteger_INLINE--{-# INLINE fromInteger_INLINE #-}-fromInteger_INLINE :: forall n . KnownNat n => Integer -> Unsigned n-fromInteger_INLINE i = U (i `mod` sz)-  where-    sz = 1 `shiftL` fromInteger (natVal (Proxy @n))+fromInteger# :: forall n . KnownNat n => Integer -> Unsigned n+fromInteger# = \x -> U (naturalFromInteger (x `mod` m))+ where+  m = 1 `shiftL` fromInteger (natVal (Proxy @n))  instance (KnownNat m, KnownNat n) => ExtendingNum (Unsigned m) (Unsigned n) where   type AResult (Unsigned m) (Unsigned n) = Unsigned (Max m n + 1)@@ -297,11 +315,10 @@ {-# NOINLINE minus# #-} minus# :: forall m n . (KnownNat m, KnownNat n) => Unsigned m -> Unsigned n                                                 -> Unsigned (Max m n + 1)-minus# (U a) (U b) =-  let sz   = fromInteger (natVal (Proxy @(Max m n + 1)))-      mask = 1 `shiftL` sz-      z    = a - b-  in  if z < 0 then U (mask + z) else U z+minus# = \(U a) (U b) -> U (subMod mask a b)+ where+  sz   = fromInteger (natVal (Proxy @(Max m n + 1)))+  mask = 1 `shiftL` sz  {-# NOINLINE times# #-} times# :: Unsigned m -> Unsigned n -> Unsigned (m + n)@@ -327,7 +344,7 @@  {-# NOINLINE toInteger# #-} toInteger# :: Unsigned n -> Integer-toInteger# (U i) = i+toInteger# (U i) = naturalToInteger i  instance KnownNat n => Parity (Unsigned n) where   even = even . pack@@ -366,15 +383,20 @@ xor# (U v1) (U v2) = U (v1 `xor` v2)  {-# NOINLINE complement# #-}-complement# :: KnownNat n => Unsigned n -> Unsigned n-complement# (U i) = fromInteger_INLINE (complement i)+complement# :: forall n . KnownNat n => Unsigned n -> Unsigned n+complement# = \(U i) -> U (complementN i)+  where complementN = complementMod (natVal (Proxy @n)) -shiftL#, shiftR#, rotateL#, rotateR# :: KnownNat n => Unsigned n -> Int -> Unsigned n+shiftL#, shiftR#, rotateL#, rotateR# :: forall n .KnownNat n => Unsigned n -> Int -> Unsigned n {-# NOINLINE shiftL# #-}-shiftL# (U v) i-  | i < 0     = error-              $ "'shiftL undefined for negative number: " ++ show i-  | otherwise = fromInteger_INLINE (shiftL v i)+shiftL# =+  \(U v) i ->+    if i >= 0 then+      U ((shiftL v i) `mod` m)+    else+      error ("'shiftL undefined for negative number: " ++ show i)+ where+  m = 1 `shiftL` fromInteger (natVal (Proxy @n))  {-# NOINLINE shiftR# #-} -- shiftR# doesn't need the KnownNat constraint@@ -386,26 +408,34 @@   | otherwise = U (shiftR v i)  {-# NOINLINE rotateL# #-}-rotateL# _ b | b < 0 = error "'shiftL undefined for negative numbers"-rotateL# bv@(U n) b   = fromInteger_INLINE (l .|. r)+rotateL# =+  \(U n) b ->+    if b >= 0 then+      let l   = shiftL n b'+          r   = shiftR n b''+          b'  = b `mod` sz+          b'' = sz - b'+      in  U ((l .|. r) `mod` m)+    else+      error "'rotateL undefined for negative numbers"   where-    l    = shiftL n b'-    r    = shiftR n b''--    b'   = b `mod` sz-    b''  = sz - b'-    sz   = fromInteger (natVal bv)+    sz = fromInteger (natVal (Proxy @n)) :: Int+    m  = 1 `shiftL` sz  {-# NOINLINE rotateR# #-}-rotateR# _ b | b < 0 = error "'shiftR undefined for negative numbers"-rotateR# bv@(U n) b   = fromInteger_INLINE (l .|. r)+rotateR# =+  \(U n) b ->+    if b >= 0 then+      let l   = shiftR n b'+          r   = shiftL n b''+          b'  = b `mod` sz+          b'' = sz - b'+      in  U ((l .|. r) `mod` m)+    else+      error "'rotateR undefined for negative numbers"   where-    l   = shiftR n b'-    r   = shiftL n b''--    b'  = b `mod` sz-    b'' = sz - b'-    sz  = fromInteger (natVal bv)+    sz = fromInteger (natVal (Proxy @n)) :: Int+    m  = 1 `shiftL` sz  instance KnownNat n => FiniteBits (Unsigned n) where   finiteBitSize        = size#@@ -419,8 +449,8 @@  {-# NOINLINE resize# #-} resize# :: forall n m . KnownNat m => Unsigned n -> Unsigned m-resize# (U i) = let m = 1 `shiftL` fromInteger (natVal (Proxy @m))-                in  if i >= m then fromInteger_INLINE i else U i+resize# = \(U i) -> if i >= m then U (i `mod` m) else U i+  where m = 1 `shiftL` fromInteger (natVal (Proxy @m))  instance Default (Unsigned n) where   def = minBound#@@ -478,3 +508,30 @@ instance KnownNat n => Ixed (Unsigned n) where   ix i f s = unpack# <$> BV.replaceBit# (pack# s) i                      <$> f (BV.index# (pack# s) i)++unsignedToWord :: Unsigned WORD_SIZE_IN_BITS -> Word+unsignedToWord (U (NatS# u#)) = W# u#+unsignedToWord (U (NatJ# u#)) = W# (bigNatToWord u#)+{-# NOINLINE unsignedToWord #-}++unsigned8toWord8 :: Unsigned 8 -> Word8+unsigned8toWord8 (U (NatS# u#)) = W8# (narrow8Word# u#)+unsigned8toWord8 (U (NatJ# u#)) = W8# (narrow8Word# (bigNatToWord u#))+{-# NOINLINE unsigned8toWord8 #-}++unsigned16toWord16 :: Unsigned 16 -> Word16+unsigned16toWord16 (U (NatS# u#)) = W16# (narrow16Word# u#)+unsigned16toWord16 (U (NatJ# u#)) = W16# (narrow16Word# (bigNatToWord u#))+{-# NOINLINE unsigned16toWord16 #-}++unsigned32toWord32 :: Unsigned 32 -> Word32+unsigned32toWord32 (U (NatS# u#)) = W32# (narrow32Word# u#)+unsigned32toWord32 (U (NatJ# u#)) = W32# (narrow32Word# (bigNatToWord u#))+{-# NOINLINE unsigned32toWord32 #-}++{-# RULES+"bitCoerce/Unsigned WORD_SIZE_IN_BITS -> Word" bitCoerce = unsignedToWord+"bitCoerce/Unsigned 8 -> Word8" bitCoerce = unsigned8toWord8+"bitCoerce/Unsigned 16 -> Word16" bitCoerce = unsigned16toWord16+"bitCoerce/Unsigned 32 -> Word32" bitCoerce = unsigned32toWord32+ #-}

@@ -82,6 +82,8 @@ >>> :set -XUndecidableInstances >>> import Clash.Prelude >>> import Data.Kind+>>> import Data.Singletons.Prelude (Apply, TyFun)+>>> import Data.Proxy >>> data IIndex (f :: TyFun Nat Type) :: Type >>> type instance Apply IIndex l = Index ((2^l)+1) >>> :{

@@ -45,6 +45,7 @@   , singleton   , replicate, repeat   , iterate, iterateI, generate, generateI+  , unfoldr, unfoldrI     -- *** Initialisation from a list   , listToVecTH     -- ** Concatenation@@ -95,6 +96,7 @@  import Control.DeepSeq            (NFData (..)) import qualified Control.Lens     as Lens hiding (pattern (:>), pattern (:<))+import Data.Bits                  ((.|.), shiftL) import Data.Constraint            ((:-)(..), Dict (..)) import Data.Constraint.Nat        (leZero) import Data.Data@@ -109,6 +111,7 @@                                    type (^), type (<=), natVal) import GHC.Base                   (Int(I#),Int#,isTrue#) import GHC.Generics               hiding (Fixity (..))+import qualified GHC.Magic import GHC.Prim                   ((==#),(<#),(-#)) import Language.Haskell.TH        (ExpQ) import Language.Haskell.TH.Syntax (Lift(..))@@ -128,7 +131,7 @@   (SNat (..), SNatLE (..), UNat (..), compareSNat, leToPlus, pow2SNat,    snatProxy, snatToInteger, subSNat, withSNat, toUNat) import Clash.Promoted.Nat.Literals (d1)-import Clash.Sized.Internal.BitVector (Bit, BitVector, (++#), split#)+import Clash.Sized.Internal.BitVector (Bit, BitVector (..), split#) import Clash.Sized.Index          (Index)  import Clash.Class.BitPack        (packXWith, BitPack (..))@@ -145,6 +148,7 @@ >>> :set -fplugin GHC.TypeLits.Normalise >>> import Clash.Prelude >>> import Data.Kind+>>> import Data.Proxy >>> let compareSwapL a b = if a < b then (a,b) else (b,a) >>> :{ let sortV xs = map fst sorted :< (snd (last sorted))@@ -1492,6 +1496,36 @@     ws = map f (lazyV xs) {-# INLINE iterateI #-} +-- | \"'unfoldr @n f s@\" builds a vector of length @n@ from a seed value @s@,+-- where every element @a@ is created by successive calls of @f@ on @s@. Unlike+-- 'Data.List.unfoldr' from "Data.List" the generating function @f@ cannot+-- dictate the length of the resulting vector, it must be statically known.+--+-- a simple use of 'unfoldr':+--+-- >>> unfoldr d10 (\s -> (s,s-1)) 10+-- <10,9,8,7,6,5,4,3,2,1>+unfoldr :: SNat n -> (s -> (a,s)) -> s -> Vec n a+unfoldr SNat = unfoldrI+{-# INLINE unfoldr #-}++-- | \"'unfoldr @f s@\" builds a vector from a seed value @s@, where every+-- element @a@ is created by successive calls of @f@ on @s@; the length of the+-- vector is inferred from the context. Unlike 'Data.List.unfoldr' from+-- "Data.List" the generating function @f@ cannot  dictate the length of the+-- resulting vector, it must be statically known.+--+-- a simple use of 'unfoldrI':+--+-- >>> unfoldrI (\s -> (s,s-1)) 10 :: Vec 10 Int+-- <10,9,8,7,6,5,4,3,2,1>+unfoldrI :: KnownNat n => (s -> (a,s)) -> s -> Vec n a+unfoldrI f s0 = map fst xs+ where+  xs = init (f s0 `Cons` ws)+  ws = map (f . snd) (lazyV xs)+{-# INLINE unfoldrI #-}+ -- | \"'generate' @n f x@\" returns a vector with @n@ repeated applications of -- @f@ to @x@. --@@ -2154,11 +2188,17 @@   unpack = map unpack . unconcatBitVector#  concatBitVector#-  :: (KnownNat n, KnownNat m)+  :: forall n m+   . (KnownNat n, KnownNat m)   => Vec n (BitVector m)   -> BitVector (n * m)-concatBitVector# Nil           = 0-concatBitVector# (x `Cons` xs) = x ++# concatBitVector# xs+concatBitVector# = go 0+ where+  go :: BitVector (n*m) -> Vec p (BitVector m) -> BitVector (n * m)+  go acc Nil = acc+  go (BV accMsk accVal) ((BV xMsk xVal) `Cons` xs) =+    let sh = fromInteger (natVal (Proxy @m)) :: Int in+    go (BV (shiftL accMsk sh .|. xMsk) (shiftL accVal sh .|. xVal)) xs {-# NOINLINE concatBitVector# #-}  unconcatBitVector#@@ -2166,12 +2206,14 @@    . (KnownNat n, KnownNat m)   => BitVector (n * m)   -> Vec n (BitVector m)-unconcatBitVector# = go (toUNat (SNat @ n))+unconcatBitVector# orig = snd (go (toUNat (SNat @ n)))   where-    go :: KnownNat x => UNat x -> BitVector (x * m) -> Vec x (BitVector m)-    go UZero     _  = Nil-    go (USucc n) bv = let (x :: BitVector m,bv') = split# bv-                      in  x :> go n bv'+    go :: forall p . (p <= n) => UNat p -> (BitVector ((n-p)*m), Vec p (BitVector m))+    go UZero = (orig,Nil)+    go (USucc (n :: UNat (p-1))) =+      let (bv,xs) = go n+          (l,x) = (GHC.Magic.noinline split#) bv+      in  (l,x :> xs) {-# NOINLINE unconcatBitVector# #-}  -- | Convert a 'BitVector' to a 'Vec' of 'Bit's.

@@ -89,6 +89,9 @@  {- $setup >>> :set -XTemplateHaskell -XDataKinds -XConstraintKinds -XTypeApplications+>>> :m -Clash.Explicit.Prelude+>>> import Clash.Prelude+>>> import Clash.Explicit.Testbench >>> :{ let ma :: Num a => a -> (a, a) -> a     ma acc (x,y) = acc + x * y@@ -123,13 +126,13 @@  >>> let mac = mealy macT 0 >>> :{-topEntity-  :: Clock System-  -> Reset System-  -> Enable System-  -> Signal System (Signed 9, Signed 9)-  -> Signal System (Signed 9)-topEntity = exposeClockResetEnable mac+let topEntity+      :: Clock System+      -> Reset System+      -> Enable System+      -> Signal System (Signed 9, Signed 9)+      -> Signal System (Signed 9)+    topEntity = exposeClockResetEnable mac :}  >>> :{@@ -1206,8 +1209,8 @@ * @~LIT[N]@: @(N+1)@'th argument to the function. An extra condition that must   hold is that this @(N+1)@'th argument is an (integer) literal. * @~CONST[N]@: @(N+1)@'th argument to the function. Clash will try to reduce-* this to a literal, even if it would otherwise consider it too expensive. As-* opposed to ~LIT, ~CONST will render a valid HDL expression.+  this to a literal, even if it would otherwise consider it too expensive. As+  opposed to @~LIT@, @~CONST@ will render a valid HDL expression. * @~TYP[N]@: VHDL type of the @(N+1)@'th argument. * @~TYPO@: VHDL type of the result. * @~TYPM[N]@: VHDL type/name/ of the @(N+1)@'th argument; used in /type/@@ -1223,30 +1226,30 @@   of the signal, and the type of the @(N+1)@'th argument. * @~SIGDO[\<HOLE\>]@: Create a signal declaration, using @\<HOLE\>@ as the name   of the signal, and the type of the result.-* @~TYPELEM[\<HOLE\>]@: The element type of the vector type represented by @\<HOLE\>@.-  The content of @\<HOLE\>@ must either be: @TYP[N]@, @TYPO@, or @TYPELEM[\<HOLE\>]@.+* @~TYPEL[\<HOLE\>]@: The element type of the vector type represented by @\<HOLE\>@.+  The content of @\<HOLE\>@ must either be: @~TYP[N]@, @~TYPO@, or @~TYPEL[\<HOLE\>]@. * @~COMPNAME@: The name of the component in which the primitive is instantiated. * @~LENGTH[\<HOLE\>]@: The vector length of the type represented by @\<HOLE\>@. * @~DEPTH[\<HOLE\>]@: The tree depth of the type represented by @\<HOLE\>@.-  The content of @\<HOLE\>@ must either be: @TYP[N]@, @TYPO@, or @TYPELEM[\<HOLE\>]@.+  The content of @\<HOLE\>@ must either be: @~TYP[N]@, @~TYPO@, or @~TYPEL[\<HOLE\>]@. * @~SIZE[\<HOLE\>]@: The number of bits needed to encode the type represented by @\<HOLE\>@.-  The content of @\<HOLE\>@ must either be: @TYP[N]@, @TYPO@, or @TYPELEM[\<HOLE\>]@.-* @~IF \<CONDITION\> ~THEN \<THEN\> ~ELSE \<ELSE\> ~FI@: renders the \<ELSE\>-  part when \<CONDITION\> evaluates to /0/, and renders the \<THEN\> in all+  The content of @\<HOLE\>@ must either be: @~TYP[N]@, @~TYPO@, or @~TYPEL[\<HOLE\>]@.+* @~IF \<CONDITION\> ~THEN \<THEN\> ~ELSE \<ELSE\> ~FI@: renders the @\<ELSE\>@+  part when @\<CONDITION\>@ evaluates to /0/, and renders the @\<THEN\>@ in all   other cases. Valid @\<CONDITION\>@s are @~LENGTH[\<HOLE\>]@, @~SIZE[\<HOLE\>]@,   @~DEPTH[\<HOLE\>]@, @~VIVADO@, @~IW64@, @~ISLIT[N]@, @~ISVAR[N]@, @~ISACTIVEENABLE[N]@,   @~ISSYNC[N]@, and @~AND[\<HOLE1\>,\<HOLE2\>,..]@. * @~VIVADO@: /1/ when Clash compiler is invoked with the @-fclash-xilinx@ or-  @-fclash-vivado@ flag. To be used with in an @~IF .. ~THEN .. ~ElSE .. ~FI@+  @-fclash-vivado@ flag. To be used with in an @~IF .. ~THEN .. ~ELSE .. ~FI@   statement. * @~TOBV[\<HOLE\>][\<TYPE\>]@: create conversion code that so that the   expression in @\<HOLE\>@ is converted to a bit vector (@std_logic_vector@).   The @\<TYPE\>@ hole indicates the type of the expression and must be either-  @~TYP[N]@, @~TYPO@, or @~TYPELEM[\<HOLE\>]@.+  @~TYP[N]@, @~TYPO@, or @~TYPEL[\<HOLE\>]@. * @~FROMBV[\<HOLE\>][\<TYPE\>]@: create conversion code that so that the   expression in @\<HOLE\>@, which has a bit vector (@std_logic_vector@) type,   is converted to type indicated by @\<TYPE\>@. The @\<TYPE\>@ hole must be-  either @~TYP[N]@, @~TYPO@, or @~TYPELEM[\<HOLE\>]@.+  either @~TYP[N]@, @~TYPO@, or @~TYPEL[\<HOLE\>]@. * @~INCLUDENAME[N]@: the generated name of the @N@'th included component. * @~FILEPATH[\<HOLE\>]@: The argument mentioned in @\<HOLE\>@ is a file which   must be copied to the location of the generated HDL.@@ -1256,14 +1259,14 @@   in a /generate/ context. * @~ISLIT[N]@: Is the @(N+1)@'th argument to the function a literal. * @~ISVAR[N]@: Is the @(N+1)@'th argument to the function explicitly not a-  literal+  literal. * @~TAG[N]@: Name of given domain. Errors when called on an argument which is not   a 'KnownDomain', 'Reset', or 'Clock'. * @~PERIOD[N]@: Clock period of given domain. Errors when called on an argument   which is not a 'KnownDomain' or 'KnownConf'. * @~ISACTIVEENABLE[N]@: Is the @(N+1)@'th argument a an Enable line NOT set to a   constant True. Can be used instead of deprecated (and removed) template tag-  ~ISGATED. Errors when called on an argument which is not a signal of bools.+  @~ISGATED@. Errors when called on an argument which is not a signal of bools. * @~ISSYNC[N]@: Does synthesis domain at the @(N+1)@'th argument have synchronous resets. Errors   when called on an argument which is not a 'KnownDomain' or 'KnownConf'. * @~ISINITDEFINED[N]@: Does synthesis domain at the @(N+1)@'th argument have defined initial@@ -1277,7 +1280,7 @@ * @~NAME[N]@: Render the @(N+1)@'th string literal argument as an identifier   instead of a string literal. Fails when the @(N+1)@'th argument is not a   string literal.-* @~DEVNULL[\<HOLE\>]@: Render all dependencies of @\<HOLE\>@, but disregard direct output+* @~DEVNULL[\<HOLE\>]@: Render all dependencies of @\<HOLE\>@, but disregard direct output. * @~REPEAT[\<HOLE\>][N]@: Repeat literal value of @\<HOLE\>@ a total of @N@ times. * @~TEMPLATE[\<HOLE1\>][\<HOLE2\>]@: Render a file @\<HOLE1\>@ with contents @\<HOLE2\>@. 

@@ -55,6 +55,7 @@ import           Data.Ord            (Down (Down)) import           Data.Ratio          (Ratio, numerator, denominator) import qualified Data.Semigroup      as SG+import qualified Data.Monoid         as M import           Data.Sequence       (Seq(Empty, (:<|))) import           Data.Word           (Word8, Word16, Word32, Word64) import           Foreign.C.Types     (CUShort)@@ -89,6 +90,7 @@ defaultSeqX :: NFDataX a => a -> b -> b defaultSeqX = if fSuperStrict then deepseqX else seqX {-# INLINE defaultSeqX #-}+infixr 0 `defaultSeqX`  -- | Like 'error', but throwing an 'XException' instead of an 'ErrorCall' --@@ -453,6 +455,7 @@ deepseqX :: NFDataX a => a -> b -> b deepseqX a b = rnfX a `seq` b {-# NOINLINE deepseqX #-}+infixr 0 `deepseqX`  -- | Reduce to weak head normal form --@@ -811,6 +814,8 @@ instance NFDataX a => NFDataX (SG.Option a) instance NFDataX a => NFDataX (SG.Product a) instance NFDataX a => NFDataX (SG.Sum a)+instance NFDataX a => NFDataX (M.First a)+instance NFDataX a => NFDataX (M.Last a)  class GDeepErrorX f where   gDeepErrorX :: HasCallStack => String -> f a

@@ -9,6 +9,8 @@ import Test.Tasty.HUnit  import Clash.Class.BitPack+import Clash.Sized.Vector+import Clash.Sized.Signed  import GHC.Generics (Generic) @@ -44,6 +46,7 @@         , testCase "SP2" (rtt (P 10))         , testCase "Rec1" (rtt (Rec1 10))         , testCase "Rec2" (rtt (Rec2 10 30))+        , testCase "Vec" (rtt ((1 :: Signed 6) :> 2 :> (-5) :> 4 :> Nil))         ]     ] 

@@ -52,10 +52,21 @@       map lawsToTest (laws (Proxy :: Proxy (BitVector 83)))   , testGroup "Random BitVector"     [ testProperty "fromInteger" fromIntegerRandomProp ]+  , testGroup "Enum"+    [ testCase "[4,3..]" $ [4,3..] @?= [4,3,2,1,0 :: BitVector 8]+    , testCase "[4,2..]" $ [4,2..] @?= [4,2,0 :: BitVector 8]+    , testCase "take 5 [4,4..]" $ take 5 [4,4..] @?= [4,4,4,4,4 :: BitVector 8]+    , testCase "[2,4..]" $ [2,4..] @?= [2,4,6 :: BitVector 3]+    , testCase "[3,4..]" $ [3,4..] @?= [3,4,5,6,7 :: BitVector 3]+    ]+  , testGroup "Bounds"+    [ testCase "maxBound :: BitVector 0" $ maxBound @(BitVector 0) @?= 0+    , testCase "minBound :: BitVector 0" $ minBound @(BitVector 0) @?= 0+    ]   ]  fromIntegerProp :: forall m. KnownNat m => Proxy m -> Integer -> Property-fromIntegerProp p n = unsafeToInteger m === fromInteger (n `mod` (2 ^ toInteger (natVal p)))+fromIntegerProp p n = unsafeToNatural m === fromInteger (n `mod` (2 ^ toInteger (natVal p)))   where     m :: BitVector m     m = fromInteger n

@@ -3,6 +3,7 @@ import Data.Proxy import GHC.TypeNats (KnownNat, SomeNat (..), natVal, someNatVal) import Test.Tasty+import Test.Tasty.HUnit import Test.Tasty.QuickCheck  import Clash.Sized.Internal.Signed@@ -24,6 +25,17 @@       map lawsToTest (laws (Proxy :: Proxy (Signed 83)))   , testGroup "Random Signed"     [ testProperty "fromInteger" fromIntegerRandomProp  ]+  , testGroup "Enum"+    [ testCase "[3,2..]" $ [3,2..] @?= [3,2,1,0,-1,-2,-3,-4 :: Signed 3]+    , testCase "[3,1..]" $ [3,1..] @?= [3,1,-1,-3,-5,-7 :: Signed 4]+    , testCase "take 5 [4,4..]" $ take 5 [4,4..] @?= [4,4,4,4,4 :: Signed 4]+    , testCase "[2,4..]" $ [2,4..] @?= [2,4,6 :: Signed 4]+    , testCase "[3,4..]" $ [3,4..] @?= [3,4,5,6,7 :: Signed 4]+    ]+  , testGroup "Bounds"+    [ testCase "maxBound :: Signed 0" $ maxBound @(Signed 0) @?= 0+    , testCase "minBound :: Signed 0" $ minBound @(Signed 0) @?= 0+    ]   ]  

@@ -138,10 +138,10 @@   Synthesize "topEntity4"     [ PortName "gadt"     , PortName "s"-    , PortProduct "cfiii" [PortName "s"]-    , PortProduct "cfbii" [PortName "s"]-    , PortProduct "ofiii" [PortName "s"]-    , PortProduct "ofbii" [PortName "s"]+    , PortName "cfiii_s"+    , PortName "cfbii_s"+    , PortName "ofiii_s"+    , PortName "ofbii_s"     , PortProduct "" [PortName "xiii", PortName "xiii2"]     , PortName "xbii"     ]@@ -209,7 +209,7 @@  Synthesize "topEntity8"     [ PortProduct "" [PortName "clk", PortName "rst", PortName "en"]     , PortProduct "pair" [PortName "left", PortName "right"]-    , PortProduct "pair" [PortProduct "left" [PortName "s"], PortProduct "right" [PortName "s"]]+    , PortProduct "pair" [PortName "left_s", PortName "right_s"]     ]     (PortName "out") @@ -261,7 +261,7 @@ #endif  topEntityFailure8-  :: "int"     ::: Signal System (Passthrough Int Simple )+  :: "int"     ::: Signal System (Passthrough Int Simple)   -> "out"     ::: Signal System Bool topEntityFailure8 = undefined 

@@ -3,6 +3,7 @@ import Data.Proxy import GHC.TypeNats (KnownNat, SomeNat (..), natVal, someNatVal) import Test.Tasty+import Test.Tasty.HUnit import Test.Tasty.QuickCheck  import Clash.Sized.Internal.Unsigned@@ -24,10 +25,21 @@       map lawsToTest (laws (Proxy :: Proxy (Unsigned 83)))   , testGroup "Random Unsigned"     [ testProperty "fromInteger" fromIntegerRandomProp ]+  , testGroup "Enum"+    [ testCase "[4,3..]" $ [4,3..] @?= [4,3,2,1,0 :: Unsigned 8]+    , testCase "[4,2..]" $ [4,2..] @?= [4,2,0 :: Unsigned 8]+    , testCase "take 5 [4,4..]" $ take 5 [4,4..] @?= [4,4,4,4,4 :: Unsigned 8]+    , testCase "[2,4..]" $ [2,4..] @?= [2,4,6 :: Unsigned 3]+    , testCase "[3,4..]" $ [3,4..] @?= [3,4,5,6,7 :: Unsigned 3]+    ]+  , testGroup "Bounds"+    [ testCase "maxBound :: Unsigned 0" $ maxBound @(Unsigned 0) @?= 0+    , testCase "minBound :: Unsigned 0" $ minBound @(Unsigned 0) @?= 0+    ]   ]  fromIntegerProp :: forall m. KnownNat m => Proxy m -> Integer -> Property-fromIntegerProp p n = unsafeToInteger m === fromInteger (n `mod` (2 ^ toInteger (natVal p)))+fromIntegerProp p n = unsafeToNatural m === fromInteger (n `mod` (2 ^ toInteger (natVal p)))   where     m :: Unsigned m     m = fromInteger n

@@ -2,40 +2,13 @@  module Main where +import Build_doctests (flags, pkgs, module_sources)+import Data.Foldable (traverse_) import Test.DocTest (doctest)  main :: IO ()-main = doctest (docTestOpts ++ ["-isrc","src/Clash/Prelude.hs"-                               ,"src/Clash/Tutorial.hs"-                               ,"src/Clash/Examples.hs"])--docTestOpts :: [String]-docTestOpts =-#if __GLASGOW_HASKELL__ >= 806-  "-XNoStarIsType" :-#endif-#if __GLASGOW_HASKELL__ <= 804-  "-XTypeInType" :-#endif-  -- TODO: Figure out a way to auto-sync this with clash-prelude.cabal-  [ "-XBangPatterns"-  , "-XBinaryLiterals"-  , "-XDataKinds"-  , "-XDefaultSignatures"-  , "-XDeriveDataTypeable"-  , "-XDeriveFoldable"-  , "-XDeriveFunctor"-  , "-XDeriveGeneric"-  , "-XDeriveLift"-  , "-XDeriveTraversable"-  , "-XDerivingStrategies"-  , "-XInstanceSigs"-  , "-XKindSignatures"-  , "-XMagicHash"-  , "-XScopedTypeVariables"-  , "-XStandaloneDeriving"-  , "-XTupleSections"-  , "-XTypeApplications"-  , "-XTypeOperators"-  , "-XViewPatterns"-  ]+main = do+  traverse_ putStrLn args+  doctest args+ where+  args = flags ++ pkgs ++ module_sources