diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,34 @@
 # Changelog for the Clash project
 
+## 1.8.2 *Jan 3rd 2025*
+
+Added:
+* Support for GHC 9.10 [#2758](https://github.com/clash-lang/clash-compiler/pull/2758)
+* Support for GHC 9.8.4 [#2852](https://github.com/clash-lang/clash-compiler/issues/2852)
+* Add `ShowX`, `NFDataX` instances for `Proxy` [#2637](https://github.com/clash-lang/clash-compiler/pull/2637)
+* Added `Clash.Sized.Vector.ToTuple.vecToTuple`: a way to safely work around incomplete patterns warnings on patterns involving `Vec`tors. [#2862](https://github.com/clash-lang/clash-compiler/pull/2682)
+* Added operator precedences for infix usage of functions exported from `Clash.Class.Num`: `mul`, `add`, `sub`, `satMul`, `satAdd`, `satSub`, `boundedMul`, `boundedAdd`, and `boundedSub`. This means that expressions such as `` a `add` b `mul` c `` now get parsed as `` a `add` (b `mul` c) `` instead of `` (a `add` b) `mul` c ``. [#2719](https://github.com/clash-lang/clash-compiler/pull/2719)
+
+Changed:
+* `BitVector n` now has an implementation for `ensureSpine` which ensures the constructor is present. [#2702](https://github.com/clash-lang/clash-compiler/pull/2702)
+* `xToBV` is now located in `Clash.Sized.Internal.BitVector` to avoid circular dependencies. [#2702](https://github.com/clash-lang/clash-compiler/pull/2702)
+* The error messages that mention the valid ranges for out-of-range inputs have been improved to be more intuitive: one of `<empty range>`, `[n]` or `[n..m]`. All _n..m_ ranges are now ordered with the lower bound on the left. [#2733](https://github.com/clash-lang/clash-compiler/pull/2733)
+
+Fixed:
+* cabal: Make `workaround-ghc-mmap-crash` a noop on non-x86_64. Fixes [#2656](https://github.com/clash-lang/clash-compiler/issues/2656)
+* Clash no longer hides error messages if it fails to load external (precompiled) modules. Note: this fix only works from GHC 9.0 on. See [#2365](https://github.com/clash-lang/clash-compiler/issues/2365)
+* HDL generation fails when using multiple-hidden feature in combination with synthesis attributes [#2593](https://github.com/clash-lang/clash-compiler/issues/2593)
+* Clash no longer errors out in the netlist generation stage when a polymorphic function is applied to type X in one alternative of a case-statement and applied to a newtype wrapper of type X in a different alternative. See [#2828](https://github.com/clash-lang/clash-compiler/issues/2628)
+* various issues with black boxes and evaluator rules for number-related primitives [#2689](https://github.com/clash-lang/clash-compiler/pull/2689)
+* `genBitVector` no longer contains off-by-one error on for generated Naturals [#2704](https://github.com/clash-lang/clash-compiler/pull/2704)
+* (+>>.) and (.<<+) such that they are compliant with (+>>) and (<<+) for vectors of zero length in the sense that the input vector is kept unchanged. [#2730](https://github.com/clash-lang/clash-compiler/issues/2730)
+* Removed `stringsearch` dependency from `v16-upgrade-primitives`. See [#2726](https://github.com/clash-lang/clash-compiler/issues/2726)
+* Bug in the compile-time evaluator [#2781](https://github.com/clash-lang/clash-compiler/issues/2781)
+* Exponentiation (`Clash.Class.Exp`) is now right-associative with a precedence level of 8 (`infixr 8`). By accident, it used to lack a fixity declaration, meaning it was implicitly left-associative at level 9. [#2818](https://github.com/clash-lang/clash-compiler/pull/2818)
+* Unused argument warnings on writeToBiSignal# [#2822](https://github.com/clash-lang/clash-compiler/pull/2822)
+* Clash errored saying it cannot translate a globally recursive function in code that originally only contains let-bound (local) recursion [#2839](https://github.com/clash-lang/clash-compiler/issues/2839)
+* Clash generates illegal Verilog names [#2845](https://github.com/clash-lang/clash-compiler/issues/2845)
+
 ## 1.8.1 *Nov 10th 2023*
 
 * Bump package dependencies to allow inclusion in stackage-nightly
diff --git a/clash-lib.cabal b/clash-lib.cabal
--- a/clash-lib.cabal
+++ b/clash-lib.cabal
@@ -1,6 +1,6 @@
 Cabal-version:        2.2
 Name:                 clash-lib
-Version:              1.8.1
+Version:              1.8.2
 Synopsis:             Clash: a functional hardware description language - As a library
 Description:
   Clash is a functional hardware description language that borrows both its
@@ -143,7 +143,7 @@
   Build-depends:      aeson                   >= 0.6.2.0  && < 2.3,
                       attoparsec-aeson        >= 2.1      && < 2.3,
                       aeson-pretty            >= 0.8      && < 0.9,
-                      ansi-terminal           >= 0.8.0.0  && < 1.1,
+                      ansi-terminal           >= 0.8.0.0  && < 1.2,
                       array,
                       async                   >= 2.2.0    && < 2.3,
                       attoparsec              >= 0.10.4.0 && < 0.15,
@@ -151,9 +151,8 @@
                       base16-bytestring       >= 0.1.1    && < 1.1,
                       binary                  >= 0.8.5    && < 0.11,
                       bytestring              >= 0.10.0.2 && < 0.13,
-                      clash-prelude           == 1.8.1,
-                      concurrent-supply       >= 0.1.7    && < 0.2,
-                      containers              >= 0.5.0.0  && < 0.7,
+                      clash-prelude           == 1.8.2,
+                      containers              >= 0.5.0.0  && < 0.8,
                       cryptohash-sha256       >= 0.11     && < 0.12,
                       data-binary-ieee754     >= 0.4.4    && < 0.6,
                       data-default            >= 0.7      && < 0.8,
@@ -162,14 +161,15 @@
                       directory               >= 1.2.0.1  && < 1.4,
                       exceptions              >= 0.8.3    && < 0.11.0,
                       extra                   >= 1.6.17   && < 1.8,
-                      filepath                >= 1.3.0.1  && < 1.5,
-                      ghc                     >= 8.6.0    && < 9.9,
+                      filepath                >= 1.3.0.1  && < 1.6,
+                      ghc                     >= 8.6.0    && < 9.11,
                       ghc-boot-th,
-                      hashable                >= 1.2.1.0  && < 1.5,
+                      ghc-prim,
+                      hashable                >= 1.2.1.0  && < 1.6,
                       haskell-src-meta        >= 0.8      && < 0.9,
                       hint                    >= 0.7      && < 0.10,
                       infinite-list           ^>= 0.1,
-                      lens                    >= 4.10     && < 5.3,
+                      lens                    >= 4.10     && < 5.4,
                       mtl                     >= 2.1.2    && < 2.4,
                       ordered-containers      >= 0.2      && < 0.3,
                       prettyprinter           >= 1.2.0.1  && < 1.8,
@@ -177,11 +177,11 @@
                       pretty-show             >= 1.9      && < 2.0,
                       primitive               >= 0.5.0.1  && < 1.0,
                       string-interpolate      ^>= 0.3,
-                      template-haskell        >= 2.8.0.0  && < 2.22,
+                      template-haskell        >= 2.8.0.0  && < 2.23,
                       temporary               >= 1.2.1    && < 1.4,
                       terminal-size           >= 0.3      && < 0.4,
                       text                    >= 1.2.2    && < 2.2,
-                      time                    >= 1.4.0.1  && < 1.14,
+                      time                    >= 1.4.0.1  && < 1.15,
                       transformers            >= 0.5.2.0  && < 0.7,
                       trifecta                >= 1.7.1.1  && < 2.2,
                       vector                  >= 0.11     && < 1.0,
@@ -239,6 +239,7 @@
                       Clash.Debug
 
                       Clash.Driver
+                      Clash.Driver.Bool
                       Clash.Driver.Manifest
                       Clash.Driver.Types
 
@@ -305,6 +306,7 @@
                       Clash.Util.Eq
                       Clash.Util.Graph
                       Clash.Util.Interpolate
+                      Clash.Util.Supply
                       Clash.Pretty
 
                       Clash.Verification.Pretty
@@ -343,9 +345,9 @@
     yaml,
     bytestring,
     clash-lib,
+    text,
     containers,
     directory,
-    stringsearch,
     Glob
   GHC-Options:        -Wall -Wcompat
   default-language:   Haskell2010
@@ -389,7 +391,7 @@
   ghc-options:      -Wall -Wcompat -threaded
   -- Note that multiple -with-rtsopts are not cumulative, so we can't add the
   -- common RTS options in the unconditional GHC-Options
-  if flag(workaround-ghc-mmap-crash)
+  if arch(x86_64) && flag(workaround-ghc-mmap-crash)
     GHC-Options: "-with-rtsopts=-N -xm20000000"
   else
     GHC-Options: -with-rtsopts=-N
@@ -411,7 +413,6 @@
       base16-bytestring,
       bytestring,
       containers,
-      concurrent-supply,
       data-default,
       deepseq,
       haskell-src-exts,
diff --git a/prims/common/Clash_Class_BitPack.primitives.yaml b/prims/common/Clash_Class_BitPack.primitives.yaml
--- a/prims/common/Clash_Class_BitPack.primitives.yaml
+++ b/prims/common/Clash_Class_BitPack.primitives.yaml
@@ -27,7 +27,7 @@
     template: ~ARG[0]
     workInfo: Never
 - BlackBox:
-    name: Clash.Class.BitPack.Internal.xToBV
+    name: Clash.Sized.Internal.BitVector.xToBV
     kind: Expression
     type: 'xToBV :: KnownNat n => BitVector n -> BitVector n'
     template: ~ARG[1]
diff --git a/prims/common/GHC_Internal_Debug_Trace.primitives.yaml b/prims/common/GHC_Internal_Debug_Trace.primitives.yaml
new file mode 100644
--- /dev/null
+++ b/prims/common/GHC_Internal_Debug_Trace.primitives.yaml
@@ -0,0 +1,7 @@
+- BlackBox:
+    name: GHC.Internal.Debug.Trace.trace
+    kind: Expression
+    type: 'trace :: String
+      -> a -> a'
+    template: ~ARG[1]
+    workInfo: Never
diff --git a/prims/common/GHC_Internal_Err.primitives.yaml b/prims/common/GHC_Internal_Err.primitives.yaml
new file mode 100644
--- /dev/null
+++ b/prims/common/GHC_Internal_Err.primitives.yaml
@@ -0,0 +1,18 @@
+- BlackBox:
+    name: GHC.Internal.Err.error
+    kind: Expression
+    type: 'error :: forall r a . HasCallStack => [Char] -> a'
+    template: ~ERRORO
+    workInfo: Constant
+- BlackBox:
+    name: GHC.Internal.Err.errorWithoutStackTrace
+    kind: Expression
+    type: 'errorWithoutStackTrace :: forall r a . [Char] -> a'
+    template: ~ERRORO
+    workInfo: Constant
+- BlackBox:
+    name: GHC.Internal.Err.undefined
+    kind: Expression
+    type: 'undefined :: forall r a . HasCallStack => a'
+    template: ~ERRORO
+    workInfo: Constant
diff --git a/prims/common/GHC_Internal_TypeNats.primitives.yaml b/prims/common/GHC_Internal_TypeNats.primitives.yaml
new file mode 100644
--- /dev/null
+++ b/prims/common/GHC_Internal_TypeNats.primitives.yaml
@@ -0,0 +1,17 @@
+- BlackBox:
+    name: GHC.Internal.TypeNats.natVal
+    kind: Expression
+    type: 'natVal :: forall
+      n proxy. KnownNat n => proxy n -> Natural'
+    template: ~ARG[0]
+    workInfo: Never
+- Primitive:
+    name: GHC.Internal.TypeNats.someNatVal
+    primType: Function
+    type: 'someNatVal :: Natural -> SomeNat'
+    workInfo: Never
+- Primitive:
+    name: GHC.Internal.TypeNats.withSomeSNat
+    primType: Function
+    type: 'withSomeSNat :: forall rep (r :: TYPE rep). Natural -> (forall n. SNat n -> r) -> r'
+    workInfo: Never
diff --git a/prims/common/GHC_Magic.primitives.yaml b/prims/common/GHC_Magic.primitives.yaml
--- a/prims/common/GHC_Magic.primitives.yaml
+++ b/prims/common/GHC_Magic.primitives.yaml
@@ -8,6 +8,11 @@
     type: forall a. a -> a
     workInfo: Never
 - Primitive:
+    name: GHC.Magic.nospec
+    primType: Function
+    type: forall a. a -> a
+    workInfo: Never
+- Primitive:
     name: GHC.Magic.runRW#
     primType: Function
     workInfo: Never
diff --git a/prims/common/GHC_Prim.primitives.yaml b/prims/common/GHC_Prim.primitives.yaml
--- a/prims/common/GHC_Prim.primitives.yaml
+++ b/prims/common/GHC_Prim.primitives.yaml
@@ -2,6 +2,12 @@
     name: GHC.Prim.dataToTag#
     primType: Function
 - Primitive:
+    name: GHC.Prim.dataToTagSmall#
+    primType: Function
+- Primitive:
+    name: GHC.Prim.dataToTagLarge#
+    primType: Function
+- Primitive:
     name: GHC.Prim.tagToEnum#
     primType: Function
 - BlackBox:
diff --git a/prims/common/GHC_TypeNats.primitives.yaml b/prims/common/GHC_TypeNats.primitives.yaml
--- a/prims/common/GHC_TypeNats.primitives.yaml
+++ b/prims/common/GHC_TypeNats.primitives.yaml
@@ -11,7 +11,7 @@
     type: 'someNatVal :: Natural -> SomeNat'
     workInfo: Never
 - Primitive:
-    name: GHC.TypeNates.withSomeSNat
+    name: GHC.TypeNats.withSomeSNat
     primType: Function
     type: 'withSomeSNat :: forall rep (r :: TYPE rep). Natural -> (forall n. SNat n -> r) -> r'
     workInfo: Never
diff --git a/prims/commonverilog/Clash_Sized_Internal_Signed.primitives.yaml b/prims/commonverilog/Clash_Sized_Internal_Signed.primitives.yaml
--- a/prims/commonverilog/Clash_Sized_Internal_Signed.primitives.yaml
+++ b/prims/commonverilog/Clash_Sized_Internal_Signed.primitives.yaml
@@ -106,8 +106,11 @@
     kind: Expression
     type: 'fromInteger# ::
       KnownNat n => Integer -> Signed (n :: Nat)'
-    template: ~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]~THEN$signed(~VAR[i][1][0+:~SIZE[~TYPO]])~ELSE$signed({{(~SIZE[~TYPO]-~SIZE[~TYP[1]])
-      {1'b0}},~VAR[i][1]})~FI
+    template: >-
+      ~IF~CMPLE[~SIZE[~TYPO]][~SIZE[~TYP[1]]]
+      ~THEN$signed(~VAR[i][1][0+:~SIZE[~TYPO]])
+      ~ELSE$signed({{(~SIZE[~TYPO]-~SIZE[~TYP[1]]){~VAR[i][1][~SIZE[~TYP[1]]-1]}},~VAR[i][1]})
+      ~FI
     workInfo: Never
 - BlackBox:
     name: Clash.Sized.Internal.Signed.toEnum#
diff --git a/prims/commonverilog/GHC_Num_Integer.primitives.yaml b/prims/commonverilog/GHC_Num_Integer.primitives.yaml
--- a/prims/commonverilog/GHC_Num_Integer.primitives.yaml
+++ b/prims/commonverilog/GHC_Num_Integer.primitives.yaml
@@ -150,8 +150,8 @@
     name: GHC.Num.Integer.integerTestBit#
     kind: Expression
     type: 'integerTestBit
-      :: Integer -> Word# -> Bool'
-    template: ~VAR[input][0][~ARG[1]] == 1'b1
+      :: Integer -> Word# -> Int#'
+    template: "((~VAR[input][0][~ARG[1]] == 1'b1) ? ~SIZE[~TYPO]'sd1 : ~SIZE[~TYPO]'sd0)"
     warning: 'GHC.Num.Integer.integerTestBit#: Integers are dynamically sized in simulation,
       but fixed-length after synthesis. Use carefully.'
 - BlackBox:
diff --git a/prims/systemverilog/GHC_Prim.primitives.yaml b/prims/systemverilog/GHC_Prim.primitives.yaml
--- a/prims/systemverilog/GHC_Prim.primitives.yaml
+++ b/prims/systemverilog/GHC_Prim.primitives.yaml
@@ -871,7 +871,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<8;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -942,7 +942,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<16;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1029,7 +1029,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1132,7 +1132,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1144,7 +1144,7 @@
       end
       ~ENDGENERATE
 
-      logic [0:47] a;
+      logic [0:47] ~GENSYM[a][4];
       genvar ~GENSYM[i1][5];
       ~GENERATE
       for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6]
@@ -1252,7 +1252,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1347,7 +1347,7 @@
       genvar ~SYM[18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~SYM[19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
diff --git a/prims/verilog/GHC_Prim.primitives.yaml b/prims/verilog/GHC_Prim.primitives.yaml
--- a/prims/verilog/GHC_Prim.primitives.yaml
+++ b/prims/verilog/GHC_Prim.primitives.yaml
@@ -920,7 +920,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<8;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -991,7 +991,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<16;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1078,7 +1078,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1181,7 +1181,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1193,7 +1193,7 @@
       end
       ~ENDGENERATE
 
-      reg [0:47] a;
+      reg [0:47] ~GENSYM[a][4];
       genvar ~GENSYM[i1][5];
       ~GENERATE
       for (~SYM[5]=0;~SYM[5]<16;~SYM[5]=~SYM[5]+1) begin : ~GENSYM[mux_stage][6]
@@ -1300,7 +1300,7 @@
       genvar ~GENSYM[k][18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<64;~SYM[18]=~SYM[18]+1) begin : ~GENSYM[reverse][19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
@@ -1395,7 +1395,7 @@
       genvar ~SYM[18];
       ~GENERATE
       for (~SYM[18]=0;~SYM[18]<32;~SYM[18]=~SYM[18]+1) begin : ~SYM[19]
-        assign ~SYM[1][~SYM[18]] = ~ARG[0][~SYM[18]];
+        assign ~SYM[1][~SYM[18]] = ~VAR[][0][~SYM[18]];
       end
       ~ENDGENERATE
 
diff --git a/prims/vhdl/Clash_Sized_Internal_Signed.primitives.yaml b/prims/vhdl/Clash_Sized_Internal_Signed.primitives.yaml
--- a/prims/vhdl/Clash_Sized_Internal_Signed.primitives.yaml
+++ b/prims/vhdl/Clash_Sized_Internal_Signed.primitives.yaml
@@ -75,10 +75,16 @@
     workInfo: Constant
 - BlackBox:
     name: Clash.Sized.Internal.Signed.*#
-    kind: Expression
+    kind: Declaration
     type: '(*#) :: KnownNat
       n => Signed n -> Signed n -> Signed n'
-    template: resize(~ARG[1] * ~ARG[2], ~LIT[0])
+    template: |-
+      ~GENSYM[~RESULT_mult][0] : block
+        signal ~GENSYM[~RESULT_mult_full][1] : signed(~SIZE[~TYPO]*2-1 downto 0);
+      begin
+        ~SYM[1] <= ~ARG[1] * ~ARG[2];
+        ~RESULT <= ~SYM[1](~SIZE[~TYPO]-1 downto 0);
+      end block;
 - BlackBox:
     name: Clash.Sized.Internal.Signed.negate#
     kind: Expression
diff --git a/prims/vhdl/GHC_Int.primitives.yaml b/prims/vhdl/GHC_Int.primitives.yaml
--- a/prims/vhdl/GHC_Int.primitives.yaml
+++ b/prims/vhdl/GHC_Int.primitives.yaml
@@ -4,6 +4,7 @@
     type: 'I8# :: Int# ->
       Int8'
     template: resize(~ARG[0],8)
+    # TODO Starting with ghc-9.0/base-4.16 this takes an I8# that is already properly sized and don't have to do this resize anymore. Same applies to the rest of this file.
     workInfo: Never
 - BlackBox:
     name: GHC.Int.I16#
diff --git a/prims/vhdl/GHC_Integer_Type.primitives.yaml b/prims/vhdl/GHC_Integer_Type.primitives.yaml
--- a/prims/vhdl/GHC_Integer_Type.primitives.yaml
+++ b/prims/vhdl/GHC_Integer_Type.primitives.yaml
@@ -18,10 +18,16 @@
     workInfo: Never
 - BlackBox:
     name: GHC.Integer.Type.timesInteger
-    kind: Expression
+    kind: Declaration
     type: 'timesInteger ::
       Integer -> Integer -> Integer'
-    template: resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])
+    template: |-
+      ~GENSYM[~RESULT_mult][0] : block
+        signal ~GENSYM[~RESULT_mult_full][1] : signed(~SIZE[~TYPO]*2-1 downto 0);
+      begin
+        ~SYM[1] <= ~ARG[0] * ~ARG[1];
+        ~RESULT <= ~SYM[1](~SIZE[~TYPO]-1 downto 0);
+      end block;
     warning: 'GHC.Integer.Type.timesInteger: Integers are dynamically sized in simulation,
       but fixed-length after synthesis. Use carefully.'
 - BlackBox:
diff --git a/prims/vhdl/GHC_Num_Integer.primitives.yaml b/prims/vhdl/GHC_Num_Integer.primitives.yaml
--- a/prims/vhdl/GHC_Num_Integer.primitives.yaml
+++ b/prims/vhdl/GHC_Num_Integer.primitives.yaml
@@ -44,10 +44,16 @@
     workInfo: Never
 - BlackBox:
     name: GHC.Num.Integer.integerMul
-    kind: Expression
+    kind: Declaration
     type: 'integerMul :: Integer
       -> Integer -> Integer'
-    template: resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])
+    template: |-
+      ~GENSYM[~RESULT_mult][0] : block
+        signal ~GENSYM[~RESULT_mult_full][1] : signed(~SIZE[~TYPO]*2-1 downto 0);
+      begin
+        ~SYM[1] <= ~ARG[0] * ~ARG[1];
+        ~RESULT <= ~SYM[1](~SIZE[~TYPO]-1 downto 0);
+      end block;
     warning: 'GHC.Num.Integer.integerMul: Integers are dynamically sized in simulation,
       but fixed-length after synthesis. Use carefully.'
 - BlackBox:
@@ -266,10 +272,10 @@
       but fixed-length after synthesis. Use carefully.'
 - BlackBox:
     name: GHC.Num.Integer.integerTestBit#
-    kind: Expression
+    kind: Declaration
     type: 'integerTestBit
-      :: Integer -> Word# -> Bool'
-    template: ~VAR[input][0](to_integer(~ARG[1])) = '1'
+      :: Integer -> Word# -> Int#'
+    template: ~RESULT <= (0 => ~VAR[input][0](to_integer(~ARG[1])), others => '0');
     warning: 'GHC.Num.Integer.integerTestBit#: Integers are dynamically sized in simulation,
       but fixed-length after synthesis. Use carefully.'
 - BlackBox:
diff --git a/prims/vhdl/GHC_Prim.primitives.yaml b/prims/vhdl/GHC_Prim.primitives.yaml
--- a/prims/vhdl/GHC_Prim.primitives.yaml
+++ b/prims/vhdl/GHC_Prim.primitives.yaml
@@ -42,10 +42,16 @@
     template: signed(std_logic_vector(resize(~ARG[0],~SIZE[~TYPO])))
 - BlackBox:
     name: GHC.Prim.*#
-    kind: Expression
+    kind: Declaration
     type: '(*#) :: Int# ->
       Int# -> Int#'
-    template: resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])
+    template: |-
+      ~GENSYM[~RESULT_mult][0] : block
+        signal ~GENSYM[~RESULT_mult_full][1] : signed(~SIZE[~TYPO]*2-1 downto 0);
+      begin
+        ~SYM[1] <= ~ARG[0] * ~ARG[1];
+        ~RESULT <= ~SYM[1](~SIZE[~TYPO]-1 downto 0);
+      end block;
 - BlackBox:
     name: GHC.Prim.remInt#
     kind: Declaration
@@ -584,7 +590,7 @@
           return ~SYM[2](3,a(0 to 5));
         end function;
       begin
-        ~RESULT <= resize(~SYM[3](~ARG[0](7 downto 0)),~SIZE[~TYPO]);
+        ~RESULT <= resize(~SYM[3](~VAR[][0](7 downto 0)),~SIZE[~TYPO]);
       end block;
       -- clz8 end
 - BlackBox:
@@ -628,7 +634,7 @@
           return ~SYM[2](4,b(0 to 7));
         end function;
       begin
-        ~RESULT <= resize(~SYM[3](~ARG[0](15 downto 0)),~SIZE[~TYPO]);
+        ~RESULT <= resize(~SYM[3](~VAR[][0](15 downto 0)),~SIZE[~TYPO]);
       end block;
       -- clz16 end
 - BlackBox:
@@ -674,7 +680,7 @@
           return ~SYM[2](5,c(0 to 9));
         end function;
       begin
-        ~RESULT <= resize(~SYM[3](~ARG[0](31 downto 0)),~SIZE[~TYPO]);
+        ~RESULT <= resize(~SYM[3](~VAR[][0](31 downto 0)),~SIZE[~TYPO]);
       end block;
       -- clz32 end
 - BlackBox:
@@ -941,7 +947,7 @@
         signal ~GENSYM[w_reversed][5] : ~TYP[0];
       begin
         ~GENSYM[reverse_loop][6] : for ~GENSYM[n][7] in ~VAR[w][0]'range generate
-          ~SYM[5](~VAR[w][0]'high - ~SYM[7]) <= ~VAR[w][0](~SYM[3]);
+          ~SYM[5](~VAR[w][0]'high - ~SYM[7]) <= ~VAR[w][0](~SYM[7]);
         end generate;
       ~IF ~IW64 ~THEN
         ~RESULT <= resize(~SYM[3](~SYM[5](63 downto 32)),~SIZE[~TYPO]);
@@ -1273,8 +1279,14 @@
     template: -~ARG[0]
 - BlackBox:
     name: GHC.Prim.timesInt8#
-    kind: Expression
-    template: resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])
+    kind: Declaration
+    template: |-
+      ~GENSYM[~RESULT_mult][0] : block
+        signal ~GENSYM[~RESULT_mult_full][1] : signed(~SIZE[~TYPO]*2-1 downto 0);
+      begin
+        ~SYM[1] <= ~ARG[0] * ~ARG[1];
+        ~RESULT <= ~SYM[1](~SIZE[~TYPO]-1 downto 0);
+      end block;
 - BlackBox:
     name: GHC.Prim.quotInt8#
     kind: Declaration
@@ -1523,8 +1535,14 @@
     template: -~ARG[0]
 - BlackBox:
     name: GHC.Prim.timesInt16#
-    kind: Expression
-    template: resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])
+    kind: Declaration
+    template: |-
+      ~GENSYM[~RESULT_mult][0] : block
+        signal ~GENSYM[~RESULT_mult_full][1] : signed(~SIZE[~TYPO]*2-1 downto 0);
+      begin
+        ~SYM[1] <= ~ARG[0] * ~ARG[1];
+        ~RESULT <= ~SYM[1](~SIZE[~TYPO]-1 downto 0);
+      end block;
 - BlackBox:
     name: GHC.Prim.quotInt16#
     kind: Declaration
@@ -1773,8 +1791,14 @@
     template: -~ARG[0]
 - BlackBox:
     name: GHC.Prim.timesInt32#
-    kind: Expression
-    template: resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])
+    kind: Declaration
+    template: |-
+      ~GENSYM[~RESULT_mult][0] : block
+        signal ~GENSYM[~RESULT_mult_full][1] : signed(~SIZE[~TYPO]*2-1 downto 0);
+      begin
+        ~SYM[1] <= ~ARG[0] * ~ARG[1];
+        ~RESULT <= ~SYM[1](~SIZE[~TYPO]-1 downto 0);
+      end block;
 - BlackBox:
     name: GHC.Prim.quotInt32#
     kind: Declaration
@@ -2023,8 +2047,14 @@
     template: -~ARG[0]
 - BlackBox:
     name: GHC.Prim.timesInt64#
-    kind: Expression
-    template: resize(~ARG[0] * ~ARG[1],~SIZE[~TYPO])
+    kind: Declaration
+    template: |-
+      ~GENSYM[~RESULT_mult][0] : block
+        signal ~GENSYM[~RESULT_mult_full][1] : signed(~SIZE[~TYPO]*2-1 downto 0);
+      begin
+        ~SYM[1] <= ~ARG[0] * ~ARG[1];
+        ~RESULT <= ~SYM[1](~SIZE[~TYPO]-1 downto 0);
+      end block;
 - BlackBox:
     name: GHC.Prim.quotInt64#
     kind: Declaration
diff --git a/src/Clash/Backend/VHDL.hs b/src/Clash/Backend/VHDL.hs
--- a/src/Clash/Backend/VHDL.hs
+++ b/src/Clash/Backend/VHDL.hs
@@ -1,7 +1,7 @@
 {-|
   Copyright   :  (C) 2015-2016, University of Twente,
                      2017-2018, Google Inc.,
-                     2021-2023, QBayLogic B.V.
+                     2021-2024, QBayLogic B.V.
                      2022     , Google Inc.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
@@ -38,7 +38,7 @@
 import           Data.HashSet                         (HashSet)
 import qualified Data.HashSet                         as HashSet
 import           Data.List
-  (mapAccumL, nub, nubBy, partition, intersperse, group, sort)
+  (mapAccumL, nub, nubBy, intersperse, group, sort)
 import           Data.List.Extra                      ((<:>), equalLength, zipEqual)
 import           Data.Maybe                           (catMaybes,mapMaybe)
 import           Data.Monoid                          (Ap(Ap))
@@ -254,25 +254,18 @@
                 | NetDecl' _ id_ hwtype _ <- ds
                 , attr <- hwTypeAttrs hwtype]
     if isEmpty decs
-       then insts ids
+       then insts ds
        else nest 2
               (pretty nm <+> colon <+> "block" <> line <>
                pure decs <>
                (if null attrs
                 then emptyDoc
-                else line <> line <> renderAttrs (TextS.pack "signal") attrs) <>
-               if null cds
-                then emptyDoc
-                else line <> line <> insts cds) <> line <> "begin" <>
-            nest 2 (line <> insts ids)
+                else line <> line <> renderAttrs (TextS.pack "signal") attrs)) <> line <>
+            "begin" <>
+            nest 2 (line <> insts ds)
             <> line <>
             "end block" <> semi
-   where
-     (cds, ids) = partition isCompDecl ds
 
-     isCompDecl (CompDecl {}) = True
-     isCompDecl _             = False
-
   addIncludes inc = includes %= (inc++)
   addLibraries libs = libraries %= (libs ++)
   addImports imps = packages %= (imps ++)
@@ -1426,6 +1419,13 @@
       | null attrs = emptyDoc
       | otherwise = renderAttrs (TextS.pack "component") [(nm, a) | a <- attrs]
 
+decl _ (CompDecl nm ps0) =
+  fmap (Just . (,0)) $ "component" <+> pretty nm <+>
+    ("port" <> line <> indent 2 (tupledSemi ps <> semi))
+    <> line <> "end component" <> semi
+  where ps = traverse (\(t,pd,ty) -> pretty t <+> ":" <+> ppd pd <+> sizedQualTyName ty) ps0
+        ppd = \case { In -> "in"; Out -> "out"}
+
 decl _ _ = return Nothing
 
 noEmptyInit :: VHDLM Doc -> VHDLM Doc
@@ -1522,13 +1522,6 @@
 inst_ (Assignment id_ Cont e) = fmap Just $
   pretty id_ <+> larrow <+> align (expr_ False e) <> semi
 
-inst_ (CompDecl nm ps0) =
-  fmap Just $ "component" <+> pretty nm <+>
-    ("port" <> line <> indent 2 (tupledSemi ps <> semi))
-    <> line <> "end component" <> semi
-  where ps = traverse (\(t,pd,ty) -> pretty t <+> ":" <+> ppd pd <+> sizedQualTyName ty) ps0
-        ppd = \case { In -> "in"; Out -> "out"}
-
 inst_ (CondAssignment id_ _ scrut _ [(Just (BoolLit b), l),(_,r)]) = fmap Just $
   pretty id_ <+> larrow
            <+> align (vsep (sequence [expr_ False t <+> "when" <+>
@@ -1863,7 +1856,7 @@
 
 exprLit (Just (hty,sz)) (NumLit i) = case hty of
   Unsigned n
-    | i < (-2^(31 :: Integer)) -> "unsigned" <> parens ("std_logic_vector" <> parens ("signed'" <> parens lit))
+    | i <= (-2^(31 :: Integer))-> "unsigned" <> parens ("std_logic_vector" <> parens ("signed'" <> parens lit))
     | i < 0                    -> "unsigned" <> parens ("std_logic_vector" <> parens ("to_signed" <> parens(integer i <> "," <> int n)))
     | i < 2^(31 :: Integer) -> "to_unsigned" <> parens (integer i <> "," <> int n)
     | otherwise -> "unsigned'" <> parens lit
diff --git a/src/Clash/Backend/Verilog.hs b/src/Clash/Backend/Verilog.hs
--- a/src/Clash/Backend/Verilog.hs
+++ b/src/Clash/Backend/Verilog.hs
@@ -1,7 +1,7 @@
 {-|
   Copyright   :  (C) 2015-2016, University of Twente,
                      2017-2018, Google Inc.,
-                     2021-2023, QBayLogic B.V.
+                     2021-2024, QBayLogic B.V.
                      2022     , Google Inc.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
@@ -49,7 +49,10 @@
 import           Data.Monoid                          (Ap(Ap))
 import           Data.Monoid.Extra                    ()
 import           Data.List
-  (mapAccumL, mapAccumR, nubBy, foldl')
+  (mapAccumL, mapAccumR, nubBy)
+#if !MIN_VERSION_base(4,20,0)
+import           Data.List                            (foldl')
+#endif
 import           Data.List.Extra                      ((<:>))
 import           Data.Text.Lazy                       (pack)
 import qualified Data.Text.Lazy                       as Text
@@ -1216,7 +1219,7 @@
 exprLit :: Lens' s (Maybe (Maybe Int)) -> Maybe (HWType,Size) -> Literal -> Ap (State s) Doc
 exprLit _ Nothing (NumLit i) = integer i
 
-exprLit k (Just (hty,sz)) (NumLit i) = case hty of
+exprLit k (Just (hty,sz)) (NumLit i0) = case hty of
   Unsigned _
    | i < 0     -> string "-" <> int sz <> string "'d" <> integer (abs i)
    | otherwise -> int sz <> string "'d" <> integer i
@@ -1227,6 +1230,11 @@
   _ -> int sz <> string "'b" <> blit
   where
     blit = bits k (toBits sz i)
+    i = case hty of
+             Signed _ -> let mask = 2^(sz-1) in case divMod i0 mask of
+                (s,i'') | even s    -> i''
+                        | otherwise -> i'' - mask
+             _ -> i0 `mod` 2^sz
 exprLit k (Just (_,sz)) (BitVecLit m i) = int sz <> string "'b" <> bvlit
   where
     bvlit = bits k (toBits' sz m i)
diff --git a/src/Clash/Core/EqSolver.hs b/src/Clash/Core/EqSolver.hs
--- a/src/Clash/Core/EqSolver.hs
+++ b/src/Clash/Core/EqSolver.hs
@@ -1,5 +1,5 @@
 {-|
-  Copyright  :  (C) 2021 QBayLogic B.V.
+  Copyright  :  (C) 2021-2024 QBayLogic B.V.
   License    :  BSD2 (see the file LICENSE)
   Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 -}
@@ -12,16 +12,18 @@
 import Data.List.Extra (zipEqual)
 import Data.Maybe (catMaybes, mapMaybe)
 
-import Clash.Core.Name (Name(nameOcc))
+import Clash.Core.Name (Name(nameUniq))
 import Clash.Core.Term
 import Clash.Core.TyCon
 import Clash.Core.Type
 import Clash.Core.Var
 import Clash.Core.VarEnv (VarSet, elemVarSet, emptyVarSet, mkVarSet)
+import Clash.Unique (fromGhcUnique)
 #if MIN_VERSION_ghc(9,0,0)
 import Clash.Core.DataCon (dcUniq)
-import GHC.Builtin.Names (unsafeReflDataConKey)
-import GHC.Types.Unique (getKey)
+import GHC.Builtin.Names (unsafeReflDataConKey, eqPrimTyConKey, typeNatAddTyFamNameKey)
+#else
+import PrelNames (eqPrimTyConKey, typeNatAddTyFamNameKey)
 #endif
 
 -- | Data type that indicates what kind of solution (if any) was found
@@ -120,7 +122,8 @@
 normalizeAdd (a, b) = do
   (n, rhs) <- lhsLit a b
   case tyView rhs of
-    TyConApp (nameOcc -> "GHC.TypeNats.+") [left, right] -> do
+    TyConApp tc [left, right]
+      | nameUniq tc == fromGhcUnique typeNatAddTyFamNameKey -> do
       (m, o) <- lhsLit left right
       return (n, m, o)
     _ ->
@@ -139,7 +142,7 @@
 #if MIN_VERSION_base(4,15,0)
 isAbsurdPat _tcm (DataPat dc _ _)
   -- unsafeCoerce is not absurd in the way intended by /isAbsurdPat/
-  | dcUniq dc == getKey unsafeReflDataConKey
+  | dcUniq dc == fromGhcUnique unsafeReflDataConKey
   = False
 #endif
 isAbsurdPat tcm pat =
@@ -178,7 +181,8 @@
   -> Maybe (Type, Type)
 typeEq tcm ty =
  case tyView (coreView tcm ty) of
-  TyConApp (nameOcc -> "GHC.Prim.~#") [_, _, left, right] ->
+  TyConApp tc [_, _, left, right]
+    | nameUniq tc == fromGhcUnique eqPrimTyConKey ->
     Just (coreView tcm left, coreView tcm right)
   _ ->
     Nothing
diff --git a/src/Clash/Core/Evaluator/Types.hs b/src/Clash/Core/Evaluator/Types.hs
--- a/src/Clash/Core/Evaluator/Types.hs
+++ b/src/Clash/Core/Evaluator/Types.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 {-|
-  Copyright     : (C) 2020-2022, QBayLogic B.V.
+  Copyright     : (C) 2020-2024, QBayLogic B.V.
   License       : BSD2 (see the file LICENSE)
   Maintainer    : QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -11,10 +11,11 @@
 -}
 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)
 import Data.List (foldl')
+#endif
 import Data.Maybe (fromMaybe, isJust)
 
 #if MIN_VERSION_prettyprinter(1,7,0)
@@ -34,6 +35,7 @@
 import Clash.Core.VarEnv
 import Clash.Driver.Types (BindingMap, bindingTerm)
 import Clash.Pretty (ClashPretty(..), fromPretty, showDoc)
+import Clash.Util.Supply (Supply)
 
 whnf'
   :: Evaluator
diff --git a/src/Clash/Core/FreeVars.hs b/src/Clash/Core/FreeVars.hs
--- a/src/Clash/Core/FreeVars.hs
+++ b/src/Clash/Core/FreeVars.hs
@@ -7,6 +7,7 @@
   Free variable calculations
 -}
 
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 
@@ -32,7 +33,11 @@
 import Control.Lens.Fold                (Fold)
 import Control.Lens.Getter              (Contravariant)
 import Data.Coerce
+#if MIN_VERSION_ghc(9,8,4)
+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 @@
   :: (Contravariant f, Applicative f)
   => (forall b . Var b -> Bool)
   -- ^ Predicate telling whether a variable is interesting
+#if MIN_VERSION_ghc(9,8,4)
+  -> IntSet.Word64Set
+#else
   -> IntSet.IntSet
+#endif
   -- ^ Uniques of the variables in scope, used by 'termFreeVars''
   -> (Var a -> f (Var a))
   -> Type
diff --git a/src/Clash/Core/PartialEval.hs b/src/Clash/Core/PartialEval.hs
--- a/src/Clash/Core/PartialEval.hs
+++ b/src/Clash/Core/PartialEval.hs
@@ -11,7 +11,6 @@
 
 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.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
diff --git a/src/Clash/Core/PartialEval/Monad.hs b/src/Clash/Core/PartialEval/Monad.hs
--- a/src/Clash/Core/PartialEval/Monad.hs
+++ b/src/Clash/Core/PartialEval/Monad.hs
@@ -60,7 +60,6 @@
   ) 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.VarEnv
 import           Clash.Driver.Types (Binding(..))
 import           Clash.Rewrite.WorkFree (isWorkFree)
+import           Clash.Util.Supply (Supply)
 
 {-
 NOTE [RWS monad]
diff --git a/src/Clash/Core/PartialEval/NormalForm.hs b/src/Clash/Core/PartialEval/NormalForm.hs
--- a/src/Clash/Core/PartialEval/NormalForm.hs
+++ b/src/Clash/Core/PartialEval/NormalForm.hs
@@ -30,7 +30,6 @@
   , 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.Var (Id)
 import Clash.Core.VarEnv (VarEnv, InScopeSet)
 import Clash.Driver.Types (Binding(..))
+import Clash.Util.Supply (Supply)
 
 type Args a
   = [Arg a]
diff --git a/src/Clash/Core/Term.hs b/src/Clash/Core/Term.hs
--- a/src/Clash/Core/Term.hs
+++ b/src/Clash/Core/Term.hs
@@ -1,7 +1,7 @@
 {-|
   Copyright   :  (C) 2012-2016, University of Twente,
                           2017, Google Inc.
-                          2021, QBayLogic B.V.
+                     2021-2024, QBayLogic B.V.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -63,7 +63,9 @@
 import Data.Coerce                             (coerce)
 import qualified Data.DList                    as DList
 import Data.Either                             (lefts, rights)
+#if !MIN_VERSION_base(4,20,0)
 import Data.Foldable                           (foldl')
+#endif
 import Data.Hashable                           (Hashable)
 import Data.Maybe                              (catMaybes)
 import Data.List                               (nub, partition)
diff --git a/src/Clash/Core/TyCon.hs b/src/Clash/Core/TyCon.hs
--- a/src/Clash/Core/TyCon.hs
+++ b/src/Clash/Core/TyCon.hs
@@ -1,6 +1,6 @@
 {-|
   Copyright   :  (C) 2012-2016, University of Twente
-                     2021,      QBayLogic B.V.
+                     2021-2024, QBayLogic B.V.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -125,7 +125,11 @@
       | Just ('(', nm1) <- T.uncons nm0
       , Just (nm2, ')') <- T.unsnoc nm1
       = T.all (== ',') nm2
-    tupleName _ = T.pack "GHC.Tuple.Prim.Tuple" `T.isPrefixOf` (nameOcc nm)
+    tupleName _ =
+      any (`T.isPrefixOf` (nameOcc nm)) $ map T.pack
+        [ "GHC.Tuple.Prim.Tuple"
+        , "GHC.Tuple.Tuple"
+        ]
 
 -- | Get the DataCons belonging to a TyCon
 tyConDataCons :: TyCon -> [DataCon]
diff --git a/src/Clash/Core/Type.hs b/src/Clash/Core/Type.hs
--- a/src/Clash/Core/Type.hs
+++ b/src/Clash/Core/Type.hs
@@ -2,7 +2,7 @@
   Copyright   :  (C) 2012-2016, University of Twente,
                      2016     , Myrtle Software Ltd,
                      2017     , Google Inc.
-                     2021     , QBayLogic B.V.
+                     2021-2024, QBayLogic B.V.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -62,7 +62,9 @@
 import           Data.Binary            (Binary)
 import           Data.Coerce            (coerce)
 import           Data.Hashable          (Hashable (hashWithSalt))
+#if !MIN_VERSION_base(4,20,0)
 import           Data.List              (foldl')
+#endif
 import           Data.List.Extra        (splitAtList)
 import           Data.Maybe             (isJust, mapMaybe)
 import           Data.Text              (Text)
@@ -91,9 +93,9 @@
   (integerTyConKey, typeNatAddTyFamNameKey, typeNatExpTyFamNameKey,
    typeNatMulTyFamNameKey, typeNatSubTyFamNameKey,
    typeNatCmpTyFamNameKey, ordLTDataConKey, ordEQDataConKey, ordGTDataConKey,
-   typeSymbolAppendFamNameKey, typeSymbolCmpTyFamNameKey)
+   typeSymbolAppendFamNameKey, typeSymbolCmpTyFamNameKey,
+   typeNatDivTyFamNameKey, typeNatModTyFamNameKey)
 import           GHC.Types.SrcLoc       (wiredInSrcSpan)
-import           GHC.Types.Unique       (getKey)
 #else
 #if __GLASGOW_HASKELL__ >= 808
 import           PrelNames
@@ -107,9 +109,9 @@
   (integerTyConKey, typeNatAddTyFamNameKey, typeNatExpTyFamNameKey,
    typeNatLeqTyFamNameKey, typeNatMulTyFamNameKey, typeNatSubTyFamNameKey,
    typeNatCmpTyFamNameKey,
-   typeSymbolAppendFamNameKey, typeSymbolCmpTyFamNameKey)
+   typeSymbolAppendFamNameKey, typeSymbolCmpTyFamNameKey,
+   typeNatDivTyFamNameKey, typeNatModTyFamNameKey)
 import           SrcLoc                 (wiredInSrcSpan)
-import           Unique                 (getKey)
 #endif
 
 -- Local imports
@@ -120,6 +122,7 @@
 import           Clash.Core.TyCon
 import           Clash.Core.Var
 import qualified Clash.Data.UniqMap as UniqMap
+import           Clash.Unique (fromGhcUnique)
 import           Clash.Util
 
 #if __GLASGOW_HASKELL__ <= 806
@@ -452,6 +455,10 @@
 funSubst _   Nothing  = const Nothing
 funSubst tcm (Just s) = uncurry go
   where
+    -- AnnType cannot be matched in type-families within regular GHC (as they
+    -- are type synonyms) so it is fine to skip over them here.
+    go (AnnType _ t1) t2 = go t1 t2
+
     go (VarTy nmF) ty = case lookup nmF s of
       Nothing -> Just ((nmF,ty):s)
       -- Given, for example, the type family definition:
@@ -470,6 +477,10 @@
       Just ty' | ty' `aeqType` ty -> Just s
       _ -> Nothing
 
+    -- Only look through annotations in RHS after the VarTy case, so we can
+    -- preserve annotations in the substitution created by the VarTy case above
+    go t1 (AnnType _ t2) = go t1 t2
+
     -- [Note] funSubst FunTy
     --
     -- Whenever type classes have associated types whose instances 'map' to
@@ -495,13 +506,11 @@
                    , argView tcm r2 -- See [Note: Eager type families]
                    )
 
-    go ty1@(ConstTy _) ty2 =
-      -- Looks through AnnType
-      if ty1 `aeqType` ty2 then Just s else Nothing
+    go (ConstTy c1) (ConstTy c2)
+      | c1 == c2 = Just s
 
-    go ty1@(LitTy _) ty2 =
-      -- Looks through AnnType
-      if ty1 `aeqType` ty2 then Just s else Nothing
+    go (LitTy l1) (LitTy l2)
+      | l1 == l2 = Just s
 
     go _ _ = Nothing
 
@@ -513,22 +522,22 @@
 
 reduceTypeFamily :: TyConMap -> Type -> Maybe Type
 reduceTypeFamily tcm (tyView -> TyConApp tc tys)
-  | nameUniq tc == getKey typeNatAddTyFamNameKey
+  | nameUniq tc == fromGhcUnique typeNatAddTyFamNameKey
   = case mapMaybe (litView tcm) tys of
       [i1,i2] -> Just (LitTy (NumTy (i1 + i2)))
       _ -> Nothing
 
-  | nameUniq tc == getKey typeNatMulTyFamNameKey
+  | nameUniq tc == fromGhcUnique typeNatMulTyFamNameKey
   = case mapMaybe (litView tcm) tys of
       [i1, i2] -> Just (LitTy (NumTy (i1 * i2)))
       _ -> Nothing
 
-  | nameUniq tc == getKey typeNatExpTyFamNameKey
+  | nameUniq tc == fromGhcUnique typeNatExpTyFamNameKey
   = case mapMaybe (litView tcm) tys of
       [i1, i2] -> Just (LitTy (NumTy (i1 ^ i2)))
       _ -> Nothing
 
-  | nameUniq tc == getKey typeNatSubTyFamNameKey
+  | nameUniq tc == fromGhcUnique typeNatSubTyFamNameKey
   = case mapMaybe (litView tcm) tys of
       [i1, i2]
         | let z = i1 - i2
@@ -537,7 +546,7 @@
       _ -> Nothing
 
 #if !MIN_VERSION_ghc(9,2,0)
-  | nameUniq tc == getKey typeNatLeqTyFamNameKey
+  | nameUniq tc == fromGhcUnique typeNatLeqTyFamNameKey
   = case mapMaybe (litView tcm) tys of
       [i1, i2]
         | Just (FunTyCon {tyConKind = tck}) <- UniqMap.lookup tc tcm
@@ -549,44 +558,53 @@
       _ -> Nothing
 #endif
 
-  | nameUniq tc == getKey typeNatCmpTyFamNameKey -- "GHC.TypeNats.CmpNat"
+  | nameUniq tc == fromGhcUnique typeNatCmpTyFamNameKey -- "GHC.TypeNats.CmpNat"
   = case mapMaybe (litView tcm) tys of
       [i1, i2] ->
         Just $ ConstTy $ TyCon $
           case compare i1 i2 of
-            LT -> Name User "GHC.Types.LT" (getKey ordLTDataConKey) wiredInSrcSpan
-            EQ -> Name User "GHC.Types.EQ" (getKey ordEQDataConKey) wiredInSrcSpan
-            GT -> Name User "GHC.Types.GT" (getKey ordGTDataConKey) wiredInSrcSpan
+            LT -> Name User "GHC.Types.LT"
+                    (fromGhcUnique ordLTDataConKey) wiredInSrcSpan
+            EQ -> Name User "GHC.Types.EQ"
+                    (fromGhcUnique ordEQDataConKey) wiredInSrcSpan
+            GT -> Name User "GHC.Types.GT"
+                    (fromGhcUnique ordGTDataConKey) wiredInSrcSpan
       _ -> Nothing
 
-  | nameUniq tc == getKey typeSymbolCmpTyFamNameKey -- "GHC.TypeNats.CmpSymbol"
+  | nameUniq tc == fromGhcUnique typeSymbolCmpTyFamNameKey -- "GHC.TypeNats.CmpSymbol"
   = case mapMaybe (symLitView tcm) tys of
       [s1, s2] ->
         Just $ ConstTy $ TyCon $
           case compare s1 s2 of
-            LT -> Name User "GHC.Types.LT" (getKey ordLTDataConKey) wiredInSrcSpan
-            EQ -> Name User "GHC.Types.EQ" (getKey ordEQDataConKey) wiredInSrcSpan
-            GT -> Name User "GHC.Types.GT" (getKey ordGTDataConKey) wiredInSrcSpan
+            LT -> Name User "GHC.Types.LT"
+                    (fromGhcUnique ordLTDataConKey) wiredInSrcSpan
+            EQ -> Name User "GHC.Types.EQ"
+                    (fromGhcUnique ordEQDataConKey) wiredInSrcSpan
+            GT -> Name User "GHC.Types.GT"
+                    (fromGhcUnique ordGTDataConKey) wiredInSrcSpan
       _ -> Nothing
 
 #if MIN_VERSION_base(4,16,0)
-  | nameUniq tc == getKey typeCharCmpTyFamNameKey -- "GHC.TypeNats.CmpSymbol"
+  | nameUniq tc == fromGhcUnique typeCharCmpTyFamNameKey -- "GHC.TypeNats.CmpSymbol"
   = case mapMaybe (charLitView tcm) tys of
       [s1, s2] ->
         Just $ ConstTy $ TyCon $
           case compare s1 s2 of
-            LT -> Name User (showt 'LT) (getKey ordLTDataConKey) wiredInSrcSpan
-            EQ -> Name User (showt 'EQ) (getKey ordEQDataConKey) wiredInSrcSpan
-            GT -> Name User (showt 'GT) (getKey ordGTDataConKey) wiredInSrcSpan
+            LT -> Name User (showt 'LT)
+                    (fromGhcUnique ordLTDataConKey) wiredInSrcSpan
+            EQ -> Name User (showt 'EQ)
+                    (fromGhcUnique ordEQDataConKey) wiredInSrcSpan
+            GT -> Name User (showt 'GT)
+                    (fromGhcUnique ordGTDataConKey) wiredInSrcSpan
       _ -> Nothing
 
-  | nameUniq tc == getKey typeConsSymbolTyFamNameKey -- ConsSymbol
+  | nameUniq tc == fromGhcUnique typeConsSymbolTyFamNameKey -- ConsSymbol
   , [c0, s0] <- tys
   , Just c1 <- charLitView tcm c0
   , Just s1 <- symLitView tcm s0
   = Just (LitTy (SymTy (c1:s1)))
 
-  | nameUniq tc == getKey typeUnconsSymbolTyFamNameKey -- UnconsSymbol
+  | nameUniq tc == fromGhcUnique typeUnconsSymbolTyFamNameKey -- UnconsSymbol
   , [s1] <- mapMaybe (symLitView tcm) tys
   = fromMaybe (error "reduceTypeFamily: cannot construct UnconsSymbol result") $ do
       FunTyCon {tyConKind = tck} <- UniqMap.lookup tc tcm
@@ -604,16 +622,16 @@
                       [charTy,symbolTy,LitTy (CharTy c),LitTy (SymTy cs)]
            in pure (Just (mkTyConApp justTc [tupTcApp,tup]))
 
-  | nameUniq tc == getKey typeCharToNatTyFamNameKey -- CharToNat
+  | nameUniq tc == fromGhcUnique typeCharToNatTyFamNameKey -- CharToNat
   , [c1] <- mapMaybe (charLitView tcm) tys
   = Just (LitTy (NumTy (fromIntegral (ord c1))))
 
-  | nameUniq tc == getKey typeNatToCharTyFamNameKey -- NatToChar
+  | nameUniq tc == fromGhcUnique typeNatToCharTyFamNameKey -- NatToChar
   , [n1] <- mapMaybe (litView tcm) tys
   = Just (LitTy (CharTy (chr (fromInteger n1))))
 #endif
 
-  | nameUniq tc == getKey typeSymbolAppendFamNameKey  -- GHC.TypeLits.AppendSymbol"
+  | nameUniq tc == fromGhcUnique typeSymbolAppendFamNameKey  -- GHC.TypeLits.AppendSymbol"
   = case mapMaybe (symLitView tcm) tys of
       [s1, s2] ->
         Just (LitTy (SymTy (s1 ++ s2)))
@@ -660,20 +678,36 @@
       [i1, i2] -> Just (LitTy (NumTy (i1 `lcm` i2)))
       _ -> Nothing
 
-  | nameOcc tc `elem` ["GHC.TypeLits.Extra.Div", "GHC.TypeNats.Div"]
+  | nameOcc tc `elem` ["GHC.TypeLits.Extra.Div"]
   = case mapMaybe (litView tcm) tys of
       [i1, i2]
         | i2 > 0
         -> Just (LitTy (NumTy (i1 `div` i2)))
       _ -> Nothing
 
-  | nameOcc tc `elem` ["GHC.TypeLits.Extra.Mod", "GHC.TypeNats.Mod"]
+  | nameOcc tc `elem` ["GHC.TypeLits.Extra.Mod"]
   = case mapMaybe (litView tcm) tys of
       [i1, i2]
         | i2 > 0
         -> Just (LitTy (NumTy (i1 `mod` i2)))
       _ -> Nothing
 
+#if MIN_VERSION_base(4,11,0)
+  | nameUniq tc == fromGhcUnique typeNatDivTyFamNameKey
+  = case mapMaybe (litView tcm) tys of
+      [i1, i2]
+        | i2 > 0
+        -> Just (LitTy (NumTy (i1 `div` i2)))
+      _ -> Nothing
+
+  | nameUniq tc == fromGhcUnique typeNatModTyFamNameKey
+  = case mapMaybe (litView tcm) tys of
+      [i1, i2]
+        | i2 > 0
+        -> Just (LitTy (NumTy (i1 `mod` i2)))
+      _ -> Nothing
+#endif
+
   | Just (FunTyCon {tyConSubst = tcSubst}) <- UniqMap.lookup tc tcm
   = let -- See [Note: Eager type families]
         tysR = map (argView tcm) tys
@@ -710,7 +744,7 @@
 #endif
 
 isIntegerTy :: Type -> Bool
-isIntegerTy (ConstTy (TyCon nm)) = nameUniq nm == getKey integerTyConKey
+isIntegerTy (ConstTy (TyCon nm)) = nameUniq nm == fromGhcUnique integerTyConKey
 isIntegerTy _ = False
 
 -- | Normalize a type, looking through Signals and newtypes
diff --git a/src/Clash/Core/TysPrim.hs b/src/Clash/Core/TysPrim.hs
--- a/src/Clash/Core/TysPrim.hs
+++ b/src/Clash/Core/TysPrim.hs
@@ -1,7 +1,7 @@
 {-|
   Copyright   :  (C) 2012-2016, University of Twente,
                      2016     , Myrtle Software Ltd,
-                     2021     , QBayLogic B.V.
+                     2021-2024, QBayLogic B.V.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -47,10 +47,8 @@
 
 #if MIN_VERSION_ghc(9,0,0)
 import           GHC.Builtin.Names
-import           GHC.Types.Unique     (getKey)
 #else
 import           PrelNames
-import           Unique               (getKey)
 #endif
 
 #if MIN_VERSION_ghc(8,8,0)
@@ -68,17 +66,21 @@
 import           Clash.Core.TyCon
 import           Clash.Core.Type
 import           Clash.Core.Var (mkTyVar)
+import           Clash.Unique (fromGhcUnique)
 import qualified Clash.Data.UniqMap as UniqMap
 
 -- | Builtin Name
 liftedTypeKindTyConName, typeNatKindTyConName, typeSymbolKindTyConName :: TyConName
-liftedTypeKindTyConName   = mkUnsafeSystemName "Type" (getKey liftedTypeKindTyConKey)
+liftedTypeKindTyConName   = mkUnsafeSystemName "Type"
+                              (fromGhcUnique liftedTypeKindTyConKey)
 #if MIN_VERSION_ghc(9,2,0)
 typeNatKindTyConName      = naturalPrimTyConName
 #else
-typeNatKindTyConName      = mkUnsafeSystemName "Nat" (getKey typeNatKindConNameKey)
+typeNatKindTyConName      = mkUnsafeSystemName "Nat"
+                              (fromGhcUnique typeNatKindConNameKey)
 #endif
-typeSymbolKindTyConName   = mkUnsafeSystemName "Symbol" (getKey typeSymbolKindConNameKey)
+typeSymbolKindTyConName   = mkUnsafeSystemName "Symbol"
+                              (fromGhcUnique typeSymbolKindConNameKey)
 
 -- | Builtin Kind
 liftedTypeKindTc, typeNatKindTc, typeSymbolKindTc :: TyCon
@@ -96,53 +98,60 @@
   floatPrimTyConName, doublePrimTyConName,
   naturalPrimTyConName, byteArrayPrimTyConName, eqPrimTyConName :: TyConName
 intPrimTyConName     = mkUnsafeSystemName "GHC.Prim.Int#"
-                                (getKey intPrimTyConKey)
+                                (fromGhcUnique intPrimTyConKey)
 #if MIN_VERSION_base(4,15,0)
 integerPrimTyConName = mkUnsafeSystemName "GHC.Num.Integer.Integer"
-                                (getKey integerTyConKey)
+                                (fromGhcUnique integerTyConKey)
 #else
 integerPrimTyConName = mkUnsafeSystemName "GHC.Integer.Type.Integer"
-                                (getKey integerTyConKey)
+                                (fromGhcUnique integerTyConKey)
 #endif
-stringPrimTyConName  = mkUnsafeSystemName "GHC.Prim.Addr#" (getKey addrPrimTyConKey)
+stringPrimTyConName  = mkUnsafeSystemName "GHC.Prim.Addr#"
+                        (fromGhcUnique addrPrimTyConKey)
 charPrimTyConName    = mkUnsafeSystemName "GHC.Prim.Char#"
-                                (getKey charPrimTyConKey)
+                                (fromGhcUnique charPrimTyConKey)
 wordPrimTyConName    = mkUnsafeSystemName "GHC.Prim.Word#"
-                                (getKey wordPrimTyConKey)
+                                (fromGhcUnique wordPrimTyConKey)
 int64PrimTyConName   = mkUnsafeSystemName "GHC.Prim.Int64#"
-                                (getKey int64PrimTyConKey)
+                                (fromGhcUnique int64PrimTyConKey)
 word64PrimTyConName  = mkUnsafeSystemName "GHC.Prim.Word64#"
-                                (getKey word64PrimTyConKey)
+                                (fromGhcUnique word64PrimTyConKey)
 floatPrimTyConName   = mkUnsafeSystemName "GHC.Prim.Float#"
-                                (getKey floatPrimTyConKey)
+                                (fromGhcUnique floatPrimTyConKey)
 doublePrimTyConName  = mkUnsafeSystemName "GHC.Prim.Double#"
-                                (getKey doublePrimTyConKey)
+                                (fromGhcUnique doublePrimTyConKey)
 #if MIN_VERSION_base(4,15,0)
 naturalPrimTyConName = mkUnsafeSystemName "GHC.Num.Natural.Natural"
-                                (getKey naturalTyConKey)
+                                (fromGhcUnique naturalTyConKey)
 #else
 naturalPrimTyConName = mkUnsafeSystemName "GHC.Natural.Natural"
-                                (getKey naturalTyConKey)
+                                (fromGhcUnique naturalTyConKey)
 #endif
 byteArrayPrimTyConName = mkUnsafeSystemName "GHC.Prim.ByteArray#"
-                          (getKey byteArrayPrimTyConKey)
+                          (fromGhcUnique byteArrayPrimTyConKey)
 
-eqPrimTyConName = mkUnsafeSystemName "GHC.Prim.~#" (getKey eqPrimTyConKey)
+eqPrimTyConName = mkUnsafeSystemName "GHC.Prim.~#" (fromGhcUnique eqPrimTyConKey)
 
 #if !MIN_VERSION_ghc(9,2,0)
 voidPrimTyConName :: TyConName
-voidPrimTyConName    = mkUnsafeSystemName "Void#" (getKey voidPrimTyConKey)
+voidPrimTyConName    = mkUnsafeSystemName "Void#" (fromGhcUnique voidPrimTyConKey)
 #endif
 
 #if MIN_VERSION_ghc(8,8,0)
 int8PrimTyConName, int16PrimTyConName, int32PrimTyConName, word8PrimTyConName,
   word16PrimTyConName, word32PrimTyConName :: TyConName
-int8PrimTyConName   = mkUnsafeSystemName (showt ''Int8#) (getKey int8PrimTyConKey)
-int16PrimTyConName  = mkUnsafeSystemName (showt ''Int16#) (getKey int16PrimTyConKey)
-int32PrimTyConName  = mkUnsafeSystemName (showt ''Int32#) (getKey int32PrimTyConKey)
-word8PrimTyConName  = mkUnsafeSystemName (showt ''Word8#) (getKey word8PrimTyConKey)
-word16PrimTyConName = mkUnsafeSystemName (showt ''Word16#) (getKey word16PrimTyConKey)
-word32PrimTyConName = mkUnsafeSystemName (showt ''Word32#) (getKey word32PrimTyConKey)
+int8PrimTyConName   = mkUnsafeSystemName (showt ''Int8#)
+                        (fromGhcUnique int8PrimTyConKey)
+int16PrimTyConName  = mkUnsafeSystemName (showt ''Int16#)
+                        (fromGhcUnique int16PrimTyConKey)
+int32PrimTyConName  = mkUnsafeSystemName (showt ''Int32#)
+                        (fromGhcUnique int32PrimTyConKey)
+word8PrimTyConName  = mkUnsafeSystemName (showt ''Word8#)
+                        (fromGhcUnique word8PrimTyConKey)
+word16PrimTyConName = mkUnsafeSystemName (showt ''Word16#)
+                        (fromGhcUnique word16PrimTyConKey)
+word32PrimTyConName = mkUnsafeSystemName (showt ''Word32#)
+                        (fromGhcUnique word32PrimTyConKey)
 #endif
 
 liftedPrimTC :: TyConName
@@ -167,7 +176,7 @@
   let
     name = integerPrimTyConName
     uniq = nameUniq name
-    isDcNm = mkUnsafeSystemName (showt 'IS) (getKey integerISDataConKey)
+    isDcNm = mkUnsafeSystemName (showt 'IS) (fromGhcUnique integerISDataConKey)
     isDc = MkData
       { dcName = isDcNm
       , dcUniq = nameUniq isDcNm
@@ -179,7 +188,7 @@
       , dcArgStrict = [Strict]
       , dcFieldLabels = []
       }
-    ipDcNm = mkUnsafeSystemName (showt 'IP) (getKey integerIPDataConKey)
+    ipDcNm = mkUnsafeSystemName (showt 'IP) (fromGhcUnique integerIPDataConKey)
     ipDc = MkData
       { dcName = ipDcNm
       , dcUniq = nameUniq ipDcNm
@@ -191,7 +200,7 @@
       , dcArgStrict = [Strict]
       , dcFieldLabels = []
       }
-    inDcNm = mkUnsafeSystemName (showt 'IN) (getKey integerINDataConKey)
+    inDcNm = mkUnsafeSystemName (showt 'IN) (fromGhcUnique integerINDataConKey)
     inDc = MkData
       { dcName = inDcNm
       , dcUniq = nameUniq inDcNm
@@ -211,7 +220,7 @@
   let
     name = naturalPrimTyConName
     uniq = nameUniq name
-    nsDcNm = mkUnsafeSystemName (showt 'NS) (getKey naturalNSDataConKey)
+    nsDcNm = mkUnsafeSystemName (showt 'NS) (fromGhcUnique naturalNSDataConKey)
     nsDc = MkData
       { dcName = nsDcNm
       , dcUniq = nameUniq nsDcNm
@@ -223,7 +232,7 @@
       , dcArgStrict = [Strict]
       , dcFieldLabels = []
       }
-    nbDcNm = mkUnsafeSystemName (showt 'NB) (getKey naturalNBDataConKey)
+    nbDcNm = mkUnsafeSystemName (showt 'NB) (fromGhcUnique naturalNBDataConKey)
     nbDc = MkData
       { dcName = nbDcNm
       , dcUniq = nameUniq nbDcNm
diff --git a/src/Clash/Core/Util.hs b/src/Clash/Core/Util.hs
--- a/src/Clash/Core/Util.hs
+++ b/src/Clash/Core/Util.hs
@@ -1,6 +1,6 @@
 {-|
   Copyright   :  (C) 2012-2016, University of Twente,
-                     2021-2023, QBayLogic B.V.,
+                     2021-2024, QBayLogic B.V.,
                      2022     , Google Inc.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
@@ -18,7 +18,12 @@
 
 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)
+#else
+import Control.Exception.Base (absentError)
+#endif
 import Control.Monad.Trans.Except              (Except, throwE, runExcept)
 import Data.Bifunctor                          (first, second)
 import qualified Data.HashSet                  as HashSet
@@ -31,14 +36,15 @@
 import qualified Data.Set                      as Set
 import qualified Data.Set.Lens                 as Lens
 import qualified Data.Text                     as T
+import           Data.Text.Extra               (showt)
+import           GHC.Real
+  (divZeroError, overflowError, ratioZeroDenominatorError, underflowError)
 import           GHC.Stack                     (HasCallStack)
 
 #if MIN_VERSION_ghc(9,0,0)
 import           GHC.Builtin.Names       (ipClassKey)
-import           GHC.Types.Unique        (getKey)
 #else
 import           PrelNames               (ipClassKey)
-import           Unique                  (getKey)
 #endif
 
 import Clash.Core.DataCon
@@ -58,8 +64,13 @@
 import Clash.Core.VarEnv
 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)
+
 -- | Rebuild a let expression / let expressions by taking the SCCs of a list
 -- of bindings and remaking Let (NonRec ...) ... and Let (Rec ...) ...
 --
@@ -480,24 +491,23 @@
                 }
 
 undefinedPrims :: [T.Text]
-undefinedPrims =
-  [ "Clash.Normalize.Primitives.undefined"
-  , "Control.Exception.Base.absentError"
-  , "Control.Exception.Base.patError"
-  , "GHC.Err.error"
-  , "GHC.Err.errorWithoutStackTrace"
-  , "GHC.Err.undefined"
-  , "GHC.Prim.Panic.absentError"
-  , "GHC.Real.divZeroError"
-  , "GHC.Real.overflowError"
-  , "GHC.Real.ratioZeroDenominatorError"
-  , "GHC.Real.underflowError"
+undefinedPrims = fmap showt
+  [ 'Primitives.undefined
+  , 'patError
+  , 'error
+  , 'errorWithoutStackTrace
+  , 'undefined
+  , 'absentError
+  , 'divZeroError
+  , 'overflowError
+  , 'ratioZeroDenominatorError
+  , 'underflowError
   ]
 
 undefinedXPrims :: [T.Text]
-undefinedXPrims =
-  [ "Clash.Normalize.Primitives.undefinedX"
-  , "Clash.XException.errorX"
+undefinedXPrims = fmap showt
+  [ 'Primitives.undefinedX
+  , 'errorX
   ]
 
 substArgTys
@@ -627,7 +637,7 @@
   --
   isHidden :: Name a -> [Type] -> Bool
   isHidden nm [a1, a2] | TyConApp a2Nm _ <- tyView a2 =
-       nameOcc nm == "GHC.Classes.(%,%)"
+       nameOcc nm `elem` ["GHC.Classes.(%,%)", "GHC.Classes.CTuple2"]
     && splitTy (tyView (stripIP a1))
     && nameOcc a2Nm == "Clash.Signal.Internal.KnownDomain"
   isHidden _ _ = False
@@ -673,7 +683,7 @@
 -- | Strip implicit parameter wrappers (IP)
 stripIP :: Type -> Type
 stripIP t@(tyView -> TyConApp tcNm [_a1, a2]) =
-  if nameUniq tcNm == getKey ipClassKey then a2 else t
+  if nameUniq tcNm == fromGhcUnique ipClassKey then a2 else t
 stripIP t = t
 
 -- | Do an inverse topological sorting of the let-bindings in a let-expression
diff --git a/src/Clash/Core/VarEnv.hs b/src/Clash/Core/VarEnv.hs
--- a/src/Clash/Core/VarEnv.hs
+++ b/src/Clash/Core/VarEnv.hs
@@ -103,6 +103,9 @@
 import qualified Data.List                 as List
 import qualified Data.List.Extra           as List
 import           Data.Maybe                (fromMaybe)
+#if MIN_VERSION_ghc(9,8,4)
+import           Data.Word                 (Word64)
+#endif
 
 #if MIN_VERSION_prettyprinter(1,7,0)
 import           Prettyprinter
@@ -385,14 +388,21 @@
 
 -- * InScopeSet
 
+type Seed
+#if MIN_VERSION_ghc(9,8,4)
+  = 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 @@
   -> [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 @@
   :: (Uniquable a, ClashPretty a)
   => (Unique -> Bool)
   -- ^ Unique in scope test
-  -> Int
+  -> Seed
   -- ^ Seed
   -> a
   -> a
@@ -510,7 +520,7 @@
 
 deriveUnique
   :: Unique
-  -> Int
+  -> Seed
   -> Unique
 deriveUnique i delta = i + delta
 
diff --git a/src/Clash/Data/UniqMap.hs b/src/Clash/Data/UniqMap.hs
--- a/src/Clash/Data/UniqMap.hs
+++ b/src/Clash/Data/UniqMap.hs
@@ -42,11 +42,16 @@
 import           Prelude hiding (elem, filter, lookup, notElem, null)
 
 import           Control.DeepSeq (NFData)
-import           Data.Binary (Binary)
+import           Data.Binary (Binary (..))
 import           Data.Bifunctor (first)
 import           Data.Function (on)
+#if MIN_VERSION_ghc(9,8,4)
+import           GHC.Data.Word64Map.Strict (Word64Map)
+import qualified GHC.Data.Word64Map.Strict as IntMap
+#else
 import           Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IntMap
+#endif
 import qualified Data.List as List (foldl')
 
 #if !MIN_VERSION_containers(0,6,2)
@@ -66,17 +71,27 @@
 -- uniqueable and provide their own key, however a unique can be associated
 -- with any value.
 newtype UniqMap a
+#if MIN_VERSION_ghc(9,8,4)
+  = UniqMap { uniqMapToIntMap :: Word64Map a }
+#else
   = UniqMap { uniqMapToIntMap :: IntMap a }
+#endif
   deriving stock Traversable
   deriving newtype
-    ( Binary
-    , Foldable
+    ( Foldable
     , Functor
     , Monoid
     , NFData
     , Semigroup
     , Show
     )
+#if MIN_VERSION_ghc(9,8,4)
+instance Binary a => Binary (UniqMap a) where
+  put (UniqMap m) = put (IntMap.size m) <> mapM_ put (IntMap.toAscList m)
+  get             = fmap (UniqMap . IntMap.fromDistinctAscList) get
+#else
+  deriving newtype Binary
+#endif
 
 instance ClashPretty a => ClashPretty (UniqMap a) where
   clashPretty xs =
diff --git a/src/Clash/Driver.hs b/src/Clash/Driver.hs
--- a/src/Clash/Driver.hs
+++ b/src/Clash/Driver.hs
@@ -2,7 +2,7 @@
   Copyright   :  (C) 2012-2016, University of Twente,
                      2016-2017, Myrtle Software Ltd,
                      2017     , QBayLogic, Google Inc.
-                     2020-2023, QBayLogic,
+                     2020-2024, QBayLogic,
                      2022     , Google Inc.
 
   License     :  BSD2 (see the file LICENSE)
@@ -12,23 +12,23 @@
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NondecreasingIndentation #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Clash.Driver where
 
 import           Control.Concurrent               (MVar, modifyMVar, modifyMVar_, newMVar, withMVar)
 import           Control.Concurrent.Async         (mapConcurrently_)
-import qualified Control.Concurrent.Supply        as Supply
 import           Control.DeepSeq
-import           Control.Exception                (throw)
+import           Control.Exception                (throw, Exception)
 import qualified Control.Monad                    as Monad
 import           Control.Monad                    (unless, foldM, forM, filterM)
-import           Control.Monad.Catch              (MonadMask)
+import           Control.Monad.Catch              (MonadMask, MonadThrow (throwM))
 import           Control.Monad.Extra              (whenM, ifM, unlessM)
 import           Control.Monad.IO.Class           (MonadIO)
 import           Control.Monad.State              (evalState, get)
@@ -49,6 +49,8 @@
 import           Data.Proxy                       (Proxy(..))
 import           Data.List                        (intercalate)
 import qualified Data.List                        as List
+import           Data.List.NonEmpty               (NonEmpty((:|)))
+import qualified Data.List.NonEmpty               as NonEmpty
 import           Data.Maybe                       (fromMaybe, maybeToList, mapMaybe)
 import qualified Data.Map.Ordered                 as OMap
 import           Data.Map.Ordered.Extra           ()
@@ -85,12 +87,10 @@
 
 #if MIN_VERSION_ghc(9,0,0)
 import           GHC.Builtin.Names                 (eqTyConKey, ipClassKey)
-import           GHC.Types.Unique                  (getKey)
 
 import           GHC.Types.SrcLoc                  (SrcSpan)
 #else
 import           PrelNames               (eqTyConKey, ipClassKey)
-import           Unique                  (getKey)
 
 import           SrcLoc                           (SrcSpan)
 #endif
@@ -144,12 +144,13 @@
 import qualified Clash.Primitives.Xilinx.ClockGen as P
 import           Clash.Primitives.Types
 import           Clash.Signal.Internal
-import           Clash.Unique                     (Unique, getUnique)
+import           Clash.Unique                     (Unique, getUnique, fromGhcUnique)
 import           Clash.Util
   (ClashException(..), reportTimeDiff,
    wantedLanguageExtensions, unwantedLanguageExtensions, curLoc)
 import           Clash.Util.Graph                 (reverseTopSort)
 import qualified Clash.Util.Interpolate           as I
+import qualified Clash.Util.Supply                as Supply
 
 -- | Worker function of 'splitTopEntityT'
 splitTopAnn
@@ -216,8 +217,8 @@
   --   * HasCallStack
   shouldNotHavePortName :: Type -> Bool
   shouldNotHavePortName (tyView -> TyConApp (nameUniq -> tcUniq) tcArgs)
-    | tcUniq == getKey eqTyConKey = True
-    | tcUniq == getKey ipClassKey
+    | tcUniq == fromGhcUnique eqTyConKey = True
+    | tcUniq == fromGhcUnique ipClassKey
     , [LitTy (SymTy "callStack"), _] <- tcArgs = True
   shouldNotHavePortName _ = False
 
@@ -539,7 +540,7 @@
   -- ^ Function name
   -> String
   -- ^ Type name ('BlackBoxFunction' or 'TemplateFunction')
-  -> m (Either Hint.InterpreterError a)
+  -> m (Either (NonEmpty Hint.InterpreterError) a)
 loadImportAndInterpret iPaths0 interpreterArgs topDir qualMod funcName typ = do
   Hint.liftIO $ Monad.when debugIsOn $
     putStr "Hint: Interpreting " >> putStrLn (qualMod ++ "." ++ funcName)
@@ -552,10 +553,10 @@
     Hint.unsafeInterpret funcName typ
 
   case bbfE of
-    Left _ -> do
+    Left globalException -> do
       -- Try to interpret module as a local module, not yet present in the
       -- global package database(s).
-      Hint.unsafeRunInterpreterWithArgsLibdir interpreterArgs topDir $ do
+      localRes <- Hint.unsafeRunInterpreterWithArgsLibdir interpreterArgs topDir $ do
         Hint.reset
         iPaths1 <- (iPaths0++) <$> Hint.get Hint.searchPath
         Hint.set [ Hint.searchPath Hint.:= iPaths1
@@ -563,8 +564,13 @@
         Hint.loadModules [qualMod]
         Hint.setImports [ "Clash.Netlist.BlackBox.Types", "Clash.Netlist.Types", qualMod]
         Hint.unsafeInterpret funcName typ
-    Right _ -> do
-      return bbfE
+
+      case localRes of
+        Left localException -> pure (Left (globalException :| [localException]))
+        Right res -> pure (Right res)
+
+    Right res -> do
+      return (Right res)
  where
    langExts = map Hint.asExtension $
                 map show wantedLanguageExtensions ++
@@ -631,11 +637,7 @@
         let interpreterArgs = concatMap (("-package-db":) . (:[])) pkgDbs
         -- Compile a blackbox template function or fetch it from an already compiled file.
         r <- go interpreterArgs source
-        processHintError
-          (show bbGenName)
-          bbName
-          id
-          r
+        processHintErrors (show bbGenName) bbName r
 
   pure (BlackBoxHaskell bbName wf usedArgs multiRes bbGenName (hash source, bbFunc))
  where
@@ -656,7 +658,7 @@
     go
       :: [String]
       -> Maybe Text
-      -> IO (Either Hint.InterpreterError BlackBoxFunction)
+      -> IO (Either (NonEmpty Hint.InterpreterError) BlackBoxFunction)
     go args (Just source') = do
       -- Create a temporary directory with user module in it, add it to the
       -- list of import direcotries, and run as if it were a "normal" compiled
@@ -709,7 +711,8 @@
       Text.writeFile (modDir </> last modNames <.>  "hs") source
       loadImportAndInterpret (tmpDir':idirs) iArgs topDir qualMod funcName "TemplateFunction"
     let hsh = hash (qualMod, source)
-    processHintError (show bbGenName) pNm (BBFunction (Data.Text.unpack pNm) hsh) r
+    BBFunction (Data.Text.unpack pNm) hsh <$>
+      processHintErrors (show bbGenName) pNm  r
   parseBB ((THaskell,bbGenName),Nothing) = do
     let BlackBoxFunctionName modNames funcName = bbGenName
         qualMod = intercalate "." modNames
@@ -720,37 +723,43 @@
         Just f -> pure f
         Nothing -> do
           r <- loadImportAndInterpret idirs iArgs topDir qualMod funcName "TemplateFunction"
-          processHintError (show bbGenName) pNm id r
+          processHintErrors (show bbGenName) pNm r
     pure (BBFunction (Data.Text.unpack pNm) hsh tf)
 
 compilePrimitive _ _ _ (Primitive pNm wf typ) =
   return (Primitive pNm wf typ)
 {-# SCC compilePrimitive #-}
 
-processHintError
-  :: Monad m
-  => String
-  -> Data.Text.Text
-  -> (t -> r)
-  -> Either Hint.InterpreterError t
-  -> m r
-processHintError fun bb go r = case r of
-  Left (Hint.GhcException err) ->
-    error' "GHC Exception" err
-  Left (Hint.NotAllowed err) ->
-    error' "NotAllowed error" err
-  Left (Hint.UnknownError err) ->
-    error' "an unknown error" err
-  Left (Hint.WontCompile ghcErrs) ->
-    error' "compilation errors" (intercalate "\n\n" $ map Hint.errMsg ghcErrs)
-  Right f ->
-    return $ go f
+newtype HintError = HintError String deriving (Exception)
+
+instance Show HintError where
+  showsPrec :: Int -> HintError -> ShowS
+  showsPrec _ (HintError e) = showString e
+
+processHintErrors ::
+  (MonadThrow m, Monad m) =>
+  -- | Function to interpret
+  String ->
+  -- | BlackBox function name
+  Data.Text.Text ->
+  -- | Hint result
+  Either (NonEmpty Hint.InterpreterError) t ->
+  m t
+processHintErrors fun bb r = case r of
+  Left es -> throwM $ HintError (formatExceptions (NonEmpty.toList es))
+  Right f -> pure f
  where
-  error' errType report =
-    error $ unwords [ "Encountered", errType, "while compiling blackbox template"
-                    , "function", show fun, "for function", show bb ++ "."
-                    , "Compilation reported: \n\n" ++ report ]
+  formatExceptions es = [I.i|
+    Encountered one or more exceptions when compiling blackbox template function
+    '#{fun}' for function '#{bb}'.
+  |] <> "\n\n" <> intercalate "\n\n" (map formatException es)
 
+  formatException e = [I.i|
+    Encountered:
+
+      #{e}
+  |]
+
 -- | Pretty print Components to HDL Documents
 createHDL
   :: Backend backend
@@ -1120,8 +1129,8 @@
 
   mapFrom tops =
     let
-      topIndices = HashMap.fromList (zip (map topToUnique tops) [(0 :: Int)..])
+      topIndices = HashMap.fromList (zip (map topToUnique tops) [(0 :: Unique)..])
       nonOrdered = HashMap.fromListWith (<>) (map (second pure) edges)
-      orderFunc k = fromMaybe (-1) (HashMap.lookup k topIndices)
+      orderFunc k = HashMap.lookup k topIndices
     in
       HashMap.map (List.sortOn orderFunc) nonOrdered
diff --git a/src/Clash/Driver/Bool.hs b/src/Clash/Driver/Bool.hs
new file mode 100644
--- /dev/null
+++ b/src/Clash/Driver/Bool.hs
@@ -0,0 +1,34 @@
+{-|
+  Copyright   :  (C) 2024, Martijn Bastiaan
+  License     :  BSD2 (see the file LICENSE)
+  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
+-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveAnyClass #-}
+
+module Clash.Driver.Bool where
+
+import Control.DeepSeq (NFData)
+import Data.Hashable (Hashable)
+import GHC.Generics (Generic)
+
+#if MIN_VERSION_ghc(9,4,0)
+import qualified GHC.Data.Bool as Ghc
+#elif MIN_VERSION_ghc(9,0,0)
+import qualified GHC.Utils.Misc as Ghc
+#else
+import qualified Util as Ghc
+#endif
+
+data OverridingBool = Auto | Never | Always
+  deriving (Show, Read, Eq, Ord, Enum, Bounded, Hashable, Generic, NFData)
+
+toGhcOverridingBool :: OverridingBool -> Ghc.OverridingBool
+toGhcOverridingBool Auto = Ghc.Auto
+toGhcOverridingBool Never = Ghc.Never
+toGhcOverridingBool Always = Ghc.Always
+
+fromGhcOverridingBool :: Ghc.OverridingBool -> OverridingBool
+fromGhcOverridingBool Ghc.Auto = Auto
+fromGhcOverridingBool Ghc.Never = Never
+fromGhcOverridingBool Ghc.Always = Always
diff --git a/src/Clash/Driver/Manifest.hs b/src/Clash/Driver/Manifest.hs
--- a/src/Clash/Driver/Manifest.hs
+++ b/src/Clash/Driver/Manifest.hs
@@ -54,6 +54,7 @@
 import           Clash.Annotations.TopEntity.Extra ()
 import           Clash.Backend (Backend (hdlType), Usage (External))
 import           Clash.Core.Name (nameOcc)
+import           Clash.Driver.Bool (OverridingBool(..))
 import           Clash.Driver.Types
 import           Clash.Primitives.Types
 import           Clash.Core.Var (Id, varName)
@@ -65,14 +66,6 @@
 import           Clash.Primitives.Util (hashCompiledPrimMap)
 import           Clash.Signal (VDomainConfiguration(..))
 import           Clash.Util.Graph (callGraphBindings)
-
-#if MIN_VERSION_ghc(9,4,0)
-import GHC.Data.Bool (OverridingBool(..))
-#elif MIN_VERSION_ghc(9,0,0)
-import GHC.Utils.Misc (OverridingBool(..))
-#else
-import Util (OverridingBool(..))
-#endif
 
 data PortDirection
   = In | Out | InOut
diff --git a/src/Clash/Driver/Types.hs b/src/Clash/Driver/Types.hs
--- a/src/Clash/Driver/Types.hs
+++ b/src/Clash/Driver/Types.hs
@@ -45,15 +45,12 @@
 #if MIN_VERSION_ghc(9,4,0)
 import           GHC.Types.Basic                (InlineSpec)
 import           GHC.Types.SrcLoc               (SrcSpan)
-import           GHC.Data.Bool                  (OverridingBool(..))
 #elif MIN_VERSION_ghc(9,0,0)
 import           GHC.Types.Basic                (InlineSpec)
 import           GHC.Types.SrcLoc               (SrcSpan)
-import           GHC.Utils.Misc                 (OverridingBool(..))
 #else
 import           BasicTypes                     (InlineSpec)
 import           SrcLoc                         (SrcSpan)
-import           Util                           (OverridingBool(..))
 #endif
 
 import           Clash.Annotations.BitRepresentation.Internal (CustomReprs)
@@ -64,6 +61,7 @@
 import           Clash.Core.TyCon               (TyConMap, TyConName)
 import           Clash.Core.Var                 (Id)
 import           Clash.Core.VarEnv              (VarEnv)
+import           Clash.Driver.Bool              (OverridingBool(..))
 import           Clash.Netlist.BlackBox.Types   (HdlSyn (..))
 import {-# SOURCE #-} Clash.Netlist.Types       (PreserveCase(..), TopEntityT)
 import           Clash.Primitives.Types         (CompiledPrimMap)
@@ -401,115 +399,7 @@
   -- ^ Timescale precision set in Verilog files. E.g., setting this would sets
   -- the second part of @`timescale 100fs/100fs@.
   }
-  deriving (Show)
-
-instance NFData ClashOpts where
-  rnf o =
-    opt_werror o `deepseq`
-    opt_inlineLimit o `deepseq`
-    opt_specLimit o `deepseq`
-    opt_inlineFunctionLimit o `deepseq`
-    opt_inlineConstantLimit o `deepseq`
-    opt_evaluatorFuelLimit o `deepseq`
-    opt_cachehdl o `deepseq`
-    opt_clear o `deepseq`
-    opt_primWarn o `deepseq`
-    opt_color o `seq`
-    opt_intWidth o `deepseq`
-    opt_hdlDir o `deepseq`
-    opt_hdlSyn o `deepseq`
-    opt_errorExtra o `deepseq`
-    opt_importPaths o `deepseq`
-    opt_componentPrefix o `deepseq`
-    opt_newInlineStrat o `deepseq`
-    opt_escapedIds o `deepseq`
-    opt_lowerCaseBasicIds o `deepseq`
-    opt_ultra o `deepseq`
-    opt_forceUndefined o `deepseq`
-    opt_checkIDir o `deepseq`
-    opt_aggressiveXOpt o `deepseq`
-    opt_aggressiveXOptBB o `deepseq`
-    opt_inlineWFCacheLimit o `deepseq`
-    opt_edalize o `deepseq`
-    opt_renderEnums o `deepseq`
-    opt_timescalePrecision o `deepseq`
-    ()
-
-instance Eq ClashOpts where
-  s0 == s1 =
-    opt_werror s0 == opt_werror s1 &&
-    opt_inlineLimit s0 == opt_inlineLimit s1 &&
-    opt_specLimit s0 == opt_specLimit s1 &&
-    opt_inlineFunctionLimit s0 == opt_inlineFunctionLimit s1 &&
-    opt_inlineConstantLimit s0 == opt_inlineConstantLimit s1 &&
-    opt_evaluatorFuelLimit s0 == opt_evaluatorFuelLimit s1 &&
-    opt_cachehdl s0 == opt_cachehdl s1 &&
-    opt_clear s0 == opt_clear s1 &&
-    opt_primWarn s0 == opt_primWarn s1 &&
-    (opt_color s0 `eqOverridingBool` opt_color s1) &&
-    opt_intWidth s0 == opt_intWidth s1 &&
-    opt_hdlDir s0 == opt_hdlDir s1 &&
-    opt_hdlSyn s0 == opt_hdlSyn s1 &&
-    opt_errorExtra s0 == opt_errorExtra s1 &&
-    opt_importPaths s0 == opt_importPaths s1 &&
-    opt_componentPrefix s0 == opt_componentPrefix s1 &&
-    opt_newInlineStrat s0 == opt_newInlineStrat s1 &&
-    opt_escapedIds s0 == opt_escapedIds s1 &&
-    opt_lowerCaseBasicIds s0 == opt_lowerCaseBasicIds s1 &&
-    opt_ultra s0 == opt_ultra s1 &&
-    opt_forceUndefined s0 == opt_forceUndefined s1 &&
-    opt_checkIDir s0 == opt_checkIDir s1 &&
-    opt_aggressiveXOpt s0 == opt_aggressiveXOpt s1 &&
-    opt_aggressiveXOptBB s0 == opt_aggressiveXOptBB s1 &&
-    opt_inlineWFCacheLimit s0 == opt_inlineWFCacheLimit s1 &&
-    opt_edalize s0 == opt_edalize s1 &&
-    opt_renderEnums s0 == opt_renderEnums s1 &&
-    opt_timescalePrecision s0 == opt_timescalePrecision s1
-
-   where
-    eqOverridingBool :: OverridingBool -> OverridingBool -> Bool
-    eqOverridingBool Auto Auto = True
-    eqOverridingBool Always Always = True
-    eqOverridingBool Never Never = True
-    eqOverridingBool _ _ = False
-
-instance Hashable ClashOpts where
-  hashWithSalt s ClashOpts {..} =
-    s `hashWithSalt`
-    opt_werror `hashWithSalt`
-    opt_inlineLimit `hashWithSalt`
-    opt_specLimit `hashWithSalt`
-    opt_inlineFunctionLimit `hashWithSalt`
-    opt_inlineConstantLimit `hashWithSalt`
-    opt_evaluatorFuelLimit `hashWithSalt`
-    opt_cachehdl `hashWithSalt`
-    opt_clear `hashWithSalt`
-    opt_primWarn `hashOverridingBool`
-    opt_color `hashWithSalt`
-    opt_intWidth `hashWithSalt`
-    opt_hdlDir `hashWithSalt`
-    opt_hdlSyn `hashWithSalt`
-    opt_errorExtra `hashWithSalt`
-    opt_importPaths `hashWithSalt`
-    opt_componentPrefix `hashWithSalt`
-    opt_newInlineStrat `hashWithSalt`
-    opt_escapedIds `hashWithSalt`
-    opt_lowerCaseBasicIds `hashWithSalt`
-    opt_ultra `hashWithSalt`
-    opt_forceUndefined `hashWithSalt`
-    opt_checkIDir `hashWithSalt`
-    opt_aggressiveXOpt `hashWithSalt`
-    opt_aggressiveXOptBB `hashWithSalt`
-    opt_inlineWFCacheLimit `hashWithSalt`
-    opt_edalize `hashWithSalt`
-    opt_renderEnums `hashWithSalt`
-    opt_timescalePrecision
-   where
-    hashOverridingBool :: Int -> OverridingBool -> Int
-    hashOverridingBool s1 Auto = hashWithSalt s1 (0 :: Int)
-    hashOverridingBool s1 Always = hashWithSalt s1 (1 :: Int)
-    hashOverridingBool s1 Never = hashWithSalt s1 (2 :: Int)
-    infixl 0 `hashOverridingBool`
+  deriving (Show, Eq, NFData, Generic, Hashable)
 
 defClashOpts :: ClashOpts
 defClashOpts
diff --git a/src/Clash/Netlist.hs b/src/Clash/Netlist.hs
--- a/src/Clash/Netlist.hs
+++ b/src/Clash/Netlist.hs
@@ -2,7 +2,7 @@
   Copyright   :  (C) 2012-2016, University of Twente,
                      2016-2017, Myrtle Software Ltd,
                      2017-2018, Google Inc.,
-                     2021-2022, QBayLogic B.V.
+                     2021-2024, QBayLogic B.V.
                      2022     , Google Inc.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
@@ -41,14 +41,8 @@
   (listToMaybe, fromMaybe)
 import qualified Data.Map.Ordered                 as OMap
 import qualified Data.Set                         as Set
-import           Data.Primitive.ByteArray         (ByteArray (..))
 import qualified Data.Text                        as StrictText
 import           GHC.Stack                        (HasCallStack)
-#if MIN_VERSION_base(4,15,0)
-import           GHC.Num.Integer                  (Integer (..))
-#else
-import           GHC.Integer.GMP.Internals        (Integer (..), BigNat (..))
-#endif
 
 #if MIN_VERSION_ghc(9,0,0)
 import           GHC.Utils.Outputable             (ppr, showSDocUnsafe)
@@ -825,30 +819,7 @@
        -> NetlistMonad (Expr,[Declaration]) -- ^ Returned expression and a list of generate BlackBox declarations
 mkExpr _ _ _ (stripTicks -> Core.Literal l) = do
   iw <- Lens.view intWidth
-  case l of
-    IntegerLiteral i -> return (HW.Literal (Just (Signed iw,iw)) $ NumLit i, [])
-    IntLiteral i     -> return (HW.Literal (Just (Signed iw,iw)) $ NumLit i, [])
-    WordLiteral w    -> return (HW.Literal (Just (Unsigned iw,iw)) $ NumLit w, [])
-    Int64Literal i   -> return (HW.Literal (Just (Signed 64,64)) $ NumLit i, [])
-    Word64Literal w  -> return (HW.Literal (Just (Unsigned 64,64)) $ NumLit w, [])
-#if MIN_VERSION_ghc(8,8,0)
-    Int8Literal i    -> return (HW.Literal (Just (Signed 8,8)) $ NumLit i, [])
-    Int16Literal i   -> return (HW.Literal (Just (Signed 16,16)) $ NumLit i, [])
-    Int32Literal i   -> return (HW.Literal (Just (Signed 32,32)) $ NumLit i, [])
-    Word8Literal w   -> return (HW.Literal (Just (Unsigned 8,8)) $ NumLit w, [])
-    Word16Literal w  -> return (HW.Literal (Just (Unsigned 16,16)) $ NumLit w, [])
-    Word32Literal w  -> return (HW.Literal (Just (Unsigned 32,32)) $ NumLit w, [])
-#endif
-    CharLiteral c    -> return (HW.Literal (Just (Unsigned 21,21)) . NumLit . toInteger $ ord c, [])
-    FloatLiteral w   -> return (HW.Literal (Just (BitVector 32,32)) (NumLit $ toInteger w), [])
-    DoubleLiteral w  -> return (HW.Literal (Just (BitVector 64,64)) (NumLit $ toInteger w), [])
-    NaturalLiteral n -> return (HW.Literal (Just (Unsigned iw,iw)) $ NumLit n, [])
-#if MIN_VERSION_base(4,15,0)
-    ByteArrayLiteral (ByteArray ba) -> return (HW.Literal Nothing (NumLit (IP ba)),[])
-#else
-    ByteArrayLiteral (ByteArray ba) -> return (HW.Literal Nothing (NumLit (Jp# (BN# ba))),[])
-#endif
-    StringLiteral s  -> return (HW.Literal Nothing $ StringLit s, [])
+  return (mkLiteral iw l, [])
 
 mkExpr bbEasD declType bndr app =
  let (appF,args,ticks) = collectArgsTicks app
@@ -1032,18 +1003,23 @@
             dcArgs   = snd $ indexNote ($(curLoc) ++ "No DC with tag: " ++ show dcI) dcArgPairs dcI
         case compare (length dcArgs) (length argExprsFiltered) of
           EQ -> return (HW.DataCon dstHType (DC (dstHType,dcI)) argExprsFiltered)
-          LT -> error $ $(curLoc) ++ "Over-applied constructor"
-          GT -> error $ $(curLoc) ++ "Under-applied constructor"
+          LT -> error $ $(curLoc) ++ "Over-applied constructor: " ++ StrictText.unpack dcNm
+          GT -> error $ $(curLoc) ++ "Under-applied constructor: " ++ StrictText.unpack dcNm
       Product _ _ dcArgs ->
         case compare (length dcArgs) (length argExprsFiltered) of
           EQ -> return (HW.DataCon dstHType (DC (dstHType,0)) argExprsFiltered)
-          LT -> error $ $(curLoc) ++ "Over-applied constructor"
-          GT -> error $ $(curLoc) ++ "Under-applied constructor"
+          LT -> error $ $(curLoc) ++ "Over-applied constructor: " ++ StrictText.unpack dcNm
+          GT -> error $ unlines [ $(curLoc) ++ "Under-applied constructor:" ++ StrictText.unpack dcNm
+                                , "dcArgs=" ++ unlines [" - " ++ show x | x <- dcArgs]
+                                , "argExprs=" ++ unlines [" - " ++ show x | x <- argExprs]
+                                , "hWTysFilt=" ++ unlines [" - " ++ show x | x <- hWTysFiltered]
+                                , "argExprsFilt=" ++ unlines [" - " ++ show x | x <- argExprsFiltered]
+                                ]
       CustomProduct _ _ _ _ dcArgs ->
         case compare (length dcArgs) (length argExprsFiltered) of
           EQ -> return (HW.DataCon dstHType (DC (dstHType,0)) argExprsFiltered)
-          LT -> error $ $(curLoc) ++ "Over-applied constructor"
-          GT -> error $ $(curLoc) ++ "Under-applied constructor"
+          LT -> error $ $(curLoc) ++ "Over-applied constructor: " ++ StrictText.unpack dcNm
+          GT -> error $ $(curLoc) ++ "Under-applied constructor: " ++ StrictText.unpack dcNm
       Sum _ _ ->
         return (HW.DataCon dstHType (DC (dstHType,dcTag dc - 1)) [])
       CustomSP _ _ _ dcArgsTups -> do
@@ -1055,8 +1031,8 @@
 
         case compare (length dcArgs) (length argExprsFiltered) of
           EQ -> return (HW.DataCon dstHType (DC (dstHType, dcI)) argExprsFiltered)
-          LT -> error $ $(curLoc) ++ "Over-applied constructor"
-          GT -> error $ $(curLoc) ++ "Under-applied constructor"
+          LT -> error $ $(curLoc) ++ "Over-applied constructor: " ++ StrictText.unpack dcNm
+          GT -> error $ $(curLoc) ++ "Under-applied constructor: " ++ StrictText.unpack dcNm
 
       CustomSum _ _ _ _ ->
         return (HW.DataCon dstHType (DC (dstHType, dcTag dc - 1)) [])
diff --git a/src/Clash/Netlist/BlackBox.hs b/src/Clash/Netlist/BlackBox.hs
--- a/src/Clash/Netlist/BlackBox.hs
+++ b/src/Clash/Netlist/BlackBox.hs
@@ -3,7 +3,7 @@
   Copyright  :  (C) 2012-2016, University of Twente,
                     2016-2017, Myrtle Software Ltd,
                     2017     , Google Inc.,
-                    2021-2023, QBayLogic B.V.
+                    2021-2024, QBayLogic B.V.
                     2022     , Google Inc.
   License    :  BSD2 (see the file LICENSE)
   Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
@@ -29,7 +29,6 @@
 import           Control.Monad.Extra           (concatMapM)
 import           Control.Monad.IO.Class        (liftIO)
 import           Data.Bifunctor                (first, second)
-import           Data.Char                     (ord)
 import           Data.Either                   (lefts, partitionEithers)
 import           Data.Foldable                 (for_)
 import qualified Data.HashMap.Lazy             as HashMap
@@ -53,13 +52,6 @@
   , ConsoleIntensity(BoldIntensity), ConsoleLayer(Foreground), ColorIntensity(Vivid))
 import           System.IO
   (hPutStrLn, stderr, hFlush, hIsTerminalDevice)
-#if MIN_VERSION_ghc(9,4,0)
-import           GHC.Data.Bool                 (OverridingBool(..))
-#elif MIN_VERSION_ghc(9,0,0)
-import           GHC.Utils.Misc                (OverridingBool(..))
-#else
-import           Util                          (OverridingBool(..))
-#endif
 
 import           Clash.Annotations.Primitive
   ( PrimitiveGuard(HasBlackBox, DontTranslate)
@@ -68,7 +60,7 @@
 import           Clash.Core.DataCon            as D (dcTag)
 import           Clash.Core.FreeVars           (freeIds)
 import           Clash.Core.HasType
-import           Clash.Core.Literal            as L (Literal (..))
+import           Clash.Core.Literal            as C (Literal (..))
 import           Clash.Core.Name
   (Name (..), mkUnsafeSystemName)
 import qualified Clash.Netlist.Id              as Id
@@ -93,6 +85,7 @@
 import qualified Clash.Backend                 as Backend
 import qualified Clash.Data.UniqMap as UniqMap
 import           Clash.Debug                   (debugIsOn)
+import           Clash.Driver.Bool             (OverridingBool(..))
 import           Clash.Driver.Types
   (ClashOpts(opt_primWarn, opt_color, opt_werror))
 import           Clash.Netlist.BlackBox.Types  as B
@@ -263,6 +256,7 @@
   (C.Literal _,_)  -> True
   _                -> False
 
+
 mkArgument
   :: TextS.Text
   -- ^ Blackbox function name
@@ -291,36 +285,9 @@
       Just hwTy -> case collectArgsTicks e of
         (C.Var v,[],_) -> do
           return ((Identifier (Id.unsafeFromCoreId v) Nothing,hwTy,False),[])
-        (C.Literal (IntegerLiteral i),[],_) ->
-          return ((N.Literal (Just (Signed iw,iw)) (N.NumLit i),hwTy,True),[])
-        (C.Literal (IntLiteral i), [],_) ->
-          return ((N.Literal (Just (Signed iw,iw)) (N.NumLit i),hwTy,True),[])
-        (C.Literal (WordLiteral w), [],_) ->
-          return ((N.Literal (Just (Unsigned iw,iw)) (N.NumLit w),hwTy,True),[])
-        (C.Literal (CharLiteral c), [],_) ->
-          return ((N.Literal (Just (Unsigned 21,21)) (N.NumLit . toInteger $ ord c),hwTy,True),[])
-        (C.Literal (StringLiteral s),[],_) ->
-          return ((N.Literal Nothing (N.StringLit s),hwTy,True),[])
-        (C.Literal (Int64Literal i), [],_) ->
-          return ((N.Literal (Just (Signed 64,64)) (N.NumLit i),hwTy,True),[])
-        (C.Literal (Word64Literal i), [],_) ->
-          return ((N.Literal (Just (Unsigned 64,64)) (N.NumLit i),hwTy,True),[])
-#if MIN_VERSION_base(4,16,0)
-        (C.Literal (Int8Literal i), [],_) ->
-          return ((N.Literal (Just (Signed 8,8)) (N.NumLit i),hwTy,True),[])
-        (C.Literal (Int16Literal i), [],_) ->
-          return ((N.Literal (Just (Signed 16,16)) (N.NumLit i),hwTy,True),[])
-        (C.Literal (Int32Literal i), [],_) ->
-          return ((N.Literal (Just (Signed 16,16)) (N.NumLit i),hwTy,True),[])
-        (C.Literal (Word8Literal i), [],_) ->
-          return ((N.Literal (Just (Unsigned 8,8)) (N.NumLit i),hwTy,True),[])
-        (C.Literal (Word16Literal i), [],_) ->
-          return ((N.Literal (Just (Unsigned 16,16)) (N.NumLit i),hwTy,True),[])
-        (C.Literal (Word32Literal i), [],_) ->
-          return ((N.Literal (Just (Unsigned 32,32)) (N.NumLit i),hwTy,True),[])
-#endif
-        (C.Literal (NaturalLiteral n), [],_) ->
-          return ((N.Literal (Just (Unsigned iw,iw)) (N.NumLit n),hwTy,True),[])
+        (C.Literal l,[],_) ->
+          return ((mkLiteral iw l,hwTy,True),[])
+
         (Prim pinfo,args,ticks) -> withTicks ticks $ \tickDecls -> do
           (e',d) <- mkPrimitive True False Concurrent (NetlistId bndr ty) pinfo args tickDecls
           case e' of
@@ -577,6 +544,26 @@
                 iw <- Lens.view intWidth
                 return (N.Literal (Just (Signed iw,iw)) (NumLit $ toInteger $ dcTag dc - 1),[])
               [Right _,Left scrut] -> do
+                tcm      <- Lens.view tcCache
+                let scrutTy = inferCoreTypeOf tcm scrut
+                scrutHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) scrutTy
+                (scrutExpr,scrutDecls) <-
+                  mkExpr False Concurrent (NetlistId (Id.unsafeMake "c$dtt_rhs") scrutTy) scrut
+                case scrutExpr of
+                  Identifier id_ Nothing -> return (DataTag scrutHTy (Right id_),scrutDecls)
+                  _ -> do
+                    tmpRhs <- Id.make "c$dtt_rhs"
+                    let assignTy = case declType of { Concurrent -> Cont ; Sequential -> Proc Blocking }
+                    netDecl <- N.mkInit declType assignTy tmpRhs scrutHTy scrutExpr
+                    return (DataTag scrutHTy (Right tmpRhs),netDecl ++ scrutDecls)
+              _ -> error $ $(curLoc) ++ "dataToTag: " ++ show (map (either showPpr showPpr) args)
+
+          | pNm `elem`
+            ["GHC.Prim.dataToTagSmall#", "GHC.Prim.dataToTagLarge#"] -> case args of
+              [Right _, Right _,Left (Data dc)] -> do
+                iw <- Lens.view intWidth
+                return (N.Literal (Just (Signed iw,iw)) (NumLit $ toInteger $ dcTag dc - 1),[])
+              [Right _, Right _,Left scrut] -> do
                 tcm      <- Lens.view tcCache
                 let scrutTy = inferCoreTypeOf tcm scrut
                 scrutHTy <- unsafeCoreTypeToHWTypeM' $(curLoc) scrutTy
diff --git a/src/Clash/Netlist/Util.hs b/src/Clash/Netlist/Util.hs
--- a/src/Clash/Netlist/Util.hs
+++ b/src/Clash/Netlist/Util.hs
@@ -2,7 +2,7 @@
   Copyright  :  (C) 2012-2016, University of Twente,
                     2017     , Myrtle Software Ltd
                     2017-2018, Google Inc.
-                    2021-2023, QBayLogic B.V.
+                    2021-2024, QBayLogic B.V.
                     2022     , Google Inc.
   License    :  BSD2 (see the file LICENSE)
   Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
@@ -39,13 +39,14 @@
 import           Control.Monad.Trans.Except
   (ExceptT (..), runExcept, runExceptT, throwE)
 import           Data.Bifunctor          (second)
+import           Data.Char               (ord)
 import           Data.Either             (partitionEithers)
 import           Data.Foldable           (Foldable(toList))
 import           Data.Functor            (($>))
 import           Data.Hashable           (Hashable)
 import           Data.HashMap.Strict     (HashMap)
 import qualified Data.HashMap.Strict     as HashMap
-import qualified Data.IntSet             as IntSet
+import           Data.Primitive.ByteArray (ByteArray (..))
 import           Control.Applicative     (Alternative((<|>)))
 import           Data.List               (unzip4, partition)
 import qualified Data.List               as List
@@ -59,6 +60,13 @@
 import           Data.Text.Extra         (showt)
 import           Data.Text.Lazy          (toStrict)
 import           Data.Text.Prettyprint.Doc.Extra
+
+#if MIN_VERSION_base(4,15,0)
+import           GHC.Num.Integer                  (Integer (..))
+#else
+import           GHC.Integer.GMP.Internals        (Integer (..), BigNat (..))
+#endif
+
 import           GHC.Stack               (HasCallStack)
 
 #if MIN_VERSION_ghc(9,0,0)
@@ -563,10 +571,10 @@
         let -- Free FVs in the LHS and RHS of the constraint that are not the
             -- in the set of universal type variables of the constructor.
             ty1FEVs = Lens.toListOf (typeFreeVars' ((`notElem` uTVs) . coerce)
-                                                   IntSet.empty)
+                                                   mempty)
                                     ty1
             ty2FEVs = Lens.toListOf (typeFreeVars' ((`notElem` uTVs) . coerce)
-                                                   IntSet.empty)
+                                                   mempty)
                                     ty2
 
             -- Determine whether `eTV` can be generated from one side of a
@@ -1168,15 +1176,13 @@
 -- | Declare uses which occur as a result of a component being instantiated,
 -- for example the following design (verilog)
 --
---    @
---    module f ( input p; output reg r ) ... endmodule
---
---    module top ( ... )
---      ...
---      f f_inst ( .p(p), .r(foo));
---      ...
---    endmodule
---    @
+-- > module f ( input p; output reg r ) ... endmodule
+-- >
+-- > module top ( ... )
+-- >   ...
+-- >   f f_inst ( .p(p), .r(foo));
+-- >   ...
+-- > endmodule
 --
 -- would declare a usage of foo, since it is assigned by @f_inst@.
 --
@@ -2116,3 +2122,31 @@
 
 expandTopEntity _ _ topEntityM =
   error ("expandTopEntity expects a Synthesize annotation, but got: " <> show topEntityM)
+
+-- | Convert a Core 'C.Literal' to a Netlist v'HW.Literal'
+mkLiteral :: Int -- ^ int width
+          -> C.Literal -> HW.Expr
+mkLiteral iw lit = case lit of
+  C.IntegerLiteral i -> HW.Literal (Just (Signed iw,iw)) $ NumLit i
+  C.IntLiteral i     -> HW.Literal (Just (Signed iw,iw)) $ NumLit i
+  C.WordLiteral w    -> HW.Literal (Just (Unsigned iw,iw)) $ NumLit w
+  C.Int64Literal i   -> HW.Literal (Just (Signed 64,64)) $ NumLit i
+  C.Word64Literal w  -> HW.Literal (Just (Unsigned 64,64)) $ NumLit w
+#if MIN_VERSION_ghc(8,8,0)
+  C.Int8Literal i    -> HW.Literal (Just (Signed 8,8)) $ NumLit i
+  C.Int16Literal i   -> HW.Literal (Just (Signed 16,16)) $ NumLit i
+  C.Int32Literal i   -> HW.Literal (Just (Signed 32,32)) $ NumLit i
+  C.Word8Literal w   -> HW.Literal (Just (Unsigned 8,8)) $ NumLit w
+  C.Word16Literal w  -> HW.Literal (Just (Unsigned 16,16)) $ NumLit w
+  C.Word32Literal w  -> HW.Literal (Just (Unsigned 32,32)) $ NumLit w
+#endif
+  C.CharLiteral c    -> HW.Literal (Just (Unsigned 21,21)) . NumLit . toInteger $ ord c
+  C.FloatLiteral w   -> HW.Literal (Just (BitVector 32,32)) (NumLit $ toInteger w)
+  C.DoubleLiteral w  -> HW.Literal (Just (BitVector 64,64)) (NumLit $ toInteger w)
+  C.NaturalLiteral n -> HW.Literal (Just (Unsigned iw,iw)) $ NumLit n
+#if MIN_VERSION_base(4,15,0)
+  C.ByteArrayLiteral (ByteArray ba) -> HW.Literal Nothing (NumLit (IP ba))
+#else
+  C.ByteArrayLiteral (ByteArray ba) -> HW.Literal Nothing (NumLit (Jp# (BN# ba)))
+#endif
+  C.StringLiteral s  -> HW.Literal Nothing $ StringLit s
diff --git a/src/Clash/Normalize.hs b/src/Clash/Normalize.hs
--- a/src/Clash/Normalize.hs
+++ b/src/Clash/Normalize.hs
@@ -16,7 +16,6 @@
 
 module Clash.Normalize where
 
-import           Control.Concurrent.Supply        (Supply)
 import           Control.Exception                (throw)
 import qualified Control.Lens                     as Lens
 import           Control.Monad                    (when)
@@ -80,6 +79,7 @@
   (apply, isUntranslatableType, runRewriteSession)
 import           Clash.Util
 import           Clash.Util.Interpolate           (i)
+import           Clash.Util.Supply                (Supply)
 
 import           Data.Binary                      (encode)
 import qualified Data.ByteString                  as BS
diff --git a/src/Clash/Normalize/PrimitiveReductions.hs b/src/Clash/Normalize/PrimitiveReductions.hs
--- a/src/Clash/Normalize/PrimitiveReductions.hs
+++ b/src/Clash/Normalize/PrimitiveReductions.hs
@@ -1,7 +1,7 @@
 {-|
   Copyright  :  (C) 2015-2016, University of Twente,
                     2016     , Myrtle Software Ltd,
-                    2021     , QBayLogic B.V.
+                    2021-2024, QBayLogic B.V.
   License    :  BSD2 (see the file LICENSE)
   Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -45,7 +45,12 @@
 import           Data.Bifunctor                   (second)
 import           Data.List                        (mapAccumR)
 import           Data.List.Extra                  (zipEqual)
+#if MIN_VERSION_base(4,20,0)
+import qualified Data.List.NonEmpty               as NE hiding (unzip)
+import qualified Data.Functor                     as NE
+#else
 import qualified Data.List.NonEmpty               as NE
+#endif
 import qualified Data.Maybe                       as Maybe
 import           Data.Semigroup                   (sconcat)
 import           Data.Text.Extra                  (showt)
@@ -55,13 +60,11 @@
 import           GHC.Builtin.Names
   (boolTyConKey, typeNatAddTyFamNameKey, typeNatMulTyFamNameKey,
    typeNatSubTyFamNameKey)
-import           GHC.Types.Unique                 (getKey)
 import           GHC.Types.SrcLoc                 (wiredInSrcSpan)
 #else
 import           PrelNames
   (boolTyConKey, typeNatAddTyFamNameKey, typeNatMulTyFamNameKey,
    typeNatSubTyFamNameKey)
-import           Unique                           (getKey)
 import           SrcLoc                           (wiredInSrcSpan)
 #endif
 
@@ -93,20 +96,21 @@
 import           Clash.Normalize.Types
 import           Clash.Rewrite.Types
 import           Clash.Rewrite.Util
+import           Clash.Unique (fromGhcUnique)
 import           Clash.Util
 import qualified Clash.Util.Interpolate           as I
 
 typeNatAdd :: TyConName
 typeNatAdd =
-  Name User "GHC.TypeNats.+" (getKey typeNatAddTyFamNameKey) wiredInSrcSpan
+  Name User "GHC.TypeNats.+" (fromGhcUnique typeNatAddTyFamNameKey) wiredInSrcSpan
 
 typeNatMul :: TyConName
 typeNatMul =
-  Name User "GHC.TypeNats.*" (getKey typeNatMulTyFamNameKey) wiredInSrcSpan
+  Name User "GHC.TypeNats.*" (fromGhcUnique typeNatMulTyFamNameKey) wiredInSrcSpan
 
 typeNatSub :: TyConName
 typeNatSub =
-  Name User "GHC.TypeNats.-" (getKey typeNatSubTyFamNameKey) wiredInSrcSpan
+  Name User "GHC.TypeNats.-" (fromGhcUnique typeNatSubTyFamNameKey) wiredInSrcSpan
 
 vecHeadPrim
   :: TyConName
@@ -1072,7 +1076,7 @@
   replace_intElement tcm iDc iTy oldA elIndex = case0
    where
     case0 = Maybe.fromMaybe (error "replace_intElement: faild to build Truce DC") $ do
-      boolTc <- UniqMap.lookup (getKey boolTyConKey) tcm
+      boolTc <- UniqMap.lookup (fromGhcUnique boolTyConKey) tcm
       [_,trueDc] <- pure (tyConDataCons boolTc)
       let eqInt = eqIntPrim iTy (mkTyConApp (tyConName boolTc) [])
       return (Case (mkApps eqInt [ Left i
@@ -1181,7 +1185,7 @@
   index_intElement tcm iDc iTy (cur,elIndex) next = case0
    where
     case0 = Maybe.fromMaybe (error "reduceIndex_int: faild to build True DC") $ do
-      boolTc <- UniqMap.lookup (getKey boolTyConKey) tcm
+      boolTc <- UniqMap.lookup (fromGhcUnique boolTyConKey) tcm
       [_,trueDc] <- pure (tyConDataCons boolTc)
       let eqInt = eqIntPrim iTy (mkTyConApp (tyConName boolTc) [])
       return (Case (mkApps eqInt [ Left i
diff --git a/src/Clash/Normalize/Primitives.hs-boot b/src/Clash/Normalize/Primitives.hs-boot
new file mode 100644
--- /dev/null
+++ b/src/Clash/Normalize/Primitives.hs-boot
@@ -0,0 +1,6 @@
+module Clash.Normalize.Primitives where
+
+import Clash.Core.Term (PrimInfo)
+
+undefined :: PrimInfo
+undefinedX :: PrimInfo
diff --git a/src/Clash/Normalize/Transformations/Case.hs b/src/Clash/Normalize/Transformations/Case.hs
--- a/src/Clash/Normalize/Transformations/Case.hs
+++ b/src/Clash/Normalize/Transformations/Case.hs
@@ -2,7 +2,7 @@
   Copyright  :  (C) 2012-2016, University of Twente,
                     2016-2017, Myrtle Software Ltd,
                     2017-2022, Google Inc.,
-                    2021-2022, QBayLogic B.V.
+                    2021-2024, QBayLogic B.V.
   License    :  BSD2 (see the file LICENSE)
   Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
   Transformations on case-expressions
@@ -26,6 +26,12 @@
   , elimExistentials
   ) where
 
+import Control.Exception.Base (patError)
+#if MIN_VERSION_base(4,16,0)
+import GHC.Prim.Panic (absentError)
+#else
+import Control.Exception.Base (absentError)
+#endif
 import qualified Control.Lens as Lens
 import Control.Monad.State.Strict (evalState)
 import Data.Bifunctor (second)
@@ -80,6 +86,8 @@
 import Clash.Rewrite.WorkFree
 import Clash.Util (curLoc)
 
+import Clash.XException (errorX)
+
 -- | Move a Case-decomposition from the subject of a Case-decomposition to the
 -- alternatives
 caseCase :: HasCallStack => NormRewrite
@@ -266,24 +274,23 @@
       -- WHNF of subject is _|_, in the form of `error`: that means that the
       -- entire case-expression is evaluates to _|_
       (Prim pInfo,repTy:_:callStack:msg:_,ticks)
-        | primName pInfo == "GHC.Err.error" ->
+        | primName pInfo == Text.showt 'error ->
         let e1 = mkApps (mkTicks (Prim pInfo) ticks)
                         [repTy,Right ty,callStack,msg]
          in changed e1
       -- WHNF of subject is _|_, in the form of `absentError`: that means that
       -- the entire case-expression is evaluates to _|_
       (Prim pInfo,_:msgOrCallStack:_,ticks)
-        | primName pInfo `elem` ["Control.Exception.Base.absentError"
-                                ,"GHC.Prim.Panic.absentError"] ->
+        | primName pInfo == Text.showt 'absentError ->
         let e1 = mkApps (mkTicks (Prim pInfo) ticks)
                         [Right ty,msgOrCallStack]
         in  changed e1
       -- WHNF of subject is _|_, in the form of  `patError`, `undefined`, or
       -- `errorWithoutStackTrace`: that means the entire case-expression is _|_
       (Prim pInfo,repTy:_:msgOrCallStack:_,ticks)
-        | primName pInfo `elem` ["Control.Exception.Base.patError"
-                                ,"GHC.Err.undefined"
-                                ,"GHC.Err.errorWithoutStackTrace"] ->
+        | primName pInfo `elem` [ Text.showt 'patError
+                                , Text.showt 'undefined
+                                , Text.showt 'errorWithoutStackTrace] ->
         let e1 = mkApps (mkTicks (Prim pInfo) ticks)
                         [repTy,Right ty,msgOrCallStack]
         in  changed e1
@@ -297,7 +304,7 @@
       -- WHNF of subject is _|_, in the form of `errorX`: that means that
       -- the entire case-expression is evaluates to _|_
       (Prim pInfo,_:callStack:msg:_,ticks)
-        | primName pInfo == "Clash.XException.errorX"
+        | primName pInfo == Text.showt 'errorX
         -> let e1 = mkApps (mkTicks (Prim pInfo) ticks) [Right ty,callStack,msg]
             in changed e1
       -- WHNF of subject is non of the above, so either a variable reference,
@@ -454,18 +461,20 @@
 
 -- | Remove non-reachable alternatives. For example, consider:
 --
---    data STy ty where
---      SInt :: Int -> STy Int
---      SBool :: Bool -> STy Bool
+-- @
+-- data STy ty where
+--   SInt :: Int -> STy Int
+--   SBool :: Bool -> STy Bool
 --
---    f :: STy ty -> ty
---    f (SInt b) = b + 1
---    f (SBool True) = False
---    f (SBool False) = True
---    {-# NOINLINE f #-}
+-- f :: STy ty -> ty
+-- f (SInt b) = b + 1
+-- f (SBool True) = False
+-- f (SBool False) = True
+-- {\-\# NOINLINE f \#-\}
 --
---    g :: STy Int -> Int
---    g = f
+-- g :: STy Int -> Int
+-- g = f
+-- @
 --
 -- @f@ is always specialized on @STy Int@. The SBool alternatives are therefore
 -- unreachable. Additional information can be found at:
@@ -498,7 +507,7 @@
 -- GHC generates Core that looks like:
 --
 -- @
--- f = \(x :: Unsigned 4) -> case x == fromInteger 3 of
+-- f = \\(x :: Unsigned 4) -> case x == fromInteger 3 of
 --                             False -> case x == fromInteger 2 of
 --                               False -> case x == fromInteger 1 of
 --                                 False -> case x == fromInteger 0 of
@@ -515,7 +524,7 @@
 -- This transformation transforms the above Core to the saner:
 --
 -- @
--- f = \(x :: Unsigned 4) -> case x of
+-- f = \\(x :: Unsigned 4) -> case x of
 --        _ -> error "incomplete case"
 --        0 -> fromInteger 3
 --        1 -> fromInteger 2
diff --git a/src/Clash/Normalize/Transformations/Cast.hs b/src/Clash/Normalize/Transformations/Cast.hs
--- a/src/Clash/Normalize/Transformations/Cast.hs
+++ b/src/Clash/Normalize/Transformations/Cast.hs
@@ -42,7 +42,7 @@
 -- transforms to:
 -- @
 --   y = f' a
---     where f' x' = (\x -> g x) (cast x')
+--     where f' x' = (\\x -> g x) (cast x')
 -- @
 --
 -- The reason d'etre for this transformation is that we hope to end up with
diff --git a/src/Clash/Normalize/Transformations/DEC.hs b/src/Clash/Normalize/Transformations/DEC.hs
--- a/src/Clash/Normalize/Transformations/DEC.hs
+++ b/src/Clash/Normalize/Transformations/DEC.hs
@@ -1,6 +1,6 @@
 {-|
   Copyright  :  (C) 2015-2016, University of Twente,
-                    2021-2022, QBayLogic B.V.
+                    2021-2024, QBayLogic B.V.
                     2022,      LumiGuide Fietsdetectie B.V.
   License    :  BSD2 (see the file LICENSE)
   Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
@@ -31,12 +31,15 @@
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MagicHash #-}
 
 module Clash.Normalize.Transformations.DEC
   ( disjointExpressionConsolidation
   ) where
 
-import Control.Concurrent.Supply (splitSupply)
+#if !MIN_VERSION_base(4,18,0)
+import Control.Applicative (liftA2)
+#endif
 import Control.Lens ((^.), _1)
 import qualified Control.Lens as Lens
 import qualified Control.Monad as Monad
@@ -48,14 +51,15 @@
 import qualified Data.Graph as Graph
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IntMap
-import qualified Data.IntSet as IntSet
 import qualified Data.List as List
 import qualified Data.List.Extra as List
 import qualified Data.Map.Strict as Map
 import qualified Data.Maybe as Maybe
 import Data.Monoid (All(..))
 import qualified Data.Text as Text
+import Data.Text.Extra (showt)
 import GHC.Stack (HasCallStack)
+import qualified Language.Haskell.TH as TH
 
 #if MIN_VERSION_ghc(9,6,0)
 import GHC.Core.Make (chunkify, mkChunkified)
@@ -72,13 +76,14 @@
 #endif
 
 -- internal
-import Clash.Core.DataCon    (DataCon)
+import Clash.Core.DataCon (DataCon)
 import Clash.Core.Evaluator.Types  (whnf')
 import Clash.Core.FreeVars
   (termFreeVars', typeFreeVars', localVarsDoNotOccurIn)
 import Clash.Core.HasType
 import Clash.Core.Literal (Literal(..))
-import Clash.Core.Name (nameOcc)
+import Clash.Core.Name (OccName, nameOcc)
+import Clash.Core.Pretty (showPpr)
 import Clash.Core.Term
   ( Alt, LetBinding, Pat(..), PrimInfo(..), Term(..), TickInfo(..)
   , collectArgs, collectArgsTicks, mkApps, mkTicks, patIds, stripTicks)
@@ -86,7 +91,7 @@
 import Clash.Core.Type
   (Type, TypeView (..), isPolyFunTy, mkTyConApp, splitFunForallTy, tyView)
 import Clash.Core.Util (mkInternalVar, mkSelectorCase, sccLetBindings)
-import Clash.Core.Var (isGlobalId, isLocalId, varName)
+import Clash.Core.Var (Id, isGlobalId, isLocalId, varName)
 import Clash.Core.VarEnv
   ( InScopeSet, elemInScopeSet, extendInScopeSet, extendInScopeSetList
   , notElemInScopeSet, unionInScope)
@@ -95,10 +100,27 @@
 import Clash.Normalize.Types (NormRewrite, NormalizeSession)
 import Clash.Rewrite.Combinators (bottomupR)
 import Clash.Rewrite.Types
-import Clash.Rewrite.Util (changed, isUntranslatableType)
+import Clash.Rewrite.Util (changed, isFromInt, isUntranslatableType)
 import Clash.Rewrite.WorkFree (isConstant)
 import Clash.Util (MonadUnique, curLoc)
+import Clash.Util.Supply (splitSupply)
 
+-- primitives
+import qualified Clash.Sized.Internal.BitVector
+import qualified Clash.Sized.Internal.Index
+import qualified Clash.Sized.Internal.Signed
+import qualified Clash.Sized.Internal.Unsigned
+import qualified GHC.Base
+import qualified GHC.Classes
+#if MIN_VERSION_base(4,15,0)
+import qualified GHC.Num.Integer
+#else
+-- interger-gmp primitives are defined in the hidden module GHC.Integer.Type,
+-- but exported from GHC.Integer
+import qualified GHC.Integer as GHC.Integer.Type
+#endif
+import qualified GHC.Prim
+
 -- | This transformation lifts applications of global binders out of
 -- alternatives of case-statements.
 --
@@ -122,6 +144,24 @@
 --       B -> f_out
 --       C -> h x
 -- @
+--
+-- Though that's a lie. It actually converts it into:
+--
+-- @
+-- let f_tupIn = case x of {A -> (3,y); B -> (x,x)}
+--     f_arg0  = case f_tupIn of (l,_) -> l
+--     f_arg1  = case f_tupIn of (_,r) -> r
+--     f_out   = f f_arg0 f_arg1
+-- in  case x of
+--       A -> f_out
+--       B -> f_out
+--       C -> h x
+-- @
+--
+-- In order to share the expression that's in the subject of the case expression,
+-- and to share the /decoder/ circuit that logic synthesis will create to map the
+-- bits of the subject expression to the bits needed to make the selection in the
+-- multiplexer.
 disjointExpressionConsolidation :: HasCallStack => NormRewrite
 disjointExpressionConsolidation ctx@(TransformContext isCtx _) e@(Case _scrut _ty _alts@(_:_:_)) = do
     -- Collect all (the applications of) global binders (and certain primitives)
@@ -134,11 +174,13 @@
        else do
          -- For every to-lift expression create (the generalization of):
          --
-         -- let fargs = case x of {A -> (3,y); B -> (x,x)}
-         -- in  f (fst fargs) (snd fargs)
+         -- let f_tupIn = case x of {A -> (3,y); B -> (x,x)}
+         --     f_arg0  = case f_tupIn of (l,_) -> l
+         --     f_arg1  = case f_tupIn of (_,r) -> r
+         -- in  f f_arg0 f_arg0
          --
-         -- the let-expression is not created when `f` has only one (selectable)
-         -- argument
+         -- if an argument is non-representable, the case-expression is inlined,
+         -- and no let-binding will be created for it.
          --
          -- NB: mkDisJointGroup needs the context InScopeSet, isCtx, to determine
          -- whether expressions reference variables from the context, or
@@ -174,11 +216,8 @@
     -- Make the let-binder for the lifted expressions
     mkFunOut tcm isN ((fun,_),(eLifted,_)) = do
       let ty  = inferCoreTypeOf tcm eLifted
-          nm  = case collectArgs fun of
-                   (Var v,_)  -> nameOcc (varName v)
-                   (Prim p,_) -> primName p
-                   _          -> "complex_expression_"
-          nm1 = last (Text.splitOn "." nm) `Text.append` "Out"
+          nm  = decFunName fun
+          nm1 = nm `Text.append` "_out"
       nm2 <- mkInternalVar isN nm1 ty
       return (extendInScopeSet isN nm2,nm2)
 
@@ -233,12 +272,26 @@
 disjointExpressionConsolidation _ e = return e
 {-# SCC disjointExpressionConsolidation #-}
 
+decFunName :: Term -> OccName
+decFunName fun = last . Text.splitOn "." $ case collectArgs fun of
+  (Var v, _) -> nameOcc (varName v)
+  (Prim p, _) -> primName p
+  _ -> "complex_expression"
+
 data CaseTree a
   = Leaf a
   | LB [LetBinding] (CaseTree a)
   | Branch Term [(Pat,CaseTree a)]
   deriving (Eq,Show,Functor,Foldable)
 
+instance Applicative CaseTree where
+  pure = Leaf
+  liftA2 f (Leaf a) (Leaf b) = Leaf (f a b)
+  liftA2 f (LB lb c1) (LB _ c2) = LB lb (liftA2 f c1 c2)
+  liftA2 f (Branch scrut alts1) (Branch _ alts2) =
+    Branch scrut (zipWith (\(p1,a1) (_,a2) -> (p1,liftA2 f a1 a2)) alts1 alts2)
+  liftA2 _ _ _ = error "CaseTree.liftA2: internal error, this should not happen."
+
 -- | Test if a 'CaseTree' collected from an expression indicates that
 -- application of a global binder is disjoint: occur in separate branches of a
 -- case-expression.
@@ -253,18 +306,6 @@
     go (Branch _ [(_,x)])   = go x
     go b@(Branch _ (_:_:_)) = allEqual (map Either.rights (Foldable.toList b))
 
--- Remove empty branches from a 'CaseTree'
-removeEmpty :: Eq a => CaseTree [a] -> CaseTree [a]
-removeEmpty l@(Leaf _) = l
-removeEmpty (LB lb ct) =
-  case removeEmpty ct of
-    Leaf [] -> Leaf []
-    ct'     -> LB lb ct'
-removeEmpty (Branch s bs) =
-  case filter ((/= (Leaf [])) . snd) (map (second removeEmpty) bs) of
-    []  -> Leaf []
-    bs' -> Branch s bs'
-
 -- | Test if all elements in a list are equal to each other.
 allEqual :: Eq a => [a] -> Bool
 allEqual []     = True
@@ -273,7 +314,7 @@
 -- | Collect 'CaseTree's for (potentially) disjoint applications of globals out
 -- of an expression. Also substitute truly disjoint applications of globals by a
 -- reference to a lifted out application.
-collectGlobals'
+collectGlobals
   :: InScopeSet
   -> [(Term,Term)]
   -- ^ Substitution of (applications of) a global binder by a reference to a
@@ -282,10 +323,8 @@
   -- ^ List of already seen global binders
   -> Term
   -- ^ The expression
-  -> Bool
-  -- ^ Whether expression is constant
   -> NormalizeSession (Term, InScopeSet, [(Term, ([Term], CaseTree [Either Term Type]))])
-collectGlobals' is0 substitution seen (Case scrut ty alts) _eIsConstant = do
+collectGlobals is0 substitution seen (Case scrut ty alts) = do
   rec (alts1, isAlts, collectedAlts) <-
         collectGlobalsAlts is0 substitution seen scrut1 alts
       (scrut1, isScrut, collectedScrut) <-
@@ -294,8 +333,8 @@
          , unionInScope isAlts isScrut
          , collectedAlts ++ collectedScrut )
 
-collectGlobals' is0 substitution seen e@(collectArgsTicks -> (fun, args@(_:_), ticks)) eIsconstant
-  | not eIsconstant = do
+collectGlobals is0 substitution seen e@(collectArgsTicks -> (fun, args@(_:_), ticks))
+  | not (isConstant e) = do
     tcm <- Lens.view tcCache
     bndrs <- Lens.use bindings
     evaluate <- Lens.view evaluator
@@ -317,10 +356,10 @@
         (args1,isArgs,collectedArgs) <-
           collectGlobalsArgs is0 substitution seen args
         let seenInArgs = map fst collectedArgs ++ seen
-        isInteresting <- interestingToLift is0 eval fun args ticks
+            isInteresting = interestingToLift is0 eval fun args ticks
         case isInteresting of
           Just fun1 | fun1 `notElem` seenInArgs -> do
-            let e1 = Maybe.fromMaybe (mkApps fun1 args1) (List.lookup fun1 substitution)
+            let e1 = Maybe.fromMaybe (mkApps (mkTicks fun1 ticks) args1) (List.lookup fun1 substitution)
             -- This function is lifted out an environment with the currently 'seen'
             -- binders. When we later apply substitution, we need to start with this
             -- environment, otherwise we perform incorrect substitutions in the
@@ -333,7 +372,7 @@
 -- the ANF, CSE, and DeadCodeRemoval pass all duplicates are removed.
 --
 -- I think we should be able to do better, but perhaps we cannot fix it here.
-collectGlobals' is0 substitution seen (Letrec lbs body) _eIsConstant = do
+collectGlobals is0 substitution seen (Letrec lbs body) = do
   let is1 = extendInScopeSetList is0 (map fst lbs)
   (body1,isBody,collectedBody) <-
     collectGlobals is1 substitution seen body
@@ -344,27 +383,11 @@
          , map (second (second (LB lbs1))) (collectedBody ++ collectedBndrs)
          )
 
-collectGlobals' is0 substitution seen (Tick t e) eIsConstant = do
-  (e1,is1,collected) <- collectGlobals' is0 substitution seen e eIsConstant
+collectGlobals is0 substitution seen (Tick t e) = do
+  (e1,is1,collected) <- collectGlobals is0 substitution seen e
   return (Tick t e1, is1, collected)
 
-collectGlobals' is0 _ _ e _ = return (e,is0,[])
-
--- | Collect 'CaseTree's for (potentially) disjoint applications of globals out
--- of an expression. Also substitute truly disjoint applications of globals by a
--- reference to a lifted out application.
-collectGlobals
-  :: InScopeSet
-  -> [(Term,Term)]
-  -- ^ Substitution of (applications of) a global binder by a reference to
-  -- a lifted term.
-  -> [Term]
-  -- ^ List of already seen global binders
-  -> Term
-  -- ^ The expression
-  -> NormalizeSession (Term, InScopeSet, [(Term, ([Term], CaseTree [Either Term Type]))])
-collectGlobals inScope substitution seen e =
-  collectGlobals' inScope substitution seen e (isConstant e)
+collectGlobals is0 _ _ e = return (e,is0,[])
 
 -- | Collect 'CaseTree's for (potentially) disjoint applications of globals out
 -- of a list of application arguments. Also substitute truly disjoint
@@ -466,90 +489,94 @@
 -- function-position\", return a let-expression: where the let-binding holds
 -- a case-expression selecting between the distinct arguments of the case-tree,
 -- and the body is an application of the term applied to the shared arguments of
--- the case tree, and projections of let-binding corresponding to the distinct
--- argument positions.
+-- the case tree, and variable references to the created let-bindings.
+--
+-- case-expressions whose type would be non-representable are not let-bound,
+-- but occur directly in the argument position of the application in the body
+-- of the let-expression.
 mkDisjointGroup
   :: InScopeSet
   -- ^ Variables in scope at the very top of the case-tree, i.e., the original
   -- expression
-  -> (Term,([Term],CaseTree [(Either Term Type)]))
+  -> (Term,([Term],CaseTree [Either Term Type]))
   -- ^ Case-tree of arguments belonging to the applied term.
   -> NormalizeSession (Term,[Term])
 mkDisjointGroup inScope (fun,(seen,cs)) = do
     tcm <- Lens.view tcCache
-    let argss    = Foldable.toList cs
-        argssT   = zip [0..] (List.transpose argss)
-        (sharedT,distinctT) = List.partition (areShared tcm inScope . fmap (first stripTicks) . snd) argssT
-        -- TODO: find a better solution than "maybe undefined fst . uncons"
-        shared   = map (second (maybe (error "impossible") fst . List.uncons)) sharedT
-        distinct = map (Either.lefts) (List.transpose (map snd distinctT))
-        cs'      = fmap (zip [0..]) cs
-        cs''     = removeEmpty
-                 $ fmap (Either.lefts . map snd)
-                        (if null shared
-                           then cs'
-                           else fmap (filter (`notElem` shared)) cs')
-    (distinctCaseM,distinctProjections) <- case distinct of
-      -- only shared arguments: do nothing.
-      [] -> return (Nothing,[])
-      -- Create selectors and projections
-      (uc:_) -> do
-        let argTys = map (inferCoreTypeOf tcm) uc
-        disJointSelProj inScope argTys cs''
-    let newArgs = mkDJArgs 0 shared distinctProjections
-    case distinctCaseM of
-      Just lb -> return (Letrec [lb] (mkApps fun newArgs), seen)
-      Nothing -> return (mkApps fun newArgs, seen)
+    let funName = decFunName fun
+        argLen = case Foldable.toList cs of
+                   [] -> error "mkDisjointGroup: no disjoint groups"
+                   l:_ -> length l
+        csT :: [CaseTree (Either Term Type)] -- "Transposed" 'CaseTree [Either Term Type]'
+        csT = map (\i -> fmap (!!i) cs) [0..(argLen-1)] -- sequenceA does the wrong thing
+    (lbs,newArgs) <- List.mapAccumRM (\lbs (c,pos) -> do
+      let cL = Foldable.toList c
+      case (cL, areShared tcm inScope (fmap (first stripTicks) cL)) of
+        (Right ty:_, True) ->
+          return (lbs,Right ty)
+        (Right _:_, False) ->
+          error ("mkDisjointGroup: non-equal type arguments: " <>
+                 showPpr (Either.rights cL))
+        (Left tm:_, True) ->
+          return (lbs,Left tm)
+        (Left tm:_, False) -> do
+          let ty = inferCoreTypeOf tcm tm
+          let err = error ("mkDisjointGroup: mixed type and term arguments: " <> show cL)
+          (lbM,arg) <- disJointSelProj inScope ty (Either.fromLeft err <$> c) funName pos
+          case lbM of
+            Just lb -> return (lb:lbs, Left arg)
+            _ -> return (lbs, Left arg)
+        ([], _) ->
+          error "mkDisjointGroup: no arguments"
+      ) [] (zip csT [0..])
+    let funApp = mkApps fun newArgs
+    tupTcm <- Lens.view tupleTcCache
+    case lbs of
+      [] ->
+        return (funApp, seen)
+      [(v,(ty,ct))] -> do
+        let e = genCase tcm tupTcm ty [ty] (fmap (:[]) ct)
+        return (Letrec [(v,e)] funApp, seen)
+      _ -> do
+        let (vs,zs) = unzip lbs
+            csL :: [CaseTree Term]
+            (tys,csL) = unzip zs
+            csLT :: CaseTree [Term]
+            csLT = fmap ($ []) (foldr1 (liftA2 (.)) (fmap (fmap (:)) csL))
+            bigTupTy = mkBigTupTy tcm tupTcm tys
+            ct = genCase tcm tupTcm bigTupTy tys csLT
+        tupIn <- mkInternalVar inScope (funName <> "_tupIn") bigTupTy
+        projections <-
+          Monad.zipWithM (\v n ->
+            (v,) <$> mkBigTupSelector inScope tcm tupTcm (Var tupIn) tys n)
+            vs [0..]
+        return (Letrec ((tupIn,ct):projections) funApp, seen)
 
--- | Create a single selector for all the representable distinct arguments by
--- selecting between tuples. This selector is only ('Just') created when the
--- number of representable uncommmon arguments is larger than one, otherwise it
--- is not ('Nothing').
---
--- It also returns:
---
--- * For all the non-representable distinct arguments: a selector
--- * For all the representable distinct arguments: a projection out of the tuple
---   created by the larger selector. If this larger selector does not exist, a
---   single selector is created for the single representable distinct argument.
+-- | Create a selector for the case-tree of the argument. If the argument is
+-- representable create a let-binding for the created selector, and return
+-- a variable reference to this let-binding. If the argument is not representable
+-- return the selector directly.
 disJointSelProj
   :: InScopeSet
-  -> [Type]
-  -- ^ Types of the arguments
-  -> CaseTree [Term]
-  -- The case-tree of arguments
-  -> NormalizeSession (Maybe LetBinding,[Term])
-disJointSelProj _ _ (Leaf []) = return (Nothing,[])
-disJointSelProj inScope argTys cs = do
-    tcm    <- Lens.view tcCache
+  -> Type
+  -- ^ Types of the argument
+  -> CaseTree Term
+  -- ^ The case-tree of argument
+  -> OccName
+  -- ^ Name of the lifted function
+  -> Word
+  -- ^ Position of the argument
+  -> NormalizeSession (Maybe (Id, (Type, CaseTree Term)),Term)
+disJointSelProj inScope argTy cs funName argN = do
+    tcm <- Lens.view tcCache
     tupTcm <- Lens.view tupleTcCache
-    let maxIndex = length argTys - 1
-        css = map (\i -> fmap ((:[]) . (!!i)) cs) [0..maxIndex]
-    (untran,tran) <- List.partitionM (isUntranslatableType False . snd) (zip [0..] argTys)
-    let untranCs   = map (css!!) (map fst untran)
-        untranSels = zipWith (\(_,ty) cs' -> genCase tcm tupTcm ty [ty]  cs')
-                             untran untranCs
-    (lbM,projs) <- case tran of
-      []       -> return (Nothing,[])
-      [(i,ty)] -> return (Nothing,[genCase tcm tupTcm ty [ty] (css!!i)])
-      tys      -> do
-        let m            = length tys
-            (tyIxs,tys') = unzip tys
-            tupTy        = mkBigTupTy tcm tupTcm tys'
-            cs'          = fmap (\es -> map (es !!) tyIxs) cs
-            djCase       = genCase tcm tupTcm tupTy tys' cs'
-        scrutId <- mkInternalVar inScope "tupIn" tupTy
-        projections <- mapM (mkBigTupSelector inScope tcm tupTcm (Var scrutId) tys') [0..m-1]
-        return (Just (scrutId,djCase),projections)
-    let selProjs = tranOrUnTran 0 (zip (map fst untran) untranSels) projs
-
-    return (lbM,selProjs)
-  where
-    tranOrUnTran _ []       projs     = projs
-    tranOrUnTran _ sels     []        = map snd sels
-    tranOrUnTran n ((ut,s):uts) (p:projs)
-      | n == ut   = s : tranOrUnTran (n+1) uts          (p:projs)
-      | otherwise = p : tranOrUnTran (n+1) ((ut,s):uts) projs
+    let sel = genCase tcm tupTcm argTy [argTy] (fmap (:[]) cs)
+    untran <- isUntranslatableType False argTy
+    case untran of
+      True -> return (Nothing, sel)
+      False -> do
+        argId <- mkInternalVar inScope (funName <> "_arg" <> showt argN) argTy
+        return (Just (argId,(argTy,cs)), Var argId)
 
 -- | Arguments are shared between invocations if:
 --
@@ -569,7 +596,7 @@
 areShared tcm inScope xs@(x:_) = noFV1 && (isProof x || allEqual xs)
  where
   noFV1 = case x of
-    Right ty -> getAll (Lens.foldMapOf (typeFreeVars' isLocallyBound IntSet.empty)
+    Right ty -> getAll (Lens.foldMapOf (typeFreeVars' isLocallyBound mempty)
                                        (const (All False)) ty)
     Left tm  -> getAll (Lens.foldMapOf (termFreeVars' isLocallyBound)
                                        (const (All False)) tm)
@@ -577,22 +604,10 @@
   isLocallyBound v = isLocalId v && v `notElemInScopeSet` inScope
 
   isProof (Left co) = case tyView (inferCoreTypeOf tcm co) of
-    TyConApp (nameOcc -> "GHC.Types.~") _ -> True
+    TyConApp (nameOcc -> nm) _ ->  nm == fromTHName ''(~)
     _ -> False
   isProof _ = False
 
--- | Create a list of arguments given a map of positions to common arguments,
--- and a list of arguments
-mkDJArgs :: Int -- ^ Current position
-         -> [(Int,Either Term Type)] -- ^ map from position to common argument
-         -> [Term] -- ^ (projections for) distinct arguments
-         -> [Either Term Type]
-mkDJArgs _ cms []   = map snd cms
-mkDJArgs _ [] uncms = map Left uncms
-mkDJArgs n ((m,x):cms) (y:uncms)
-  | n == m    = x       : mkDJArgs (n+1) cms (y:uncms)
-  | otherwise = Left y  : mkDJArgs (n+1) ((m,x):cms) uncms
-
 -- | Create a case-expression that selects between the distinct arguments given
 -- a case-tree
 genCase :: TyConMap
@@ -687,8 +702,11 @@
 -- This holds for all global functions, and certain primitives. Currently those
 -- primitives are:
 --
--- * All non-power-of-two multiplications
--- * All division-like operations with a non-power-of-two divisor
+-- * All non-cheap multiplications
+-- * All division-like operations with a non-cheap divisor
+--
+-- Multiplying/dividing by zero or powers of two are considered cheap and
+-- isn't lifted out.
 interestingToLift
   :: InScopeSet
   -- ^ in scope
@@ -700,99 +718,99 @@
   -- ^ Arguments
   -> [TickInfo]
   -- ^ Tick annoations
-  -> RewriteMonad extra (Maybe Term)
+  -> Maybe Term
 interestingToLift inScope _ e@(Var v) _ ticks =
   if NoDeDup `notElem` ticks && (isGlobalId v ||  v `elemInScopeSet` inScope)
-     then pure (Just e)
-     else pure Nothing
+     then (Just e)
+     else Nothing
 interestingToLift inScope eval e@(Prim pInfo) args ticks
   | NoDeDup `notElem` ticks = do
   let anyArgNotConstant = any (not . isConstant) lArgs
   case List.lookup (primName pInfo) interestingPrims of
-    Just t | t || anyArgNotConstant -> pure (Just e)
-    _ | DeDup `elem` ticks -> pure (Just e)
-    _ -> do
-      let isInteresting = (\(x, y, z) -> interestingToLift inScope eval x y z) . collectArgsTicks
+    Just t | t || anyArgNotConstant -> (Just e)
+    _ | DeDup `elem` ticks -> (Just e)
+    _ ->
       if isHOTy (coreTypeOf pInfo) then do
-        anyInteresting <- List.anyM (fmap Maybe.isJust . isInteresting) lArgs
-        if anyInteresting then pure (Just e) else pure Nothing
+        let anyInteresting = List.any (Maybe.isJust . isInteresting) lArgs
+        if anyInteresting then Just e else Nothing
       else
-        pure Nothing
+        Nothing
 
   where
-    interestingPrims =
-      [("Clash.Sized.Internal.BitVector.*#",tailNonPow2)
-      ,("Clash.Sized.Internal.BitVector.times#",tailNonPow2)
-      ,("Clash.Sized.Internal.BitVector.quot#",lastNotPow2)
-      ,("Clash.Sized.Internal.BitVector.rem#",lastNotPow2)
-      ,("Clash.Sized.Internal.Index.*#",tailNonPow2)
-      ,("Clash.Sized.Internal.Index.quot#",lastNotPow2)
-      ,("Clash.Sized.Internal.Index.rem#",lastNotPow2)
-      ,("Clash.Sized.Internal.Signed.*#",tailNonPow2)
-      ,("Clash.Sized.Internal.Signed.times#",tailNonPow2)
-      ,("Clash.Sized.Internal.Signed.rem#",lastNotPow2)
-      ,("Clash.Sized.Internal.Signed.quot#",lastNotPow2)
-      ,("Clash.Sized.Internal.Signed.div#",lastNotPow2)
-      ,("Clash.Sized.Internal.Signed.mod#",lastNotPow2)
-      ,("Clash.Sized.Internal.Unsigned.*#",tailNonPow2)
-      ,("Clash.Sized.Internal.Unsigned.times#",tailNonPow2)
-      ,("Clash.Sized.Internal.Unsigned.quot#",lastNotPow2)
-      ,("Clash.Sized.Internal.Unsigned.rem#",lastNotPow2)
-      ,("GHC.Base.quotInt",lastNotPow2)
-      ,("GHC.Base.remInt",lastNotPow2)
-      ,("GHC.Base.divInt",lastNotPow2)
-      ,("GHC.Base.modInt",lastNotPow2)
-      ,("GHC.Classes.divInt#",lastNotPow2)
-      ,("GHC.Classes.modInt#",lastNotPow2)
+    isInteresting = (\(x, y, z) -> interestingToLift inScope eval x y z) . collectArgsTicks
+    interestingPrims = map (first fromTHName)
+      [('(Clash.Sized.Internal.BitVector.*#),bothNotPow2)
+      ,('Clash.Sized.Internal.BitVector.times#,bothNotPow2)
+      ,('Clash.Sized.Internal.BitVector.quot#,lastNotPow2)
+      ,('Clash.Sized.Internal.BitVector.rem#,lastNotPow2)
+      ,('(Clash.Sized.Internal.Index.*#),bothNotPow2)
+      ,('Clash.Sized.Internal.Index.times#,bothNotPow2)
+      ,('Clash.Sized.Internal.Index.quot#,lastNotPow2)
+      ,('Clash.Sized.Internal.Index.rem#,lastNotPow2)
+      ,('(Clash.Sized.Internal.Signed.*#),bothNotPow2)
+      ,('Clash.Sized.Internal.Signed.times#,bothNotPow2)
+      ,('Clash.Sized.Internal.Signed.rem#,lastNotPow2)
+      ,('Clash.Sized.Internal.Signed.quot#,lastNotPow2)
+      ,('Clash.Sized.Internal.Signed.div#,lastNotPow2)
+      ,('Clash.Sized.Internal.Signed.mod#,lastNotPow2)
+      ,('(Clash.Sized.Internal.Unsigned.*#),bothNotPow2)
+      ,('Clash.Sized.Internal.Unsigned.times#,bothNotPow2)
+      ,('Clash.Sized.Internal.Unsigned.quot#,lastNotPow2)
+      ,('Clash.Sized.Internal.Unsigned.rem#,lastNotPow2)
+      ,('GHC.Base.quotInt,lastNotPow2)
+      ,('GHC.Base.remInt,lastNotPow2)
+      ,('GHC.Base.divInt,lastNotPow2)
+      ,('GHC.Base.modInt,lastNotPow2)
+      ,('GHC.Classes.divInt#,lastNotPow2)
+      ,('GHC.Classes.modInt#,lastNotPow2)
 #if MIN_VERSION_base(4,15,0)
-      ,("GHC.Num.Integer.integerMul",allNonPow2)
-      ,("GHC.Num.Integer.integerDiv",lastNotPow2)
-      ,("GHC.Num.Integer.integerMod",lastNotPow2)
-      ,("GHC.Num.Integer.integerQuot",lastNotPow2)
-      ,("GHC.Num.Integer.integerRem",lastNotPow2)
+      ,('GHC.Num.Integer.integerMul,bothNotPow2)
+      ,('GHC.Num.Integer.integerDiv,lastNotPow2)
+      ,('GHC.Num.Integer.integerMod,lastNotPow2)
+      ,('GHC.Num.Integer.integerQuot,lastNotPow2)
+      ,('GHC.Num.Integer.integerRem,lastNotPow2)
 #else
-      ,("GHC.Integer.Type.timesInteger",allNonPow2)
-      ,("GHC.Integer.Type.divInteger",lastNotPow2)
-      ,("GHC.Integer.Type.modInteger",lastNotPow2)
-      ,("GHC.Integer.Type.quotInteger",lastNotPow2)
-      ,("GHC.Integer.Type.remInteger",lastNotPow2)
+      ,('GHC.Integer.Type.timesInteger,bothNotPow2)
+      ,('GHC.Integer.Type.divInteger,lastNotPow2)
+      ,('GHC.Integer.Type.modInteger,lastNotPow2)
+      ,('GHC.Integer.Type.quotInteger,lastNotPow2)
+      ,('GHC.Integer.Type.remInteger,lastNotPow2)
 #endif
-      ,("GHC.Prim.*#",allNonPow2)
-      ,("GHC.Prim.quotInt#",lastNotPow2)
-      ,("GHC.Prim.remInt#",lastNotPow2)
+      ,('(GHC.Prim.*#),bothNotPow2)
+      ,('GHC.Prim.quotInt#,lastNotPow2)
+      ,('GHC.Prim.remInt#,lastNotPow2)
       ]
 
     lArgs       = Either.lefts args
 
-    allNonPow2  = all (not . termIsPow2) lArgs
-    tailNonPow2 = case lArgs of
-                    [] -> True
-                    _  -> all (not . termIsPow2) (drop 1 lArgs)
     lastNotPow2 = case lArgs of
                     [] -> True
                     _  -> not (termIsPow2 (last lArgs))
+    -- | This only looks at the last two arguments, skipping over any constraints if they exist
+    bothNotPow2 = go lArgs
+     where
+      go xs = case xs of
+                [] -> True
+                [a] -> not (termIsPow2 a)
+                [a,b] -> not (termIsPow2 a) && not (termIsPow2 b)
+                (_:rest) -> go rest
 
     termIsPow2 e' = case eval e' of
       Literal (IntegerLiteral n) -> isPow2 n
       a -> case collectArgs a of
-        (Prim p,[Right _,Left _,Left (Literal (IntegerLiteral n))])
-          | isFromInteger (primName p) -> isPow2 n
+        (Prim p,[Right _,Left _,       Left (Literal (IntegerLiteral n))])
+          | isFromInt (primName p) -> isPow2 n
         (Prim p,[Right _,Left _,Left _,Left (Literal (IntegerLiteral n))])
-          | primName p == "Clash.Sized.Internal.BitVector.fromInteger#"  -> isPow2 n
-        (Prim p,[Right _,       Left _,Left (Literal (IntegerLiteral n))])
-          | primName p == "Clash.Sized.Internal.BitVector.fromInteger##" -> isPow2 n
-
+          | primName p == fromTHName 'Clash.Sized.Internal.BitVector.fromInteger#  -> isPow2 n
         _ -> False
 
-    isPow2 x = x /= 0 && (x .&. (complement x + 1)) == x
-
-    isFromInteger x = x `elem` ["Clash.Sized.Internal.BitVector.fromInteger#"
-                               ,"Clash.Sized.Integer.Index.fromInteger"
-                               ,"Clash.Sized.Internal.Signed.fromInteger#"
-                               ,"Clash.Sized.Internal.Unsigned.fromInteger#"
-                               ]
+    -- This used to contain (x /= 0), but multiplying by zero is free
+    isPow2 x = (x .&. (complement x + 1)) == x
 
     isHOTy t = case splitFunForallTy t of
       (args',_) -> any isPolyFunTy (Either.rights args')
 
-interestingToLift _ _ _ _ _ = pure Nothing
+interestingToLift _ _ _ _ _ = Nothing
+
+fromTHName :: TH.Name -> Text.Text
+fromTHName = Text.pack . show
diff --git a/src/Clash/Normalize/Transformations/Inline.hs b/src/Clash/Normalize/Transformations/Inline.hs
--- a/src/Clash/Normalize/Transformations/Inline.hs
+++ b/src/Clash/Normalize/Transformations/Inline.hs
@@ -2,7 +2,7 @@
   Copyright  :  (C) 2012-2016, University of Twente,
                     2016-2017, Myrtle Software Ltd,
                     2017-2022, Google Inc.,
-                    2021-2022, QBayLogic B.V.
+                    2021-2024, QBayLogic B.V.
   License    :  BSD2 (see the file LICENSE)
   Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -14,6 +14,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -48,7 +49,7 @@
 import GHC.BasicTypes.Extra (isNoInline)
 
 import qualified Clash.Explicit.SimIO as SimIO
-import qualified Clash.Sized.Internal.BitVector as BV (Bit(Bit), BitVector(BV))
+import qualified Clash.Sized.Internal.BitVector as BV (Bit(Bit), BitVector(BV), xToBV)
 
 import Clash.Annotations.Primitive (extractPrim)
 import Clash.Core.DataCon (DataCon(..))
@@ -119,7 +120,14 @@
       True -> return (i `notElemFreeVars` e)
       _    -> do
         tcm <- Lens.view tcCache
-        case isWorkFreeIsh tcm e of
+        (fn,_) <- Lens.use curFun
+        -- Don't inline things that perform work, it increases the circuit size.
+        --
+        -- Also don't inline globally recursive calls, it prevents the
+        -- recToLetRec transformation from transforming global recursion to
+        -- local recursion.
+        -- See https://github.com/clash-lang/clash-compiler/issues/2839
+        case isWorkFreeIsh tcm e && not (e == Var fn) of
           True -> Lens.view inlineConstantLimit >>= \case
             0 -> return True
             n -> return (termSize e <= n)
@@ -438,7 +446,8 @@
     isNoopApp x (Prim PrimInfo{primWorkInfo=WorkIdentity i []},args) = do
       arg <- getTermArg (lefts args) i
       isNoopApp x (collectArgs arg)
-    isNoopApp x (Prim PrimInfo{primName="Clash.Class.BitPack.Internal.xToBV"},args) = do
+    isNoopApp x (Prim PrimInfo{primName},args)
+      | primName == Text.showt 'BV.xToBV = do
       -- We don't make 'xToBV' something of 'WorkIdentity 1 []' because we don't
       -- want 'getIdentity' to replace "naked" occurances of 'xToBV' by
       -- 'unsafeCoerce#'. We don't want that since 'xToBV' has a special evaluator
diff --git a/src/Clash/Normalize/Transformations/MultiPrim.hs b/src/Clash/Normalize/Transformations/MultiPrim.hs
--- a/src/Clash/Normalize/Transformations/MultiPrim.hs
+++ b/src/Clash/Normalize/Transformations/MultiPrim.hs
@@ -58,7 +58,7 @@
 -- will be rewritten to:
 --
 -- @
---   \(x :: a) ->
+--   \\(x :: a) ->
 --         let
 --            r  = prim @a @b @c x r0 r1 -- With 'Clash.Core.Term.MultiPrim'
 --            r0 = c$multiPrimSelect r0 r
@@ -98,10 +98,11 @@
   internalNm prefix n = mkUnsafeInternalName (prefix <> showt n) n
   internalId prefix typ n = mkLocalId typ (internalNm prefix n)
 
-  nTermArgs = length (Either.rights pArgs)
+  nTermArgs = fromIntegral (length (Either.rights pArgs))
+  nResTypes = fromIntegral (length resTypes)
   argIds = zipWith (internalId "a") (Either.rights pArgs) [1..nTermArgs]
-  resIds = zipWith (internalId "r") resTypes [nTermArgs+1..nTermArgs+length resTypes]
-  resId = mkLocalId pResTy (mkUnsafeInternalName "r" (nTermArgs+length resTypes+1))
+  resIds = zipWith (internalId "r") resTypes [nTermArgs+1..nTermArgs+nResTypes]
+  resId = mkLocalId pResTy (mkUnsafeInternalName "r" (nTermArgs+nResTypes+1))
 
   (pArgs, pResTy) = splitFunForallTy primType
   MultiPrimInfo{mpi_resultDc=tupTc, mpi_resultTypes=resTypes} =
diff --git a/src/Clash/Normalize/Transformations/Specialize.hs b/src/Clash/Normalize/Transformations/Specialize.hs
--- a/src/Clash/Normalize/Transformations/Specialize.hs
+++ b/src/Clash/Normalize/Transformations/Specialize.hs
@@ -96,6 +96,7 @@
   ( NormRewrite, NormalizeSession, specialisationCache, specialisationHistory)
 import Clash.Normalize.Util
   (constantSpecInfo, csrFoundConstant, csrNewBindings, csrNewTerm)
+import Clash.Unique (Unique)
 import Clash.Util (ClashException(..))
 
 -- | Propagate arguments of application inwards; except for 'Lam' where the
@@ -141,7 +142,7 @@
 -- Imagine
 --
 -- @
--- (\x -> e) u
+-- (\\x -> e) u
 -- @
 --
 -- where @u@ has a free variable named @x@, rewriting this to:
@@ -438,7 +439,7 @@
             else do
               let existingNames = collectBndrsMinusApps bodyTm
                   newNames      = [ mkUnsafeInternalName ("pTS" `Text.append` Text.pack (show n)) n
-                                  | n <- [(0::Int)..]
+                                  | n <- [(0::Unique)..]
                                   ]
               -- Make new binders for existing arguments
               (boundArgs,argVars) <- fmap (unzip . map (either (Left &&& Left . Var) (Right &&& Right . VarTy))) $
diff --git a/src/Clash/Normalize/Util.hs b/src/Clash/Normalize/Util.hs
--- a/src/Clash/Normalize/Util.hs
+++ b/src/Clash/Normalize/Util.hs
@@ -1,6 +1,6 @@
 {-|
   Copyright  :  (C) 2012-2016, University of Twente,
-                    2021-2022, QBayLogic B.V.
+                    2021-2024, QBayLogic B.V.
   License    :  BSD2 (see the file LICENSE)
   Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -48,10 +48,8 @@
 
 #if MIN_VERSION_ghc(9,0,0)
 import           GHC.Builtin.Names       (eqTyConKey)
-import           GHC.Types.Unique        (getKey)
 #else
 import           PrelNames               (eqTyConKey)
-import           Unique                  (getKey)
 #endif
 
 import           Clash.Annotations.Primitive (extractPrim)
@@ -450,7 +448,7 @@
   go args changed (TyLam tv e) = go (Right tv : args) changed e
   go args changed (Lam v e)
     | TyConApp (nameUniq -> tcUniq) (tvFirst -> Just (tv, ty)) <- tyView (coreTypeOf v)
-    , tcUniq == getKey eqTyConKey
+    , tcUniq == fromGhcUnique eqTyConKey
     , Right tv `elem` args
     = let
         tvs = rights args
@@ -479,7 +477,7 @@
     = go (Left tv:argsOut) changed ty
   go argsOut changed (tyView -> FunTy arg tyRes)
     | Just (tc,tcArgs) <- splitTyConAppM arg
-    , nameUniq tc == getKey eqTyConKey
+    , nameUniq tc == fromGhcUnique eqTyConKey
     , Just (tv,ty) <- tvFirst tcArgs
     = let
         argsOut2 = Right arg : (argsOut List.\\ [Left tv])
diff --git a/src/Clash/Primitives/DSL.hs b/src/Clash/Primitives/DSL.hs
--- a/src/Clash/Primitives/DSL.hs
+++ b/src/Clash/Primitives/DSL.hs
@@ -1,6 +1,6 @@
 {-|
   Copyright   :  (C) 2019,      Myrtle Software Ltd.
-                     2020-2023, QBayLogic B.V.
+                     2020-2024, QBayLogic B.V.
                      2021,      Myrtle.ai
                      2022-2023, Google Inc
   License     :  BSD2 (see the file LICENSE)
@@ -127,7 +127,8 @@
 import           Clash.Netlist.Util
 import           Clash.Util                      (clogBase)
 import qualified Data.String.Interpolate         as I
-import           Language.Haskell.TH             (Name)
+import qualified Language.Haskell.TH             as TH
+import qualified Language.Haskell.TH.Syntax      as TH
 import           Prelude
 
 -- | Options for 'blackBoxHaskell' function. Use 'def' from package
@@ -164,9 +165,9 @@
 --
 -- @[1,2]@ would mean this blackbox __ignores__ its second and third argument.
 blackBoxHaskell
-  :: Name
+  :: TH.Name
   -- ^ blackbox name
-  -> Name
+  -> TH.Name
   -- ^ template function name
   -> BlackBoxHaskellOpts
   -- ^ Options, see data structure for more information
@@ -649,14 +650,32 @@
 
 -- | Create an n-tuple of 'TExpr'
 tuple :: HasCallStack => [TExpr] -> TExpr
-tuple [] = error $ "nTuple: Cannot create empty tuple"
+tuple [] = error $ "tuple: Cannot create empty tuple"
 tuple [_] =
   -- If we don't put this in: tuple . untuple /= id
-  error $ "nTuple: Cannot create 1-tuple"
+  error $ "tuple: Cannot create 1-tuple"
 tuple els = constructProduct tupTy els
  where
+#if MIN_VERSION_base(4,19,0)
+  tupTy = Product (tupModule <> ".Tuple" <> showt (length els)) Nothing (map ety els)
+  tupModule =
+    $(
+    let tupNm = ''(,)
+    in case (TH.nameModule tupNm, TH.nameBase tupNm) of
+        (Just modNm, "Tuple2") -> TH.lift modNm :: TH.ExpQ
+        _ -> error $ "tuple: (,) has an unexpected name: " <> show tupNm
+    )
+#else
   commas = Text.replicate (length els - 1) ","
-  tupTy = Product ("GHC.Tuple.(" <> commas <> ")") Nothing (map ety els)
+  tupTy = Product (tupModule <> ".(" <> commas <> ")") Nothing (map ety els)
+  tupModule =
+    $(
+    let tupNm = ''(,)
+    in case (TH.nameModule tupNm, TH.nameBase tupNm) of
+        (Just modNm, "(,)") -> TH.lift modNm :: TH.ExpQ
+        _ -> error $ "tuple: (,) has an unexpected name: " <> show tupNm
+    )
+#endif
 
 -- | Try to get the literal string value of an expression.
 getStr :: TExpr -> Maybe String
@@ -842,14 +861,12 @@
 --
 -- A typical result is that a
 --
--- @
--- component fifo port
---    ( rst : in std_logic
---    ...
---    ; full : out std_logic
---    ; empty : out std_logic );
---  end component;
--- @
+-- > component fifo port
+-- >    ( rst : in std_logic
+-- >    ...
+-- >    ; full : out std_logic
+-- >    ; empty : out std_logic );
+-- >  end component;
 --
 -- declaration would be added in the appropriate place.
 compInBlock
@@ -1068,9 +1085,7 @@
 
 -- | Creates a BV that produces the following vhdl:
 --
--- @
---    (0 to n => ARG)
--- @
+-- > (0 to n => ARG)
 --
 -- TODO: Implement for (System)Verilog
 pureToBV
@@ -1090,9 +1105,7 @@
 
 -- | Creates a BV that produces the following vhdl:
 --
--- @
---    std_logic_vector(resize(ARG, n))
--- @
+-- > std_logic_vector(resize(ARG, n))
 --
 -- TODO: Implement for (System)Verilog
 pureToBVResized
diff --git a/src/Clash/Rewrite/Types.hs b/src/Clash/Rewrite/Types.hs
--- a/src/Clash/Rewrite/Types.hs
+++ b/src/Clash/Rewrite/Types.hs
@@ -21,7 +21,6 @@
 
 module Clash.Rewrite.Types where
 
-import Control.Concurrent.Supply             (Supply, freshId)
 import Control.DeepSeq                       (NFData)
 import Control.Lens                          (Lens', use, (.=))
 import qualified Control.Lens as Lens
@@ -57,6 +56,7 @@
 import Clash.Primitives.Types    (CompiledPrimMap)
 import Clash.Rewrite.WorkFree    (isWorkFree)
 import Clash.Util
+import Clash.Util.Supply         (Supply, freshId)
 
 import Clash.Annotations.BitRepresentation.Internal (CustomReprs)
 
diff --git a/src/Clash/Rewrite/Util.hs b/src/Clash/Rewrite/Util.hs
--- a/src/Clash/Rewrite/Util.hs
+++ b/src/Clash/Rewrite/Util.hs
@@ -2,7 +2,7 @@
   Copyright  :  (C) 2012-2016, University of Twente,
                     2016     , Myrtle Software Ltd,
                     2017     , Google Inc.,
-                    2021-2022, QBayLogic B.V.
+                    2021-2023, QBayLogic B.V.
   License    :  BSD2 (see the file LICENSE)
   Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -24,7 +24,6 @@
   , module Clash.Rewrite.WorkFree
   ) where
 
-import           Control.Concurrent.Supply   (splitSupply)
 import           Control.DeepSeq
 import           Control.Exception           (throw)
 import           Control.Lens ((%=), (+=), (^.))
@@ -77,7 +76,7 @@
 import           Clash.Core.Var
   (Id, IdScope (..), TyVar, Var (..), mkGlobalId, mkLocalId, mkTyVar)
 import           Clash.Core.VarEnv
-  (InScopeSet, extendInScopeSet, extendInScopeSetList, mkInScopeSet,
+  (InScopeSet, extendInScopeSet, extendInScopeSetList, mkInScopeSet, notElemInScopeSet,
    uniqAway, uniqAway', mapVarEnv, eltsVarEnv, unitVarSet, emptyVarEnv,
    mkVarEnv, eltsVarSet, elemVarEnv, lookupVarEnv, extendVarEnv, elemVarSet,
    differenceVarEnv)
@@ -95,6 +94,7 @@
 import           Clash.Util
 import           Clash.Util.Eq               (fastEqBy)
 import qualified Clash.Util.Interpolate as I
+import           Clash.Util.Supply           (splitSupply)
 
 -- | Lift an action working in the '_extra' state to the 'RewriteMonad'
 zoomExtra :: State.State extra a -> RewriteMonad extra a
@@ -173,12 +173,13 @@
     return ()
 
   if isDebugging opts
-    then applyDebug s expr0 hasChanged expr1
+    then applyDebug ctx s expr0 hasChanged expr1
     else return expr1
 {-# INLINE apply #-}
 
 applyDebug
-  :: String
+  :: TransformContext
+  -> String
   -- ^ Name of the transformation
   -> Term
   -- ^ Original expression
@@ -187,7 +188,7 @@
   -> Term
   -- ^ New expression
   -> RewriteMonad extra Term
-applyDebug name exprOld hasChanged exprNew = do
+applyDebug ctx name exprOld hasChanged exprNew = do
   nTrans <- Lens.use transformCounter
   opts <- Lens.view debugOpts
 
@@ -212,9 +213,14 @@
       let beforeTy          = inferCoreTypeOf tcm exprOld
           beforeFV          = Lens.setOf freeLocalVars exprOld
           afterTy           = inferCoreTypeOf tcm exprNew
-          afterFV           = Lens.setOf freeLocalVars exprNew
+          afterFV           = filterFVs (Lens.setOf freeLocalVars exprNew)
           newFV             = not (afterFV `Set.isSubsetOf` beforeFV)
           accidentalShadows = findAccidentialShadows exprNew
+          -- see NOTE [Filter free variables]
+          allowNewFVsFromCtx = name == "caseCon"
+          filterFVs | allowNewFVsFromCtx = Set.filter notInCtx
+                    | otherwise = id
+          notInCtx v = notElemInScopeSet v (tfInScope ctx)
 
       Monad.when newFV $
               error ( concat [ $(curLoc)
@@ -265,6 +271,17 @@
    where
     before = showPpr exprOld
     after  = showPpr exprNew
+
+-- NOTE [Filter free variables]
+-- Since [Give evaluator acces to inscope let-bindings #2571](https://github.com/clash-lang/clash-compiler/pull/2571)
+-- the evaluator can rewrite expressions using let bindings from the 'TransformContext',
+-- these bindings may reference other things bound in the context which weren't
+-- in the expression before, and in doing so introduces new free variables and
+-- fails this check for new free variables.
+-- To prevent this we filter out all variables from bound in the context.
+-- But only during a caseCon transformation, to not weaken this check unnecessarily.
+
+
 
 -- | Perform a transformation on a Term
 runRewrite
diff --git a/src/Clash/Rewrite/WorkFree.hs b/src/Clash/Rewrite/WorkFree.hs
--- a/src/Clash/Rewrite/WorkFree.hs
+++ b/src/Clash/Rewrite/WorkFree.hs
@@ -155,7 +155,18 @@
   if isClockOrReset tcm eTy || isEnable tcm eTy then
     case collectArgs e of
       (Prim p,_) -> Just (primName p == Text.showt 'removedArg)
-      (Var _, []) -> Just True
+      -- Only local variables with a clock type are work-free. When it is a global
+      -- variable, it is probably backed by a clock generator, which is definitely
+      -- not work-free.
+      --
+      -- Inlining let-bindings referencing a global variable with a clock type
+      -- can sometimes lead to the post-normalization flattening stage to generate
+      -- code that violates the invariants of the netlist generation stage.
+      -- Especially when this global binder is defined recursively such as when
+      -- using `tbClockGen`.
+      -- This then ultimately leads to bad verilog names being generated as
+      -- reported in: https://github.com/clash-lang/clash-compiler/issues/2845
+      (Var v, []) -> Just (isLocalId v)
       (Data _, [_dom, Left (stripTicks -> Data _)]) -> Just True -- For Enable True/False
       (Literal _,_) -> Just True
       _ -> Just False
diff --git a/src/Clash/Unique.hs b/src/Clash/Unique.hs
--- a/src/Clash/Unique.hs
+++ b/src/Clash/Unique.hs
@@ -1,12 +1,60 @@
+{-|
+  Copyright   :  (C) 2024, QBayLogic B.V.
+  License     :  BSD2 (see the file LICENSE)
+  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
+-}
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Clash.Unique
   ( Unique
+  , pattern Unique#
+  , Unique#
   , Uniquable (..)
+  , fromGhcUnique
   ) where
 
+import Data.Word (Word64)
+#if MIN_VERSION_ghc(9,8,4)
+import GHC.Word (Word64(W64#))
+import GHC.Exts (Word64#)
+#else
+import GHC.Int (Int(I#))
+import GHC.Exts (Int#)
+#endif
+#if MIN_VERSION_ghc(9,0,0)
+import qualified GHC.Types.Unique as GHC
+#else
+import qualified Unique as GHC
+#endif
+
+#if MIN_VERSION_ghc(9,8,4)
+type Unique = Word64
+type Unique# = Word64#
+
+pattern Unique#
+  :: Unique#
+  -- ^ Type of signal
+  -> Unique
+pattern Unique# u <- W64# u
+  where
+    Unique# u = W64# u
+#else
 type Unique = Int
+type Unique# = Int#
 
+pattern Unique#
+  :: Unique#
+  -- ^ Type of signal
+  -> Unique
+pattern Unique# u <- I# u
+  where
+    Unique# u = I# u
+#endif
+
 class Uniquable a where
   getUnique :: a -> Unique
   setUnique :: a -> Unique -> a
@@ -14,3 +62,12 @@
 instance Uniquable Unique where
   getUnique = id
   setUnique = flip const
+
+#if !MIN_VERSION_ghc(9,8,4)
+instance Uniquable Word64 where
+  getUnique = fromIntegral
+  setUnique _ = fromIntegral
+#endif
+
+fromGhcUnique :: GHC.Unique -> Unique
+fromGhcUnique = GHC.getKey
diff --git a/src/Clash/Util.hs b/src/Clash/Util.hs
--- a/src/Clash/Util.hs
+++ b/src/Clash/Util.hs
@@ -153,9 +153,9 @@
 -- | A class that can generate unique numbers
 class Monad m => MonadUnique m where
   -- | Get a new unique
-  getUniqueM :: m Int
+  getUniqueM :: m Unique
 
-instance Monad m => MonadUnique (StateT Int m) where
+instance Monad m => MonadUnique (StateT Unique m) where
   getUniqueM = do
     supply <- State.get
     State.modify (+1)
diff --git a/src/Clash/Util/Graph.hs b/src/Clash/Util/Graph.hs
--- a/src/Clash/Util/Graph.hs
+++ b/src/Clash/Util/Graph.hs
@@ -6,6 +6,8 @@
   Collection of utilities
 -}
 
+{-# LANGUAGE CPP #-}
+
 module Clash.Util.Graph
   ( topSort
   , reverseTopSort
@@ -14,15 +16,28 @@
 
 import           Data.Tuple            (swap)
 import           Data.Foldable         (foldlM)
+#if MIN_VERSION_ghc(9,8,4)
+import qualified GHC.Data.Word64Map.Strict as IntMap
+import qualified GHC.Data.Word64Set        as IntSet
+#else
+import           Data.IntMap.Strict    (IntMap)
 import qualified Data.IntMap.Strict    as IntMap
+import           Data.IntSet           (IntSet)
 import qualified Data.IntSet           as IntSet
+#endif
 
 import           Clash.Core.Var (Id)
 import           Clash.Core.Term (Term)
 import qualified Clash.Data.UniqMap as UniqMap
 import           Clash.Driver.Types (BindingMap, Binding (bindingTerm))
 import           Clash.Normalize.Util (callGraph)
+import           Clash.Unique (Unique)
 
+#if MIN_VERSION_ghc(9,8,4)
+type IntMap = IntMap.Word64Map
+type IntSet = IntSet.Word64Set
+#endif
+
 data Marker
   = Temporary
   | Permanent
@@ -32,17 +47,17 @@
 headSafe (a:_) = Just a
 
 topSortVisit'
-  :: IntMap.IntMap [Int]
+  :: IntMap [Unique]
   -- ^ Edges
-  -> IntSet.IntSet
+  -> IntSet
   -- ^ Unmarked nodes
-  -> IntMap.IntMap Marker
+  -> IntMap Marker
   -- ^ Marked nodes
-  -> [Int]
+  -> [Unique]
   -- ^ Sorted so far
-  -> Int
+  -> Unique
   -- ^ Node to visit
-  -> Either String (IntSet.IntSet, IntMap.IntMap Marker, [Int])
+  -> Either String (IntSet, IntMap Marker, [Unique])
 topSortVisit' edges unmarked marked sorted node =
   case IntMap.lookup node marked of
     Just Permanent -> Right (unmarked, marked, sorted)
@@ -60,17 +75,17 @@
       topSortVisit' edges unmarked' marked' sorted' node'
 
 topSortVisit
-  :: IntMap.IntMap [Int]
+  :: IntMap [Unique]
   -- ^ Edges
-  -> IntSet.IntSet
+  -> IntSet
   -- ^ Unmarked nodes
-  -> IntMap.IntMap Marker
+  -> IntMap Marker
   -- ^ Marked nodes
-  -> [Int]
+  -> [Unique]
   -- ^ Sorted so far
-  -> Int
+  -> Unique
   -- ^ Node to visit
-  -> Either String (IntSet.IntSet, IntMap.IntMap Marker, [Int])
+  -> Either String (IntSet, IntMap Marker, [Unique])
 topSortVisit edges unmarked marked sorted node = do
   (unmarked', marked', sorted') <-
     topSortVisit' edges unmarked marked sorted node
@@ -83,9 +98,9 @@
 -- errors if edges mention nodes not mentioned in the node list or if the
 -- given graph contains cycles.
 topSort
-  :: [(Int, a)]
+  :: [(Unique, a)]
   -- ^ Nodes
-  -> [(Int, Int)]
+  -> [(Unique, Unique)]
   -- ^ Edges
   -> Either String [a]
   -- ^ Error message or topologically sorted nodes
@@ -128,9 +143,9 @@
 -- Likewise, this function promises __one__ of those lists in reverse, but not
 -- necessarily the reverse of topSort itself.
 reverseTopSort
-  :: [(Int, a)]
+  :: [(Unique, a)]
   -- ^ Nodes
-  -> [(Int, Int)]
+  -> [(Unique, Unique)]
   -- ^ Edges
   -> Either String [a]
   -- ^ Reversely, topologically sorted nodes
diff --git a/src/Clash/Util/Supply.hs b/src/Clash/Util/Supply.hs
new file mode 100644
--- /dev/null
+++ b/src/Clash/Util/Supply.hs
@@ -0,0 +1,158 @@
+{-# LANGUAGE MagicHash, UnboxedTuples, CPP, PatternSynonyms #-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+{-# OPTIONS_GHC -fno-full-laziness #-}
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Clash.Util.Supply
+-- Copyright   :  (C) 2011-2013 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A fast unique identifier supply with local pooling and replay
+-- support.
+--
+-- One often has a desire to generate a bunch of integer identifiers within
+-- a single process that are unique within that process. You could use
+-- UUIDs, but they can be expensive to generate; you don't want to have
+-- your threads contending for a single external counter if the identifier
+-- is not going to be used outside the process.
+--
+-- @concurrent-supply@ builds a tree-like structure which can be split; you
+-- can make smaller unique supplies and then you allocate from your supplies
+-- locally. Internally it pulls from a unique supply one block at a time as
+-- you walk into parts of the tree that haven't been explored.
+--
+----------------------------------------------------------------------------
+module Clash.Util.Supply
+  ( Supply
+  -- * Variables
+  , newSupply
+  , freshId
+  , splitSupply
+  -- * Unboxed API
+  , freshId#
+  , splitSupply#
+  ) where
+
+import Data.Hashable
+import Data.IORef
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 710
+import Data.Functor ((<$>))
+import Data.Monoid
+#endif
+import GHC.IO (unsafeDupablePerformIO, unsafePerformIO)
+
+import Clash.Unique (Unique, Unique#, pattern Unique#)
+
+infixr 5 :-
+data Stream a = a :- Stream a
+
+instance Functor Stream where
+  fmap f (a :- as) = f a :- fmap f as
+
+extract :: Stream a -> a
+extract (a :- _) = a
+
+units :: Stream ()
+units = () :- units
+{-# NOINLINE units #-}
+
+data Block = Block Unique !(Stream Block)
+
+instance Eq Block where
+  Block a (Block b _ :- _) == Block c (Block d _ :- _) = a == c && b == d
+
+instance Ord Block where
+  Block a (Block b _ :- _) `compare` Block c (Block d _ :- _) = compare a c `mappend` compare b d
+
+instance Show Block where
+  showsPrec d (Block a (Block b _ :- _)) = showParen (d >= 10) $
+    showString "Block " . showsPrec 10 a . showString " (Block " . showsPrec 10 b . showString " ... :- ...)"
+
+instance Hashable Block where
+  hashWithSalt s (Block a (Block b _ :- _)) = s `hashWithSalt` a `hashWithSalt` b
+
+blockSize :: Unique
+blockSize = 1024
+{-# INLINE blockSize #-}
+
+-- Minimum size to be worth splitting a supply rather than just CAS'ing twice to avoid multiple subsequent biased splits
+minSplitSupplySize :: Unique
+minSplitSupplySize = 32 -- based on sqrt blockSize
+{-# INLINE minSplitSupplySize #-}
+
+blockCounter :: IORef Unique
+blockCounter = unsafePerformIO (newIORef 0)
+{-# NOINLINE blockCounter #-}
+
+modifyBlock :: a -> IO Unique
+modifyBlock _ = atomicModifyIORef blockCounter $ \ i -> let i' = i + blockSize in i' `seq` (i', i)
+{-# NOINLINE modifyBlock #-}
+
+gen :: a -> Block
+gen x = Block (unsafeDupablePerformIO (modifyBlock x)) (gen <$> units)
+{-# NOINLINE gen #-}
+
+newBlock :: IO Block
+newBlock = return $! gen ()
+{-# NOINLINE newBlock #-}
+
+splitBlock# :: Block -> (# Block, Block #)
+splitBlock# (Block i (x :- xs)) = (# x, Block i xs #)
+{-# INLINE splitBlock# #-}
+
+-- | A user managed globally unique variable supply.
+data Supply = Supply {-# UNPACK #-} !Unique {-# UNPACK #-} !Unique Block
+  deriving (Eq,Ord,Show)
+
+instance Hashable Supply where
+  hashWithSalt s (Supply i j b) = s `hashWithSalt` i `hashWithSalt` j `hashWithSalt` b
+
+blockSupply :: Block -> Supply
+blockSupply (Block i bs) = Supply i (i + blockSize - 1) (extract bs)
+{-# INLINE blockSupply #-}
+
+-- | Grab a new supply. Any two supplies obtained with newSupply are guaranteed to return
+-- disjoint sets of identifiers. Replaying the same sequence of operations on the same
+-- Supply will yield the same results.
+newSupply :: IO Supply
+newSupply = blockSupply <$> newBlock
+{-# INLINE newSupply #-}
+
+-- | Obtain a fresh Id from a Supply.
+freshId :: Supply -> (Unique, Supply)
+freshId s = case freshId# s of
+  (# i, s' #) -> (Unique# i, s')
+{-# INLINE freshId #-}
+
+-- | Split a supply into two supplies that will return disjoint identifiers
+splitSupply :: Supply -> (Supply, Supply)
+splitSupply s = case splitSupply# s of
+  (# l, r #) -> (l, r)
+{-# INLINE splitSupply #-}
+
+-- | An unboxed version of freshId
+freshId# :: Supply -> (# Unique#, Supply #)
+freshId# (Supply i@(Unique# i#) j b)
+  | i /= j = (# i#, Supply (i + 1) j b #)
+  | otherwise = (# i#, blockSupply b #)
+{-# INLINE freshId# #-}
+
+-- | An unboxed version of splitSupply
+splitSupply# :: Supply -> (# Supply, Supply #)
+splitSupply# (Supply i k b) = case splitBlock# b of
+    (# bl, br #)
+      | k - i >= minSplitSupplySize
+      , j <- i + div (k - i) 2 ->
+        (# Supply i j bl, Supply (j + 1) k br #)
+      | Block x (l :- r :- _) <- bl
+      , y <- x + div blockSize 2
+      , z <- x + blockSize - 1 ->
+        (# Supply x (y - 1) l, Supply y z r #)
+{-# INLINE splitSupply# #-}
diff --git a/src/Data/Aeson/Extra.hs b/src/Data/Aeson/Extra.hs
--- a/src/Data/Aeson/Extra.hs
+++ b/src/Data/Aeson/Extra.hs
@@ -1,5 +1,6 @@
 {-|
   Copyright   :  (C) 2015-2016, University of Twente
+                     2024, QBayLogic B.V.
   License     :  BSD2 (see the file LICENSE)
   Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>
 -}
@@ -23,7 +24,12 @@
 import           Data.Text.Encoding.Error (UnicodeException(..))
 import           Data.List            (intercalate)
 import           Data.List.NonEmpty   (NonEmpty (..))
+#if MIN_VERSION_base(4,20,0)
+import qualified Data.List.NonEmpty   as NE hiding (unzip)
+import qualified Data.Functor         as NE
+#else
 import qualified Data.List.NonEmpty   as NE
+#endif
 import           Data.Tuple.Extra     (second, first)
 import           Data.Aeson           (FromJSON, Result (..), fromJSON)
 import           Data.Aeson.Parser    (json)
diff --git a/src/Data/List/Extra.hs b/src/Data/List/Extra.hs
--- a/src/Data/List/Extra.hs
+++ b/src/Data/List/Extra.hs
@@ -4,6 +4,7 @@
 module Data.List.Extra
   ( partitionM
   , mapAccumLM
+  , mapAccumRM
   , iterateNM
   , (<:>)
   , indexMaybe
@@ -45,6 +46,19 @@
   (acc',y) <- f acc x
   (acc'',ys) <- mapAccumLM f acc' xs
   return (acc'',y:ys)
+
+-- | Monadic version of 'Data.List.mapAccumR'
+mapAccumRM
+  :: Monad m
+  => (acc -> x -> m (acc,y))
+  -> acc
+  -> [x]
+  -> m (acc,[y])
+mapAccumRM _ acc [] = return (acc,[])
+mapAccumRM f acc (x:xs) = do
+  (acc1,ys) <- mapAccumRM f acc xs
+  (acc2,y) <- f acc1 x
+  return (acc2,y:ys)
 
 -- | Monadic version of 'iterate'. A carbon copy ('iterateM') would not
 -- terminate, hence the first argument.
diff --git a/tests/Clash/Tests/Core/Subst.hs b/tests/Clash/Tests/Core/Subst.hs
--- a/tests/Clash/Tests/Core/Subst.hs
+++ b/tests/Clash/Tests/Core/Subst.hs
@@ -18,6 +18,7 @@
 import           Clash.Core.Subst
 import           Clash.Core.VarEnv
 import           Clash.Core.Var          (IdScope(..), Var(..))
+import           Clash.Unique            (Unique)
 
 fakeName :: Name a
 fakeName =
@@ -28,7 +29,7 @@
     , nameLoc=noSrcSpan
     }
 
-unique :: Int
+unique :: Unique
 unique = 20
 
 termVar :: Var Term
diff --git a/tests/Test/Clash/Rewrite.hs b/tests/Test/Clash/Rewrite.hs
--- a/tests/Test/Clash/Rewrite.hs
+++ b/tests/Test/Clash/Rewrite.hs
@@ -27,9 +27,10 @@
 import Clash.Rewrite.Util (runRewrite)
 import Clash.Normalize.Types
 import qualified Clash.Util.Interpolate as I
+import Clash.Util.Supply (newSupply)
+import Clash.Unique (Unique)
 
 import Control.Applicative ((<|>))
-import Control.Concurrent.Supply (newSupply)
 import Data.Default
 import Language.Haskell.Exts.Syntax
 import Language.Haskell.Exts.Parser (parseExp, fromParseResult)
@@ -46,9 +47,9 @@
 import qualified Data.IntMap as IntMap
 import qualified Data.Text as Text
 
-type TypeMap = HashMap.HashMap Int C.Type
+type TypeMap = HashMap.HashMap Unique C.Type
 
-lookupTM :: Int -> TypeMap -> C.Type
+lookupTM :: Unique -> TypeMap -> C.Type
 lookupTM u tm = case HashMap.lookup u tm of
   Just t -> t
   Nothing ->
@@ -217,7 +218,7 @@
     e ->
       error ("parseOtherDecl: " <> show e)
 
-  parseTypeDecl :: Decl l -> [(Int, C.Type)]
+  parseTypeDecl :: Decl l -> [(Unique, C.Type)]
   parseTypeDecl (TypeSig _ nms t) =
     map (\nm -> (C.nameUniq (parseName nm), parseType t)) nms
   parseTypeDecl _ = error "impossible"
diff --git a/tools/v16-upgrade-primitives.hs b/tools/v16-upgrade-primitives.hs
--- a/tools/v16-upgrade-primitives.hs
+++ b/tools/v16-upgrade-primitives.hs
@@ -9,8 +9,9 @@
 
 #if MIN_VERSION_aeson(2,0,0)
 import qualified Data.Aeson.KeyMap as Aeson
-import Data.ByteString.Lazy.Search (replace)
 import Data.String (IsString)
+import qualified Data.Text.Lazy as LazyText
+import qualified Data.Text.Lazy.Encoding as LazyText
 #endif
 
 import qualified Data.Aeson.Extra as AesonExtra
@@ -89,9 +90,10 @@
       Just val -> Aeson.insert kNew val (Aeson.delete kOld obj)
 
 removeTempKey :: ByteString -> ByteString
-removeTempKey inp = foldl go inp keySortingRenames
+removeTempKey inp =
+  LazyText.encodeUtf8 (foldl go (LazyText.decodeUtf8 inp) keySortingRenames)
  where
-  go bs (orig,temp) = replace (ByteString.toStrict temp) orig bs
+  go txt (orig,temp) = LazyText.replace temp orig txt
 #else
 -- < aeson-2.0 stores keys in HashMaps, whose order we can't possibly predict.
 removeTempKey :: ByteString -> ByteString