FIXED: Reduce constants to NF before specialisation [#3129](#3129) (#3130)

(cherry picked from commit 2ad5b61)

# Conflicts:
#	clash-lib/src/Clash/Normalize/Transformations/Specialize.hs

Author: rowanG077

changelog/2026-01-29T18_10_05+01_00_fix_3129

@@ -0,0 +1 @@
+FIXED: Reduce constants to NF before specialization [#3129](https://github.com/clash-lang/clash-compiler/issues/3129)

clash-lib/src/Clash/Normalize/Transformations/Specialize.hs

@@ -2,7 +2,7 @@
   Copyright  :  (C) 2012-2016, University of Twente,
                     2016-2017, Myrtle Software Ltd,
                     2017-2018, Google Inc.,
-                    2021-2023, QBayLogic B.V.
+                    2021-2026, QBayLogic B.V.
   License    :  BSD2 (see the file LICENSE)
   Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 
@@ -90,7 +90,7 @@ import Clash.Rewrite.Types
   , typeTranslator, workFreeBinders, debugOpts, topEntities, specializationLimit)
 import Clash.Rewrite.Util
   ( mkBinderFor, mkDerivedName, mkFunction, mkTmBinderFor, setChanged, changed
-  , normalizeTermTypes, normalizeId)
+  , normalizeTermTypes, normalizeId, whnfRW)
 import Clash.Rewrite.WorkFree (isWorkFree)
 import Clash.Normalize.Types
   ( NormRewrite, NormalizeSession, specialisationCache, specialisationHistory)
@@ -293,9 +293,17 @@ constantSpec ctx@(TransformContext is0 tfCtx) e@(App e1 e2)
   = do specInfo<- constantSpecInfo ctx e2
        if csrFoundConstant specInfo then
          let newBindings = csrNewBindings specInfo in
-         if null newBindings then
-           -- Whole of e2 is constant
-           specialize ctx (App e1 e2)
+         if null newBindings then do
+           -- Whole of e2 is constant, we reduce it here eagerly before specialization
+           -- because we have observed long running compile times when having
+           -- recursively defined constants, see:
+           -- https://github.com/clash-lang/clash-compiler/issues/3129
+            e2Red <- case collectArgs e2 of
+                           (Prim p0, _) -> whnfRW False ctx e2 $ \_ctx1 e2Red -> case e2Red of
+                             (collectArgs -> (Prim p1, _)) | primName p0 == primName p1 -> return e2
+                             _ -> changed e2Red
+                           _ -> return e2
+            specialize ctx (App e1 e2Red)
          else do
            -- Parts of e2 are constant
            let is1 = extendInScopeSetList is0 (fst <$> csrNewBindings specInfo)

tests/Main.hs

@@ -1137,6 +1137,7 @@ runClashTest = defaultMain
         , outputTest "PortNamesWithRTree" def{hdlTargets=[Verilog]}
         , clashLibTest "T1182A" def
         , clashLibTest "T1182B" def
+        , runTest "T3129" def{hdlSim=[], clashFlags=["-fclash-spec-limit=400"]}
         ]
       , clashTestGroup "Unit"
         [ runTest "Imap" def

tests/shouldwork/TopEntity/T3129.hs

@@ -0,0 +1,33 @@
+module T3129 where
+
+import Clash.Prelude
+
+import GHC.Base        (isTrue#)
+import GHC.Num.Natural (Natural (NS), naturalLogBase#)
+import GHC.Prim        (eqWord#, plusWord#)
+
+naturalCLogBase :: Natural -> Natural -> Natural
+naturalCLogBase x y =
+             let z1 = naturalLogBase# x y
+                 z2 = naturalLogBase# x (y-1)
+             in  case y of
+                    1 -> 0
+                    _ | isTrue# (z1 `eqWord#` z2) -> NS (z1 `plusWord#` 1##)
+                      | otherwise                 -> NS z1
+
+f :: Natural -> Natural
+f m = 2 * (naturalCLogBase 2 m)
+
+g :: Natural -> Natural
+g m =
+  let i = f m
+      calc 0 _   _   = 1
+      calc 1 val tmp = (val * tmp) `mod` m
+      calc n val tmp = calc
+          (if n `mod` 2 == 0 then n `div` 2         else n - 1              )
+          (if n `mod` 2 == 0 then val * val `mod` m else val                )
+          (if n `mod` 2 == 0 then tmp `mod` m       else (tmp * val) `mod` m)
+   in calc (m - i - 1) 2 1
+
+topEntity :: Natural
+topEntity = g 0xffffffff00000001000000000000000000000000ffffffffffffffffffffffff