------------------------------------------------------------------------------- -- 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 -------------------------------------------------------------------------------