leaky-0.1.0.0: leaky-full.hs
-------------------------------------------------------------------------------
-- 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
-------------------------------------------------------------------------------