Merge pull request #2994 from clash-lang/lucas/poly-kinds-default-extensions

martijnbastiaan · web-flow · commit dc70c15562d6 · 2025-09-24T15:59:20.000+02:00
Add `PolyKinds` as default extension to `clash-prelude`
diff --git a/changelog/2025-08-25T09_57_02+02_00_enable_polykinds_for_clash_prelude b/changelog/2025-08-25T09_57_02+02_00_enable_polykinds_for_clash_prelude
@@ -0,0 +1 @@
+CHANGED: The `clash-prelude` package now uses `PolyKinds` by default, meaning all its type class instances are now more general than before. As an example, without `PolyKinds`, `BitPack (Proxy a)` would only be defined when `a :: Type`, with the extension it would be defined for any  `a :: k`. After this change, some instances in user code might now overlap.
diff --git a/clash-prelude/LICENSE b/clash-prelude/LICENSE
@@ -1,6 +1,6 @@
 Copyright (c) 2013-2016, University of Twente,
               2016-2019, Myrtle Software Ltd,
-              2017-2019, QBayLogic B.V., Google Inc.
+              2017-2025, QBayLogic B.V., Google Inc.
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
diff --git a/clash-prelude/clash-prelude.cabal b/clash-prelude/clash-prelude.cabal
@@ -131,6 +131,7 @@ common common-options
                       KindSignatures
                       MagicHash
                       NoStarIsType
+                      PolyKinds
                       PostfixOperators
                       ScopedTypeVariables
                       StandaloneDeriving
diff --git a/clash-prelude/src/Clash/Annotations/SynthesisAttributes.hs b/clash-prelude/src/Clash/Annotations/SynthesisAttributes.hs
@@ -1,6 +1,6 @@
 {-|
   Copyright   :  (C) 2018,      Google Inc.,
-                     2021-2023, QBayLogic B.V.
+                     2021-2025, QBayLogic B.V.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -13,7 +13,6 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
-{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskellQuotes #-}
 
diff --git a/clash-prelude/src/Clash/Annotations/TH.hs b/clash-prelude/src/Clash/Annotations/TH.hs
@@ -51,7 +51,6 @@ makeTopEntity 'topEntity
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
diff --git a/clash-prelude/src/Clash/Class/BitPack/Internal.hs b/clash-prelude/src/Clash/Class/BitPack/Internal.hs
@@ -58,6 +58,7 @@ import Clash.Sized.Internal.BitVector
 >>> :m -Prelude
 >>> :set -XDataKinds
 >>> import Clash.Prelude
+>>> import Data.Proxy
 -}
 
 -- | Convert data to/from a 'BitVector'. This allows functions to be defined
@@ -92,7 +93,7 @@ import Clash.Sized.Internal.BitVector
 -- places.
 --
 -- Clash provides some generic functions on packable types in the prelude, such
--- as indexing into packable stuctures (see "Clash.Class.BitPack.BitIndex") and
+-- as indexing into packable structures (see "Clash.Class.BitPack.BitIndex") and
 -- bitwise reduction of packable data (see "Clash.Class.BitPack.BitReduction").
 --
 class KnownNat (BitSize a) => BitPack a where
@@ -478,7 +479,16 @@ instance ( BitPack a
          ) => BitPack (Either a b)
 
 instance BitPack a => BitPack (Maybe a)
-instance BitPack (Proxy a) => BitPack (Proxy a)
+
+-- | Any 'Proxy' has a bit size of 0 and hence packs to @0 :: BitVector 0@.
+--
+-- >>> pack (Proxy @())
+-- 0
+-- >>> pack (Proxy @5)
+-- 0
+-- >>> pack (Proxy @Bool)
+-- 0
+instance BitPack (Proxy a)
 
 instance BitPack a => BitPack (Complex a)
 instance BitPack a => BitPack (Down a)
diff --git a/clash-prelude/src/Clash/Class/HasDomain/Common.hs b/clash-prelude/src/Clash/Class/HasDomain/Common.hs
@@ -4,7 +4,6 @@ License    :  BSD2 (see the file LICENSE)
 Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>
 -}
 
-{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Clash.Class.HasDomain.Common {-# DEPRECATED "Experimental feature multiple hidden has been removed. This module will therefore be removed in Clash 1.12." #-}
diff --git a/clash-prelude/src/Clash/Class/HasDomain/HasSingleDomain.hs b/clash-prelude/src/Clash/Class/HasDomain/HasSingleDomain.hs
@@ -1,6 +1,6 @@
 {-|
 Copyright  :  (C) 2019, Myrtle Software Ltd
-                  2022, QBayLogic B.V.
+                  2022-2025, QBayLogic B.V.
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -10,7 +10,6 @@ Internals for "Clash.Class.HasDomain"
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
diff --git a/clash-prelude/src/Clash/Class/HasDomain/HasSpecificDomain.hs b/clash-prelude/src/Clash/Class/HasDomain/HasSpecificDomain.hs
@@ -1,5 +1,6 @@
 {-|
 Copyright  :  (C) 2019, Myrtle Software Ltd
+                  2022-2025, QBayLogic B.V.
 License    :  BSD2 (see the file LICENSE)
 Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>
 
@@ -10,7 +11,6 @@ Internals for "Clash.Class.HasDomain"
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
diff --git a/clash-prelude/src/Clash/NamedTypes.hs b/clash-prelude/src/Clash/NamedTypes.hs
@@ -34,7 +34,6 @@ fifo @System
 -}
 
 {-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
-{-# LANGUAGE PolyKinds #-}
 
 {-# LANGUAGE Safe #-}
 
diff --git a/clash-prelude/src/Clash/Signal/Delayed/Bundle.hs b/clash-prelude/src/Clash/Signal/Delayed/Bundle.hs
@@ -8,7 +8,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
 
 module Clash.Signal.Delayed.Bundle (
diff --git a/clash-prelude/src/Clash/Signal/Internal.hs b/clash-prelude/src/Clash/Signal/Internal.hs
@@ -17,7 +17,6 @@ Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
diff --git a/clash-prelude/src/Clash/XException.hs-boot b/clash-prelude/src/Clash/XException.hs-boot
@@ -1,13 +1,14 @@
 module Clash.XException where
 
+import Data.Kind (Type)
 import GHC.Stack (HasCallStack)
 
 isX :: a -> Either String a
 
-class ShowX a
+class ShowX (a :: Type)
 showsPrecX :: ShowX a => Int -> a -> ShowS
 
-class NFDataX a
+class NFDataX (a :: Type)
 deepErrorX :: NFDataX a => HasCallStack => String -> a
 hasUndefined :: NFDataX a => a -> Bool
 rnfX :: NFDataX a => a -> ()
diff --git a/clash-prelude/tests/Clash/Tests/Reset.hs b/clash-prelude/tests/Clash/Tests/Reset.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE PolyKinds #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 
diff --git a/tests/shouldwork/Basic/T1242.hs b/tests/shouldwork/Basic/T1242.hs
@@ -1,50 +1,14 @@
-{-# LANGUAGE StandaloneDeriving    #-}
-{-# LANGUAGE UndecidableInstances  #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 module T1242 where
 
-import           Clash.Prelude
-import           Control.DeepSeq   (NFData)
-import           GHC.Generics      (Generic)
+import Clash.Prelude
 
-data RepKind = AppRep | WireRep
-  deriving (Generic, Show, Eq, NFData, NFDataX)
+class C a where
+  type T a :: Nat
 
-newtype U16 (t :: RepKind) = U16 (Unsigned 16)
+data Wrapper (t :: Bool)
 
-deriving instance Generic (U16 a)
-deriving instance Eq (U16 a)
-deriving instance Show (U16 a)
-deriving instance NFData (U16 a)
-deriving instance NFDataX (U16 a)
-deriving instance BitPack (U16 'AppRep)
+instance C (t 'True) where
+  type T (t 'True) = 16
 
-class WireApp w a where
-    toWire :: a -> w
-    toApp :: w -> a
-
-instance WireApp (U16 'WireRep) (U16 'AppRep) where
-    toWire v = case v of U16 x -> U16 x
-    toApp v = case v of U16 x -> U16 x
-
-instance (BitPack (t 'AppRep), WireApp (t 'WireRep)  (t 'AppRep)) => BitPack (t 'WireRep) where
-  type BitSize (t 'WireRep) = BitSize (t 'AppRep)
-  pack x = bv
-    where
-        bv :: BitVector (BitSize (t 'WireRep))
-        bv = pack app
-        app :: t 'AppRep
-        app = toApp $ x
-  unpack x = toWire app
-    where
-        app :: t 'AppRep
-        app = unpack x
-
-data Record
-  = Record
-  { f1 :: U16 'WireRep
-  , f2 :: U16 'WireRep
-  } deriving (Generic, NFData, Show, Eq, BitPack, NFDataX)
-
-topEntity :: Signal System Bool -> Signal System Bool
-topEntity _ = pure (unpack 0 == Record (U16 0) (U16 0))
+topEntity :: Vec (T (Wrapper 'True)) Int
+topEntity = undefined
diff --git a/tests/src/Test/Tasty/Clash.hs b/tests/src/Test/Tasty/Clash.hs
@@ -216,6 +216,14 @@ dOpaque =
   "-DCLASH_OPAQUE=NOINLINE"
 #endif
 
+commonArgs :: [String]
+commonArgs =
+  [ "-fclash-debug", "DebugSilent"
+  , "-fclash-ignore-broken-ghcs"
+  , "-Werror=unrecognised-pragmas"
+  , dOpaque
+  ]
+
 instance IsTest ClashGenTest where
   run optionSet ClashGenTest{..} progressCallback = do
     oDir <- cgOutputDirectory
@@ -247,10 +255,8 @@ instance IsTest ClashGenTest where
       , "-fclash-hdldir", hdlDir
       , "-odir", oDir
       , "-hidir", oDir
-      , "-fclash-debug", "DebugSilent"
-      , "-fclash-ignore-broken-ghcs"
-      , dOpaque
-      ] <> cgExtraArgs
+      ] <> commonArgs
+        <> cgExtraArgs
 
     target =
       case cgBuildTarget of
@@ -287,10 +293,9 @@ instance IsTest ClashBinaryTest where
       , "-o", oDir </> "out"
       , "-i" <> cbSourceDirectory
       , "-outputdir", oDir
-      , "-fclash-ignore-broken-ghcs"
-      ] <> cbExtraBuildArgs <>
-      [ cbSourceDirectory </> cbModName <.> "hs"
-      ]
+      ] <> commonArgs
+        <> cbExtraBuildArgs
+        <> [cbSourceDirectory </> cbModName <.> "hs"]
 
     execProgram oDir =
       TestProgram (oDir </> "out") (oDir:cbExtraExecArgs) NoGlob PrintStdErr False Nothing []

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1 @@`
	`1`	+CHANGED: The `clash-prelude` package now uses `PolyKinds` by default, meaning all its type class instances are now more general than before. As an example, without `PolyKinds`, `BitPack (Proxy a)` would only be defined when `a :: Type`, with the extension it would be defined for any `a :: k`. After this change, some instances in user code might now overlap.