<html>
<head>
<meta content="text/html; charset=windows-1252"
http-equiv="Content-Type">
</head>
<body bgcolor="#FFFFFF" text="#000000">
Hello<br>
<br>
I have no idea why this happens but GHC eta expands before passing
it to the recursive case. i.e.<br>
<br>
run1 f state <br>
<br>
de-sugars to<br>
<br>
run1 (\a dictNum -> f a dictNum) state<br>
<br>
So it allocates a new closure each time. The time increases as each
time f is called we must descend through the stack of closure. As to
why this happens I have no idea but as it is there after de-sugaring
I presume it has something to so with passing dictionaries.<br>
<br>
Alex<br>
<br>
<div class="moz-cite-prefix">On 15/06/15 23:38, Ben Gunton wrote:<br>
</div>
<blockquote
cite="mid:CADOkYs5Jdk4BpaPrVpeL1bmBZgknx8=qTHrtApXy_VJkghNuVA@mail.gmail.com"
type="cite">
<meta http-equiv="Context-Type" content="text/html; charset=UTF-8">
<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
moz-do-not-send="true" 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>
<br>
<fieldset class="mimeAttachmentHeader"></fieldset>
<br>
<pre wrap="">_______________________________________________
Haskell-Cafe mailing list
<a class="moz-txt-link-abbreviated" href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a>
<a class="moz-txt-link-freetext" href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a>
</pre>
</blockquote>
<br>
</body>
</html>