seqaid-0.1.1: Seqaid/Runtime.hs
-------------------------------------------------------------------------------
-- 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
-------------------------------------------------------------------------------