------------------------------------------------------------------------------- -- Plans -- -- Try to make the optimiser pure. -- -- For simplicity, let's assume a steady-state program; this will -- still be useful with minimal change if need to respond adaptively... -- -- If you can afford the sum-of-products weighting coefficients, -- you can get pretty flexible objective functions out of the -- three main quantities of interest (that I can think of): -- -- (1) Time. -- The amount of time elapsed since last checkpoint -- should preferably not increase. -- -- (2) Heap size. -- The size of the live heap since last checkpoint -- should preferably not increase. -- -- (3) Bytes allocated (this frame). -- The amount of GC activity since last checkpoint -- should preferably not increase. -- -- Any of these, taken individually (i.e. extremes of the l.c.) -- would be interesting and useful, but it seems reasonable -- to expect a non-trivial blend of two, or all, to be -- most "meta-performant" (best convergence rates). Or who knows! -- -- Need to experiment. -- -- I don't yet have code in place measuring (1); only (2) and (3). ------------------------------------------------------------------------------- -- The specific strategy for this next round at least: -- Two-phase optimisation: -- -- (1) N-phase : sweep forcen n=0,1,... until either: -- - gets too costly in Time [once can measure that...]; or -- - achieve dramatic improvement in objective function (at n' say) -- -- (2) P-phase : begin with mkPatN n' -- - forcep . (mkPatN n) = forcen n -- Then call erodePat (with weighting of choice). -- keep doing this, accepting steps only if performance -- improves (rel. to your objective criterion). Eventually -- no improvement will be made for a long time -- this is -- taken as an "approximation to global optimum", and a -- fresh pass through the P-phase can be used to try -- additional stochastic trials. -- -- Also, in principle, you might be better to start mkPatN at -- an n' higher than the very lowest which plugged leak. -- This seems a bit unlikely, but I don't know why not... -- That you might arrive at a better global optimum -- if you allow some "surplus forcing" at one or more points. -- -- These are the nagging questions that I'm not sure about, -- and expect to learn more as begin testing and seqaid on -- a corpus of programs. ------------------------------------------------------------------------------- {- OPTIONS_GHC -O2 #-} {-# LANGUAGE CPP #-} -- XXX Should scour the code for "max_depth" etc. -- all those -- names which are specific to this DEMO_MODE hack!... And get -- them into CPP guards. And get something sane in the OTHER -- branches of those guards!!... -- (Switch now promoted to .cabal flag.) --- #define DEMO_MODE 1 {-# LANGUAGE BangPatterns #-} -- for debugging only? (maybe more...) ------------------------------------------------------------------------------- -- | -- Module : Seqaid.Optim -- Copyright : (c) 2014, Andrew G. Seniuk -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Andrew Seniuk <rasfar@gmail.com> -- Stability : provisional -- Portability : GHC (uses global IORefs) -- -- Harness morphological code. -- -- The optimiser is just barely begun, but implementing it is -- straight-forward Haskell programming, as contrasted with most -- of the supporting infrastructure. module Seqaid.Optim ( run_IO_SM , optimIO , optim , optim_N_phase , optim_P_phase , ) where ------------------------------------------------------------------------------- import Control.DeepSeq.Bounded import Data.Typeable ( Typeable ) -- Stuff for monitoring resource use (i.e. computing objective function): import GHC.Int ( Int64 ) import Data.IORef #if SEQABLE_ONLY -- I've seen this one displayed, so going with the more formal name: import Generics.SOP.Universe ( Generic ) --import Generics.SOP ( Generic ) #endif #if 0 #if ! DEMO_MODE import qualified Data.HashTable.IO as H #endif #endif --import Debug.Trace ( trace ) ------------------------------------------------------------------------------- import Seqaid.Global ( depth_ioref ) #if DEMO_MODE import Seqaid.Global ( pattern_ioref ) #else import Seqaid.Global ( patterns_ioref ) #endif import Seqaid.Global ( snk_ioref ) import Seqaid.Global ( stats_query_idx_ioref ) import Seqaid.Global ( counter_ioref ) import Seqaid.Global ( next_sample_at_ioref ) import Seqaid.Global ( bytes_allocated_ioref ) import Seqaid.Global ( bytes_allocated_prev_ioref ) import Seqaid.Global ( current_bytes_used_ioref ) import Seqaid.Global ( update_bytes_allocated_ioref ) --depth_ioref :: IORef Int --pattern_ioref :: IORef Pattern --patterns_ioref :: IORef (HashTable Int Pattern) --snk_ioref :: IORef SeqNodeKind --stats_query_idx_ioref :: IORef Int --counter_ioref :: IORef Int64 --next_sample_at_ioref :: IORef Int64 --bytes_allocated_ioref :: IORef Int64 --bytes_allocated_prev_ioref :: IORef Int64 --current_bytes_used_ioref :: IORef Int64 --update_bytes_allocated_ioref :: IO Int64 --type HashTable k v = H.CuckooHashTable k v ------------------------------------------------------------------------------- import Seqaid.Global ( update_current_bytes_used_ioref ) import Seqaid.Global ( max_depth ) import Seqaid.Global ( sample_period ) import Seqaid.Global ( fixed_pat_sequence ) import Seqaid.Global ( SiteID ) ------------------------------------------------------------------------------- -- The plan is to keep this module pure. -- So, it must be up the call chain someplace that -- the IORef operations occur. -- -- XXX Since that sounds like boilerplate, it might be -- a good idea to offer a wrapper to the pure, here, -- which also takes care of the IORef stuff... ------------------------------------------------------------------------------- -- XXX Why is depth global, but patterns is per-site?... ----- -- This needs to read the (most recently cached) GHC.Stats data. -- If N-phase, needs to affect the depth_ioref. -- If P-phase, needs to affect the patterns_ioref. -- It could actually have type IO (), but might like to -- return some pertinent information as well. optimIO :: IO () --optimIO :: IO (Int,Int,Pattern,SeqNodeKind,Int64,Int64,Int64,Int64,Int64) optimIO = do -- XXX Based on a clone of run_IO_SM. #if 0 stats_query_idx <- do sqi <- readIORef stats_query_idx_ioref return sqi depth <- do d <- readIORef depth_ioref return d #if 0 -- XXX a code fragment expected to be useful (see seqaidDispatch where clause) tmp = stats_query_idx-(2+max_depth) pat' | tmp < length fixed_pat_sequence = fixed_pat_sequence!!tmp | otherwise = last fixed_pat_sequence #endif #if NFDATAN_ONLY #error "NFDATAN_ONLY is not valid at this time." #else #if 1 pat <- do #if 1 || DEMO_MODE let tmp = stats_query_idx -- let tmp = stats_query_idx-(2+max_depth) let p | tmp < length fixed_pat_sequence = fixed_pat_sequence!!tmp | otherwise = last fixed_pat_sequence #if 0 H.insert ht sid_hash p #endif return p #else ht <- readIORef patterns_ioref let sid_hash = thd3 sid mp <- H.lookup ht sid_hash if isNothing mp then do let p = compilePat "#" H.insert ht sid_hash p return p else do return $ fromJust mp #endif #else -- XXX wrong and never tested, obviously pat = patterns_ioref!(fst3 sid) #endif #endif #endif i <- do ii <- readIORef counter_ioref modifyIORef' counter_ioref (1+) return ii ba <- readIORef bytes_allocated_ioref cbu <- readIORef current_bytes_used_ioref #if 0 #if 0 if stats_query_idx >= max_depth && i >= t then do let j = stats_query_idx - max_depth writeIORef pattern_ioref (fixed_pat_sequence!!j) return () else return () #endif if depth <= max_depth && i >= t then do #if 1 modifyIORef' depth_ioref (1+) #else -- XXX need Data instances... -- writeIORef pattern_ioref (mkPatN depth x) #endif return () else return () #endif --- !_ <- return x -- magic! thank you!! -- return (stats_query_idx,depth,pat,snk,i,t,size,cbu,t') return () ------------------------------------------------------------------------------- optim :: () optim = () ------------------------------------------------------------------------------- optim_N_phase :: () optim_N_phase = () ------------------------------------------------------------------------------- optim_P_phase :: () optim_P_phase = () ------------------------------------------------------------------------------- -- Okay! -- Now it is time to use the hash values -- XXX This is simply the collected unsafePerformIO calls -- that were initially scattered throughout seqaidDispatch. -- It happened to behave the same as that did, without change; -- but a once-over reorganising the logic slightly would be good... -- is this pragma necessary? does it even make sense with IO?... {-# NOINLINE run_IO_SM #-} #if SEQABLE_ONLY run_IO_SM :: (Generic a,Typeable a) => SiteID -> a -> IO (Int,Int,Pattern,SeqNodeKind,Int64,Int64,Int64,Int64,Int64) #else #if NFDATAN_ONLY run_IO_SM :: (NFDataN a,Typeable a) => SiteID -> a -> IO (Int,Int,Pattern,SeqNodeKind,Int64,Int64,Int64,Int64,Int64) #else run_IO_SM :: (NFData a,NFDataN a,Typeable a,NFDataP a) => SiteID -> a -> IO (Int,Int,Pattern,SeqNodeKind,Int64,Int64,Int64,Int64,Int64) #endif #endif run_IO_SM sid x = do stats_query_idx <- do sqi <- readIORef stats_query_idx_ioref return sqi depth <- do d <- readIORef depth_ioref return d #if 0 -- XXX a code fragment expected to be useful (see seqaidDispatch where clause) tmp = stats_query_idx-(2+max_depth) pat' | tmp < length fixed_pat_sequence = fixed_pat_sequence!!tmp | otherwise = last fixed_pat_sequence #endif #if SEQABLE_ONLY let pat = compilePat "#" -- just whatever #else #if NFDATAN_ONLY --- #error "NFDATA_ONLY is not valid at this time." let pat = compilePat "#" -- just whatever #else pat <- do #if 1 || DEMO_MODE let tmp = stats_query_idx -- let tmp = stats_query_idx-(2+max_depth) let p | tmp < length fixed_pat_sequence = fixed_pat_sequence!!tmp | otherwise = last fixed_pat_sequence #if 0 H.insert ht sid_hash p #endif return p #else ht <- readIORef patterns_ioref let sid_hash = thd3 sid mp <- H.lookup ht sid_hash if isNothing mp then do let p = compilePat "#" H.insert ht sid_hash p return p else do return $ fromJust mp #endif #endif #endif #if SEQABLE_ONLY let snk = Propagate #else let snk = Propagate -- just whatever #endif i <- do ii <- readIORef counter_ioref modifyIORef' counter_ioref (1+) return ii t <- do tt <- readIORef next_sample_at_ioref return tt (size,cbu,t') <- if i >= t then do modifyIORef' next_sample_at_ioref (+sample_period) -- (the snd component of result is for repairing -- a lag in the value for t shown in trace lines) tt <- readIORef next_sample_at_ioref ba <- update_bytes_allocated_ioref cbu <- update_current_bytes_used_ioref return (ba,cbu,tt) else do ba <- readIORef bytes_allocated_ioref cbu <- readIORef current_bytes_used_ioref return (ba,cbu,t) if i >= t then do modifyIORef' stats_query_idx_ioref (1+) return () else return () #if 0 if stats_query_idx >= max_depth && i >= t then do let j = stats_query_idx - max_depth writeIORef pattern_ioref (fixed_pat_sequence!!j) return () else return () #endif if depth <= max_depth && i >= t then do #if 1 modifyIORef' depth_ioref (1+) #else -- XXX need Data instances... -- writeIORef pattern_ioref (mkPatN depth x) #endif return () else return () optimIO --- (!_,!_,!_,!_,!_,!_,!_,!_,!_) <- optimIO -- XXX (as if XXX is nec. lol!) -- At the moment, this no longer seems necessary at all. -- (But maybe it was for when first getting it working, -- and sample_period was 1 [or at least small]; and -- when the test program did little work...). -- XXX Note that if we can avoid this, there is another benefit: -- We don't necessarily WANT to force the head of x! (forcen 0, -- or forcep "#")... --- _ <- return $! x -- works as well?... !_ <- return x -- magic! thank you!! return (stats_query_idx,depth,pat,snk,i,t,size,cbu,t') -- return () -------------------------------------------------------------------------------