Merge pull request #3136 from clash-lang/martijn/add-numconvert-through

Fix overlapping instances in `NumConvert` with `Canonical`

Author: martijnbastiaan

clash-prelude/clash-prelude.cabal

@@ -188,6 +188,7 @@ Library
                       Clash.Class.NumConvert
                       Clash.Class.NumConvert.Internal.NumConvert
                       Clash.Class.NumConvert.Internal.MaybeNumConvert
+                      Clash.Class.NumConvert.Internal.Canonical
                       Clash.Class.Parity
                       Clash.Class.Resize
 

clash-prelude/src/Clash/Class/NumConvert.hs

@@ -22,11 +22,23 @@ ways:
  1. It offers no partial functions
  2. All its conversions are translatable to synthesizable HDL
  3. It is focused on (Clash's) number types
+
+== __Implementing 'NumConvert' for your own type__
+If you want to implement 'NumConvert' and 'MaybeNumConvert' for your own type,
+see 'NumConvertCanonical'.
 -}
 module Clash.Class.NumConvert (
-  NumConvert (..),
-  MaybeNumConvert (..),
+  NumConvert,
+  numConvert,
+  MaybeNumConvert,
+  maybeNumConvert,
+
+  -- * For implementers only
+  NumConvertCanonical(..),
+  MaybeNumConvertCanonical(..),
+  Canonical,
 ) where
 
 import Clash.Class.NumConvert.Internal.MaybeNumConvert
 import Clash.Class.NumConvert.Internal.NumConvert
+import Clash.Class.NumConvert.Internal.Canonical

clash-prelude/src/Clash/Class/NumConvert/Internal/Canonical.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+#include "MachDeps.h"
+
+{- |
+Copyright  :  (C) 2026     , Martijn Bastiaan
+License    :  BSD2 (see the file LICENSE)
+Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
+-}
+module Clash.Class.NumConvert.Internal.Canonical where
+
+import Clash.Sized.BitVector
+import Clash.Sized.Index
+import Clash.Sized.Signed
+import Clash.Sized.Unsigned
+
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+
+-- | Type family mapping types to their canonical \"unwrapped\" Clash form.
+-- This is used by 'Clash.Class.NumConvert.numConvert' and
+-- 'Clash.Class.NumConvert.maybeNumConvert' to determine the intermediate type.
+type family Canonical a
+
+-- Instances for Data.Word types
+type instance Canonical Word = Unsigned WORD_SIZE_IN_BITS
+type instance Canonical Word64 = Unsigned 64
+type instance Canonical Word32 = Unsigned 32
+type instance Canonical Word16 = Unsigned 16
+type instance Canonical Word8 = Unsigned 8
+
+-- Instances for Data.Int types
+type instance Canonical Int = Signed WORD_SIZE_IN_BITS
+type instance Canonical Int64 = Signed 64
+type instance Canonical Int32 = Signed 32
+type instance Canonical Int16 = Signed 16
+type instance Canonical Int8 = Signed 8
+
+-- Bit
+type instance Canonical Bit = BitVector 1
+
+-- Clash types are already in canonical form
+type instance Canonical (Unsigned n) = Unsigned n
+type instance Canonical (Signed n) = Signed n
+type instance Canonical (BitVector n) = BitVector n
+type instance Canonical (Index n) = Index n

clash-prelude/src/Clash/Class/NumConvert/Internal/MaybeNumConvert.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -16,6 +17,8 @@ Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 module Clash.Class.NumConvert.Internal.MaybeNumConvert where
 
 import Clash.Class.BitPack
+import Clash.Class.NumConvert.Internal.NumConvert (NumConvertCanonical (..))
+import Clash.Class.NumConvert.Internal.Canonical (Canonical)
 import Clash.Class.Resize
 import Clash.Sized.BitVector
 import Clash.Sized.Index
@@ -25,29 +28,35 @@ import Clash.Sized.Unsigned
 import GHC.TypeLits (KnownNat, type (+), type (<=), type (^))
 import GHC.TypeLits.Extra (CLog)
 
-import Data.Int (Int16, Int32, Int64, Int8)
-import Data.Word (Word16, Word32, Word64, Word8)
-
 {- $setup
 >>> import Clash.Prelude
 >>> import Clash.Class.NumConvert
+>>> import Data.Word
+>>> import Data.Int
+-}
+
+{- | Internal class for concrete conversions that may fail. This class is used
+internally by 'MaybeNumConvert' and should not be used directly. Use
+'MaybeNumConvert' instead.
 -}
+class MaybeNumConvertCanonical a b where
+  maybeNumConvertCanonical :: a -> Maybe b
 
 {- | Conversions that may fail for some values. A successful conversion retains
 the numerical value interpretation of the source type in the target type. A
 failure is expressed by returning 'Nothing', never by an 'Clash.XException.XException'.
 
 == __Laws__
 A conversion is either successful or it fails gracefully. I.e., it does not
-produces produce errors (also see "Clash.XException"). I.e.,
+produce errors (also see "Clash.XException"). I.e.,
 
 > x == fromMaybe x (maybeNumConvert @a @b x >>= maybeNumConvert @b @a)
 
 for all values @x@ of type @a@. It should also preserve the numerical value
 interpretation of the bits. For types that have an @Integral@ instance, this
 intuition is captured by:
 
-> toInteger x == fromMaybe (toInteger x) (toInteger (numConvert @a @b x))
+> toInteger x == fromMaybe (toInteger x) (toInteger <$> maybeNumConvert @a @b x)
 
 If a conversion succeeds one way, it should also succeed the other way. I.e.,
 
@@ -65,117 +74,79 @@ All implementations should be total, i.e., they should not produce \"bottoms\".
 
 Additionally, any implementation should be translatable to synthesizable HDL.
 -}
-class MaybeNumConvert a b where
-  {- | Convert a supplied value of type @a@ to a value of type @b@. If the value
-    cannot be represented in the target type, 'Nothing' is returned.
-
-    >>> maybeNumConvert (1 :: Index 8) :: Maybe (Unsigned 2)
-    Just 1
-    >>> maybeNumConvert (7 :: Index 8) :: Maybe (Unsigned 2)
-    Nothing
-
-    For the time being, if the input is an 'Clash.XException.XException', then
-    the output is too. This property might be relaxed in the future.
-  -}
-  maybeNumConvert :: a -> Maybe b
+type MaybeNumConvert a b =
+  ( NumConvertCanonical a (Canonical a)
+  , MaybeNumConvertCanonical (Canonical a) (Canonical b)
+  , NumConvertCanonical (Canonical b) b
+  )
+
+{- | Convert a supplied value of type @a@ to a value of type @b@. If the value
+cannot be represented in the target type, 'Nothing' is returned.
+
+>>> maybeNumConvert (1 :: Index 8) :: Maybe (Unsigned 2)
+Just 1
+>>> maybeNumConvert (7 :: Index 8) :: Maybe (Unsigned 2)
+Nothing
+
+For the time being, if the input is an 'Clash.XException.XException', then
+the output is too. This property might be relaxed in the future.
+-}
+maybeNumConvert :: forall a b. MaybeNumConvert a b => a -> Maybe b
+maybeNumConvert a =
+    fmap (numConvertCanonical @(Canonical b) @b)
+  $ maybeNumConvertCanonical @(Canonical a) @(Canonical b)
+  $ numConvertCanonical @a @(Canonical a) a
 
-instance (KnownNat n, KnownNat m) => MaybeNumConvert (Index n) (Index m) where
-  maybeNumConvert !a = maybeResize a
+instance (KnownNat n, KnownNat m) => MaybeNumConvertCanonical (Index n) (Index m) where
+  maybeNumConvertCanonical !a = maybeResize a
 
-instance (KnownNat n, KnownNat m, 1 <= n) => MaybeNumConvert (Index n) (Unsigned m) where
-  maybeNumConvert !a = maybeResize $ bitCoerce @_ @(Unsigned (CLog 2 n)) a
+instance (KnownNat n, KnownNat m, 1 <= n) => MaybeNumConvertCanonical (Index n) (Unsigned m) where
+  maybeNumConvertCanonical !a = maybeResize $ bitCoerce @_ @(Unsigned (CLog 2 n)) a
 
-instance (KnownNat n, KnownNat m, 1 <= n) => MaybeNumConvert (Index n) (Signed m) where
-  maybeNumConvert !a = maybeNumConvert $ bitCoerce @_ @(Unsigned (CLog 2 n)) a
+instance (KnownNat n, KnownNat m, 1 <= n) => MaybeNumConvertCanonical (Index n) (Signed m) where
+  maybeNumConvertCanonical !a = maybeNumConvertCanonical $ bitCoerce @_ @(Unsigned (CLog 2 n)) a
 
-instance (KnownNat n, KnownNat m, 1 <= n) => MaybeNumConvert (Index n) (BitVector m) where
-  maybeNumConvert !a = maybeResize $ pack a
+instance (KnownNat n, KnownNat m, 1 <= n) => MaybeNumConvertCanonical (Index n) (BitVector m) where
+  maybeNumConvertCanonical !a = maybeResize $ pack a
 
-instance (KnownNat n, KnownNat m) => MaybeNumConvert (Unsigned n) (Index m) where
-  maybeNumConvert !a = maybeResize $ bitCoerce @_ @(Index (2 ^ n)) a
+instance (KnownNat n, KnownNat m) => MaybeNumConvertCanonical (Unsigned n) (Index m) where
+  maybeNumConvertCanonical !a = maybeResize $ bitCoerce @_ @(Index (2 ^ n)) a
 
-instance (KnownNat n, KnownNat m) => MaybeNumConvert (Unsigned n) (Unsigned m) where
-  maybeNumConvert !a = maybeResize a
+instance (KnownNat n, KnownNat m) => MaybeNumConvertCanonical (Unsigned n) (Unsigned m) where
+  maybeNumConvertCanonical !a = maybeResize a
 
-instance (KnownNat n, KnownNat m) => MaybeNumConvert (Unsigned n) (Signed m) where
-  maybeNumConvert !a = maybeResize $ bitCoerce @(Unsigned (n + 1)) $ extend a
+instance (KnownNat n, KnownNat m) => MaybeNumConvertCanonical (Unsigned n) (Signed m) where
+  maybeNumConvertCanonical !a = maybeResize $ bitCoerce @(Unsigned (n + 1)) $ extend a
 
-instance (KnownNat n, KnownNat m) => MaybeNumConvert (Unsigned n) (BitVector m) where
-  maybeNumConvert !a = maybeResize $ pack a
+instance (KnownNat n, KnownNat m) => MaybeNumConvertCanonical (Unsigned n) (BitVector m) where
+  maybeNumConvertCanonical !a = maybeResize $ pack a
 
-instance (KnownNat n, KnownNat m) => MaybeNumConvert (Signed n) (Index m) where
-  maybeNumConvert n
+instance (KnownNat n, KnownNat m) => MaybeNumConvertCanonical (Signed n) (Index m) where
+  maybeNumConvertCanonical n
     | n < 0 = Nothing
     | otherwise = maybeResize (bitCoerce @_ @(Index (2 ^ n)) (resize n))
 
-instance (KnownNat n, KnownNat m) => MaybeNumConvert (Signed n) (Unsigned m) where
-  maybeNumConvert n
+instance (KnownNat n, KnownNat m) => MaybeNumConvertCanonical (Signed n) (Unsigned m) where
+  maybeNumConvertCanonical n
     | n < 0 = Nothing
     | otherwise = maybeResize (bitCoerce @(Signed (n + 1)) (extend n))
 
-instance (KnownNat n, KnownNat m) => MaybeNumConvert (Signed n) (Signed m) where
-  maybeNumConvert !a = maybeResize a
+instance (KnownNat n, KnownNat m) => MaybeNumConvertCanonical (Signed n) (Signed m) where
+  maybeNumConvertCanonical !a = maybeResize a
 
-instance (KnownNat n, KnownNat m) => MaybeNumConvert (Signed n) (BitVector m) where
-  maybeNumConvert n
+instance (KnownNat n, KnownNat m) => MaybeNumConvertCanonical (Signed n) (BitVector m) where
+  maybeNumConvertCanonical n
     | n < 0 = Nothing
     | otherwise = maybeResize (pack @(Signed (n + 1)) (extend n))
 
-instance (KnownNat n, KnownNat m) => MaybeNumConvert (BitVector n) (Index m) where
-  maybeNumConvert !a = maybeResize $ unpack @(Index (2 ^ n)) a
-
-instance (KnownNat n, KnownNat m) => MaybeNumConvert (BitVector n) (Unsigned m) where
-  maybeNumConvert !a = maybeResize $ unpack @(Unsigned n) a
-
-instance (KnownNat n, KnownNat m) => MaybeNumConvert (BitVector n) (Signed m) where
-  maybeNumConvert !a = maybeResize $ unpack @(Signed (n + 1)) $ extend a
-
-instance (KnownNat n, KnownNat m) => MaybeNumConvert (BitVector n) (BitVector m) where
-  maybeNumConvert !a = maybeResize a
-
-instance (MaybeNumConvert (Unsigned 64) a) => MaybeNumConvert Word a where
-  maybeNumConvert !a = maybeNumConvert $ bitCoerce @_ @(Unsigned 64) a
-instance (MaybeNumConvert (Unsigned 64) a) => MaybeNumConvert Word64 a where
-  maybeNumConvert !a = maybeNumConvert $ bitCoerce @_ @(Unsigned 64) a
-instance (MaybeNumConvert (Unsigned 32) a) => MaybeNumConvert Word32 a where
-  maybeNumConvert !a = maybeNumConvert $ bitCoerce @_ @(Unsigned 32) a
-instance (MaybeNumConvert (Unsigned 16) a) => MaybeNumConvert Word16 a where
-  maybeNumConvert !a = maybeNumConvert $ bitCoerce @_ @(Unsigned 16) a
-instance (MaybeNumConvert (Unsigned 8) a) => MaybeNumConvert Word8 a where
-  maybeNumConvert !a = maybeNumConvert $ bitCoerce @_ @(Unsigned 8) a
-
-instance (MaybeNumConvert (Signed 64) a) => MaybeNumConvert Int a where
-  maybeNumConvert !a = maybeNumConvert $ bitCoerce @_ @(Signed 64) a
-instance (MaybeNumConvert (Signed 64) a) => MaybeNumConvert Int64 a where
-  maybeNumConvert !a = maybeNumConvert $ bitCoerce @_ @(Signed 64) a
-instance (MaybeNumConvert (Signed 32) a) => MaybeNumConvert Int32 a where
-  maybeNumConvert !a = maybeNumConvert $ bitCoerce @_ @(Signed 32) a
-instance (MaybeNumConvert (Signed 16) a) => MaybeNumConvert Int16 a where
-  maybeNumConvert !a = maybeNumConvert $ bitCoerce @_ @(Signed 16) a
-instance (MaybeNumConvert (Signed 8) a) => MaybeNumConvert Int8 a where
-  maybeNumConvert !a = maybeNumConvert $ bitCoerce @_ @(Signed 8) a
-
-instance (MaybeNumConvert a (Unsigned 64)) => MaybeNumConvert a Word where
-  maybeNumConvert !a = fmap (bitCoerce @(Unsigned 64)) $ maybeNumConvert a
-instance (MaybeNumConvert a (Unsigned 64)) => MaybeNumConvert a Word64 where
-  maybeNumConvert !a = fmap (bitCoerce @(Unsigned 64)) $ maybeNumConvert a
-instance (MaybeNumConvert a (Unsigned 32)) => MaybeNumConvert a Word32 where
-  maybeNumConvert !a = fmap (bitCoerce @(Unsigned 32)) $ maybeNumConvert a
-instance (MaybeNumConvert a (Unsigned 16)) => MaybeNumConvert a Word16 where
-  maybeNumConvert !a = fmap (bitCoerce @(Unsigned 16)) $ maybeNumConvert a
-instance (MaybeNumConvert a (Unsigned 8)) => MaybeNumConvert a Word8 where
-  maybeNumConvert !a = fmap (bitCoerce @(Unsigned 8)) $ maybeNumConvert a
-
-instance (MaybeNumConvert a (Signed 64)) => MaybeNumConvert a Int64 where
-  maybeNumConvert !a = fmap (bitCoerce @(Signed 64)) $ maybeNumConvert a
-instance (MaybeNumConvert a (Signed 32)) => MaybeNumConvert a Int32 where
-  maybeNumConvert !a = fmap (bitCoerce @(Signed 32)) $ maybeNumConvert a
-instance (MaybeNumConvert a (Signed 16)) => MaybeNumConvert a Int16 where
-  maybeNumConvert !a = fmap (bitCoerce @(Signed 16)) $ maybeNumConvert a
-instance (MaybeNumConvert a (Signed 8)) => MaybeNumConvert a Int8 where
-  maybeNumConvert !a = fmap (bitCoerce @(Signed 8)) $ maybeNumConvert a
-
-instance (MaybeNumConvert a (BitVector 1)) => MaybeNumConvert a Bit where
-  maybeNumConvert !a = unpack <$> maybeNumConvert a
-instance (MaybeNumConvert (BitVector 1) a) => MaybeNumConvert Bit a where
-  maybeNumConvert !a = maybeNumConvert (pack a)
+instance (KnownNat n, KnownNat m) => MaybeNumConvertCanonical (BitVector n) (Index m) where
+  maybeNumConvertCanonical !a = maybeResize $ unpack @(Index (2 ^ n)) a
+
+instance (KnownNat n, KnownNat m) => MaybeNumConvertCanonical (BitVector n) (Unsigned m) where
+  maybeNumConvertCanonical !a = maybeResize $ unpack @(Unsigned n) a
+
+instance (KnownNat n, KnownNat m) => MaybeNumConvertCanonical (BitVector n) (Signed m) where
+  maybeNumConvertCanonical !a = maybeResize $ unpack @(Signed (n + 1)) $ extend a
+
+instance (KnownNat n, KnownNat m) => MaybeNumConvertCanonical (BitVector n) (BitVector m) where
+  maybeNumConvertCanonical !a = maybeResize a