leaky (empty) → 0.1.0.0
raw patch · 23 files changed
+3591/−0 lines, 23 filesdep +basedep +deepseq-boundeddep +deepseq-genericssetup-changed
Dependencies added: base, deepseq-bounded, deepseq-generics, generics-sop, ghc-prim, random, seqaid, template-haskell
Files
- HTML/index.html +17/−0
- HTML/leaky.html +498/−0
- HTML/output.html +91/−0
- HTML/style.css +27/−0
- LICENSE +30/−0
- README +77/−0
- Setup.hs +2/−0
- Types.hs +111/−0
- Types_explicit_SOP.hs +173/−0
- Types_min.hs +14/−0
- Types_no_SOP.hs +111/−0
- leaky-full-incl-types.hs +654/−0
- leaky-full.hs +594/−0
- leaky-min-cppd-working.hs +33/−0
- leaky-min-cppd.hs +21/−0
- leaky-min.hs +164/−0
- leaky.cabal +311/−0
- leaky.hs +594/−0
- rough-fs-twiddling-guide.txt +37/−0
- seqaid.config +5/−0
- seqaid.config-full +5/−0
- seqaid.config-full-incl-types +10/−0
- seqaid.config-min +12/−0
+ HTML/index.html view
@@ -0,0 +1,17 @@+<!DOCTYPE html>+<html>+<head>+<title>Leaky: Minimal robust Haskell space leak</title>+<link rel="stylesheet" href="style.css" />+</head>+<body>++<div style="color: #F33; margin-top: 40px; font-size: 16pt;">+(Notes to self.)+</div>++<script>document.location = "leaky.html";</script>++</body>+</html>+
+ HTML/leaky.html view
@@ -0,0 +1,498 @@+<!DOCTYPE html>+<html>+<head>+<title>Leaky: Minimal robust Haskell space leak</title>+<link rel="stylesheet" href="style.css" />+</head>+<body>++<div class="main">++<a id="r1"></a>+<!--h3>Space Leak : A Haskell Sore Spot</h3-->+<h2 style="margin-top: 50px; margin-bottom: 10px;">Space Leak</h2>+<h3 style="margin-top: 12px; color: #666;">A Haskell Sore Spot</h3>++When a program retains memory longer than the programmer expects,<br />+it is said to <span><em>leak space</em>. <a href="#1">[1]</a></span>++<p>++<!-- http://neilmitchell.blogspot.ca/2013/11/acm-article-leaking-space.html -->+Quoting from Neil Mitchell's 2013 <a href="http://queue.acm.org/detail.cfm?id=2538488">article</a> in <em>ACM Queue</em>:++<p>+<em style="display: block; margin-left: 15px; margin-right: 100px;">+"[Writers of] compilers for lazy functional languages have been dealing with space leaks for more than 30 years and have developed a number of strategies to help.+...+Despite all the improvements, space leaks remain a thorn in the side of lazy evaluation, producing a significant disadvantage to weigh against the benefits."+<p>+"Pinpointing space leaks is a skill that takes practice and perseverance. Better tools could significantly simplify the process."+</em>++<p>++<a id="r2"></a>+The Haskell applications programmer is well aware that space leak poses a significant impediment to <span>development. <a href="#2">[2]</a></span>+In fact, any large Haskell program, even carefully coded by skilled programmers, will typically exhibit space leak compounded of multiple causes.+The most serious cases are catastrophic, requiring urgent measures for development and testing to proceed.+Such dire leaks can arise several times per week.++<p>++<a id="r3"></a>+All space leak degrades performance, and production-quality programs should eradicate as much leak behaviour as <span>possible. <a href="#3">[3]</a></span>+Difficulty ranges from distracting (minutes) to formidable (days, or worse).+This steers development resources away from the application domain, forcing one to resort to bag-of-tricks hackery in attempting to isolate and resolve the more serious leaks as they arise.+Understanding what's going on requires thinking about memory at a low level, and the abstractions involved are more complex than traditional block allocation.+For space leak debugging, the current best practises constitute a black art.+Leak behaviour is also extremely sensitive to build configuration (compiler version, and flags such as optimisation level).++<p>++<a id="r4"></a>+The problem stems from the lazy evaluation model of <span>Haskell <a href="#4">[4]</a></span>+which has been discussed at length elsewhere (see <a href="#Related">Related</a>).++<p>++<h3>What can we do?</h3>++This situation seems pretty hopeless. Can anything be done?++<p>++Of course! We can keep studying the phenomenon:++<ul>+<li>programming practise evolves as leaky coding patterns are recognised+<li>compilers get better at optimising leak away+<li>diagnostic and remedial tool support improves (for instance <a href="http://hackage.haskell.org/package/seqaid">seqaid</a>)+</ul>++There is also a wealth of blog posts online concerning space leak and related topics.+The examples you find may not leak with current compilers, but the principles of <em>demand</em>, <em>strictness</em> and <em>forcing</em> are still worth understanding: Space leak always arises in the development of real Haskell applications.++<h3>I heard Haskell will be strict-by-default in future...</h3>++Nah. ;) But if it were, you'd then have complementary problems, of overly strict code hurting performance.+Making the language implicitly strict is not a panacea (though a pragma to that effect would be welcome; also consider <a href="http://hackage.haskell.org/package/strict-ghc-plugin">strict-ghc-plugin</a> and <a href="http://hackage.haskell.org/package/seqaid">seqaid</a>).++<p>++<a id="r5"></a>+We will prevail against space leak, and all such things, without forfeiting lazy semantics;+through an improved understanding of demand, strictness, and evaluation.+The optimal solution will often be a complex fusion of lazy and strict.+As better tools emerge, these judgements will be automated, meaning less disruption to your development objectives.+You'll enjoy more sustained attention on your domain of <span>interest! <a href="#5">[5]</a></span>++<h3>Show me a simple example of a program that leaks</h3>++The <a href="http://hackage.haskell.org/package/leaky">leaky</a> package contains a small Haskell 98 program known to leak even with -O2 optimisation under GHC 7.8.3.+It also contains build flavours which test some new tools (<a href="http://hackage.haskell.org/package/deepseq-bounded">deepseq-bounded</a> and <a href="http://hackage.haskell.org/package/seqaid">seqaid</a>). +Installing <tt>seqaid</tt> and running <tt>seqaid demo</tt> is a good way to get started experimenting with <tt>leaky</tt>.+<!--Installing <a href="http://hackage.haskell.org/package/seqaid">seqaid</a> and running <tt>seqaid demo</tt> is a good way to get started experimenting with <a href="http://hackage.haskell.org/package/leaky">leaky</a>.-->++<!--+<p>+<div style="margin-top: -24px;"><a id="dig02s" class="dig-toggle-show" style="margin-left: 20px; border-top: 0px; margin-top: 6px; margin-bottom: 6px;" href='javascript:toggle("dig02");'>Show</a></div>+<div id="dig02" class="digression" style="margin-left: 20px; border-top: 0px; margin-top: 6px; margin-bottom: 12px;">+<a id="dig02h" class="dig-toggle-hide" href='javascript:toggle("dig02");'>Hide</a><p>+ !--div style="font-size: 12pt; margin: 45px 20% 35px 20px;"-- +The purpose of this wiki page is to help ensure that a space leak example which actually leaks is always available.+The maintainer of the <a href="http://hackage.haskell.org/package/leaky">leaky</a> package is committed to its good upkeep, so a working example leak should always be there, based on the most current information collected here.+<p>+If you have any comments, or information relating to the behaviour of this code under Haskell implementations other than GHC, please feel free to add to this page.+General discussion is on the <a href="">talk page</a> for this article.+Deletions from the page should first be discussed there.+</div>+-->+<p>+<a id="r6"></a>+<!--+The code that follows on this page is community edited, so may differ from the hackage repository.+-->+As new GHC releases come out, there may be some lag in case the upgraded compiler automatically optimises the leak out of <tt>leaky</tt>.+This is a natural progress, and reflects the importance of the space leak <span>problem. <a href="#6">[6]</a></span>++<p>++<div style="margin-top: 20px;">+<!--a href="code.html" style="margin-left: 30px;">leaky-min-cppd.hs</a-->+<pre style="width: 800px;">++ -- This leaks with GHC 7.8.3 -O2, strict field notwithstanding.++ duration = 5000000 -- XXX tune for your hardware+ period = duration `div` 10++ data State = St !Bool+ toggle (St b) = St (not b)++ main = do+ putStrLn "Leaky started."+ rslt <- duty (St False) 0+ (return $! rslt) >>= return+ putStrLn "Finished."++ duty :: State -> Int -> IO State+ duty state i = do+ let state' = toggle state+ if 0 == i `mod` period then return () else return ()+ if i < duration then duty state' (1+i) else return state'++</pre>+</div>++<p>+And <a href="leaky-min.hs">leaky-min.hs</a> is the same program with some extras to tinker with.++<p>+<a id="dig01s" class="dig-toggle-show" href='javascript:toggle("dig01");'>Show</a>+<div id="dig01" class="digression">+<a id="dig01h" class="dig-toggle-hide" href='javascript:toggle("dig01");'>Hide</a><p>+<!--div style="margin-top: 20px;"-->+<!--a href="code.html" style="margin-left: 30px;">leaky-min.hs</a-->+<pre style="width: 800px;">++-------------------------------------------------------------------------------++-- So, with the following configuration, -O2 is smart enough+-- to produce the correct Bool output, without seeming to+-- do any work. (But not with -O0 or even with -O.)+--- #define STATS 0+--- #define NO_PERIODIC_BRANCH 1+--- #define STRICT_FIELDS 1+--+-- In fact, -O0, -O and -O2 all have distinct behaviour:+-- -O2 returns the result "instantly"+-- -O returns the result in a second or two+-- -O0 returns only after a long run++-------------------------------------------------------------------------------++ {-# LANGUAGE CPP #-} -- (or run cpp manually if need be)++-------------------------------------------------------------------------------++-- Whether to run getStats computation (and output status lines).+-- Note that when STATS is 1, this constitutes a forcing factor:+-- Strictness is a bit like QM that way...+#define STATS 1++-- If you explicitly performGC at the start of each getStats, you+-- get a more regular sequence of status lines; but you are also+-- tampering with the natural behaviour of the garbage collector.+#define PERFORM_GC 1++-- This switch is offered because, only when set, is there a+-- difference between -O and -O2 evident. (-O0 differs in any case.)+-- And only when un-set will this program leak at -O2.+-- (Only applicable when STATS is 0.)+#define NO_PERIODIC_BRANCH 0++-- This leak is not plugged by strict fields!+-- (In the case of STATS 0 and NO_PERIODIC_BRANCH 1, the leak is+-- not manifest with -O2, but this is not due to the strict field.)+#define STRICT_FIELDS 1++-- Superfluous I guess.+#define RECORD_SYNTAX 0++-------------------------------------------------------------------------------++#if STATS+-- XXX This doesn't work!+-- Please GHC-compile with -rtsopts -with-rtsopts=-s -with-rtsopts=-T+-- (-s not -T are independent; nice to see -s summary info.)+ {-# OPTIONS_GHC -rtsopts #-}+ {- OPTIONS_GHC -with-rtsopts=-s #-}+ {-# OPTIONS_GHC -with-rtsopts=-T #-}+#endif++-------------------------------------------------------------------------------++ import Control.Exception ( evaluate ) -- (\x -> (return $! x) >>= return)++ import GHC.Stats+ import GHC.Int ( Int64 )+ import System.Mem ( performGC )++-------------------------------------------------------------------------------++ duration = 5000000 -- XXX tune for your hardware++ report_period = duration `div` 10+--report_period = 500000 -- GHC 7.8.3 -O2 is two smart (when STATS=0)++-------------------------------------------------------------------------------++#if RECORD_SYNTAX+#if STRICT_FIELDS+ data State = St { st :: !Bool }+#else+ data State = St { st :: Bool }+#endif+#else+#if STRICT_FIELDS+ data State = St !Bool+#else+ data State = St Bool+#endif+#endif++ toggle (St b) = St (not b)++-------------------------------------------------------------------------------++ main = do++ putStrLn "Leaky started."+#if STATS+ putStrLn $ "\n" ++ pad "live heap" ++ " " ++ pad "just alloc'd"+#endif++ rslt <- duty (St False) 0 0+ evaluate rslt++ putStrLn "\nFinished."++-------------------------------------------------------------------------------++ duty :: State -> Int -> Int64 -> IO State+ duty state i last_total_bytes_allocated = do++#if RECORD_SYNTAX+ let state' = state { st = not (st state) }+#else+ let state' = toggle state+-- let state' = (\(St b)->St (not b)) state+-- let state' = let St b = state in St (not b)+#endif++#if STATS+ new_total_bytes_allocated+ <- if 0 == i `mod` report_period+ then do+#if PERFORM_GC+ performGC+#endif+ stats <- getGCStats+ let bytes = bytesAllocated stats+ putStrLn $ pad (show (currentBytesUsed stats)) ++ " "+ ++ pad (show (bytes - last_total_bytes_allocated))+ return $ bytesAllocated stats+ else return last_total_bytes_allocated+#else+ let new_total_bytes_allocated = last_total_bytes_allocated+#if ! NO_PERIODIC_BRANCH+ if 0 == i `mod` report_period+-- if 0 == i `mod` 2 -- GHC 7.8.3 -O2 is two smart+ then do+-- putStrLn "." -- unnecessary+ return ()+ else return ()+#endif+#endif++ if i < duration+ then duty state' (1+i) new_total_bytes_allocated+ else return state'++-------------------------------------------------------------------------------++ pad :: String -> String+ pad s = (take (15 - length s) $ repeat ' ') ++ s++-------------------------------------------------------------------------------++</pre>+</div>++<h3>Explanation of Output</h3>++If you actually build the <tt>leaky</tt> package with Cabal, the version built is further elaborated, and demonstrates <tt>seqaid</tt>.+The output is <a href="output.html">discussed here</a>.++<!--+<h3>Formal distinction between memory leak and space leak?</h3>++<p>+Space leak is not really well-differentiated from the better known <em>memory leak</em> phenomenon, common across all substantial programs such as web browsers.+Any attempt to pin down a difference seems flawed.+You might say, space leak begins where memory leak ends.+Both are a result of programmer error, but the errors differ in subtlety.+<p>+Memory leak harks back to the days when the programmer was explicitly in charge of allocating and freeing memory.+In particular, the programmer has instructed the runtime to consume space, and failed to reclaim it.+So far as the execution environment is concerned, the space is still needed;+but the programmer (and program) is oblivious to its existence.+Managed memory (garbage collection) has helped by removing <em>some</em> such possibilities for disparity between programmer belief and implementation reality.+<div style="display: none;">Memory leak involves the gradual consumption of memory (space) that would never be reclaimed so long as the offending program ran, since neither the programmer nor the implementation believe it to exist.<p></div>+<p>+Space leak is also due to programmer error, but the error is "anything less blatant than allocating memory and then failing to deallocate it".+Space leak is usually due to a failure of the programmer to give due consideration to the space behaviour of their code.+How much consideration is "due" will depend on how smart your compiler and execution environment are, and how good your language and libraries are.+<p>+Space leak is frequently characterised by non-locality - you can influence leak at a smattering of sites within the AST.+Some edits will plug a leak; others will exacerbate it, or introduce new leak; most edits will do nothing at all, quite often against our expectations.+This makes it difficult to talk about "a" (particular) space leak, although of course multinefarious leak aspects ("multiple leaks") can coexist independently in a program.+<p>+And although the causes are subtle, the effects can be catastrophic - steep linear growth (or even superlinear growth) of live memory is required to make progress.+<p>+In a way this is not the fault of the programmer, but of the language or API.+The programmer should not <em>have</em> to think too hard about whether a fold is strict or not.+All the programmer really wants is to receive timely output from the program as it's demanded.+The ideal language/implementation relieves as many concerns about the "how" as possible, letting the human focus on the "what".+<p>+<div class="digression" style="display: none;">+<div class="red">+I cannot seem to put my finger on the difference...+Having that much trouble to find /anything/ to say that might differentiate space and memory leak is telling...+Of what though? That there is no difference? Or that I'm too ignorant to imagine it?...+</div>+<p>+This is a worst-case scenario:+<p>+Subtle programmer error, or results +<p>+That most classic of space leak examples, <tt>foldl</tt> <em>vs.</em> <tt>foldl'</tt>, is proof enough that space leaks are not necessarily due to faults of the runtime system.+<p>+You get what you ask for, and the appropriate choice can depend on use case.+<p>+(But has anyone ever shown a viable example of where foldl would be preferred over foldl'?...)+<p>+Within a managed memory model (such as any Haskell implementation), the runtime (and the programmer, to any +<p>+<span class="red">Probably false</span> In contrast, space leaks when the runtime implementation (and the programmer, in principle) are accounting for the retained memory, only reclamation is taking longer than expected.+<p>+<span class="red">FALSE!</span> A space leak may grow without bound; a memory leak always grows without bound.+</div>+-->++<h3 style="margin-top: 50px; margin-bottom: 8px;">Notes</h3>++<!--div class="red">+I've changed my mind (todo): Don't use links for [1] etc. here. The user will use their back button if they want to jump back. (Personally, I frequently scroll back up...). Instead, offer a caret at the END of the note. <a href=""><tt><b>^</b></tt></a>+<p>+Unfortunately, it looks like ass - it's so small it's hard to see the blue colour.+</div-->++<table>++<tr id="1">+<td>+[1]+</td>+<td>+Given the non-locality of space leak phenomena in lazy languages, it is usually more appropriate to speak of "space leak" as an holistic, abstract quality of a program, rather than to speak of "a space leak" in particular.+When I speak of "a leak", this refers to a particular leaking program as a whole, or to a particular run of a leaking program.+Sometimes we leave out the word "space" and just speak of "leak", since space leak is the dominant form of resource leak plaguing <span>Haskell. <a href="#r1">⇪</a></span>+</td>+</tr>++<tr id="2">+<td>+[2]+</td>+<td>+Current state of the art, 2014.+One indicator of the pervasiveness of the space leak problem is the popularity of the <a href="http://packdeps.haskellers.com/reverse/deepseq">deepseq</a> package, despite its notoriety and ill repute.+(It has over 400 reverse dependencies on hackage, making it one of the most popular libraries of all time, coming in well ahead of <tt>lens</tt> <span>even!) <a href="#r2">⇪</a></span>+</tr>+</td>++<tr id="3">+<td>+[3]+</td>+<td>+One eventually enters the vast and nebulous realm of program optimisation, where the criterion "retains memory longer than expected" ramifies and <span>effervesces. <a href="#r3">⇪</a></span>+</td>+</tr>++<tr id="4">+<td>+[4]+</td>+<td>+At least, the GHC implementation of Haskell is <span>lazy. <a href="#r4">⇪</a></span>+</td>+</tr>++<tr id="5">+<td>+[5]+</td>+<td>+Otherwise, your domain of interest slides gradually, out of necessity or frustration, towards programming language theory and implementation.+Not a bad thing of itself, but it's not entirely satisfying to have your goals deflected, even if the shift was toward the noble pursuit of better <span>tools. <a href="#r5">⇪</a></span>+</td>+</tr>++<tr id="6">+<td>+[6]+</td>+<td>+For instance, Haskell's most famous space leak, <a href="http://blog.ezyang.com/2011/05/anatomy-of-a-thunk-leak">Anatomy of a Thunk Leak</a>, no longer leaks with GHC 7.8 and <span>-O2. <a href="#r6">⇪</a></span>+</td>+</tr>++</table>++<h3 id="Related">Related</h3>++Wiki Books - Haskell pages:+<ul>+<li><a href="http://en.wikibooks.org/wiki/Haskell/Laziness">+Laziness</a>+</ul>++haskellwiki pages:+<ul>+<li><a href="https://www.haskell.org/haskellwiki/Memory_leak">+Memory leak</a>+<li><a href="https://www.haskell.org/haskellwiki/Performance/Space">+Space</a>+<li><a href="https://www.haskell.org/haskellwiki/Performance/Laziness">+Laziness</a> (different than the above!)+<li><a href="https://www.haskell.org/haskellwiki/Performance/Strictness">+Strictness</a>+<li><a href="https://www.haskell.org/haskellwiki/How_to_profile_a_Haskell_program">+How to profile a Haskell program</a>+<li><a href="https://www.haskell.org/haskellwiki/Performance/Accumulating_parameter">+Accumulating parameter</a>+<li><a href="https://www.haskell.org/haskellwiki/Performance/Data_types">+Data types</a>+</ul>++<div class="footer">+Andrew Seniuk 2014+<br>+<tt>rasfar@gmail.com</tt>+</div>++</div>++<script language="javascript">+function toggle(id1){+ var ele_s = document.getElementById(id1+"s");+ var ele_h = document.getElementById(id1+"h");+ var ele = document.getElementById(id1);+ if( ele.style.display == "inline-block" ){+ ele.style.display = "none";+ ele_s.style.display = "inline-block";+ ele_h.style.display = "none";+ }else{+ ele.style.display = "inline-block";+ ele_s.style.display = "none";+ ele_h.style.display = "block";+ }+}+</script>++</body>+</html>+
+ HTML/output.html view
@@ -0,0 +1,91 @@+<!DOCTYPE html>+<html>+<head>+<title>Leaky : Output Under Seqaid</title>+<link rel="stylesheet" href="style.css" />+</head>+<body>+<!--body style="width: 800px;"-->++<div class="main">++<h3 style="margin-top: 50px; margin-bottom: 30px; color: #666;">+Output of <tt>leaky</tt> as instrumented with <tt>seqaid</tt>+</h3>++The following shows the output of <a href="http://hackage.haskell.org/package/seqaid"><tt>seqaid</tt></a> with <a href="http://hackage.haskell.org/package/leaky"><tt>leaky</tt></a>.+You would see something close to this if you ran <tt>leaky</tt> with default configuration.+It is a wee bit contrived, as I sweep <a href="http://hackage.haskell.org/package/deepseq-bounded/docs/Control-DeepSeq-Bounded-NFDataN.html"><tt>NFDataN</tt></a> <tt><em>N</em></tt> value to a fixed depth, and then the fixed (hand-optimised) <a href="http://hackage.haskell.org/package/deepseq-bounded/docs/Control-DeepSeq-Bounded-Pattern.html"><tt>Pattern</tt></a> is developed by replaying iterated <a href="https://hackage.haskell.org/package/deepseq-bounded/docs/Control-DeepSeq-Bounded-PatAlg.html#v:shrinkPat"><tt>shrinkPat</tt></a> in reverse.+But it does illustrate the sorts of effects possible, once <tt>seqaid</tt> has an optimiser.++<p>+Using <tt>NFDataN.forcen <em>N</em></tt>:+<pre>+ live alloc type+ N 0 357828 3350236 TA+ N 1 686376 3316512 TA+ N 2 909104 4942636 TA+ N 3 1121052 4979364 TA+ N 4 1301872 5560432 TA+ N 5 1609760 53440684 TA+ N 6 151460 54431296 TA+ N 7 139240 53374284 TA+ N 8 129440 53405380 TA+</pre>+<p>+Using <tt>NFDataP.forcep <em>P</em></tt>:+<pre>+ live alloc type+ P . 457296 3341600 TA+ P .{...} 698872 5220200 TA+ P .{.{...}..} 954252 6063164 TA+ P .{.{...{.}}..} 1243156 6572740 TA+ P .{.{...{.{.#..}}}..{..}} 1452016 8829248 TA+ P .{.{..{.}.{.{.{.}#..{.}}}}..{..{.}}} 319744 10577588 TA+ P .{.{..{.}.{.{.{.}#..{.}}}}..{..{.}}} 159284 8870360 TA+ P .{.{..{.}.{.{.{.}#..{.}}}}..{..{.}}} 150004 8826904 TA+ P .{.{..{.}.{.{.{.}#..{.}}}}..{..{.}}} 190012 8748076 TA+ P .{.{..{.}.{.{.{.}#..{.}}}}..{..{.}}} 128232 8867404 TA+</pre>++<p>+A few comments are in order:+<ul>+<li>You can see the space leak as a steady, substantial growth in the heap size, from N=0 through N=5, and again in the first five pattern lines.+<li>You can see the first large, strict blobs get hit at a depth of 5 (with <tt>forcen</tt>).+<li>Unfortunately :) it is not until a depth of 6 that the leak can be plugged. (Well, you can plug it without forcing the spine, using let-lifting, but <tt>seqaid</tt> doesn't do that yet.) So <tt>NFDataN</tt> is not a feasible solution for this leak.+<li><tt>NFDataP.forcep</tt> successfully plugs the leak without hitting the big strict blobs.+<li>This output doesn't show how <tt>NFData</tt> would perform worse, but for large N there is additional penalty due to the presence of some long lists (not strict, but deep) in the state.+<!--<li>It may appear there is still a slight leak in the heap, with the final pattern, but if the run is extended, this space is reclaimed periodically.+I don't quite understand this, since I am using <tt>performGC</tt> before each stats line is printed, but the fact is there is no longitudinal net growth.+(Oops, I don't see it in this paste anyways...).-->+</ul>++<div class="footer">+Andrew Seniuk 2014+<br>+<tt>rasfar@gmail.com</tt>+</div>++</div>++<script language="javascript">+function toggle(id1){+ var ele_s = document.getElementById(id1+"s");+ var ele_h = document.getElementById(id1+"h");+ var ele = document.getElementById(id1);+ if( ele.style.display == "inline-block" ){+ ele.style.display = "none";+ ele_s.style.display = "inline-block";+ ele_h.style.display = "none";+ }else{+ ele.style.display = "inline-block";+ ele_s.style.display = "none";+ ele_h.style.display = "block";+ }+}+</script>++</body>+</html>+
+ HTML/style.css view
@@ -0,0 +1,27 @@+pre { font-size: 12pt; margin-left: 20px; padding-left: 10px; padding-right: 10px; padding-top: 10px; padding-bottom: 10px; background-color: #DDD; }+tt { padding-left: 2px; padding-right: 2px; font-size: 85%; background-color: rgba(220,220,220,0.5); }+tt.virgin { padding-left: 0px; padding-right: 0px; font-size: 85%; background-color: transparent; }+/* Works, but not nicely:+red { color: #f00; }+*/+.red { color: #f00; }+div.outdated { display: inline-block; padding-left: 2px; padding-right: 2px; padding-top: 2px; font-size: 80%; background-color: #EEC; }+div.digression { display: none; padding: 8px 8px 8px 8px; font-size: 80%; background-color: #EDD; }+div.digression-closed { display: inline-block; padding: 8px 8px 8px 8px; font-size: 80%; background-color: #EDD; }+.dig-toggle-show { outline: 0; text-decoration: none; color: #33E; display: inline-block; padding: 8px 8px 8px 8px; font-size: 11pt; background-color: #EDD; }+.dig-toggle-hide { outline: 0; text-decoration: none; color: #33E; display: inline-block; padding: 0px 0px 4px 0px; font-size: 11pt; background-color: #EDD; }+a { text-decoration: none; }+div.main { font-size: 18pt; margin-left: 10px; margin-right: 100px; margin-bottom: 40px; }+h2 { margin-top: 30px; color: #777; }+h3 { margin-top: 30px; color: #444; }+h4 { margin-top: 40px; color: #222; }+div.footer { font-size: 12pt; margin-top: 30px; }+/*+table.table { text-align: top; vertical-align: top; }+table.table > tr { text-align: top; vertical-align: top; }+table.table > tr > td { text-align: top; vertical-align: top; }+*/+/* table { border-collapse: collapse; } */+tr { text-align: top; vertical-align: top; }+td { text-align: top; vertical-align: top; padding-left: 8px; padding-top: 16px; }+li { margin-top: 4px; }
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Andrew Seniuk++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Andrew Seniuk nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README view
@@ -0,0 +1,77 @@+++This leaky mini-project provides a Haskell program exhibiting classic+space leak behaviour. It leaks in GHC 7.8.3 (and lower), even when+compiled -O2.+++leaky-min-cppd.hs - a tiny Haskell program that leaks in GHC 7.8.3 -O2+leaky-min.hs - like leaky-min-cppd.hs, with some alternatives+leaky.hs - a similar but elaborated example, with .cabal flags+++In addition to the source files, more information can be found+at the http://www.fremissant.net/leaky project homepage,+including discussion links (cafe, reddit, etc.).++There may also be a community-editable version at the+https://www.haskell.org/haskellwiki/Space_Leak wiki page.+++Configure and build in place:++ > cabal get leaky # download and unpack leaky+ > cd leaky-0.1.0.0 # (or whatever version it is)+ > cabal configure && cabal build # build in place++Run by supplying a seed for the random number generator:++ > ./dist/build/leaky/leaky 123+++Or you may prefer to build in a sandbox:++ > cabal get leaky+ > cd leaky-0.1.0.0+ > cabal sandbox init+ > cabal install --only-dependencies+ > cabal install++And to run:++ > ./.cabal-sandbox/bin/leaky 123+++NOTE: If you don't build with Cabal, you will need to+put options from leaky.cabal into your command line.++Anyway, seqaid uses both the Cabal library and+the cabal executable, meaning that only FORCING_STRATEGY+from 0 through 3 (refer to leaky.cabal) can work+wtihout the presence of the leaky.cabal file.+++The output is explained at http://www.fremissant.net/leaky/output.html+or in the corresponding local document ./HTML/output.html.+++The FORCING_STRATEGY CPP macro currently controls the leak and plug+variants, which are best set by editing the leaky.cabal file,reconfiguring+and rebuilding (or reinstalling in the case of a sandbox). See the+included file rough-fs-twiddling-guide.txt for more details.++There are also some constants in leaky.hs you may like to adjust.+++If you have a version of the compiler that does not leak for+the default variant of leaky, please let me know at rasfar@gmail.com,+on in the haskell-cafe thread (http://) announcing leaky.++Also, any discussion whatsoever is most welcome.+++Sept. 20, 2014+Andrew Seniuk+rasfar on #haskell++
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Types.hs view
@@ -0,0 +1,111 @@++-------------------------------------------------------------------------------++ -- XXX Note that -dcore-lint exposes a bug in GHC with this module,+ -- so we cannot have it on when Types.hs recompiles.+ -- Incidentally, this error happens with -O2 but not -O0...+ {- OPTIONS_GHC -dno-core-lint #-} -- nonesuch, unfortunately++ {- OPTIONS_GHC -O2 #-}+ {-# OPTIONS_GHC -O0 #-}++ {-# LANGUAGE CPP #-}++ {-# LANGUAGE DeriveDataTypeable #-}+ {-# LANGUAGE DeriveGeneric #-}+ {-# LANGUAGE StandaloneDeriving #-}++-------------------------------------------------------------------------------++ module Types where++ import Control.DeepSeq.Bounded+ import Control.DeepSeq.Generics++--import Generics.SOP.TH+ import GHC.Generics ( Generic )+ import Data.Typeable ( Typeable )+ import Data.Data ( Data )++ import System.Random++ import Data.List ( foldl' )+++#if 0+#if FORCING_STRATEGY == 4+ import Seqaid.Runtime ( seqaid )+#endif+#if FORCING_STRATEGY >= 5+--import Seqaid.Runtime -- comes in with Seqaid.TH+ import Seqaid.TH+#endif+#endif++-------------------------------------------------------------------------------++ type State = TA++ doWork :: Num a => Blob a -> a+ doWork (Blob lst) = foldl' (+) 0 lst++ data Blob a = Blob [a]+ deriving (Show,Generic,Typeable,Data)++ instance (NFData a,Num a) => NFData (Blob a) where rnf x = force (doWork x) `seq` ()+ instance (NFData a,Num a) => NFDataN (Blob a) where rnfn n x = force (doWork x) `seq` ()+ instance (NFData a,Num a,Typeable a) => NFDataP (Blob a) where rnfp p x = force (doWork x) `seq` ()++-- XXX Why exactly is this needed, when it wasn't needed when+-- everything was in one module??...+#if 0+ {-# NOINLINE hackblah #-}+ hackblah :: IO StdGen+ hackblah = getStdGen+#else+ deriving instance Typeable StdGen+ instance NFData StdGen where rnf x = ()+ instance NFDataN StdGen where rnfn n x = ()+ instance NFDataP StdGen where rnfp p x = ()+#endif++#if 1+ -- (No strict fields.)+ data TA = A1 Int | A2 TB Int TC+ data TB = B1 | B2 TC | B3 Int TA TB+#if USE_STRICT_BLOB+ -- Note: I think Blob must NOT have a strictness bang (!).+ -- Later: I doubt it matters, the way doing Blob's now...+ data TC = C1 Int TC | C2 Int | C3 TC (Blob Int) ![Int] TC+#else+ data TC = C1 Int TC | C2 Int | C3 TC ![Int] TC+#endif+#else+ -- All Int fields strict (!):+ data TA = A1 !Int | A2 TB !Int TC+ data TB = B1 | B2 TC | B3 !Int TA TB+#if USE_STRICT_BLOB+ -- Note: I think Blob must NOT have a strictness bang (!).+ -- Later: I doubt it matters, the way doing Blob's now...+ data TC = C1 !Int TC | C2 !Int | C3 TC (Blob Int) ![Int] TC+#else+ data TC = C1 !Int TC | C2 !Int | C3 TC ![Int] TC+#endif+#endif++#if FORCING_STRATEGY >= 5+ -- LATER: XXX Exactly the opposite is true now; I have+ -- switched off the use of -fplugin-opt= flags, and am+ -- opting for the seqaidTH splice meta-call to signal+ -- to the plugin (via presence of SeqaidAnnIncludeList+ -- annotation) that the module is to be processed.+ -- If you leave this splice active, you get an error,+ -- at the present time (that's the reason for USE_SECOND_MODULE).+ ------+ -- No need to comment this out when not in use; the TH code knows+ -- if the plugin is slated to run on a module or not.+--seqaidTH+#endif++-------------------------------------------------------------------------------+
+ Types_explicit_SOP.hs view
@@ -0,0 +1,173 @@++-------------------------------------------------------------------------------++-- (See leaky.hs for comments.)++-------------------------------------------------------------------------------++ -- XXX Note that -dcore-lint exposes a bug in GHC with this module,+ -- so we cannot have it on when Types.hs recompiles.+ -- Incidentally, this error happens with -O2 but not -O0...+ {- OPTIONS_GHC -dno-core-lint #-} -- nonesuch, unfortunately++ {- OPTIONS_GHC -O2 #-}+ {-# OPTIONS_GHC -O0 #-}++-------------------------------------------------------------------------------++ {-# LANGUAGE CPP #-}++-------------------------------------------------------------------------------++-- For NFDataP (which perforce includes NFDataN and NFData):+ {-# LANGUAGE TemplateHaskell #-}+ {- LANGUAGE ScopedTypeVariables #-}+ {-# LANGUAGE DataKinds #-}+ {-# LANGUAGE TypeFamilies #-}+ {- LANGUAGE ConstraintKinds #-}+ {-# LANGUAGE GADTs #-} -- for GHC 7.6.3+ {-# LANGUAGE DeriveGeneric #-}+ {-# LANGUAGE DeriveDataTypeable #-}+ {-# LANGUAGE StandaloneDeriving #-}++-------------------------------------------------------------------------------++ -- RankNTypes wanted since some injected type signatures,+ -- due to imported types, may require it.+ -- The user currently has to add this themselves; it would+ -- be nice if SOME available form of automatic injection+ -- could do this! (A text-based pre-processor might be able...).+ -- (So far as I know, no Haskell library or GHC feature will+ -- allow auto-injection of pragmas, but it's quite trivial+ -- as a text pre-process.)+ {-# LANGUAGE RankNTypes #-}++-------------------------------------------------------------------------------++ module Types where++ import Control.DeepSeq.Bounded+ import Control.DeepSeq.Generics++ import Generics.SOP.TH+ import GHC.Generics ( Generic )+ import Data.Typeable ( Typeable )+ import Data.Data ( Data )++--import Control.Concurrent ( threadDelay )+ import Control.Monad ( when )+--import Control.Exception ( evaluate )++ import System.Environment ( getArgs )+ import System.IO ( stdout, hFlush )++ import System.Random++ import Data.List ( foldl' )++ import Debug.Trace ( trace )++#if 0+#if FORCING_STRATEGY == 4+ import Seqaid.Runtime ( seqaid )+#endif+#if FORCING_STRATEGY >= 5+--import Seqaid.Runtime -- comes in with Seqaid.TH+ import Seqaid.TH+#endif+#endif++-------------------------------------------------------------------------------++ type State = TA++ doWork :: Num a => Blob a -> a+ doWork (Blob lst) = foldl' (+) 0 lst++ data Blob a = Blob [a]+ deriving (Show,Generic,Typeable,Data)++ instance (NFData a,Num a) => NFData (Blob a) where rnf x = force (doWork x) `seq` ()+ instance (NFData a,Num a) => NFDataN (Blob a) where rnfn n x = force (doWork x) `seq` ()+ instance (NFData a,Num a,Typeable a) => NFDataP (Blob a) where rnfp p x = force (doWork x) `seq` ()++-- XXX Why exactly is this needed, when it wasn't needed when+-- everything was in one module??...+#if 0+ {-# NOINLINE hackblah #-}+ hackblah :: IO StdGen+ hackblah = getStdGen+#else+ deriving instance Typeable StdGen+ instance NFData StdGen where rnf x = ()+ instance NFDataN StdGen where rnfn n x = ()+ instance NFDataP StdGen where rnfp p x = ()+#endif++#if 1+ -- (No strict fields.)+ data TA = A1 Int | A2 TB Int TC+ data TB = B1 | B2 TC | B3 Int TA TB+#if USE_STRICT_BLOB+ -- Note: I think Blob must NOT have a strictness bang (!).+ -- Later: I doubt it matters, the way doing Blob's now...+ data TC = C1 Int TC | C2 Int | C3 TC (Blob Int) ![Int] TC+#else+ data TC = C1 Int TC | C2 Int | C3 TC ![Int] TC+#endif+#else+ -- All Int fields strict (!):+ data TA = A1 !Int | A2 TB !Int TC+ data TB = B1 | B2 TC | B3 !Int TA TB+#if USE_STRICT_BLOB+ -- Note: I think Blob must NOT have a strictness bang (!).+ -- Later: I doubt it matters, the way doing Blob's now...+ data TC = C1 !Int TC | C2 !Int | C3 TC (Blob Int) ![Int] TC+#else+ data TC = C1 !Int TC | C2 !Int | C3 TC ![Int] TC+#endif+#endif++ deriving instance Show TA+ deriving instance Generic TA+ deriving instance Typeable TA+ deriving instance Data TA+ deriving instance Show TB+ deriving instance Generic TB+ deriving instance Typeable TB+ deriving instance Data TB+ deriving instance Show TC+ deriving instance Generic TC+ deriving instance Typeable TC+ deriving instance Data TC++ instance NFDataP TA where rnfp = grnfp+ instance NFDataN TA where rnfn = grnfn+ instance NFData TA where rnf = genericRnf+ instance NFDataP TB where rnfp = grnfp+ instance NFDataN TB where rnfn = grnfn+ instance NFData TB where rnf = genericRnf+ instance NFDataP TC where rnfp = grnfp+ instance NFDataN TC where rnfn = grnfn+ instance NFData TC where rnf = genericRnf++#if FORCING_STRATEGY >= 5+ -- LATER: XXX Exactly the opposite is true now; I have+ -- switched off the use of -fplugin-opt= flags, and am+ -- opting for the seqaidTH splice meta-call to signal+ -- to the plugin (via presence of SeqaidAnnIncludeList+ -- annotation) that the module is to be processed.+ -- If you leave this splice active, you get an error,+ -- at the present time (that's the reason for USE_SECOND_MODULE).+ ------+ -- No need to comment this out when not in use; the TH code knows+ -- if the plugin is slated to run on a module or not.+--seqaidTH+#endif++ deriveGeneric ''TA+ deriveGeneric ''TB+ deriveGeneric ''TC++-------------------------------------------------------------------------------+
+ Types_min.hs view
@@ -0,0 +1,14 @@++{-# LANGUAGE CPP #-}++ module Types_min where++#if 1+ type State = St+ data St = St Bool+--data St = St !Bool+#else+ data State = St Bool+--data State = St !Bool+#endif+
+ Types_no_SOP.hs view
@@ -0,0 +1,111 @@++-------------------------------------------------------------------------------++ -- XXX Note that -dcore-lint exposes a bug in GHC with this module,+ -- so we cannot have it on when Types.hs recompiles.+ -- Incidentally, this error happens with -O2 but not -O0...+ {- OPTIONS_GHC -dno-core-lint #-} -- nonesuch, unfortunately++ {- OPTIONS_GHC -O2 #-}+ {-# OPTIONS_GHC -O0 #-}++ {-# LANGUAGE CPP #-}++ {-# LANGUAGE DeriveDataTypeable #-}+ {-# LANGUAGE DeriveGeneric #-}+ {-# LANGUAGE StandaloneDeriving #-}++-------------------------------------------------------------------------------++ module Types where++ import Control.DeepSeq.Bounded+ import Control.DeepSeq.Generics++--import Generics.SOP.TH+ import GHC.Generics ( Generic )+ import Data.Typeable ( Typeable )+ import Data.Data ( Data )++ import System.Random++ import Data.List ( foldl' )+++#if 0+#if FORCING_STRATEGY == 4+ import Seqaid.Runtime ( seqaid )+#endif+#if FORCING_STRATEGY >= 5+--import Seqaid.Runtime -- comes in with Seqaid.TH+ import Seqaid.TH+#endif+#endif++-------------------------------------------------------------------------------++ type State = TA++ doWork :: Num a => Blob a -> a+ doWork (Blob lst) = foldl' (+) 0 lst++ data Blob a = Blob [a]+ deriving (Show,Generic,Typeable,Data)++ instance (NFData a,Num a) => NFData (Blob a) where rnf x = force (doWork x) `seq` ()+ instance (NFData a,Num a) => NFDataN (Blob a) where rnfn n x = force (doWork x) `seq` ()+ instance (NFData a,Num a,Typeable a) => NFDataP (Blob a) where rnfp p x = force (doWork x) `seq` ()++-- XXX Why exactly is this needed, when it wasn't needed when+-- everything was in one module??...+#if 0+ {-# NOINLINE hackblah #-}+ hackblah :: IO StdGen+ hackblah = getStdGen+#else+ deriving instance Typeable StdGen+ instance NFData StdGen where rnf x = ()+ instance NFDataN StdGen where rnfn n x = ()+ instance NFDataP StdGen where rnfp p x = ()+#endif++#if 1+ -- (No strict fields.)+ data TA = A1 Int | A2 TB Int TC+ data TB = B1 | B2 TC | B3 Int TA TB+#if USE_STRICT_BLOB+ -- Note: I think Blob must NOT have a strictness bang (!).+ -- Later: I doubt it matters, the way doing Blob's now...+ data TC = C1 Int TC | C2 Int | C3 TC (Blob Int) ![Int] TC+#else+ data TC = C1 Int TC | C2 Int | C3 TC ![Int] TC+#endif+#else+ -- All Int fields strict (!):+ data TA = A1 !Int | A2 TB !Int TC+ data TB = B1 | B2 TC | B3 !Int TA TB+#if USE_STRICT_BLOB+ -- Note: I think Blob must NOT have a strictness bang (!).+ -- Later: I doubt it matters, the way doing Blob's now...+ data TC = C1 !Int TC | C2 !Int | C3 TC (Blob Int) ![Int] TC+#else+ data TC = C1 !Int TC | C2 !Int | C3 TC ![Int] TC+#endif+#endif++#if FORCING_STRATEGY >= 5+ -- LATER: XXX Exactly the opposite is true now; I have+ -- switched off the use of -fplugin-opt= flags, and am+ -- opting for the seqaidTH splice meta-call to signal+ -- to the plugin (via presence of SeqaidAnnIncludeList+ -- annotation) that the module is to be processed.+ -- If you leave this splice active, you get an error,+ -- at the present time (that's the reason for USE_SECOND_MODULE).+ ------+ -- No need to comment this out when not in use; the TH code knows+ -- if the plugin is slated to run on a module or not.+--seqaidTH+#endif++-------------------------------------------------------------------------------+
+ leaky-full-incl-types.hs view
@@ -0,0 +1,654 @@++-------------------------------------------------------------------------------++-- INSTRUCTIONS+--+-- This example concerns "steady-state" programs, where there+-- is a loop behaviour, and we want to sustain it indefinitely+-- with bounded (constant) space (and ca. constant frame period).+-- Servers and games are two exmaples of applications which fall+-- in this category.+--+-- Adjust duration to suit your hardware.+--+-- Toggle USE_GROWING_LIST and USE_INFINITE_LIST (see comments+-- at the #define's).+--+-- Set FORCING_STRATEGY:+-- 0 = None+-- 1 = Use the usual rnf from Control.DeepSeq+-- 2 = Use rnfn from Control.DeepSeq.Bounded+-- 3 = Use rnfp from Control.DeepSeq.Bounded+-- 4 = Test manual instrumentation with Seqaid.Runtime.seqaid+-- 5 = Test seqaid blanket auto-instrumentation of top-level RHSs+-- 6 = Test seqaid blanket auto-instrumentation at requested type+--+-- Suppose USE_GROWING_LIST=0, and suppose USE_INFINITE_LIST=1+-- (except where stated otherwise). This represents the+-- most "stressful" conditions.+--+-- You should be able to observe that FORCING_STRATEGY = ...+--+-- ... 0 : Has a space leak.+--+-- ... 1 : If USE_INFINITE_LIST, nonterminates; otherwise, has no leak+-- but runs very slowly.+--+-- ... 2 : Has no leak and runs fairly quickly, unless USE_STRICT_BLOB=1.+--+-- ... 3 : Has no leak and, while rnfp is slower than rnfn, it is+-- in the same ballpark (i.e. much faster than the usual rnf).+-- Morever, it gives us fine-grained control that rnfn cannot,+-- and is much faster than rnfn when USE_STRICT_BLOB=1.+--+-- ... 4 : +--+-- ... 5 : +--+-- ... 6 : +--+-- (Mainly tested with GHC 7.8.3 with -O2. -O2 was preferred b/c it+-- represents the most difficult case, where we're definitely+-- seeing these relative performance characteristics, even after+-- GHC has thrown everything it has at this bit of code in the+-- way of optimisations.)++-------------------------------------------------------------------------------++ {- OPTIONS_GHC -O2 #-}+ {-# OPTIONS_GHC -O0 #-}++-- How frustrating! It's been quite hard to induce this leak with+-- default optimisations in GHC 7.6.3, harder with 7.8.3, and+-- really hard with -O2 and 7.8.3. (But finally got there!)+--+-- And if go -O0, then even simplest recursion with+-- ctor applications leaks! (And "force" doesn't plug it.)+--+-- This scenario is however the classic justification for the+-- relatively lauded strict fields (actually part of Haskell98).+-- Have strict fields been unnecessary since 7.6.3, with default+-- optimisation? I don't think so...+--+-- What is going on "exactly"?...++-------------------------------------------------------------------------------++ {-# LANGUAGE CPP #-}++#define DBG 0++#if 0+#ifndef FORCING_STRATEGY+#warning UNDEF+#else+#if FORCING_STRATEGY == 0+#warning 0+#elif FORCING_STRATEGY == 1+#warning 1+#elif FORCING_STRATEGY == 2+#warning 2+#elif FORCING_STRATEGY == 3+#warning 3+#elif FORCING_STRATEGY == 4+#warning 4+#elif FORCING_STRATEGY == 5+#warning 5+#elif FORCING_STRATEGY == 6+#warning 6+#endif+#endif+#endif++-- XXX Sorry! It seems that TH doesn't see a consistent state+-- of CPP macros set by the .cabal flags. For the case that+-- FORCING_STRATEGY is undefined, this must be a TH run, and+-- in that case it's safest to force it to 5...+-- I've not been able to get a definite picture of how CPP,+-- TH, and pragmas interact, but it's not always ideal.+#ifndef FORCING_STRATEGY+#define FORCING_STRATEGY 5+#endif++-- XXX Note that GHC.Stats requires runtime option +RTS -T -RTS to use!++#if FORCING_STRATEGY >= 4+-- (In these cases, seqaid auto-instrumentation generates the output.)+#ifdef STATS+#undef STATS+#endif+#define STATS 0+#else+#endif++#if 0+#if FORCING_STRATEGY == 6+#warning FORCING_STRATEGY 6 not yet working. (Use 5 instead.)+#endif+#endif++-- -- The problem with using a growing list is, it itself is+-- -- a leak (as it were), so it's hard to see you've plugged+-- -- anything. However, the slowdown of "force" relative to "forcep"+-- -- will be noticed!+-- -- Alternative to GROWING is FIXED (is at length 10000 at the moment).+-- -- Fixed list is infinite if INFINITE set below.+-- -- (INFINITE has no effect when GROWING set.)+-- #define USE_GROWING_LIST 1+-- -- XXX For some reason, memory is being retained with REDUCTION.+-- #define USE_GROWING_LIST_REDUCTION 1+-- #define USE_INFINITE_LIST 0+-- +-- -- Put some weighty strict subtrees in the test data structure,+-- -- so can showcase forcep's specificity relative to forcen.+-- #define USE_STRICT_BLOB 1+-- +-- -- 0 = None+-- -- 1 = Use rnf (the standard Control.DeepSeq)+-- -- 2 = Use rnfn (from Control.DeepSeq.Bounded)+-- -- 3 = Use rnfp (from Control.DeepSeq.Bounded)+-- -- 4 = Test manual instrumentation with Seqaid.Runtime.seqaid+-- -- 5 = Test seqaid blanket auto-instrumentation of top-level RHSs+-- -- 6 = Test seqaid blanket auto-instrumentation at requested type+-- #define FORCING_STRATEGY 6++-------------------------------------------------------------------------------++-- For NFDataP (which perforce includes NFDataN and NFData):+ {-# LANGUAGE TemplateHaskell #-}+ {- LANGUAGE ScopedTypeVariables #-}+ {-# LANGUAGE DataKinds #-}+ {-# LANGUAGE TypeFamilies #-}+ {- LANGUAGE ConstraintKinds #-}+ {-# LANGUAGE GADTs #-} -- for GHC 7.6.3+ {-# LANGUAGE DeriveGeneric #-}+ {-# LANGUAGE DeriveDataTypeable #-}+ {-# LANGUAGE StandaloneDeriving #-}++-------------------------------------------------------------------------------++ -- RankNTypes wanted since some injected type signatures,+ -- due to imported types, may require it.+ -- The user currently has to add this themselves; it would+ -- be nice if SOME available form of automatic injection+ -- could do this! (A text-based pre-processor might be able...).+ -- (So far as I know, no Haskell library or GHC feature will+ -- allow auto-injection of pragmas, but it's quite trivial+ -- as a text pre-process.)+ {-# LANGUAGE RankNTypes #-}++-------------------------------------------------------------------------------++ -- XXX Unfortunately, the way seqaidpp works, a module declaration+ -- is mandatory. This won't normally be a big deal, as Main is+ -- the only module that is allowed to omit the declaration, and+ -- when omitted, it's always equivalent to the following:++ module Main ( main ) where++-------------------------------------------------------------------------------++ import Control.DeepSeq.Bounded+ import Control.DeepSeq.Generics++ import Generics.SOP.TH+ import GHC.Generics ( Generic )+ import Data.Typeable ( Typeable )+ import Data.Data ( Data )++--import Control.Concurrent ( threadDelay )+ import Control.Monad ( when )+ import Control.Exception ( evaluate ) -- (\x -> (return $! x) >>= return)++ import System.Environment ( getArgs )+ import System.IO ( stdout, hFlush )++ import System.Random++ import Data.List ( foldl' )++ import Debug.Trace ( trace )++-- We synthesize it.+#if 0 && FORCING_STRATEGY == 4+ import Seqaid.Runtime ( seqaid )+#endif++-- Now seeing if can inject with seqaidpp...+-- It's not foolproof yet: What if the module+-- has no imports? What if the topmost import+-- is within a block comment???.....+#if ! TEST_SEQAIDPP+#if FORCING_STRATEGY >= 4+ import Seqaid.TH+--import Seqaid.Runtime -- comes in with Seqaid.TH+--import Seqaid.Ann -- comes in with Seqaid.TH+#endif+#endif++--import Temp++#if STATS+ import GHC.Stats -- requires runtime option +RTS -T -RTS to use!+ import GHC.Int ( Int64 )+#endif++-------------------------------------------------------------------------------++#if FORCING_STRATEGY >= 4+ {- ANN module (SeqaidAnnExclude "bigStrictBlob") #-} -- works+ {- ANN module (SeqaidAnnExclude "main") #-} -- works+ {- ANN module (SeqaidAnnExclude "duration") #-} -- fails+ {- ANN module (SeqaidAnnExclude "initState") #-} -- fails+ -- Those that fail, also fail if give them ++ -- Oh I see: I ended up "reserving" List one for internal use. [?]+ -- But should give an appropriate error when seen in user code then!+ {- ANN module (SeqaidAnnExcludeList ["bigStrictBlob","main"]) #-}+#endif++-------------------------------------------------------------------------------++-- XXX Now using GHC -F preprocessor instead.+#if 0 && FORCING_STRATEGY == 4+ seqaidManTH+#endif++-------------------------------------------------------------------------------++#if 1+#if FORCING_STRATEGY >= 4+ {-# NOINLINE test_auto_ann #-}+#if 1+ {- ANN module (SeqaidAnnExclude "test_auto_ann") #-}+ test_auto_ann :: a+ test_auto_ann = undefined+#else+ {- ANN module (SeqaidAnnExclude "test_auto_ann") #-}+ test_auto_ann :: NFDataP a => a+ test_auto_ann = seqaidDispatch (23,"") $ undefined+#endif+#endif+#endif++-------------------------------------------------------------------------------++#if DBG+ duration = 8+--duration = 4+#else+ -- XXX tune for your hardware+--duration = 50000+ duration = 130000+--duration = 200000+--duration = 500000+--duration = 5000000+#endif++ report_period = duration `div` 20++-------------------------------------------------------------------------------++ type State = TA++ doWork :: Num a => Blob a -> a+ doWork (Blob lst) = foldl' (+) 0 lst++ data Blob a = Blob [a]+ deriving (Show,Generic,Typeable,Data)++ instance (NFData a,Num a) => NFData (Blob a) where rnf x = force (doWork x) `seq` ()+ instance (NFData a,Num a) => NFDataN (Blob a) where rnfn n x = force (doWork x) `seq` ()+ instance (NFData a,Num a,Typeable a) => NFDataP (Blob a) where rnfp p x = force (doWork x) `seq` ()++#if 1+ -- (No strict fields.)+ data TA = A1 Int | A2 TB Int TC+ data TB = B1 | B2 TC | B3 Int TA TB+#if USE_STRICT_BLOB+ -- Note: I think Blob must NOT have a strictness bang (!).+ -- Later: I doubt it matters, the way doing Blob's now...+ data TC = C1 Int TC | C2 Int | C3 TC (Blob Int) ![Int] TC+#else+ data TC = C1 Int TC | C2 Int | C3 TC ![Int] TC+#endif+#else+ -- All Int fields strict (!):+ data TA = A1 !Int | A2 TB !Int TC+ data TB = B1 | B2 TC | B3 !Int TA TB+#if USE_STRICT_BLOB+ -- Note: I think Blob must NOT have a strictness bang (!).+ -- Later: I doubt it matters, the way doing Blob's now...+ data TC = C1 !Int TC | C2 !Int | C3 TC (Blob Int) ![Int] TC+#else+ data TC = C1 !Int TC | C2 !Int | C3 TC ![Int] TC+#endif+#endif++ deriving instance Show TA+ deriving instance Generic TA+ deriving instance Typeable TA+ deriving instance Data TA+ deriving instance Show TB+ deriving instance Generic TB+ deriving instance Typeable TB+ deriving instance Data TB+ deriving instance Show TC+ deriving instance Generic TC+ deriving instance Typeable TC+ deriving instance Data TC++ instance NFDataP TA where rnfp = grnfp+ instance NFDataN TA where rnfn = grnfn+ instance NFData TA where rnf = genericRnf+ instance NFDataP TB where rnfp = grnfp+ instance NFDataN TB where rnfn = grnfn+ instance NFData TB where rnf = genericRnf+ instance NFDataP TC where rnfp = grnfp+ instance NFDataN TC where rnfn = grnfn+ instance NFData TC where rnf = genericRnf++#if 1+ deriveGeneric ''TA+ deriveGeneric ''TB+ deriveGeneric ''TC+#endif++-------------------------------------------------------------------------------++#if FORCING_STRATEGY >= 4+ {-# ANN module (SeqaidAnnExclude "main") #-}+#endif+ main :: IO ()+ main = do++ putStrLn "Started leaky..."+#if STATS+ putStrLn $ pad 15 "live heap" ++ pad 15 "total bytes"+#endif++ [saltstr] <- getArgs+ let salt = read saltstr :: Int+ let g = mkStdGen salt++ let state = initState++ -- Set up the Pattern.+ -- (Only referenced when FORCING_STRATEGY=3.)+#if FORCING_STRATEGY == 3+#if USE_STRICT_BLOB+ let pat = compilePat ".{.{..{.}.{.{.{.}#..{.}}}}..{..{.}}}"+-- let pat = compilePat ".{.{..{.}.{.{.{.}...{.}}}}..{..{.}}}"+#else+#if 0+#elif 1+ let pat = mkPat state -- identical to the explicit pattern below+#elif 0+ let pat = compilePat ".{.{..{.}.{.{.{.}..{.}}}}..{..{.}}}"+#elif 0+ let pat = compilePat "*" -- should be (is) equivalent to rnf+#endif+#endif+ putStrLn $ showPat pat+#else+ let pat = compilePat "#"+#endif++#if USE_GROWING_LIST+ let state' = state+#else+ -- Now that we used "mkPat state" to get the shape of interest,+ -- fill in one or more heavy data branches.+#if USE_INFINITE_LIST+ let state' = setList [1,2..] state -- bwahaha!!+#else+ let state' = setList (take 10000 [1,2..]) state+#endif+#endif++#if STATS+ rslt <- duty g pat state' 0 0+ evaluate rslt -- force the head+#else+#if 0+#elif 0+ rslt <- return $! duty g pat state' 0 -- force the head?+#elif 0+ duty g pat state' 0 `seq` return () -- force the head?+#elif 0+ evaluate $ duty g pat state' 0 -- force the head?+#elif 0+ rslt <- duty g pat state' 0+ rslt `seq` return () -- force the head?+#elif 1+ rslt <- duty g pat state' 0+ evaluate rslt -- force the head!+-- evaluate = \x -> (return $! x) >>= return+#endif+#endif++#if DBG+ putStrLn "Finished."+#else+ putStrLn "\nFinished."+#endif++-------------------------------------------------------------------------------++#if FORCING_STRATEGY == 4+ {-# ANN module (SeqaidAnnManual "duty") #-}+#endif+#if 1+--- #if FORCING_STRATEGY >= 4+#if FORCING_STRATEGY == 4+ {-# ANN module (SeqaidAnnExclude "duty") #-}+#endif+#if FORCING_STRATEGY == 5+ {-# ANN module (SeqaidAnnExclude "duty") #-}+#endif+#if STATS+ duty :: StdGen -> Pattern -> State -> Int -> Int64 -> IO Int+ duty g pat state ii last_total_bytes_allocated = do+#else+ duty :: StdGen -> Pattern -> State -> Int -> IO Int+ duty g pat state ii = do+#endif+#else+-- Or shouldn't this be == 4 || == 5, now? (It might not matter;+-- if it works Excluded with 4, it'll work Excl. with 6.)+-- Later: I'm not sure that's true; will see as the smoke clears...+#if FORCING_STRATEGY >= 4+ -- this works whether ANN on or off:+ {-# ANN module (SeqaidAnnExclude "duty") #-}+#endif+#if STATS+ duty :: StdGen -> Pattern -> State -> Int -> Int64 -> IO Int+ duty g pat state ii last_total_bytes_allocated = seqaidDispatch $ do+#else+ duty :: StdGen -> Pattern -> State -> Int -> IO Int+ duty g pat state ii = seqaidDispatch $ do+--duty g pat state ii = do -- see "tail call" for the manual injection+#endif+#endif++ let (r,g') = random g :: (Bool,StdGen)++ let (A2 (B3 i1+ (A1 i2)+#if USE_STRICT_BLOB+ (B2 (C3 (C2 i3) blob lst (C2 i4))))+#else+ (B2 (C3 (C2 i3) lst (C2 i4))))+#endif+ i5+ (C1 i6 (C2 i7))) = state++#if USE_GROWING_LIST && USE_GROWING_LIST_REDUCTION+ let lst' = if 0 == ii `mod` 5000+ then [ii] else (ii:lst)+#else+ let lst' = lst+#endif++ let state' = if r then state else+ let state_ = A2 (B3 (1+i1)+ (A1 (1+i2))+#if USE_STRICT_BLOB+ (B2 (C3 (C2 (1+i3)) blob lst' (C2 (1+i4)))))+#else+ (B2 (C3 (C2 (1+i3)) lst' (C2 (1+i4)))))+#endif+ (1+i5)+ (C1 (1+i6) (C2 (1+i7))) in+#if FORCING_STRATEGY == 0+ state_+#elif FORCING_STRATEGY == 1+ force $ state_+#elif FORCING_STRATEGY == 2+ forcen 6 $ state_+#elif FORCING_STRATEGY == 3+ forcep_ pat $ state_+#elif FORCING_STRATEGY == 4+ seqaid state_+-- seqaid $ state_+#elif FORCING_STRATEGY == 5+ pure_escape state_+#elif FORCING_STRATEGY == 6+ state_+#endif++ -- Unless you do this, the forcing code above never runs:+ evaluate state' -- forces only the head! (a way to place demand)++#if 0+#if DBG+ when ( True ) $ do+#else+ when ( 0 == ii `mod` 5000 ) $ do+#endif+-- threadDelay 500+#if DBG+ putStr ".\n"+#else+ putStr "."+#endif+ hFlush stdout+#endif++#if STATS+ new_total_bytes_allocated+ <- if 0 == ii `mod` report_period+ then do+ stats <- getGCStats+ let bytes = bytesAllocated stats+ putStrLn $ pad 15 (show (currentBytesUsed stats))+ ++ pad 15 (show (bytes - last_total_bytes_allocated))+ return $ bytesAllocated stats+ else return last_total_bytes_allocated+#else+#if 0+ when ( 0 == ii `mod` report_period ) $ do+-- threadDelay 500+ putStr "."+ hFlush stdout+#endif+#endif++ -- (However, the interesting case is when pat' changes dynamically...+ -- That is what happens with FORCING_STRATEGY >= 4.)+ let pat' = pat++ let ii' = 1+ii+ if ii' < duration+ then do+#if STATS+ duty g' pat' state' ii' new_total_bytes_allocated+#else+ duty g' pat' state' ii'+-- seqaidDispatch (duty g' pat' state' ii')+#endif+ else do+ return ii'++-------------------------------------------------------------------------------++-- XXX Yep, still true! So it's not only a matter of+-- the == 5 || == 6 construct!+-- XXX Must be commented out, for TH not to complain;+-- the problem with Cabal flags not reaching TH passes+-- in such cases (sometimes)...+#if 0+#if FORCING_STRATEGY == 5+ {-# NOINLINE pure_escape #-}+ -- XXX This is still needed, until we decide what to do about+ -- auto-instrumenting monadic binds...+ pure_escape :: State -> State+ pure_escape state = state+#endif+#endif++-------------------------------------------------------------------------------++#if FORCING_STRATEGY >= 4+ {-# ANN module (SeqaidAnnExclude "initState") #-}+ {- NOINLINE initState #-} -- does not help linker errors I'm getting!...+#endif+ initState :: State+#if USE_STRICT_BLOB+ initState = let blob = bigstrictblob 3000 in+ A2 (B3 0 (A1 0) (B2 (C3 (C2 0) blob [] (C2 0)))) 0 (C1 0 (C2 0))+#else+ initState = A2 (B3 0 (A1 0) (B2 (C3 (C2 0) [] (C2 0)))) 0 (C1 0 (C2 0))+#endif++#if FORCING_STRATEGY >= 4+ {-# ANN module (SeqaidAnnExclude "bigstrictblob") #-}+#endif+ bigstrictblob :: Int -> Blob Int+ bigstrictblob n = Blob (take n [1,2..])++-------------------------------------------------------------------------------++#if FORCING_STRATEGY >= 4+ {-# ANN module (SeqaidAnnExclude "setList") #-}+#endif+ setList :: [Int] -> State -> State+#if USE_STRICT_BLOB+ setList lst (A2 (B3 i1 (A1 i2) (B2 (C3 (C2 i3) blob _ (C2 i4)))) i5 c1)+ = (A2 (B3 i1 (A1 i2) (B2 (C3 (C2 i3) blob lst (C2 i4)))) i5 c1)+#else+ setList lst (A2 (B3 i1 (A1 i2) (B2 (C3 (C2 i3) _ (C2 i4)))) i5 c1)+ = (A2 (B3 i1 (A1 i2) (B2 (C3 (C2 i3) lst (C2 i4)))) i5 c1)+#endif++-------------------------------------------------------------------------------++#if STATS+ pad :: Int -> String -> String+ pad n s = (take (n-len) $ repeat ' ') ++ s+ where len = length s+#endif++-------------------------------------------------------------------------------++-- Later: Now we always do it via seqaidpp.+#if 0+-- Now seeing if can inject with seqaidpp...+#if ! TEST_SEQAIDPP+#if FORCING_STRATEGY >= 5+ seqaidTH+#endif+#endif+#endif++-------------------------------------------------------------------------------++-- Now done via seqaidpp.+#if 0+ deriveGeneric ''TA+ deriveGeneric ''TB+ deriveGeneric ''TC+#endif++-------------------------------------------------------------------------------+
+ leaky-full.hs view
@@ -0,0 +1,594 @@++-------------------------------------------------------------------------------++-- INSTRUCTIONS+--+-- This example concerns "steady-state" programs, where there+-- is a loop behaviour, and we want to sustain it indefinitely+-- with bounded (constant) space (and ca. constant frame period).+-- Servers and games are two exmaples of applications which fall+-- in this category.+--+-- Adjust duration to suit your hardware.+--+-- Toggle USE_GROWING_LIST and USE_INFINITE_LIST (see comments+-- at the #define's).+--+-- Set FORCING_STRATEGY:+-- 0 = None+-- 1 = Use the usual rnf from Control.DeepSeq+-- 2 = Use rnfn from Control.DeepSeq.Bounded+-- 3 = Use rnfp from Control.DeepSeq.Bounded+-- 4 = Test manual instrumentation with Seqaid.Runtime.seqaid+-- 5 = Test seqaid blanket auto-instrumentation of top-level RHSs+-- 6 = Test seqaid blanket auto-instrumentation at requested type+--+-- Suppose USE_GROWING_LIST=0, and suppose USE_INFINITE_LIST=1+-- (except where stated otherwise). This represents the+-- most "stressful" conditions.+--+-- You should be able to observe that FORCING_STRATEGY = ...+--+-- ... 0 : Has a space leak.+--+-- ... 1 : If USE_INFINITE_LIST, nonterminates; otherwise, has no leak+-- but runs very slowly.+--+-- ... 2 : Has no leak and runs fairly quickly, unless USE_STRICT_BLOB=1.+--+-- ... 3 : Has no leak and, while rnfp is slower than rnfn, it is+-- in the same ballpark (i.e. much faster than the usual rnf).+-- Morever, it gives us fine-grained control that rnfn cannot,+-- and is much faster than rnfn when USE_STRICT_BLOB=1.+--+-- ... 4 : +--+-- ... 5 : +--+-- ... 6 : +--+-- (Mainly tested with GHC 7.8.3 with -O2. -O2 was preferred b/c it+-- represents the most difficult case, where we're definitely+-- seeing these relative performance characteristics, even after+-- GHC has thrown everything it has at this bit of code in the+-- way of optimisations.)++-------------------------------------------------------------------------------++ {- OPTIONS_GHC -O2 #-}+ {-# OPTIONS_GHC -O0 #-}++ {- OPTIONS_GHC -ddump-splices #-}++-- How frustrating! It's been quite hard to induce this leak with+-- default optimisations in GHC 7.6.3, harder with 7.8.3, and+-- really hard with -O2 and 7.8.3. (But finally got there!)+--+-- And if go -O0, then even simplest recursion with+-- ctor applications leaks! (And "force" doesn't plug it.)+--+-- This scenario is however the classic justification for the+-- relatively lauded strict fields (actually part of Haskell98).+-- Have strict fields been unnecessary since 7.6.3, with default+-- optimisation? I don't think so...+--+-- What is going on "exactly"?...++-------------------------------------------------------------------------------++ {-# LANGUAGE CPP #-}++#define DBG 0++#if 0+#ifndef FORCING_STRATEGY+#warning UNDEF+#else+#if FORCING_STRATEGY == 0+#warning 0+#elif FORCING_STRATEGY == 1+#warning 1+#elif FORCING_STRATEGY == 2+#warning 2+#elif FORCING_STRATEGY == 3+#warning 3+#elif FORCING_STRATEGY == 4+#warning 4+#elif FORCING_STRATEGY == 5+#warning 5+#elif FORCING_STRATEGY == 6+#warning 6+#endif+#endif+#endif++-- XXX Sorry! It seems that TH doesn't see a consistent state+-- of CPP macros set by the .cabal flags. For the case that+-- FORCING_STRATEGY is undefined, this must be a TH run, and+-- in that case it's safest to force it to 5...+-- I've not been able to get a definite picture of how CPP,+-- TH, and pragmas interact, but it's not always ideal.+#ifndef FORCING_STRATEGY+#define FORCING_STRATEGY 5+#endif++-- XXX Note that GHC.Stats requires runtime option +RTS -T -RTS to use!++#if FORCING_STRATEGY >= 4+-- (In these cases, seqaid auto-instrumentation generates the output.)+#ifdef STATS+#undef STATS+#endif+#define STATS 0+#else+#endif++#if 0+#if FORCING_STRATEGY == 6+#warning FORCING_STRATEGY 6 not yet working. (Use 5 instead.)+#endif+#endif++-- -- The problem with using a growing list is, it itself is+-- -- a leak (as it were), so it's hard to see you've plugged+-- -- anything. However, the slowdown of "force" relative to "forcep"+-- -- will be noticed!+-- -- Alternative to GROWING is FIXED (is at length 10000 at the moment).+-- -- Fixed list is infinite if INFINITE set below.+-- -- (INFINITE has no effect when GROWING set.)+-- #define USE_GROWING_LIST 1+-- -- XXX For some reason, memory is being retained with REDUCTION.+-- #define USE_GROWING_LIST_REDUCTION 1+-- #define USE_INFINITE_LIST 0+-- +-- -- Put some weighty strict subtrees in the test data structure,+-- -- so can showcase forcep's specificity relative to forcen.+-- #define USE_STRICT_BLOB 1+-- +-- -- 0 = None+-- -- 1 = Use rnf (the standard Control.DeepSeq)+-- -- 2 = Use rnfn (from Control.DeepSeq.Bounded)+-- -- 3 = Use rnfp (from Control.DeepSeq.Bounded)+-- -- 4 = Test manual instrumentation with Seqaid.Runtime.seqaid+-- -- 5 = Test seqaid blanket auto-instrumentation of top-level RHSs+-- -- 6 = Test seqaid blanket auto-instrumentation at requested type+-- #define FORCING_STRATEGY 6++-------------------------------------------------------------------------------++-- For NFDataP (which perforce includes NFDataN and NFData):+ {-# LANGUAGE TemplateHaskell #-}+ {- LANGUAGE ScopedTypeVariables #-}+ {-# LANGUAGE DataKinds #-}+ {-# LANGUAGE TypeFamilies #-}+ {- LANGUAGE ConstraintKinds #-}+ {-# LANGUAGE GADTs #-} -- for GHC 7.6.3+ {-# LANGUAGE DeriveGeneric #-}+ {-# LANGUAGE DeriveDataTypeable #-}+ {-# LANGUAGE StandaloneDeriving #-}++-------------------------------------------------------------------------------++ -- RankNTypes wanted since some injected type signatures,+ -- due to imported types, may require it.+ -- The user currently has to add this themselves; it would+ -- be nice if SOME available form of automatic injection+ -- could do this! (A text-based pre-processor might be able...).+ -- (So far as I know, no Haskell library or GHC feature will+ -- allow auto-injection of pragmas, but it's quite trivial+ -- as a text pre-process.)+ {-# LANGUAGE RankNTypes #-}++-------------------------------------------------------------------------------++ -- XXX Unfortunately, the way seqaidpp works, a module declaration+ -- is mandatory. This won't normally be a big deal, as Main is+ -- the only module that is allowed to omit the declaration, and+ -- when omitted, it's always equivalent to the following:++ module Main ( main ) where++-------------------------------------------------------------------------------++ import Control.DeepSeq.Bounded+ import Control.DeepSeq.Generics++ import Generics.SOP.TH+ import GHC.Generics ( Generic )+ import Data.Typeable ( Typeable )+ import Data.Data ( Data )++--import Control.Concurrent ( threadDelay )+ import Control.Monad ( when )+ import Control.Exception ( evaluate ) -- (\x -> (return $! x) >>= return)++ import System.Environment ( getArgs )+ import System.IO ( stdout, hFlush )++ import System.Random++ import Data.List ( foldl' )++ import Debug.Trace ( trace )++-- We synthesize it.+#if 0 && FORCING_STRATEGY == 4+ import Seqaid.Runtime ( seqaid )+#endif++-- Now seeing if can inject with seqaidpp...+-- It's not foolproof yet: What if the module+-- has no imports? What if the topmost import+-- is within a block comment???.....+#if ! TEST_SEQAIDPP+#if FORCING_STRATEGY >= 4+ import Seqaid.TH+--import Seqaid.Runtime -- comes in with Seqaid.TH+--import Seqaid.Ann -- comes in with Seqaid.TH+#endif+#endif++ import Types++--import Temp++#if STATS+ import GHC.Stats -- requires runtime option +RTS -T -RTS to use!+ import GHC.Int ( Int64 )+#endif++-------------------------------------------------------------------------------++#if FORCING_STRATEGY >= 4+ {- ANN module (SeqaidAnnExclude "bigStrictBlob") #-} -- works+ {- ANN module (SeqaidAnnExclude "main") #-} -- works+ {- ANN module (SeqaidAnnExclude "duration") #-} -- fails+ {- ANN module (SeqaidAnnExclude "initState") #-} -- fails+ -- Those that fail, also fail if give them ++ -- Oh I see: I ended up "reserving" List one for internal use. [?]+ -- But should give an appropriate error when seen in user code then!+ {- ANN module (SeqaidAnnExcludeList ["bigStrictBlob","main"]) #-}+#endif++-------------------------------------------------------------------------------++-- XXX Now using GHC -F preprocessor instead.+#if 0 && FORCING_STRATEGY == 4+ seqaidManTH+#endif++-------------------------------------------------------------------------------++#if 1+#if FORCING_STRATEGY >= 4+ {-# NOINLINE test_auto_ann #-}+#if 1+ {- ANN module (SeqaidAnnExclude "test_auto_ann") #-}+ test_auto_ann :: a+ test_auto_ann = undefined+#else+ {- ANN module (SeqaidAnnExclude "test_auto_ann") #-}+ test_auto_ann :: NFDataP a => a+ test_auto_ann = seqaidDispatch (23,"") $ undefined+#endif+#endif+#endif++-------------------------------------------------------------------------------++-- XXX tune for your hardware+#if DBG+ duration = 8+#else+-- XXX I haven't gotten to the bottom of why there's this discrepancy...+#if FORCING_STRATEGY == 6+ duration = 10000+--duration = 100000+#else+#if FORCING_STRATEGY == 5+ duration = 10000+#else+#if FORCING_STRATEGY <= 3+ duration = 500000+#else+ duration = 100000+#endif+#endif+#endif+#endif++ report_period = duration `div` 20++-------------------------------------------------------------------------------++#if FORCING_STRATEGY >= 4+ {-# ANN module (SeqaidAnnExclude "main") #-}+#endif+ main :: IO ()+ main = do++ putStrLn "Started leaky..."++ [saltstr] <- getArgs+ let salt = read saltstr :: Int+ let g = mkStdGen salt++ let state = initState++ -- Set up the Pattern.+ -- (Only referenced when FORCING_STRATEGY=3.)+#if FORCING_STRATEGY == 3+#if USE_STRICT_BLOB+ let pat = compilePat ".{.{..{.}.{.{.{.}#..{.}}}}..{..{.}}}"+-- let pat = compilePat ".{.{..{.}.{.{.{.}...{.}}}}..{..{.}}}"+#else+#if 0+#elif 1+ let pat = mkPat state -- identical to the explicit pattern below+#elif 0+ let pat = compilePat ".{.{..{.}.{.{.{.}..{.}}}}..{..{.}}}"+#elif 0+ let pat = compilePat "*" -- should be (is) equivalent to rnf+#endif+#endif+ putStrLn $ showPat pat+#else+ let pat = compilePat "#"+#endif++#if STATS+ putStrLn $ pad 15 "live heap" ++ pad 15 "total bytes"+#endif++#if USE_GROWING_LIST+ let state' = state+#else+ -- Now that we used "mkPat state" to get the shape of interest,+ -- fill in one or more heavy data branches.+#if USE_INFINITE_LIST+ let state' = setList [1,2..] state -- bwahaha!!+#else+ let state' = setList (take 10000 [1,2..]) state+#endif+#endif++#if STATS+ rslt <- duty g pat state' 0 0+ evaluate rslt -- force the head+#else+#if 0+#elif 0+ rslt <- return $! duty g pat state' 0 -- force the head?+#elif 0+ duty g pat state' 0 `seq` return () -- force the head?+#elif 0+ evaluate $ duty g pat state' 0 -- force the head?+#elif 0+ rslt <- duty g pat state' 0+ rslt `seq` return () -- force the head?+#elif 1+ rslt <- duty g pat state' 0+ evaluate rslt -- force the head!+-- evaluate = \x -> (return $! x) >>= return+#endif+#endif++#if DBG+ putStrLn "Finished."+#else+ putStrLn "\nFinished."+#endif++-------------------------------------------------------------------------------++#if FORCING_STRATEGY == 4+ {-# ANN module (SeqaidAnnManual "duty") #-}+#endif+#if 1+--- #if FORCING_STRATEGY >= 4+#if FORCING_STRATEGY == 4+ {-# ANN module (SeqaidAnnExclude "duty") #-}+#endif+#if FORCING_STRATEGY == 5+ {-# ANN module (SeqaidAnnExclude "duty") #-}+#endif+#if STATS+ duty :: StdGen -> Pattern -> State -> Int -> Int64 -> IO Int+ duty g pat state ii last_total_bytes_allocated = do+#else+ duty :: StdGen -> Pattern -> State -> Int -> IO Int+ duty g pat state ii = do+#endif+#else+-- Or shouldn't this be == 4 || == 5, now? (It might not matter;+-- if it works Excluded with 4, it'll work Excl. with 6.)+-- Later: I'm not sure that's true; will see as the smoke clears...+#if FORCING_STRATEGY >= 4+ -- this works whether ANN on or off:+ {-# ANN module (SeqaidAnnExclude "duty") #-}+#endif+#if STATS+ duty :: StdGen -> Pattern -> State -> Int -> Int64 -> IO Int+ duty g pat state ii last_total_bytes_allocated = seqaidDispatch $ do+#else+ duty :: StdGen -> Pattern -> State -> Int -> IO Int+ duty g pat state ii = seqaidDispatch $ do+--duty g pat state ii = do -- see "tail call" for the manual injection+#endif+#endif++ let (r,g') = random g :: (Bool,StdGen)++ let (A2 (B3 i1+ (A1 i2)+#if USE_STRICT_BLOB+ (B2 (C3 (C2 i3) blob lst (C2 i4))))+#else+ (B2 (C3 (C2 i3) lst (C2 i4))))+#endif+ i5+ (C1 i6 (C2 i7))) = state++#if USE_GROWING_LIST && USE_GROWING_LIST_REDUCTION+ let lst' = if 0 == ii `mod` 5000+ then [ii] else (ii:lst)+#else+ let lst' = lst+#endif++ let state' = if r then state else+ let state_ = A2 (B3 (1+i1)+ (A1 (1+i2))+#if USE_STRICT_BLOB+ (B2 (C3 (C2 (1+i3)) blob lst' (C2 (1+i4)))))+#else+ (B2 (C3 (C2 (1+i3)) lst' (C2 (1+i4)))))+#endif+ (1+i5)+ (C1 (1+i6) (C2 (1+i7))) in+#if FORCING_STRATEGY == 0+ state_+#elif FORCING_STRATEGY == 1+ force $ state_+#elif FORCING_STRATEGY == 2+ forcen 6 $ state_+#elif FORCING_STRATEGY == 3+ forcep_ pat $ state_+#elif FORCING_STRATEGY == 4+ seqaid state_+-- seqaid $ state_+#elif FORCING_STRATEGY == 5+ pure_escape state_+#elif FORCING_STRATEGY == 6+ state_+#endif++ -- Unless you do this, the forcing code above never runs:+ evaluate state' -- forces only the head! (a way to place demand)++#if 0+#if DBG+ when ( True ) $ do+#else+ when ( 0 == ii `mod` 5000 ) $ do+#endif+-- threadDelay 500+#if DBG+ putStr ".\n"+#else+ putStr "."+#endif+ hFlush stdout+#endif++#if STATS+ new_total_bytes_allocated+ <- if 0 == ii `mod` report_period+ then do+ stats <- getGCStats+ let bytes = bytesAllocated stats+ putStrLn $ pad 15 (show (currentBytesUsed stats))+ ++ pad 15 (show (bytes - last_total_bytes_allocated))+ return $ bytesAllocated stats+ else return last_total_bytes_allocated+#else+#if 0+ when ( 0 == ii `mod` report_period ) $ do+-- threadDelay 500+ putStr "."+ hFlush stdout+#endif+#endif++ -- (However, the interesting case is when pat' changes dynamically...+ -- That is what happens with FORCING_STRATEGY >= 4.)+ let pat' = pat++ let ii' = 1+ii+ if ii' < duration+ then do+#if STATS+ duty g' pat' state' ii' new_total_bytes_allocated+#else+ duty g' pat' state' ii'+-- seqaidDispatch (duty g' pat' state' ii')+#endif+ else do+ return ii'++-------------------------------------------------------------------------------++-- Later: Due to some changes in the last couple hours, this+-- seems to no longer be necessary.+-- XXX Yep, still true! So it's not only a matter of+-- the == 5 || == 6 construct!+-- XXX Must be commented out, for TH not to complain;+-- the problem with Cabal flags not reaching TH passes+-- in such cases (sometimes)...+#if 1+#if FORCING_STRATEGY == 5+ {-# NOINLINE pure_escape #-}+ -- XXX This is still needed, until we decide what to do about+ -- auto-instrumenting monadic binds...+ pure_escape :: State -> State+ pure_escape state = state+#endif+#endif++-------------------------------------------------------------------------------++#if FORCING_STRATEGY >= 4+ {-# ANN module (SeqaidAnnExclude "initState") #-}+ {- NOINLINE initState #-} -- does not help linker errors I'm getting!...+#endif+ initState :: State+#if USE_STRICT_BLOB+ initState = let blob = bigstrictblob 3000 in+ A2 (B3 0 (A1 0) (B2 (C3 (C2 0) blob [] (C2 0)))) 0 (C1 0 (C2 0))+#else+ initState = A2 (B3 0 (A1 0) (B2 (C3 (C2 0) [] (C2 0)))) 0 (C1 0 (C2 0))+#endif++#if FORCING_STRATEGY >= 4+ {-# ANN module (SeqaidAnnExclude "bigstrictblob") #-}+#endif+ bigstrictblob :: Int -> Blob Int+ bigstrictblob n = Blob (take n [1,2..])++-------------------------------------------------------------------------------++#if FORCING_STRATEGY >= 4+ {-# ANN module (SeqaidAnnExclude "setList") #-}+#endif+ setList :: [Int] -> State -> State+#if USE_STRICT_BLOB+ setList lst (A2 (B3 i1 (A1 i2) (B2 (C3 (C2 i3) blob _ (C2 i4)))) i5 c1)+ = (A2 (B3 i1 (A1 i2) (B2 (C3 (C2 i3) blob lst (C2 i4)))) i5 c1)+#else+ setList lst (A2 (B3 i1 (A1 i2) (B2 (C3 (C2 i3) _ (C2 i4)))) i5 c1)+ = (A2 (B3 i1 (A1 i2) (B2 (C3 (C2 i3) lst (C2 i4)))) i5 c1)+#endif++-------------------------------------------------------------------------------++#if STATS+ pad :: Int -> String -> String+ pad n s = (take (n-len) $ repeat ' ') ++ s+ where len = length s+#endif++-------------------------------------------------------------------------------++-- Later: Now we always do it via seqaidpp.+#if 0+-- Now seeing if can inject with seqaidpp...+#if ! TEST_SEQAIDPP+#if FORCING_STRATEGY >= 5+ seqaidTH+#endif+#endif+#endif++-------------------------------------------------------------------------------+
+ leaky-min-cppd-working.hs view
@@ -0,0 +1,33 @@++ -- This leaks with GHC 7.8.3 -O2, strict field notwithstanding.++ {- OPTIONS_GHC -O2 #-}+ {-# OPTIONS_GHC -O0 #-}++ module Main ( main ) where++ import Types_min++ toggle (St b) = St (not b)++ {-# ANN module (SeqaidAnnExclude "toggle") #-}+ {-# ANN module (SeqaidAnnExclude "duration") #-}+ {-# ANN module (SeqaidAnnExclude "period") #-}+ {-# ANN module (SeqaidAnnExclude "main") #-}++ duration = 5000000 -- XXX tune for your hardware+ period = duration `div` 10++ main = do+ putStrLn "Leaky started."+ rslt <- duty (St False) 0+ (return $! rslt) >>= return+ putStrLn "Finished."++ duty :: State -> Int -> IO State+ duty state i = do+ let state' = toggle state+ if 0 == i `mod` period then return () else return ()+ if i < duration then duty state' (1+i) else return state'+ {-# NOINLINE duty #-}+
+ leaky-min-cppd.hs view
@@ -0,0 +1,21 @@++ -- This leaks with GHC 7.8.3 -O2, strict field notwithstanding.++ duration = 5000000 -- XXX tune for your hardware+ period = duration `div` 10++ data State = St !Bool+ toggle (St b) = St (not b)++ main = do+ putStrLn "Leaky started."+ rslt <- duty (St False) 0+ (return $! rslt) >>= return+ putStrLn "Finished."++ duty :: State -> Int -> IO State+ duty state i = do+ let state' = toggle state+ if 0 == i `mod` period then return () else return ()+ if i < duration then duty state' (1+i) else return state'+
+ leaky-min.hs view
@@ -0,0 +1,164 @@++-------------------------------------------------------------------------------++-- So, with the following configuration, -O2 is smart enough+-- to produce the correct Bool output, without seeming to+-- do any work. (But not with -O0 or even with -O.)+--- #define STATS 0+--- #define NO_PERIODIC_BRANCH 1+--- #define STRICT_FIELDS 1+--+-- In fact, -O0, -O and -O2 all have distinct behaviour:+-- -O2 returns the result "instantly"+-- -O returns the result in a second or two+-- -O0 returns only after a long run++-------------------------------------------------------------------------------++ {-# LANGUAGE CPP #-} -- (or run cpp manually if need be)++-------------------------------------------------------------------------------++-- Whether to run getStats computation (and output status lines).+-- Note that when STATS is 1, this constitutes a forcing factor:+-- Strictness is a bit like QM that way...+#define STATS 1++-- If you explicitly performGC at the start of each getStats, you+-- get a more regular sequence of status lines; but you are also+-- tampering with the natural behaviour of the garbage collector.+#define PERFORM_GC 1++-- This switch is offered because, only when set, is there a+-- difference between -O and -O2 evident. (-O0 differs in any case.)+-- And only when un-set will this program leak at -O2.+-- (Only applicable when STATS is 0.)+#define NO_PERIODIC_BRANCH 0++-- This leak is not plugged by strict fields!+-- (In the case of STATS 0 and NO_PERIODIC_BRANCH 1, the leak is+-- not manifest with -O2, but this is not due to the strict field.)+#define STRICT_FIELDS 1++-- Superfluous I guess.+#define RECORD_SYNTAX 0++-------------------------------------------------------------------------------++#if STATS+-- XXX This doesn't work!+-- Please GHC-compile with -rtsopts -with-rtsopts=-s -with-rtsopts=-T+-- (-s not -T are independent; nice to see -s summary info.)+ {-# OPTIONS_GHC -rtsopts #-}+ {- OPTIONS_GHC -with-rtsopts=-s #-}+ {-# OPTIONS_GHC -with-rtsopts=-T #-}+#endif++-------------------------------------------------------------------------------++ module Main ( main ) where++ import Control.Exception ( evaluate ) -- (\x -> (return $! x) >>= return)++ import GHC.Stats+ import GHC.Int ( Int64 )+ import System.Mem ( performGC )++#if USE_SECOND_MODULE+ import Types_min+#endif++-------------------------------------------------------------------------------++ duration = 5000000 -- XXX tune for your hardware++ report_period = duration `div` 10+--report_period = 500000 -- GHC 7.8.3 -O2 is two smart (when STATS=0)++-------------------------------------------------------------------------------++#if ! USE_SECOND_MODULE+#if RECORD_SYNTAX+#if STRICT_FIELDS+ data State = St { st :: !Bool }+#else+ data State = St { st :: Bool }+#endif+#else+#if STRICT_FIELDS+ data State = St !Bool+#else+ data State = St Bool+#endif+#endif+#endif++ toggle (St b) = St (not b)++-------------------------------------------------------------------------------++ main = do++ putStrLn "Leaky started."+#if STATS+ putStrLn $ "\n" ++ pad "live heap" ++ " " ++ pad "just alloc'd"+#endif++ rslt <- duty (St False) 0 0+ evaluate rslt++#if STATS+ putStrLn "\nFinished."+#else+ putStrLn "Finished."+#endif++-------------------------------------------------------------------------------++ duty :: State -> Int -> Int64 -> IO State+ duty state i last_total_bytes_allocated = do++#if RECORD_SYNTAX+ let state' = state { st = not (st state) }+#else+ let state' = toggle state+-- let state' = (\(St b)->St (not b)) state+-- let state' = let St b = state in St (not b)+#endif++#if STATS+ new_total_bytes_allocated+ <- if 0 == i `mod` report_period+ then do+#if PERFORM_GC+ performGC+#endif+ stats <- getGCStats+ let bytes = bytesAllocated stats+ putStrLn $ pad (show (currentBytesUsed stats)) ++ " "+ ++ pad (show (bytes - last_total_bytes_allocated))+ return $ bytesAllocated stats+ else return last_total_bytes_allocated+#else+ let new_total_bytes_allocated = last_total_bytes_allocated+#if ! NO_PERIODIC_BRANCH+ if 0 == i `mod` report_period+-- if 0 == i `mod` 2 -- GHC 7.8.3 -O2 is two smart+ then do+-- putStrLn "." -- unnecessary+ return ()+ else return ()+#endif+#endif++ if i < duration+ then duty state' (1+i) new_total_bytes_allocated+ else return state'++-------------------------------------------------------------------------------++ pad :: String -> String+ pad s = (take (15 - length s) $ repeat ' ') ++ s++-------------------------------------------------------------------------------+
+ leaky.cabal view
@@ -0,0 +1,311 @@++name: leaky+version: 0.1.0.0+synopsis: Robust space leak, and its strictification+description: Robust space leak, and its strictification, for testing <http://hackage.haskell.org/package/deepseq-bounded deepseq-bounded> and <http://hackage.haskell.org/package/seqaid seqaid>.+license: BSD3+license-file: LICENSE+author: Andrew Seniuk+maintainer: rasfar@gmail.com+category: Testing+build-type: Simple+cabal-version: >=1.10+tested-with: GHC==7.8.1, GHC==7.8.3+--tested-with: GHC==7.6.3, GHC==7.8.1, GHC==7.8.3++extra-source-files:++ README+ , HTML/*.html+ , HTML/*.css+ , rough-fs-twiddling-guide.txt++ , leaky-full.hs+ , leaky-full-incl-types.hs+ , Types_no_SOP.hs+ , Types_explicit_SOP.hs+ , seqaid.config+ , seqaid.config-full+ , seqaid.config-full-incl-types+--- , seqaid.config-full-no2ndmod++ , leaky-min-cppd.hs+ , leaky-min-cppd-working.hs+ , leaky-min.hs+ , Types_min.hs+ , seqaid.config-min++-- , LICENSE+-- , leaky.cabal+-- , Setup.hs+--- , cabal.config++-- XXX Would be nice if could avoid the TH when FORCING_STRATEGY < 4.++Flag TURN_ON_SEQAID_PLUGIN+ Description: Only provide the options to enable the seqaid preprocessor and GHC plugin.+ Default: True+--Default: False++Flag OMNITYPIC+ Description: Shouldn't need a Cabal flag for this, but it's the same problem of casing over integer values for a macro (in a .cabal file). So this need not be orthogonal to FORCING_STRATEGY, but this way it is ... which is okay, actually. (Can then test interactions with other FS=0..6.)+--Default: True+ Default: False++Flag TEST_SEQAIDPP+ Description: Finally crumbed and availed myself of -F -pgmF, although only for things which are /fairly/ safe via regex (injecting imports, top-level splices, "deriving instance" statements, LANGUAGE pragmas, etc.). (Later: You can't really do without this anymore, although with FORCING_STRATEGY=4 it is possible.)+ Default: True+--Default: False++Flag STATS+ Description: Dump periodic stats lines, for FORCING_STRATEGY that need it.+ Default: True+--Default: False++Flag USING_SANDBOX+ Description: I use them, but it's not default because it makes for much longer initial build, as all the dependencies (except base libs) need first to be installed (into the sandbox).+--Default: True+ Default: False++Flag USE_SECOND_MODULE+ Description: Temporary for testing... (Later: Sadly this is not so temporary. There is some kind of interference between SOP.TH and Seqaid.TH splices which is still unresolved. So, types needing NFDataP (etc.) instances will need to live in a module which is /not/ being harnessed.)+ Default: True+--Default: False++Flag PROFILE+ Description: Enable profiling+ Default: True+--Default: False++Flag USE_GROWING_LIST+ Description: The problem with using a growing list is, it itself is a leak (as it were), so it's hard to see you've plugged anything. However, the slowdown of "force" relative to "forcep" will be noticed! Alternative to GROWING is FIXED (is at length 10000 at the moment). Fixed list is infinite if INFINITE set below. (INFINITE has no effect when GROWING set.)+ Default: True+--Default: False++Flag USE_GROWING_LIST_REDUCTION+ Description: XXX For some reason, memory is being retained when REDUCTION is enabled. (Later: Is this still the case? I see it's been set to True throughout development...).+ Default: True+--Default: False++Flag USE_INFINITE_LIST+ Description: To show DeepSeq.force (FORCING_STRATEGY=1) at its worst.+--Default: True+ Default: False++Flag USE_STRICT_BLOB+ Description: Put some weighty strict subtrees in the test data structure, so can showcase forcep's specificity relative to forcen.+ Default: True+--Default: False++-- Flag FORCING_STRATEGY+-- Description: +-- --Default: 6+-- Default: (6::Int)+-------+-- Sadly, not.+-- See bottom of this file for the meanings of the values.++executable leaky++ main-is: leaky.hs+--main-is: leaky-min.hs+--main-is: leaky-min-cppd.hs+--leaky-pris.hs contains just the maladies.+--leaky.hs contains these, and remedies as well.+--leaky-no-let-without-in.hs is due to a bug in GHC HsExpr Outputable+---main-is: leaky-pris.hs+---main-is: leaky-no-let-without-in.hs++-- -- XXX Get rid of this Temp one soon (just a wee experiment)!...+-- other-modules: Temp++-- XXX Must later: I don't understand this:+ if flag(USE_STRICT_BLOB)+ other-modules: Types++ build-depends:+ base >=4.0 && <5.0+ , random++---------- BEGIN SEQAID-SPECIFIC -- PART 1 of 2 ----------++ -- User needs to add these deps themselves:+ -- Later: I'm sure not every one of these needs to be named,+ -- when using only FORCING_STRATEGY >= 4; probably, only+ -- seqaid (and template-haskell?).++ build-depends:+ deepseq-bounded+ , deepseq-generics+ , generics-sop+ , seqaid+ , template-haskell++ if flag(OMNITYPIC)+ build-depends:+ -- first needed by seqaidpp with the omnitypic blanket:+ ghc-prim+-- , integer-gmp+ +---------- END SEQAID-SPECIFIC -- PART 1 of 2 ----------++ -- hs-source-dirs: + default-language: Haskell2010+ ghc-options: -optP-Wundef -fno-warn-overlapping-patterns+--ghc-options: -optP-Wundef -fno-warn-overlapping-patterns -rtsopts -threaded+ if flag(PROFILE)+ ghc-options: -fprof-auto -auto-all -caf-all++---------- BEGIN SEQAID-SPECIFIC -- PART 2 of 2 ----------++-- XXX This whole section should be commented out+-- if you want to try FORCING_STRATEGY < 3.++--ghc-options: -fplugin=Seqaid.Plugin+-- -XTemplateHaskell+-- -with-rtsopts=-T+-- -rtsopts++ if flag(TURN_ON_SEQAID_PLUGIN)++ ghc-options: -fplugin=Seqaid.Plugin++ if flag(USING_SANDBOX)+ ghc-options: -F -pgmF .cabal-sandbox/bin/seqaidpp+ else+ ghc-options: -F -pgmF seqaidpp++ if flag(OMNITYPIC)+ ghc-options: -optF omnitypic++ -- Cabal (1.20) says that we should use "extensions: TemplateHaskell",+ -- which it then complains is deprecated -- but we'd really rather just+ -- give -XTemplateHaskell to GHC along with the other plugin-related+ -- options, in a compact group:+-- ghc-options: -XTemplateHaskell+ default-extensions: TemplateHaskell+-- other-extensions: TemplateHaskell+-- extensions: TemplateHaskell++-- We need -rtsopts above for other reasons (when get into -h* profile+-- integration); although -rtsopts is probably not needed for that+-- in recent GHC? But in any case, the below I think you WOULDN'T+-- need -rtsopts, since you're explicitly setting (augmenting, hopefully)+-- the default RTS options with the -T option.+ ghc-options: -with-rtsopts=-T+-- ghc-options: -rtsopts -with-rtsopts=-T++-- ghc-options: -split-objs++-- No longer used (TH provides this info to the plugin code):+-- -- Provide multiple target module names thus:+-- -fplugin-opt=Seqaid.Plugin:Main+-- -- -fplugin-opt=Seqaid.Plugin:Types+-- --- -fplugin-opt=Seqaid.Plugin:Leaky++-- ghc-options: -fforce-recomp+-- ghc-options: -dcore-lint+-- ghc-options: -ddump-splices+-- ghc-options: -ddump-simpl++-- ghc-options: -fno-liberate-case+-- ghc-options: -fliberate-case-threshold=0+-- --ghc-options: -fliberate-case-threshold=999+-- ghc-options: -fno-spec-constr++---------- END SEQAID-SPECIFIC -- PART 2 of 2 ----------++------------------------------------------------------++-- Trying to silence the "Loading package" lines of TH!+-- (This did not work out, but there's always sed...).+-- Refer to https://ghc.haskell.org/trac/ghc/ticket/5647 and its+-- usurper https://ghc.haskell.org/trac/ghc/ticket/7863.++-- http://www.macs.hw.ac.uk/~dsg/gph/docs/4.06/users_guide/options-output.html+-- this was suggested, but 7.8.3 doesn't recognise an -odump option.+--ghc-options: -odump seqaid-ghc-odump.log++-- With -v0 you get no "Compiling" lines for each module compiled :(+-- On the other hand, ... we /could/ detect the presence of this option+-- via seqaidpp, and synthesize compilation progress output lines.+-- In either case, we do see the plugin-specific output lines, which+-- is almost enough...+-- ...And I tried that, but I'm getting duplicate output and don't+-- quite understand it; so living with the "standard" TH dumping+-- of "Loading package" lines!+-- Will provide the "z" bash script that pipes through sed,+-- for user's convenience in case they care.+--ghc-options: -v0++-- This doesn't suppress any output for me, anyway.+------+-- Seems to work.+--ghc-options: -j=2+-- Seems to work.+--ghc-options: "-j 2"+-- This will cause an error when seqaidpp runs, for some+-- undetermined reason.+--ghc-options: -j 2++------------------------------------------------------++ -- Needed for all FORCING_STRATEGY's now:+ ghc-options: -with-rtsopts=-T+--ghc-options: -rtsopts -with-rtsopts=-T++ if flag(OMNITYPIC)+ cpp-options: -DOMNITYPIC=1+ else+ cpp-options: -DOMNITYPIC=0+ if flag(TEST_SEQAIDPP)+ cpp-options: -DTEST_SEQAIDPP=1+ else+ cpp-options: -DTEST_SEQAIDPP=0+ if flag(STATS)+ cpp-options: -DSTATS=1+ else+ cpp-options: -DSTATS=0+ if flag(USE_SECOND_MODULE)+ cpp-options: -DUSE_SECOND_MODULE=1+ else+ cpp-options: -DUSE_SECOND_MODULE=0+ if flag(USE_GROWING_LIST)+ cpp-options: -DUSE_GROWING_LIST=1+ else+ cpp-options: -DUSE_GROWING_LIST=0+ if flag(USE_GROWING_LIST_REDUCTION)+ cpp-options: -DUSE_GROWING_LIST_REDUCTION=1+ else+ cpp-options: -DUSE_GROWING_LIST_REDUCTION=0+ if flag(USE_INFINITE_LIST)+ cpp-options: -DUSE_INFINITE_LIST=1+ else+ cpp-options: -DUSE_INFINITE_LIST=0+ if flag(USE_STRICT_BLOB)+ cpp-options: -DUSE_STRICT_BLOB=1+ else+ cpp-options: -DUSE_STRICT_BLOB=0++-- 0 = None+-- 1 = Use rnf (the standard Control.DeepSeq)+-- 2 = Use rnfn (from Control.DeepSeq.Bounded)+-- 3 = Use rnfp (from Control.DeepSeq.Bounded)+-- 4 = Test manual instrumentation with Seqaid.Runtime.seqaid+-- 5 = Test seqaid blanket auto-instrumentation of top-level RHSs+-- 6 = Test seqaid blanket auto-instrumentation at requested type++ cpp-options: -DFORCING_STRATEGY=6+--cpp-options: -DFORCING_STRATEGY=flag(FORCING_STRATEGY)++-- Doesn't work (strange error, seems unrelated to my code):+-- Preprocessing executable 'leaky' for leaky-0.1.0.0...+-- Unknown option -include, for valid options try cpphs --help+--ghc-options: -pgmP cpphs+---ghc-options: -optP ...++--ghc-options: -fno-pre-inlining++--ghc-options: -ddump-simpl+--ghc-options: -ddump-splices+
+ leaky.hs view
@@ -0,0 +1,594 @@++-------------------------------------------------------------------------------++-- INSTRUCTIONS+--+-- This example concerns "steady-state" programs, where there+-- is a loop behaviour, and we want to sustain it indefinitely+-- with bounded (constant) space (and ca. constant frame period).+-- Servers and games are two exmaples of applications which fall+-- in this category.+--+-- Adjust duration to suit your hardware.+--+-- Toggle USE_GROWING_LIST and USE_INFINITE_LIST (see comments+-- at the #define's).+--+-- Set FORCING_STRATEGY:+-- 0 = None+-- 1 = Use the usual rnf from Control.DeepSeq+-- 2 = Use rnfn from Control.DeepSeq.Bounded+-- 3 = Use rnfp from Control.DeepSeq.Bounded+-- 4 = Test manual instrumentation with Seqaid.Runtime.seqaid+-- 5 = Test seqaid blanket auto-instrumentation of top-level RHSs+-- 6 = Test seqaid blanket auto-instrumentation at requested type+--+-- Suppose USE_GROWING_LIST=0, and suppose USE_INFINITE_LIST=1+-- (except where stated otherwise). This represents the+-- most "stressful" conditions.+--+-- You should be able to observe that FORCING_STRATEGY = ...+--+-- ... 0 : Has a space leak.+--+-- ... 1 : If USE_INFINITE_LIST, nonterminates; otherwise, has no leak+-- but runs very slowly.+--+-- ... 2 : Has no leak and runs fairly quickly, unless USE_STRICT_BLOB=1.+--+-- ... 3 : Has no leak and, while rnfp is slower than rnfn, it is+-- in the same ballpark (i.e. much faster than the usual rnf).+-- Morever, it gives us fine-grained control that rnfn cannot,+-- and is much faster than rnfn when USE_STRICT_BLOB=1.+--+-- ... 4 : +--+-- ... 5 : +--+-- ... 6 : +--+-- (Mainly tested with GHC 7.8.3 with -O2. -O2 was preferred b/c it+-- represents the most difficult case, where we're definitely+-- seeing these relative performance characteristics, even after+-- GHC has thrown everything it has at this bit of code in the+-- way of optimisations.)++-------------------------------------------------------------------------------++ {- OPTIONS_GHC -O2 #-}+ {-# OPTIONS_GHC -O0 #-}++ {- OPTIONS_GHC -ddump-splices #-}++-- How frustrating! It's been quite hard to induce this leak with+-- default optimisations in GHC 7.6.3, harder with 7.8.3, and+-- really hard with -O2 and 7.8.3. (But finally got there!)+--+-- And if go -O0, then even simplest recursion with+-- ctor applications leaks! (And "force" doesn't plug it.)+--+-- This scenario is however the classic justification for the+-- relatively lauded strict fields (actually part of Haskell98).+-- Have strict fields been unnecessary since 7.6.3, with default+-- optimisation? I don't think so...+--+-- What is going on "exactly"?...++-------------------------------------------------------------------------------++ {-# LANGUAGE CPP #-}++#define DBG 0++#if 0+#ifndef FORCING_STRATEGY+#warning UNDEF+#else+#if FORCING_STRATEGY == 0+#warning 0+#elif FORCING_STRATEGY == 1+#warning 1+#elif FORCING_STRATEGY == 2+#warning 2+#elif FORCING_STRATEGY == 3+#warning 3+#elif FORCING_STRATEGY == 4+#warning 4+#elif FORCING_STRATEGY == 5+#warning 5+#elif FORCING_STRATEGY == 6+#warning 6+#endif+#endif+#endif++-- XXX Sorry! It seems that TH doesn't see a consistent state+-- of CPP macros set by the .cabal flags. For the case that+-- FORCING_STRATEGY is undefined, this must be a TH run, and+-- in that case it's safest to force it to 5...+-- I've not been able to get a definite picture of how CPP,+-- TH, and pragmas interact, but it's not always ideal.+#ifndef FORCING_STRATEGY+#define FORCING_STRATEGY 5+#endif++-- XXX Note that GHC.Stats requires runtime option +RTS -T -RTS to use!++#if FORCING_STRATEGY >= 4+-- (In these cases, seqaid auto-instrumentation generates the output.)+#ifdef STATS+#undef STATS+#endif+#define STATS 0+#else+#endif++#if 0+#if FORCING_STRATEGY == 6+#warning FORCING_STRATEGY 6 not yet working. (Use 5 instead.)+#endif+#endif++-- -- The problem with using a growing list is, it itself is+-- -- a leak (as it were), so it's hard to see you've plugged+-- -- anything. However, the slowdown of "force" relative to "forcep"+-- -- will be noticed!+-- -- Alternative to GROWING is FIXED (is at length 10000 at the moment).+-- -- Fixed list is infinite if INFINITE set below.+-- -- (INFINITE has no effect when GROWING set.)+-- #define USE_GROWING_LIST 1+-- -- XXX For some reason, memory is being retained with REDUCTION.+-- #define USE_GROWING_LIST_REDUCTION 1+-- #define USE_INFINITE_LIST 0+-- +-- -- Put some weighty strict subtrees in the test data structure,+-- -- so can showcase forcep's specificity relative to forcen.+-- #define USE_STRICT_BLOB 1+-- +-- -- 0 = None+-- -- 1 = Use rnf (the standard Control.DeepSeq)+-- -- 2 = Use rnfn (from Control.DeepSeq.Bounded)+-- -- 3 = Use rnfp (from Control.DeepSeq.Bounded)+-- -- 4 = Test manual instrumentation with Seqaid.Runtime.seqaid+-- -- 5 = Test seqaid blanket auto-instrumentation of top-level RHSs+-- -- 6 = Test seqaid blanket auto-instrumentation at requested type+-- #define FORCING_STRATEGY 6++-------------------------------------------------------------------------------++-- For NFDataP (which perforce includes NFDataN and NFData):+ {-# LANGUAGE TemplateHaskell #-}+ {- LANGUAGE ScopedTypeVariables #-}+ {-# LANGUAGE DataKinds #-}+ {-# LANGUAGE TypeFamilies #-}+ {- LANGUAGE ConstraintKinds #-}+ {-# LANGUAGE GADTs #-} -- for GHC 7.6.3+ {-# LANGUAGE DeriveGeneric #-}+ {-# LANGUAGE DeriveDataTypeable #-}+ {-# LANGUAGE StandaloneDeriving #-}++-------------------------------------------------------------------------------++ -- RankNTypes wanted since some injected type signatures,+ -- due to imported types, may require it.+ -- The user currently has to add this themselves; it would+ -- be nice if SOME available form of automatic injection+ -- could do this! (A text-based pre-processor might be able...).+ -- (So far as I know, no Haskell library or GHC feature will+ -- allow auto-injection of pragmas, but it's quite trivial+ -- as a text pre-process.)+ {-# LANGUAGE RankNTypes #-}++-------------------------------------------------------------------------------++ -- XXX Unfortunately, the way seqaidpp works, a module declaration+ -- is mandatory. This won't normally be a big deal, as Main is+ -- the only module that is allowed to omit the declaration, and+ -- when omitted, it's always equivalent to the following:++ module Main ( main ) where++-------------------------------------------------------------------------------++ import Control.DeepSeq.Bounded+ import Control.DeepSeq.Generics++ import Generics.SOP.TH+ import GHC.Generics ( Generic )+ import Data.Typeable ( Typeable )+ import Data.Data ( Data )++--import Control.Concurrent ( threadDelay )+ import Control.Monad ( when )+ import Control.Exception ( evaluate ) -- (\x -> (return $! x) >>= return)++ import System.Environment ( getArgs )+ import System.IO ( stdout, hFlush )++ import System.Random++ import Data.List ( foldl' )++ import Debug.Trace ( trace )++-- We synthesize it.+#if 0 && FORCING_STRATEGY == 4+ import Seqaid.Runtime ( seqaid )+#endif++-- Now seeing if can inject with seqaidpp...+-- It's not foolproof yet: What if the module+-- has no imports? What if the topmost import+-- is within a block comment???.....+#if ! TEST_SEQAIDPP+#if FORCING_STRATEGY >= 4+ import Seqaid.TH+--import Seqaid.Runtime -- comes in with Seqaid.TH+--import Seqaid.Ann -- comes in with Seqaid.TH+#endif+#endif++ import Types++--import Temp++#if STATS+ import GHC.Stats -- requires runtime option +RTS -T -RTS to use!+ import GHC.Int ( Int64 )+#endif++-------------------------------------------------------------------------------++#if FORCING_STRATEGY >= 4+ {- ANN module (SeqaidAnnExclude "bigStrictBlob") #-} -- works+ {- ANN module (SeqaidAnnExclude "main") #-} -- works+ {- ANN module (SeqaidAnnExclude "duration") #-} -- fails+ {- ANN module (SeqaidAnnExclude "initState") #-} -- fails+ -- Those that fail, also fail if give them ++ -- Oh I see: I ended up "reserving" List one for internal use. [?]+ -- But should give an appropriate error when seen in user code then!+ {- ANN module (SeqaidAnnExcludeList ["bigStrictBlob","main"]) #-}+#endif++-------------------------------------------------------------------------------++-- XXX Now using GHC -F preprocessor instead.+#if 0 && FORCING_STRATEGY == 4+ seqaidManTH+#endif++-------------------------------------------------------------------------------++#if 1+#if FORCING_STRATEGY >= 4+ {-# NOINLINE test_auto_ann #-}+#if 1+ {- ANN module (SeqaidAnnExclude "test_auto_ann") #-}+ test_auto_ann :: a+ test_auto_ann = undefined+#else+ {- ANN module (SeqaidAnnExclude "test_auto_ann") #-}+ test_auto_ann :: NFDataP a => a+ test_auto_ann = seqaidDispatch (23,"") $ undefined+#endif+#endif+#endif++-------------------------------------------------------------------------------++-- XXX tune for your hardware+#if DBG+ duration = 8+#else+-- XXX I haven't gotten to the bottom of why there's this discrepancy...+#if FORCING_STRATEGY == 6+ duration = 10000+--duration = 100000+#else+#if FORCING_STRATEGY == 5+ duration = 10000+#else+#if FORCING_STRATEGY <= 3+ duration = 500000+#else+ duration = 100000+#endif+#endif+#endif+#endif++ report_period = duration `div` 20++-------------------------------------------------------------------------------++#if FORCING_STRATEGY >= 4+ {-# ANN module (SeqaidAnnExclude "main") #-}+#endif+ main :: IO ()+ main = do++ putStrLn "Started leaky..."++ [saltstr] <- getArgs+ let salt = read saltstr :: Int+ let g = mkStdGen salt++ let state = initState++ -- Set up the Pattern.+ -- (Only referenced when FORCING_STRATEGY=3.)+#if FORCING_STRATEGY == 3+#if USE_STRICT_BLOB+ let pat = compilePat ".{.{..{.}.{.{.{.}#..{.}}}}..{..{.}}}"+-- let pat = compilePat ".{.{..{.}.{.{.{.}...{.}}}}..{..{.}}}"+#else+#if 0+#elif 1+ let pat = mkPat state -- identical to the explicit pattern below+#elif 0+ let pat = compilePat ".{.{..{.}.{.{.{.}..{.}}}}..{..{.}}}"+#elif 0+ let pat = compilePat "*" -- should be (is) equivalent to rnf+#endif+#endif+ putStrLn $ showPat pat+#else+ let pat = compilePat "#"+#endif++#if STATS+ putStrLn $ pad 15 "live heap" ++ pad 15 "total bytes"+#endif++#if USE_GROWING_LIST+ let state' = state+#else+ -- Now that we used "mkPat state" to get the shape of interest,+ -- fill in one or more heavy data branches.+#if USE_INFINITE_LIST+ let state' = setList [1,2..] state -- bwahaha!!+#else+ let state' = setList (take 10000 [1,2..]) state+#endif+#endif++#if STATS+ rslt <- duty g pat state' 0 0+ evaluate rslt -- force the head+#else+#if 0+#elif 0+ rslt <- return $! duty g pat state' 0 -- force the head?+#elif 0+ duty g pat state' 0 `seq` return () -- force the head?+#elif 0+ evaluate $ duty g pat state' 0 -- force the head?+#elif 0+ rslt <- duty g pat state' 0+ rslt `seq` return () -- force the head?+#elif 1+ rslt <- duty g pat state' 0+ evaluate rslt -- force the head!+-- evaluate = \x -> (return $! x) >>= return+#endif+#endif++#if DBG+ putStrLn "Finished."+#else+ putStrLn "\nFinished."+#endif++-------------------------------------------------------------------------------++#if FORCING_STRATEGY == 4+ {-# ANN module (SeqaidAnnManual "duty") #-}+#endif+#if 1+--- #if FORCING_STRATEGY >= 4+#if FORCING_STRATEGY == 4+ {-# ANN module (SeqaidAnnExclude "duty") #-}+#endif+#if FORCING_STRATEGY == 5+ {-# ANN module (SeqaidAnnExclude "duty") #-}+#endif+#if STATS+ duty :: StdGen -> Pattern -> State -> Int -> Int64 -> IO Int+ duty g pat state ii last_total_bytes_allocated = do+#else+ duty :: StdGen -> Pattern -> State -> Int -> IO Int+ duty g pat state ii = do+#endif+#else+-- Or shouldn't this be == 4 || == 5, now? (It might not matter;+-- if it works Excluded with 4, it'll work Excl. with 6.)+-- Later: I'm not sure that's true; will see as the smoke clears...+#if FORCING_STRATEGY >= 4+ -- this works whether ANN on or off:+ {-# ANN module (SeqaidAnnExclude "duty") #-}+#endif+#if STATS+ duty :: StdGen -> Pattern -> State -> Int -> Int64 -> IO Int+ duty g pat state ii last_total_bytes_allocated = seqaidDispatch $ do+#else+ duty :: StdGen -> Pattern -> State -> Int -> IO Int+ duty g pat state ii = seqaidDispatch $ do+--duty g pat state ii = do -- see "tail call" for the manual injection+#endif+#endif++ let (r,g') = random g :: (Bool,StdGen)++ let (A2 (B3 i1+ (A1 i2)+#if USE_STRICT_BLOB+ (B2 (C3 (C2 i3) blob lst (C2 i4))))+#else+ (B2 (C3 (C2 i3) lst (C2 i4))))+#endif+ i5+ (C1 i6 (C2 i7))) = state++#if USE_GROWING_LIST && USE_GROWING_LIST_REDUCTION+ let lst' = if 0 == ii `mod` 5000+ then [ii] else (ii:lst)+#else+ let lst' = lst+#endif++ let state' = if r then state else+ let state_ = A2 (B3 (1+i1)+ (A1 (1+i2))+#if USE_STRICT_BLOB+ (B2 (C3 (C2 (1+i3)) blob lst' (C2 (1+i4)))))+#else+ (B2 (C3 (C2 (1+i3)) lst' (C2 (1+i4)))))+#endif+ (1+i5)+ (C1 (1+i6) (C2 (1+i7))) in+#if FORCING_STRATEGY == 0+ state_+#elif FORCING_STRATEGY == 1+ force $ state_+#elif FORCING_STRATEGY == 2+ forcen 6 $ state_+#elif FORCING_STRATEGY == 3+ forcep_ pat $ state_+#elif FORCING_STRATEGY == 4+ seqaid state_+-- seqaid $ state_+#elif FORCING_STRATEGY == 5+ pure_escape state_+#elif FORCING_STRATEGY == 6+ state_+#endif++ -- Unless you do this, the forcing code above never runs:+ evaluate state' -- forces only the head! (a way to place demand)++#if 0+#if DBG+ when ( True ) $ do+#else+ when ( 0 == ii `mod` 5000 ) $ do+#endif+-- threadDelay 500+#if DBG+ putStr ".\n"+#else+ putStr "."+#endif+ hFlush stdout+#endif++#if STATS+ new_total_bytes_allocated+ <- if 0 == ii `mod` report_period+ then do+ stats <- getGCStats+ let bytes = bytesAllocated stats+ putStrLn $ pad 15 (show (currentBytesUsed stats))+ ++ pad 15 (show (bytes - last_total_bytes_allocated))+ return $ bytesAllocated stats+ else return last_total_bytes_allocated+#else+#if 0+ when ( 0 == ii `mod` report_period ) $ do+-- threadDelay 500+ putStr "."+ hFlush stdout+#endif+#endif++ -- (However, the interesting case is when pat' changes dynamically...+ -- That is what happens with FORCING_STRATEGY >= 4.)+ let pat' = pat++ let ii' = 1+ii+ if ii' < duration+ then do+#if STATS+ duty g' pat' state' ii' new_total_bytes_allocated+#else+ duty g' pat' state' ii'+-- seqaidDispatch (duty g' pat' state' ii')+#endif+ else do+ return ii'++-------------------------------------------------------------------------------++-- Later: Due to some changes in the last couple hours, this+-- seems to no longer be necessary.+-- XXX Yep, still true! So it's not only a matter of+-- the == 5 || == 6 construct!+-- XXX Must be commented out, for TH not to complain;+-- the problem with Cabal flags not reaching TH passes+-- in such cases (sometimes)...+#if 1+#if FORCING_STRATEGY == 5+ {-# NOINLINE pure_escape #-}+ -- XXX This is still needed, until we decide what to do about+ -- auto-instrumenting monadic binds...+ pure_escape :: State -> State+ pure_escape state = state+#endif+#endif++-------------------------------------------------------------------------------++#if FORCING_STRATEGY >= 4+ {-# ANN module (SeqaidAnnExclude "initState") #-}+ {- NOINLINE initState #-} -- does not help linker errors I'm getting!...+#endif+ initState :: State+#if USE_STRICT_BLOB+ initState = let blob = bigstrictblob 3000 in+ A2 (B3 0 (A1 0) (B2 (C3 (C2 0) blob [] (C2 0)))) 0 (C1 0 (C2 0))+#else+ initState = A2 (B3 0 (A1 0) (B2 (C3 (C2 0) [] (C2 0)))) 0 (C1 0 (C2 0))+#endif++#if FORCING_STRATEGY >= 4+ {-# ANN module (SeqaidAnnExclude "bigstrictblob") #-}+#endif+ bigstrictblob :: Int -> Blob Int+ bigstrictblob n = Blob (take n [1,2..])++-------------------------------------------------------------------------------++#if FORCING_STRATEGY >= 4+ {-# ANN module (SeqaidAnnExclude "setList") #-}+#endif+ setList :: [Int] -> State -> State+#if USE_STRICT_BLOB+ setList lst (A2 (B3 i1 (A1 i2) (B2 (C3 (C2 i3) blob _ (C2 i4)))) i5 c1)+ = (A2 (B3 i1 (A1 i2) (B2 (C3 (C2 i3) blob lst (C2 i4)))) i5 c1)+#else+ setList lst (A2 (B3 i1 (A1 i2) (B2 (C3 (C2 i3) _ (C2 i4)))) i5 c1)+ = (A2 (B3 i1 (A1 i2) (B2 (C3 (C2 i3) lst (C2 i4)))) i5 c1)+#endif++-------------------------------------------------------------------------------++#if STATS+ pad :: Int -> String -> String+ pad n s = (take (n-len) $ repeat ' ') ++ s+ where len = length s+#endif++-------------------------------------------------------------------------------++-- Later: Now we always do it via seqaidpp.+#if 0+-- Now seeing if can inject with seqaidpp...+#if ! TEST_SEQAIDPP+#if FORCING_STRATEGY >= 5+ seqaidTH+#endif+#endif+#endif++-------------------------------------------------------------------------------+
+ rough-fs-twiddling-guide.txt view
@@ -0,0 +1,37 @@++Wed Dec 17 20:50:05 CST 2014+ - trying to go over the FS=0..6 again now+ - starting from a configuration for 6 (which is the default+ leaky distribution), will go back to 0 and work back up,+ noting what had to do+ - the same seqaid.config can be used in all cases++ - FS=0 (does no forcing)+ - leaky.cabal TURN_ON_SEQAID_PLUGIN flag must be False+ - invoke cabal configure --flag=-TURN_ON_SEQAID_PLUGIN+ - or, just edit the default in leaky.cabal++ - FS=1 (rnf)+ - you need the Types.hs module to do it's own SOP deriving, so:+ cp Types_explicit_SOP.hs Types.hs+ - this would perform immesurably worse if we turned on USE_INFINITE_LIST+ - (and leaky.cabal TURN_ON_SEQAID_PLUGIN flag must still be False)++ - FS=2 (rnfn)+ - no change needed from FS=1++ - FS=3 (rnfp)+ - no change needed from FS=1,2++ - FS=4 (manual seqaid)+ - leaky.cabal TURN_ON_SEQAID_PLUGIN flag must be True+ - need to uncomment the leaky.cabal plugin options (-fplugin and -F)+ - need to get non-explicit-SOP Types.hs in place:+ cp Types_no_SOP.hs Types.hs++ - FS=5 (top-level RHS's)+ - no change needed from FS=4++ - FS=6 (seqaid.config type-directed harnessing)+ - no change needed from FS=4+
+ seqaid.config view
@@ -0,0 +1,5 @@+package leaky+module Main+ binds duty+ types Types.TA+instances Types.TA, Types.TB, Types.TC
+ seqaid.config-full view
@@ -0,0 +1,5 @@+package leaky+module Main+ binds duty+ types Types.TA+instances Types.TA, Types.TB, Types.TC
+ seqaid.config-full-incl-types view
@@ -0,0 +1,10 @@++ package: leaky+ module: Main+ types: Main.TA, Main.State+# types: Main.State+# types: Main.TA+# module: Temp+ instances: Main.TA, Main.TB, Main.TC+# instances: Main.TA, Main.TB, Main.TC, Main.Blob+
+ seqaid.config-min view
@@ -0,0 +1,12 @@++ package leaky+ module Main+ binds duty+# types State+ types Types_min.State+# types Types_min.St+# types Types_min.State, Types_min.St+# instances Main.State+ instances Types_min.St+# instances Types_min.State+