Avoid warnings instead of hiding them

clash-prelude/src/Clash/Examples/Internal.hs

@@ -2,6 +2,7 @@
 Copyright : © 2015-2016, Christiaan Baaij,
               2017     , Google Inc.
               2019     , Myrtle Software Ltd
+              2025     , QBayLogic B.V.
 Licence   : Creative Commons 4.0 (CC BY 4.0) (https://creativecommons.org/licenses/by/4.0/)
 -}
 
@@ -13,16 +14,10 @@ Licence   : Creative Commons 4.0 (CC BY 4.0) (https://creativecommons.org/licens
 {-# 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.Lens hiding ((:>))
 import Control.Monad
 import Control.Monad.Trans.State
 
@@ -45,6 +40,7 @@ decoderCase enable binaryIn | enable =
     0xD -> 0x2000
     0xE -> 0x4000
     0xF -> 0x8000
+    _   -> 0
 decoderCase _ _ = 0
 
 decoderShift :: Bool -> BitVector 4 -> BitVector 16
@@ -72,6 +68,7 @@ encoderCase enable binaryIn | enable =
     0x2000 -> 0xD
     0x4000 -> 0xE
     0x8000 -> 0xF
+    _      -> 0
 encoderCase _ _ = 0
 
 upCounter
@@ -107,7 +104,8 @@ upDownCounter upDown = s
 lfsrF' :: BitVector 16 -> BitVector 16
 lfsrF' s = pack feedback ++# slice (SNat @15) d1 s
   where
-    feedback = s!5 `xor` s!3 `xor` s!2 `xor` s!0
+    feedback = foldr1 xor
+      $ (s !) <$> (5 :: Int) :> 3 :> 2 :> 0 :> Nil
 
 lfsrF
   :: HiddenClockResetEnable dom
@@ -153,9 +151,9 @@ crcT
   => a
   -> Bit
   -> a
-crcT bv dIn = replaceBit 0  dInXor
-            $ replaceBit 5  (bv!4  `xor` dInXor)
-            $ replaceBit 12 (bv!11 `xor` dInXor)
+crcT bv dIn = replaceBit ( 0 :: Int) dInXor
+            $ replaceBit ( 5 :: Int) (bv ! ( 4 :: Int) `xor` dInXor)
+            $ replaceBit (12 :: Int) (bv ! (11 :: Int) `xor` dInXor)
               rotated
   where
     dInXor  = dIn `xor` fb
@@ -200,6 +198,7 @@ data TxReg
 
 makeLenses ''TxReg
 
+uartTX :: TxReg -> Bool -> BitVector 8 -> Bool -> 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
@@ -220,6 +219,7 @@ uartTX t@(TxReg {..}) ld_tx_data tx_data tx_enable = flip execState t $ do
   unless tx_enable $
     tx_cnt .= 0
 
+uartRX :: RxReg -> Bit -> Bool -> Bool -> RxReg
 uartRX r@(RxReg {..}) rx_in uld_rx_data rx_enable = flip execState r $ do
   -- Synchronize the async signal
   rx_d1 .= rx_in
@@ -260,6 +260,19 @@ uartRX r@(RxReg {..}) rx_in uld_rx_data rx_enable = flip execState r $ do
   else do
     rx_busy .= False
 
+uart ::
+  HiddenClockResetEnable dom =>
+  Signal dom Bool ->
+  Signal dom (BitVector 8) ->
+  Signal dom Bool ->
+  Signal dom Bit ->
+  Signal dom Bool ->
+  Signal dom Bool ->
+  ( Signal dom Bit
+  , Signal dom Bool
+  , Signal dom (BitVector 8)
+  , Signal dom Bool
+  )
 uart ld_tx_data tx_data tx_enable rx_in uld_rx_data rx_enable =
     ( _tx_out   <$> txReg
     , _tx_empty <$> txReg

clash-prelude/src/Clash/Sized/Index.hs

@@ -1,5 +1,6 @@
 {-|
 Copyright  :  (C) 2013-2016, University of Twente
+                  2025     , QBayLogic B.V.
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  Christiaan Baaij <[email protected]>
 -}
@@ -8,17 +9,14 @@ Maintainer :  Christiaan Baaij <[email protected]>
 
 {-# OPTIONS_GHC -fplugin GHC.TypeLits.Extra.Solver -fplugin GHC.TypeLits.KnownNat.Solver #-}
 {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise  #-}
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Clash.Sized.Index
   (Index, bv2i, fromSNat)
 where
 
 import GHC.TypeLits (KnownNat, type (^))
-import GHC.TypeLits.Extra (CLog) -- documentation only
 
-import Clash.Promoted.Nat (SNat (..), pow2SNat)
 import Clash.Sized.Internal.BitVector (BitVector)
 import Clash.Sized.Internal.Index
 
@@ -29,7 +27,7 @@ import Clash.Sized.Internal.Index
 -- That is, the type of 'Clash.Class.BitPack.unpack' is:
 --
 -- @
--- __unpack__ :: 'BitVector' ('CLog' 2 n) -> 'Index' n
+-- __unpack__ :: 'BitVector' ('GHC.TypeLits.Extra.CLog' 2 n) -> 'Index' n
 -- @
 --
 -- And is useful when you know the size of the 'Index', and want to get a value

clash-prelude/src/Clash/Sized/Vector.hs

@@ -8,6 +8,7 @@ Maintainer :  QBayLogic B.V. <[email protected]>
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE EmptyCase #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -23,8 +24,6 @@ Maintainer :  QBayLogic B.V. <[email protected]>
 {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
 {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise       #-}
 
-{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-redundant-constraints #-}
-
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Clash.Sized.Vector
@@ -184,6 +183,9 @@ data Vec :: Nat -> Type -> Type where
 
 {-# COMPLETE Nil, (:>) #-}
 
+-- | Tag for K1: @n ~ 0@ proof
+data N
+
 -- | In many cases, this Generic instance only allows generic
 -- functions/instances over vectors of at least size 1, due to the
 -- /n-1/ in the /Rep (Vec n a)/ definition.
@@ -194,7 +196,7 @@ data Vec :: Nat -> Type -> Type where
 instance KnownNat n => Generic (Vec n a) where
   type Rep (Vec n a) =
     D1 ('MetaData "Vec" "Clash.Data.Vector" "clash-prelude" 'False)
-      (C1 ('MetaCons "Nil" 'PrefixI 'False) U1 :+:
+      (C1 ('MetaCons "Nil" 'PrefixI 'False) (K1 N (Dict (n ~ 0))) :+:
        C1 ('MetaCons "Cons" 'PrefixI 'False)
         (S1 ('MetaSel 'Nothing
                 'NoSourceUnpackedness
@@ -206,13 +208,14 @@ instance KnownNat n => Generic (Vec n a) where
                 'NoSourceStrictness
                 'DecidedLazy)
             (Rec0 (Vec (n-1) a))))
-  from Nil         = M1 (L1 (M1 U1))
+  from Nil         = M1 (L1 (M1 (K1 Dict)))
   from (Cons x xs) = M1 (R1 (M1 (M1 (K1 x) :*: M1 (K1 xs))))
   to (M1 g) = case compareSNat (SNat @n) (SNat @0) of
     SNatLE -> case leZero @n of
       Sub Dict -> Nil
     SNatGT -> case g of
       R1 (M1 (M1 (K1 p) :*: M1 (K1 q))) -> Cons p q
+      L1 (M1 (K1 eqZero)) -> case eqZero of {}
 
 instance (KnownNat n, Typeable a, Data a) => Data (Vec n a) where
   gunfold k z _ = case compareSNat (SNat @n) (SNat @0) of
@@ -449,6 +452,12 @@ singleton = (`Cons` Nil)
 -}
 head :: Vec (n + 1) a -> a
 head (x `Cons` _) = x
+#if !MIN_VERSION_base(4,16,0) || MIN_VERSION_base(4,17,0)
+head xs = unreachable xs
+ where
+  unreachable :: forall n a. 1 <= n => Vec n a -> a
+  unreachable (x `Cons` _) = x
+#endif
 
 -- See: https://github.com/clash-lang/clash-compiler/pull/2511
 {-# CLASH_OPAQUE tail #-}
@@ -494,7 +503,13 @@ head (x `Cons` _) = x
 #endif
 -}
 tail :: Vec (n + 1) a -> Vec n a
-tail (_ `Cons` xs) = xs
+tail (_ `Cons` xr) = xr
+#if !MIN_VERSION_base(4,16,0) || MIN_VERSION_base(4,17,0)
+tail xs = unreachable xs
+ where
+  unreachable :: forall n a. 1 <= n => Vec n a -> Vec (n - 1) a
+  unreachable (_ `Cons` xr) = xr
+#endif
 
 -- See: https://github.com/clash-lang/clash-compiler/pull/2511
 {-# CLASH_OPAQUE last #-}
@@ -541,7 +556,13 @@ tail (_ `Cons` xs) = xs
 -}
 last :: Vec (n + 1) a -> a
 last (x `Cons` Nil)         = x
-last (_ `Cons` y `Cons` ys) = last (y `Cons` ys)
+last (_ `Cons` y `Cons` xr) = last (y `Cons` xr)
+#if !MIN_VERSION_base(4,16,0) || MIN_VERSION_base(4,17,0)
+last xs = unreachable xs
+ where
+  unreachable :: 1 <= n => Vec n a -> a
+  unreachable ys@(Cons _ _) = last ys
+#endif
 
 -- See: https://github.com/clash-lang/clash-compiler/pull/2511
 {-# CLASH_OPAQUE init #-}
@@ -588,7 +609,13 @@ last (_ `Cons` y `Cons` ys) = last (y `Cons` ys)
 -}
 init :: Vec (n + 1) a -> Vec n a
 init (_ `Cons` Nil)         = Nil
-init (x `Cons` y `Cons` ys) = x `Cons` init (y `Cons` ys)
+init (x `Cons` y `Cons` xr) = x `Cons` init (y `Cons` xr)
+#if !MIN_VERSION_base(4,16,0) || MIN_VERSION_base(4,17,0)
+init xs = unreachable xs
+ where
+  unreachable :: 1 <= n => Vec n a -> Vec (n - 1) a
+  unreachable ys@(Cons _ _) = init ys
+#endif
 
 {-# INLINE shiftInAt0 #-}
 -- | Shift in elements to the head of a vector, bumping out elements at the
@@ -740,9 +767,9 @@ splitAt n xs = splitAtU (toUNat n) xs
 {-# ANN splitAt hasBlackBox #-}
 
 splitAtU :: UNat m -> Vec (m + n) a -> (Vec m a, Vec n a)
-splitAtU UZero     ys            = (Nil,ys)
-splitAtU (USucc s) (y `Cons` ys) = let (as,bs) = splitAtU s ys
-                                   in  (y `Cons` as, bs)
+splitAtU UZero     ys = (Nil, ys)
+splitAtU (USucc s) ys = let (as, bs) = splitAtU s $ tail ys
+                        in  (head ys `Cons` as, bs)
 
 -- | Split a vector into two vectors where the length of the two is determined
 -- by the context.
@@ -1237,7 +1264,7 @@ scanl f z xs = ws
 -- >>> scanl1 (-) (1 :> 2 :> 3 :> 4 :> Nil)
 -- 1 :> -1 :> -4 :> -8 :> Nil
 scanl1 :: KnownNat n => (a -> a -> a) -> Vec (n+1) a -> Vec (n+1) a
-scanl1 op (v:>vs) = scanl op v vs
+scanl1 op vs = scanl op (head vs) (tail vs)
 {-# INLINE scanl1 #-}
 
 -- | 'scanr' with no seed value
@@ -2587,6 +2614,11 @@ dtfold _ f g = go (SNat :: SNat k)
           sn'       = sn `subSNat` d1
           (xsL,xsR) = splitAt (pow2SNat sn') xs
       in  g sn' (go sn' xsL) (go sn' xsR)
+#if !MIN_VERSION_base(4,16,0) || MIN_VERSION_base(4,17,0)
+    go _  Nil =
+      case (const Dict :: forall m. Proxy m -> Dict (1 <= 2 ^ m)) (Proxy @n) of
+        {}
+#endif
 -- See: https://github.com/clash-lang/clash-compiler/pull/2511
 {-# CLASH_OPAQUE dtfold #-}
 {-# ANN dtfold hasBlackBox #-}