{- |
Module: Probes
Description: Example usage of probes in Atom
Copyright: (c) 2015 Chris Hodapp

This demonstrates the usage of Atom's probe functionality. In this case, it
simply uses @printf@ to log a probe's value. Most POSIX systems should be able
to build and run the generated C code.

-}
module Language.Atom.Example.Probes where

import Data.Word
import Language.Atom

-- | Invoke the Atom compiler
main :: IO ()
main = do
  let atomCfg = defaults { cCode = prePostCode , cRuleCoverage = False }
  (sched, _, _, _, _) <- compile "probe_example" atomCfg example
  putStrLn $ reportSchedule sched

-- | Generate a code comment about the given probe.
probeStr :: (Name, Type) -> String
probeStr (n, t) = "// Probe: " ++ n ++ ", type: " ++ show t

-- | Use 'action' to call @PROBE_PRINTF@ on a probe given as (name, value).
-- This will work only on integer-valued probes.
logProbe :: (String, UE) -> Atom ()
logProbe (str, ue_) = action probeFn [ue_]
  where probeFn v = "PROBE_PRINTF(\"%u, " ++ str ++
                    ": %i\\n\", __global_clock, " ++ head v ++ ")"

-- | Top-level rule
example :: Atom ()
example = do

  -- Include in the once-per-second clock:
  sec <- tickSecond

  -- Compute minutes and hours as well (probes take arbitrary expressions):
  probe "Minutes" $ (value sec) `div_` 60
  probe "Hours" $ (value sec) `div_` 3600

  -- At 1/200 of our base rate (~ 5 seconds), we call 'logProbe' on all of the
  -- probes that are in use.
  period 200 $ atom "monitor" $ do
    mapM_ logProbe =<< probes

prePostCode :: [Name] -> [Name] -> [(Name, Type)] -> (String, String)
prePostCode _ _ probeList =
  ( unlines $ [ "// ---- This source is automatically generated by Atom ----"
              , "#define PROBE_PRINTF printf"
              , "#include <stdio.h>"
              , "#include <stdlib.h>"
              , "#include <unistd.h>"
              ] ++ map probeStr probeList
    -- Basic stub to call with a 1 millisecond delay (do not attempt anything like
    -- this in production - use an interrupt):
  , unlines [ "int main(void) {"
            , "    while (true) {"
            , "        probe_example();"
            , "        usleep(1000);"
            , "    }"
            , "    return 0;"
            , "}"
            , "// ---- End automatically-generated source ----"
            ])

-- | Count up seconds of runtime, assuming our base rate is 1 millisecond:
tickSecond :: Atom (V Word64)
tickSecond = do
  
  sec <- word64 "seconds" 0

  -- Add a probe to the clock:
  probe "Seconds" $ value sec
  
  period 1000 $ exactPhase 0 $ atom "second" $ incr sec
  
  return sec