Merge pull request #2857 from clash-lang/unique_word64

Use Word64 Unique on GHC 9.10+

.ci/stack-9.2.yaml

@@ -13,7 +13,6 @@ packages:
 - tests
 
 extra-deps:
-- concurrent-supply-0.1.8@sha256:80b658533141660818d0781b8c8fb9a8cf69b987fcfbab782dc788bfc7df4846,1627
 - prettyprinter-interp-0.2.0.0@sha256:7072e659fb902cbcab790c9cca2b0739f9f4b81b666a63f2140139950f05025d,2086
 - infinite-list-0.1@sha256:4de250517ce75e128c766fbc1f23b5a778ea964e695e47f8e83e0f3b293091bf,2383
 - tasty-1.5@sha256:c62c96da1e9d65bf61ce583e9f7085eed1daeb62a45f3106ca252bf9ef87025b,2763

.ci/stack-9.4.yaml

@@ -13,7 +13,6 @@ packages:
 - tests
 
 extra-deps:
- - concurrent-supply-0.1.8@sha256:80b658533141660818d0781b8c8fb9a8cf69b987fcfbab782dc788bfc7df4846,1627
  - prettyprinter-interp-0.2.0.0@sha256:7072e659fb902cbcab790c9cca2b0739f9f4b81b666a63f2140139950f05025d,2086
  - git: https://github.com/christiaanb/hint.git
    commit: 7803c34c8ae1d83c0f7c13fe6b30fcb3abd0ac51

benchmark/benchmark-normalization.hs

@@ -12,10 +12,10 @@ import           Clash.GHC.Evaluator
 import           Clash.GHC.NetlistTypes       (ghcTypeToHWType)
 
 import           Clash.Netlist.Types          (TopEntityT(topId))
+import qualified Clash.Util.Supply            as Supply
 
 import           Criterion.Main
 
-import qualified Control.Concurrent.Supply    as Supply
 import           Control.DeepSeq              (NFData(..), rwhnf)
 import           Data.List                    (isPrefixOf, partition)
 import           System.Environment           (getArgs, withArgs)

benchmark/clash-benchmark.cabal

@@ -15,7 +15,6 @@ library
   ghc-options:         -O2 -Wall -Wcompat
   Exposed-Modules:     BenchmarkCommon
   build-depends:       base,
-                       concurrent-supply,
                        containers,
                        ghc,
                        mtl,
@@ -34,7 +33,6 @@ executable clash-benchmark-normalization
   default-language:    Haskell2010
   ghc-options:         -O2 -Wall -Wcompat -threaded -rtsopts "-with-rtsopts=-N -A128m"
   build-depends:       base,
-                       concurrent-supply,
                        containers,
                        criterion,
                        deepseq,

benchmark/common/BenchmarkCommon.hs

@@ -10,14 +10,13 @@ import Clash.Core.Var
 import Clash.Driver
 import Clash.Driver.Types
 import Clash.Netlist.Types (TopEntityT(topId))
+import Clash.Util.Supply as Supply
 
 import Clash.GHC.PartialEval
 import Clash.GHC.Evaluator
 import Clash.GHC.GenerateBindings
 import Clash.GHC.NetlistTypes
 
-import qualified Control.Concurrent.Supply as Supply
-
 #if MIN_VERSION_ghc(9,2,0)
 import qualified GHC.Driver.Monad as GHC
 import qualified GHC.Driver.Session as GHC

benchmark/profiling/run/clash-profiling.cabal

@@ -16,7 +16,6 @@ executable clash-profile-normalization-run
   build-depends:       base,
                        binary,
                        bytestring,
-                       concurrent-supply,
                        deepseq,
 
                        clash-benchmark,
@@ -34,7 +33,6 @@ executable clash-profile-netlist-run
   build-depends:       base,
                        binary,
                        bytestring,
-                       concurrent-supply,
                        deepseq,
                        filepath,
                        text,

benchmark/profiling/run/profile-normalization-run.hs

@@ -2,12 +2,12 @@
 
 import           Clash.Driver
 import           Clash.Driver.Types           (ClashEnv(..), ClashOpts(opt_intWidth))
+import qualified Clash.Util.Supply            as Supply
 
 import           Clash.GHC.PartialEval
 import           Clash.GHC.Evaluator
 import           Clash.GHC.NetlistTypes       (ghcTypeToHWType)
 
-import qualified Control.Concurrent.Supply    as Supply
 import           Control.DeepSeq              (deepseq)
 import           Data.Binary                  (decode)
 import           Data.List                    (partition)

changelog/2024-07-26T07_36_58+02_00_ghc_910_upgrade

@@ -1,4 +1 @@
 ADDED: Support for GHC 9.10.
-A word of caution: When the Clash compiler is compiled against GHC 9.10, it will
-currently only work reliably on 64-bit platforms. Compile the Clash compiler with
-GHC 9.8 or older if you are on a 32-bit platform.

clash-ghc/clash-ghc.cabal

@@ -168,7 +168,6 @@ library
 
                       clash-lib                 == 1.9.0,
                       clash-prelude             == 1.9.0,
-                      concurrent-supply         >= 0.1.7    && < 0.2,
                       ghc-typelits-extra        >= 0.3.2    && < 0.5,
                       ghc-typelits-knownnat     >= 0.6      && < 0.8,
                       ghc-typelits-natnormalise >= 0.6      && < 0.8,

clash-ghc/src-ghc/Clash/GHC/Evaluator.hs

@@ -22,7 +22,6 @@ module Clash.GHC.Evaluator where
 
 import           Prelude                                 hiding (lookup)
 
-import           Control.Concurrent.Supply               (Supply, freshId)
 import           Data.Either                             (lefts,rights)
 import           Data.List                               (mapAccumL)
 #if !MIN_VERSION_base(4,20,0)
@@ -55,6 +54,7 @@ import           Clash.Debug
 import qualified Clash.Normalize.Primitives as NP (removedArg, undefined, undefinedX)
 import           Clash.Unique
 import           Clash.Util                              (curLoc)
+import           Clash.Util.Supply                (Supply, freshId)
 
 import           Clash.GHC.Evaluator.Primitive
 

clash-ghc/src-ghc/Clash/GHC/Evaluator/Primitive.hs

@@ -25,7 +25,6 @@ module Clash.GHC.Evaluator.Primitive
   , isUndefinedXPrimVal
   ) where
 
-import           Control.Concurrent.Supply  (Supply,freshId)
 import           Control.DeepSeq            (force)
 import           Control.Exception          (ArithException(..), Exception, tryJust, evaluate)
 import           Control.Monad.State.Strict (State, MonadState)
@@ -117,6 +116,7 @@ import           Clash.GHC.GHC2Core  (modNameM)
 import           Clash.Unique        (fromGhcUnique)
 import           Clash.Util
   (MonadUnique (..), clogBase, flogBase, curLoc)
+import           Clash.Util.Supply   (Supply,freshId)
 import           Clash.Normalize.PrimitiveReductions
   (typeNatMul, typeNatSub, typeNatAdd, vecLastPrim, vecInitPrim, vecHeadPrim,
    vecTailPrim, mkVecCons, mkVecNil)

clash-ghc/src-ghc/Clash/GHC/GenerateBindings.hs

@@ -99,6 +99,7 @@ import           Clash.Netlist.Types     (TopEntityT(..))
 import           Clash.Primitives.Types
   (Primitive (..), CompiledPrimMap)
 import           Clash.Primitives.Util   (generatePrimMap)
+import           Clash.Unique            (Unique)
 import           Clash.Util              (reportTimeDiff)
 import qualified Clash.Util.Interpolate as I
 
@@ -400,15 +401,15 @@ mkClassSelector inScope0 tcm ty sel = newExpr
       Just dictTy@(tyView -> TyConApp tcNm _)
         | Just tc <- UniqMap.lookup tcNm tcm
         , not (isNewTypeTc tc)
-        -> flip State.evalState (0 :: Int) $ do
+        -> flip State.evalState (0 :: Unique) $ do
               dcId <- mkInternalVar inScope0 "dict" dictTy
               let inScope1 = extendInScopeSet inScope0 dcId
               selE <- mkSelectorCase "mkClassSelector" inScope1 tcm (Var dcId) 1 sel
               return (mkTyLams (mkLams selE [dcId]) tvs)
-      Just (tyView -> FunTy arg res) -> flip State.evalState (0 :: Int) $ do
+      Just (tyView -> FunTy arg res) -> flip State.evalState (0 :: Unique) $ do
               dcId <- mkInternalVar inScope0 "dict" (mkFunTy arg res)
               return (mkTyLams (mkLams (Var dcId) [dcId]) tvs)
-      Just dictTy -> flip State.evalState (0 :: Int) $ do
+      Just dictTy -> flip State.evalState (0 :: Unique) $ do
               dcId <- mkInternalVar inScope0 "dict" dictTy
               return (mkTyLams (mkLams (Var dcId) [dcId]) tvs)
       Nothing -> error "mkClassSelector: expected at least one dictionary argument"

clash-lib-hedgehog/src/Clash/Hedgehog/Unique.hs

@@ -6,6 +6,7 @@ Maintainer  : QBayLogic B.V. <[email protected]>
 Random generation of unique variables and unique containers.
 -}
 
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE TupleSections #-}
 
 module Clash.Hedgehog.Unique
@@ -33,7 +34,13 @@ import Clash.Unique
 import Clash.Hedgehog.Internal.Bias
 
 genUnique :: forall m. MonadGen m => m Unique
-genUnique = Gen.int Range.linearBounded
+genUnique =
+#if __GLASGOW_HASKELL__ >= 910
+  Gen.word64
+#else
+  Gen.int
+#endif
+    Range.linearBounded
 
 genUniqMap
   :: forall m k v

clash-lib/clash-lib.cabal

@@ -152,7 +152,6 @@ Library
                       binary                  >= 0.8.5    && < 0.11,
                       bytestring              >= 0.10.0.2 && < 0.13,
                       clash-prelude           == 1.9.0,
-                      concurrent-supply       >= 0.1.7    && < 0.2,
                       containers              >= 0.5.0.0  && < 0.8,
                       cryptohash-sha256       >= 0.11     && < 0.12,
                       data-binary-ieee754     >= 0.4.4    && < 0.6,
@@ -309,6 +308,7 @@ Library
                       Clash.Util.Eq
                       Clash.Util.Graph
                       Clash.Util.Interpolate
+                      Clash.Util.Supply
                       Clash.Pretty
 
                       Clash.Verification.Pretty
@@ -415,7 +415,6 @@ test-suite unittests
       base16-bytestring,
       bytestring,
       containers,
-      concurrent-supply,
       data-default,
       deepseq,
       haskell-src-exts,

clash-lib/src/Clash/Core/Evaluator/Types.hs

@@ -11,7 +11,6 @@
 -}
 module Clash.Core.Evaluator.Types where
 
-import Control.Concurrent.Supply (Supply)
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IntMap (insert, lookup)
 #if !MIN_VERSION_base(4,20,0)
@@ -36,6 +35,7 @@ import Clash.Core.Var (Id, IdScope(..), TyVar)
 import Clash.Core.VarEnv
 import Clash.Driver.Types (BindingMap, bindingTerm)
 import Clash.Pretty (ClashPretty(..), fromPretty, showDoc)
+import Clash.Util.Supply (Supply)
 
 whnf'
   :: Evaluator

clash-lib/src/Clash/Core/FreeVars.hs

@@ -7,6 +7,7 @@
   Free variable calculations
 -}
 
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 
@@ -32,7 +33,11 @@ import qualified Control.Lens           as Lens
 import Control.Lens.Fold                (Fold)
 import Control.Lens.Getter              (Contravariant)
 import Data.Coerce
+#if MIN_VERSION_ghc(9,10,0)
+import qualified GHC.Data.Word64Set     as IntSet
+#else
 import qualified Data.IntSet            as IntSet
+#endif
 import Data.Monoid                      (All (..), Any (..))
 
 import Clash.Core.Term                  (Pat (..), Term (..), TickInfo (..), Bind(..))
@@ -81,7 +86,11 @@ typeFreeVars'
   :: (Contravariant f, Applicative f)
   => (forall b . Var b -> Bool)
   -- ^ Predicate telling whether a variable is interesting
+#if MIN_VERSION_ghc(9,10,0)
+  -> IntSet.Word64Set
+#else
   -> IntSet.IntSet
+#endif
   -- ^ Uniques of the variables in scope, used by 'termFreeVars''
   -> (Var a -> f (Var a))
   -> Type

clash-lib/src/Clash/Core/PartialEval.hs

@@ -11,7 +11,6 @@ library for the compiler front-end, e.g. Clash.GHC.PartialEval in clash-ghc.
 
 module Clash.Core.PartialEval where
 
-import Control.Concurrent.Supply (Supply)
 import Data.IntMap.Strict (IntMap)
 
 import Clash.Core.PartialEval.AsTerm
@@ -22,6 +21,7 @@ import Clash.Core.TyCon (TyConMap)
 import Clash.Core.Var (Id)
 import Clash.Core.VarEnv (InScopeSet)
 import Clash.Driver.Types (Binding(..), BindingMap)
+import Clash.Util.Supply (Supply)
 
 -- | An evaluator for Clash core. This consists of two functions: one to
 -- evaluate a term to weak-head normal form (WHNF) and another to recursively

clash-lib/src/Clash/Core/PartialEval/Monad.hs

@@ -60,7 +60,6 @@ module Clash.Core.PartialEval.Monad
   ) where
 
 import           Control.Applicative (Alternative)
-import           Control.Concurrent.Supply (Supply)
 import           Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
 import           Control.Monad.IO.Class (MonadIO)
 
@@ -85,6 +84,7 @@ import           Clash.Core.Var (Id, TyVar, Var)
 import           Clash.Core.VarEnv
 import           Clash.Driver.Types (Binding(..))
 import           Clash.Rewrite.WorkFree (isWorkFree)
+import           Clash.Util.Supply (Supply)
 
 {-
 NOTE [RWS monad]

clash-lib/src/Clash/Core/PartialEval/NormalForm.hs

@@ -30,7 +30,6 @@ module Clash.Core.PartialEval.NormalForm
   , workFreeCache
   ) where
 
-import Control.Concurrent.Supply (Supply)
 import Control.Lens (Lens', lens)
 import Data.IntMap.Strict (IntMap)
 import Data.Map.Strict (Map)
@@ -44,6 +43,7 @@ import Clash.Core.Util (undefinedPrims, undefinedXPrims)
 import Clash.Core.Var (Id)
 import Clash.Core.VarEnv (VarEnv, InScopeSet)
 import Clash.Driver.Types (Binding(..))
+import Clash.Util.Supply (Supply)
 
 type Args a
   = [Arg a]

clash-lib/src/Clash/Core/Util.hs

@@ -18,7 +18,6 @@
 
 module Clash.Core.Util where
 
-import           Control.Concurrent.Supply     (Supply, freshId)
 import Control.Exception.Base (patError)
 #if MIN_VERSION_base(4,16,0)
 import GHC.Prim.Panic (absentError)
@@ -67,6 +66,7 @@ import qualified Clash.Data.UniqMap as UniqMap
 import Clash.Debug                       (traceIf)
 import Clash.Unique                      (fromGhcUnique)
 import Clash.Util
+import Clash.Util.Supply                 (Supply, freshId)
 
 import {-# SOURCE #-} qualified Clash.Normalize.Primitives as Primitives
 import Clash.XException (errorX)

clash-lib/src/Clash/Core/VarEnv.hs

@@ -103,6 +103,9 @@ import           Data.Coerce               (coerce)
 import qualified Data.List                 as List
 import qualified Data.List.Extra           as List
 import           Data.Maybe                (fromMaybe)
+#if MIN_VERSION_ghc(9,10,0)
+import           Data.Word                 (Word64)
+#endif
 
 #if MIN_VERSION_prettyprinter(1,7,0)
 import           Prettyprinter
@@ -385,14 +388,21 @@ eltsVarSet = UniqMap.elems
 
 -- * InScopeSet
 
+type Seed
+#if MIN_VERSION_ghc(9,10,0)
+  = Word64
+#else
+  = Int
+#endif
+
 -- | Set of variables that is in scope at some point
 --
--- The 'Int' is a kind of hash-value used to generate new uniques. It should
+-- The 'Seed' is a kind of hash-value used to generate new uniques. It should
 -- never be zero
 --
 -- See "Secrets of the Glasgow Haskell Compiler inliner" Section 3.2 for the
 -- motivation
-data InScopeSet = InScopeSet VarSet {-# UNPACK #-} !Int
+data InScopeSet = InScopeSet VarSet {-# UNPACK #-} !Seed
   deriving (Generic, NFData, Binary)
 
 instance ClashPretty InScopeSet where
@@ -412,7 +422,7 @@ extendInScopeSetList
   -> [Var a]
   -> InScopeSet
 extendInScopeSetList (InScopeSet inScope n) vs =
-  InScopeSet (List.foldl' extendVarSet inScope vs) (n + length vs)
+  InScopeSet (List.foldl' extendVarSet inScope vs) (n + fromIntegral (length vs))
 
 -- | Union two sets of in scope variables
 unionInScope
@@ -484,7 +494,7 @@ uniqAway'
   :: (Uniquable a, ClashPretty a)
   => (Unique -> Bool)
   -- ^ Unique in scope test
-  -> Int
+  -> Seed
   -- ^ Seed
   -> a
   -> a
@@ -510,7 +520,7 @@ uniqAway' inScopeTest n u =
 
 deriveUnique
   :: Unique
-  -> Int
+  -> Seed
   -> Unique
 deriveUnique i delta = i + delta