Clash takes a long time to compile a recursively defined constant.

[christiaanb]

The following:

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

Seems to take forever when compiling with:

cabal run clash -- --vhdl -fclash-spec-limit=400 T3129.hs

It seems to specialize on an ever growing argument (in terms of AST).

With the following quick hack:

--- a/clash-lib/src/Clash/Normalize/Transformations/Specialize.hs
+++ b/clash-lib/src/Clash/Normalize/Transformations/Specialize.hs
@@ -87,7 +87,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)
@@ -290,9 +290,14 @@ 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
+         if null newBindings then do
            -- Whole of e2 is constant
-           specialize ctx (App e1 e2)
+           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)

It compiles in an okay time:

$ cabal run clash -- --vhdl -fclash-spec-limit=400 T3129.hs -fclash-no-cache -fclash-clear -fforce-recomp
Loaded package environment from /home/christiaan/devel/clash-compiler/.ghc.environment.x86_64-linux-9.10.3
GHC: Setting up GHC took: 0.084s
GHC: Compiling and loading modules took: 0.258s
Clash: Parsing and compiling primitives took 0.152s
GHC+Clash: Loading modules cumulatively took 0.572s
Clash: Ignoring previously made caches
Clash: Compiling T3129.topEntity
Clash: Normalization took 0.278s
Clash: Netlist generation took 0.000s
Clash: Compiling T3129.topEntity took 0.286s
Clash: Total compilation took 0.859s