<div dir="ltr">When I write a function with the type constraint "embedded" in the function's type declaration, instead of at the beginning, the function takes longer each time it is run. The simplest example I could write is this: <a href="http://lpaste.net/134563" target="_blank">http://lpaste.net/134563</a>. "run1" is near instantaneous the first time, but gets marginally slower after each iteration... after thousands of iterations it takes about a millisecond to run (and keeps getting worse). "run2" is always near instantaneous. What is happening in "run1" that makes it slow down?<div><br></div><div>PS: The example is fairly contrived, I know "run1"'s type declaration wouldn't be used in practice.</div><div><br></div><div>Thanks for any guidance!<br><div><br></div><div><div>{-# LANGUAGE RankNTypes #-}</div><div>{-# LANGUAGE FlexibleContexts #-}</div><div><br></div><div>module Main where</div><div><br></div><div>import Control.Monad.State.Strict</div><div>import qualified Data.Time.Clock as Clock</div><div>import Control.Exception</div><div><br></div><div>run1 :: (Int -> (Num Int => State Int Bool)) -> Int -> IO ()</div><div>run1 f state = do</div><div>    t1 <- Clock.getCurrentTime</div><div>    evaluate $ runState (f 1) state</div><div>    t2 <- Clock.getCurrentTime</div><div>    print $ Clock.diffUTCTime t2 t1</div><div>    run1 f state</div><div><br></div><div>run2 :: Num s => (Int -> State s Bool) -> s -> IO ()</div><div>run2 f state = do</div><div>    t1 <- Clock.getCurrentTime</div><div>    evaluate $ runState (f 1) state</div><div>    t2 <- Clock.getCurrentTime</div><div>    print $ Clock.diffUTCTime t2 t1</div><div>    run2 f state</div><div><br></div><div>main :: IO ()</div><div>main = run1 (const $ return False) 1</div><div>--main = run2 (const $ return False) 1</div></div><div><br></div></div></div>