see https://lobste.rs/s/xf6yfw/calculating_integer_factorials_in_constant_time_taking_advantage_of_overflow_behavior/comments/jnzup5#c_jnzup5

Collatz.hs

{-# LANGUAGE BangPatterns #-}
module Collatz where

-- thing I want to know: what's the smallest (n) such that a naive C
-- implementation of "iterate the Collatz function until I get to 1" with
-- fixed-size integers will encounter an integer overflow
-- the below is terrible and contains multiple implementations because I kept
-- trying to make it go faster.

import Data.Word

treeN_bound :: Integer -> Word64
treeN_bound z = fromInteger ((2^z-2) `div` 3)

col_past4_start :: Integer -> Integer -> Integer
col_past4_start z start = toInteger . head . dropWhile (\i -> not $ col_bound wend i i) $ [wstart..wend] where
  wend = treeN_bound z
  wstart = fromInteger start :: Word64
  col_bound big small 1 = False
  col_bound big small n | n < small      = False
  col_bound big small n | n `mod` 2 == 0 = col_bound big small (n `div` 2)
  col_bound big small n | n >= big       = True
  col_bound big small n | otherwise      = col_bound big small (3*n + 1)

col_past4 :: Integer -> Integer
col_past4 z = toInteger . head . dropWhile (not . col_bound (treeN_bound z)) $ [(1::Word64)..] where
  col_bound big 1 = False
  col_bound big n | n `mod` 2 == 0 = col_bound big (n `div` 2)
  col_bound big n | n >= big       = True
  col_bound big n | otherwise      = col_bound big (3*n + 1)

col_past3 :: Integer -> Integer
col_past3 z = head . dropWhile (not . col_bound (2^z-1)) $ [1..] where
  col_bound big 1 = False
  col_bound big n | n > big = True
  col_bound big n | n `mod` 2 == 0 = col_bound big (n `div` 2)
  col_bound big n | otherwise      = col_bound big (3*n + 1)

collatz f !a 1 = a
collatz f !a n | n `mod` 2 == 0 = collatz f (f a n) (n `div` 2)
collatz f !a n | otherwise      = collatz f (f a n) (3*n + 1)

collatzBound :: Integer -> Integer
collatzBound = collatz max 0

collatzPath :: Integer -> [Integer]
collatzPath = reverse . collatz (flip (:)) []

col_past2 :: Integer -> Integer
col_past2 z = head . dropWhile ((2^z-1 >) . collatzBound) $ [1..]

col_too_big :: Integer -> Integer -> Bool
col_too_big z n = colk cont n where
  cont 1 k = False
  cont n k = if n > z then True else k n 

col_past :: Integer -> Integer
col_past z = head . dropWhile (not . col_too_big (2^z-1)) $ [1..]

col_list :: Integer -> [Integer]
col_list n = colk cont n where
  cont 1 k = []
  cont n k = n : k n

colk :: (Integer -> (Integer -> t) -> t) -> (Integer -> t)
colk k n | n `mod` 2 == 0 = k (n `div` 2) (colk k)
colk k n | otherwise      = k (3*n + 1) (colk k)

-- main = interact (unlines . map (\s ->
--    show . head .
--    dropWhile (not . col_too_big (2^(read s)-1)) $ [1..]) . lines)

showAround f n = "f(" ++ show n ++ ") = " ++ show (f n)

-- main = putStrLn . unlines . map (showAround col_past4) $ [1..64]

{-
f(4) = 3
f(5) = 7
f(6) = 15
f(7) = 15
f(8) = 27
f(9) = 27
f(10) = 27
f(11) = 27
f(12) = 27
f(13) = 27
f(14) = 447
f(15) = 447
f(16) = 703
f(17) = 703
f(18) = 1819
f(19) = 1819
f(20) = 1819
f(21) = 4255
f(22) = 4255
f(23) = 9663
f(24) = 9663
f(25) = 20895
f(26) = 26623
f(27) = 60975
f(28) = 60975
f(29) = 60975
f(30) = 77671
f(31) = 113383
f(32) = 159487
f(33) = 159487
f(34) = 159487
f(35) = 665215
f(36) = 1042431
f(37) = 1212415
f(38) = 2684647
f(39) = 3041127
f(40) = 4637979
f(41) = 5656191
f(42) = 6416623
f(43) = 6631675
f(44) = 6631675
f(45) = 6631675
f(46) = 19638399
f(47) = 19638399
f(48) = 19638399
f(49) = 80049391
f(50) = 80049391
f(51) = 120080895
f(52) = 210964383
f(53) = 319804831
f(54) = 319804831
f(55) = 319804831
f(56) = 319804831
f(57) = 319804831
f(58) = 319804831
f(59) = 319804831
f(60) = 319804831
f(61) = 1410123943
f(62) = 1410123943
f(63) = 8528817511
f(64) = 12327829503
-}

main = cols [4..64] 1 where
  cols []     _     = return ()
  cols (i:is) start = do
    let start' = col_past4_start i start
    putStrLn $ "f(" ++ show i ++ ") = " ++ show (start')
    cols is start'