Loop unrolling, Haskell style

We'd written digitsIn' to allow tail call optimization, so that the recursive call gets compiled as a loop:

digitsIn base n = digitsIn' n 1
    where digitsIn' n count
            | n < base  = count
            | otherwise = digitsIn' (n `div` base) (count + 1)

This does remind me of a blog post that Hacker News pointed at, in which another operation was being done in Haskell a digit at a time. The solution there, as here, is something kind of like loop unrolling:

digitsIn base n = digitsIn' n 1
    where base2 = base * base
          base4 = base2 * base2
          digitsIn' n count
            | n < base  = count
            | n > base4 = digitsIn' (n `div` base4) (count + 4)
            | n > base2 = digitsIn' (n `div` base2) (count + 2)
            | otherwise = digitsIn' (n `div` base)  (count + 1)

And the results:

real    0m0.679s
user    0m0.656s
sys     0m0.020s

From the profiler:

COST CENTRE                MODULE  %time %alloc

numWithin                  Main     31.6    7.0
solve                      Main     21.0   34.6
backwards.backwards'       Main     14.7   17.1
backwards.backwards'.(...) Main      9.0   12.9
choices                    Main      5.5   10.8
nDigitYs                   Main      4.8    5.7
digitsIn.digitsIn'         Main      4.5    4.8
oddDigitsPals              Main      1.3    1.8
noTwos                     Main      1.1    1.3
tenToThe                   Main      1.1    0.0
digitsIn                   Main      1.1    0.0
floorSqrt.floorSqrt'.y     Main      0.7    1.2

digitsIn' is down from almost 15% of the time to 4.5%, and from a sixth of the allocation to under a twentieth. We've gotten closer to the runtime of the C++ solution I grabbed and compiled, going from taking not quite twice as long to not quite 1.7 times as long. There ought to be a way to similarly speed up backwards'. (And what's up with solve?)

I'm really procrastinating on that data structure change, huh?