------------------------------------------------------------------------------- -- XXX Later: OLD comment! probably not correct -- This is a static module injected by Seqaid. -- It is not designed to depend dynamically on the target source. {- OPTIONS_GHC -O2 #-} {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} -- for debugging only (maybe for more...) ------------------------------------------------------------------------------- -- | -- Module : Seqaid.Runtime -- Copyright : (c) 2014, Andrew G. Seniuk -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Andrew Seniuk <rasfar@gmail.com> -- Stability : provisional -- Portability : GHC (unsafePerformIO) -- -- This module is for seqaid internal use. module Seqaid.Runtime ( SiteID -- re-export , seqaidDispatch , seqaidDispatchDyn -- would be best if could... (less for plugin/lib user to do) -- , module Control.DeepSeq.Bounded -- , Typeable ) where ------------------------------------------------------------------------------- import Control.DeepSeq.Bounded import Data.Typeable ( typeOf ) import Data.Typeable ( Typeable ) import Seqaid.Global ( SiteID --- , run_IO_SM -- moved to Optim [not ideal, but...] -- , sample_period , max_depth -- , fixed_pat_sequence , fixed_pat ) import Seqaid.Optim -- (for monitoring resource use, and computing objective function) import System.IO.Unsafe ( unsafePerformIO ) import Debug.Trace ( trace ) #if SEQABLE_ONLY import Generics.SOP ( Generic ) #endif ------------------------------------------------------------------------------- {-# NOINLINE seqaidDispatch #-} #if SEQABLE_ONLY seqaidDispatch :: ( #if SHOW_TYPE --- #warning "WARNING-2" Typeable a, #endif Generic a) => SiteID -> a -> a seqaidDispatch sid x = #if DBG_SEQAID if {- True || -} i >= t then trace (">>> S " ++snd3 sid++"\t" ++show stats_query_idx++" " ++show (i,t,size)++" " #if SHOW_TYPE ++show (typeOf x) #endif ) $ #endif x' else x' #else #if NFDATAN_ONLY --- #warning "WARNING-1" -- It's very tempting to write this with the CPP subconditionals deeper in... seqaidDispatch :: ( #if SHOW_TYPE --- #warning "WARNING-2" Typeable a, #endif NFDataN a) => SiteID -> a -> a seqaidDispatch sid x = #if DBG_SEQAID if {- True || -} i >= t then trace (">>> N " -- trace ("SEQAIDDISPATCH N " ++snd3 sid++"\t" ++show stats_query_idx++" " ++show (i,t,size)++" " #if SHOW_TYPE ++show (typeOf x) #endif ) $ #endif x' else x' #else seqaidDispatch :: (NFData a,NFDataN a,Typeable a,NFDataP a) => SiteID -> a -> a seqaidDispatch sid x = #if DBG_SEQAID #if 1 -- 80 cols if i >= t -- if True || i >= t then trace ((if stats_query_idx == 0 then " live alloc\n" else "")++(if stats_query_idx <= (1+max_depth) then " N " else " P ") ++(if stats_query_idx <= (1+max_depth) then (padr 36 (show depth)) else padr 36 (showPat pat'))++" " -- ++padl 2 (show (fst3 sid))++" " ++padr 13 (dropQuals (snd3 sid)) -- ++padl 3 (show stats_query_idx)++" " ++padl 8 (show cbu)++" " ++padl 9 (show size)++" " -- ++show (cbu, size)++" " -- ++show (i, size)++" " -- ++show (i,t',size)++" " ++show (typeOf x) ) $ #else -- 110 cols if i >= t -- if True || i >= t then #if 1 trace ((if stats_query_idx == 0 then " live heap alloc\n" else "")++(if stats_query_idx <= (1+max_depth) then ">>> N " else ">>> P ") #else trace (">>> P " #endif -- trace ("SEQAIDDISPATCH P " ++(if stats_query_idx <= (1+max_depth) then (padr 40 (show depth)) else padr 40 (showPat pat'))++" " ++padl 2 (show (fst3 sid))++" " -- ++(if fst3 sid > 9 then "" else " ")++show (fst3 sid)++" " ++snd3 sid++"\t" -- ++show sid++"\t" ++padl 3 (show stats_query_idx)++" " ++padl 11 (show cbu)++" " ++padl 11 (show size)++" " -- ++show (cbu, size)++" " -- ++show (i, size)++" " -- ++show (i,t',size)++" " ++show (typeOf x) ) $ #endif #endif x' else x' #endif #endif where ( stats_query_idx, depth, pat, snk, i, t, size, cbu, t') -- (!stats_query_idx,!depth,!pat,!snk,!i,!t,!size,!cbu,!t') = unsafePerformIO $! run_IO_SM sid x -- The constants 6 and fixed_pat are specific to the leaky-1.0 package. -- They are minimal sufficient depth and pattern (respectively) to plug leaky. #if SEQABLE_ONLY x' = force_ snk x -- x' = force_ Insulate x #else #if NFDATAN_ONLY x' = forcen depth x -- x' = forcen 6 x #else pat' = pat x' | stats_query_idx <= (1+max_depth) = forcep_ pat x -- trying to use *n patterns instead -- = forcen depth x | otherwise = forcep_ pat x #endif #endif ------------------------------------------------------------------------------- -- Note that NFDataP already has Typeable superclass. -- (This is not ideal perhaps, as a lot of NFDataP's -- functionality doesn't depend on Typeable...). #if 1 -- For plugin, we prefer to try without the extra argument first... seqaidDispatchDyn :: NFDataP a => a -> a seqaidDispatchDyn x = x' where t = show $ typeOf x x' | t == "TA" = forcep_ fixed_pat x | otherwise = x #else seqaidDispatchDyn :: NFDataP a => SiteID -> a -> a --seqaidDispatchDyn :: NFDataP a => a -> a --seqaidDispatchDyn :: (Typeable a,NFDataP a) => a -> a seqaidDispatchDyn _ x = x' where -- !_ = trace t $ () t = show $ typeOf x x' | t == "TA" = forcep_ fixed_pat x -- x' | t == "State" = forcep_ fixed_pat x | otherwise = x #endif ------------------------------------------------------------------------------- padr :: Int -> String -> String padr n s = s ++ (take (n-(length s)) $ repeat ' ') padl :: Int -> String -> String padl n s = (take (n-(length s)) $ repeat ' ') ++ s ------------------------------------------------------------------------------- -- use it on (String-ified) types!... (See caveat in Core.hs.) dropQuals :: String -> String dropQuals = reverse . takeWhile (/= '.') . reverse ------------------------------------------------------------------------------- fst3 :: (a,b,c) -> a fst3 (x,_,_) = x snd3 :: (a,b,c) -> b snd3 (_,y,_) = y thd3 :: (a,b,c) -> c thd3 (_,_,z) = z -------------------------------------------------------------------------------