From b69ec3f6d953e67422dd32b72688cba850fd1b2e Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Mon, 13 Jan 2014 15:56:57 -0800 Subject: Initial commit --- bindings/haskell/src/PPAML/Tracer.hs | 268 +++++++++++++++++++++++++++++++++++ 1 file changed, 268 insertions(+) create mode 100644 bindings/haskell/src/PPAML/Tracer.hs (limited to 'bindings/haskell/src/PPAML/Tracer.hs') diff --git a/bindings/haskell/src/PPAML/Tracer.hs b/bindings/haskell/src/PPAML/Tracer.hs new file mode 100644 index 0000000..ddff15c --- /dev/null +++ b/bindings/haskell/src/PPAML/Tracer.hs @@ -0,0 +1,268 @@ +{- PPAML.Tracer -- PPAML timing instrumentation system (Haskell bindings) +Copyright (C) 2014 Galois, Inc. + +This library is free software: you can redistribute it and/or modify it under +the terms of the GNU General Public License as published by the Free Software +Foundation, either version 3 of the License, or (at your option) any later +version. + +This library is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A +PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along with +this library. If not, see . + +To contact Galois, complete the Web form at or +write to Galois, Inc., 421 Southwest 6th Avenue, Suite 300, Portland, Oregon, +97204-1622. -} + +{-| Getting started with ppamltracer is easy. Because of Haskell’s intrinsic +laziness, though, getting meaningful results out of ppamltracer is slightly more +difficult. For instance, consider the following (correctly written) example: + +> import PPAML.Tracer +> +> main = +> withTracer "/tmp/my_report" $ \tracer -> +> withPhase tracer "phase 1" $ \phase -> +> withPhaseRunning phase doStuff +> withPhase tracer "phase 2" $ \phase -> do +> withPhaseRunning phase doOtherStuff +> withPhaseRunning phase doYetMoreStuff + +This creates a report which appears to record the total runtime of 'doStuff' +recorded as \"phase 1\" and the total runtime of 'doOtherStuff' and +'doYetMoreStuff' combined as \"phase 2\". In actuality, however, the report +does not record the total runtime – instead, + +> withPhaseRunning phase f + +records the time required to evaluate 'f'’s result to normal form. Thus, 'f' +can leverage infinite data as intermediate values; only 'f'’s final result need +be finite. -} + +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE LambdaCase #-} +module PPAML.Tracer + ( -- * Tracers + Tracer, TracerHandle + , withTracer + -- * Phases + , Phase, PhaseHandle + , withPhase + -- * Timing + , withPhaseRunning, withPhaseRunning_ + -- * Exceptions + {-| ppamltracer defines a fairly detailed exception hierarchy; however, + all exceptions are truly exceptional cases, and they likely will not + occur in normal use. For reference, the hierarchy looks like this: + + @ +'Control.Exception.SomeException' +└─ 'TracerException' + ├─ 'OTFException' + │ ├─ 'OTFManagerException' + │ │ └─ 'OTFManagerInitializationFailure' + │ └─ 'OTFWriterException' + │ ├─ 'OTFWriterInitializationFailure' + │ ├─ 'OTFPhaseDefinitionFailure' + │ ├─ 'OTFPhaseEntryFailure' + │ ├─ 'OTFPhaseExitFailure' + │ ├─ 'OTFWriterCloseFailure' + │ ├─ 'OTFTraceResolutionFailure' + │ └─ 'OTFProcessDefinitionFailure' + └─ 'TimingException' + └─ 'ClockAcquisitionFailure' + @ -} + , TracerException + -- ** Open Trace Format exceptions + , OTFException + , OTFManagerException, OTFManagerInitializationFailure + , OTFWriterException, OTFWriterInitializationFailure, + OTFPhaseDefinitionFailure, OTFPhaseEntryFailure, OTFPhaseExitFailure, + OTFWriterCloseFailure, OTFTraceResolutionFailure, + OTFProcessDefinitionFailure + -- ** Timing exceptions + , TimingException, ClockAcquisitionFailure + ) where + +import Control.DeepSeq (NFData, ($!!)) +import Control.Exception (bracket_, throw) +import Foreign (Storable, Ptr, allocaBytes, peek) +import Foreign.C (CInt(CInt), CSize(CSize), CString, withCString) +import System.IO.Unsafe (unsafeDupablePerformIO) + +import PPAML.Tracer.Exception + + +-------------------------------- High-level API -------------------------------- + +{-| Constructs a 'Tracer' and executes the specified computation. The trace +report will be stored in Open Trace Format; all trace file paths will begin with +the specified path. + +Throws: + + * 'OTFManagerInitializationFailure' if the Open Trace Format manager could not + be initialized. + + * 'OTFWriterInitializationFailure' if the Open Trace Format writer could not + be initialized. + + * 'OTFTraceResolutionFailure' if setting the trace resolution failed. + + * 'OTFProcessDefinitionFailure' if defining the main OTF process failed. + + * 'OTFWriterCloseFailure' if the Open Trace Format writer could not be closed + after the computation ran. -} + +withTracer :: FilePath -> (TracerHandle -> IO a) -> IO a +withTracer reportBaseName f = + allocaBytes tracerSize $ \tracerHandle -> + bracket_ (tracerInit tracerHandle reportBaseName) + (tracerDone tracerHandle) + (f tracerHandle) + +{-| Constructs a 'Phase' and executes the specified computation. + +Throws 'OTFPhaseDefinitionFailure' if the phase could not be defined. -} +withPhase :: TracerHandle -- ^ the associated 'Tracer' + -> String -- ^ the name of the 'Phase' + -> (PhaseHandle -> IO a) + -> IO a +withPhase tracer name f = + allocaBytes phaseSize $ \phaseHandle -> + bracket_ (phaseInit tracer phaseHandle name) + (phaseDone phaseHandle) + (f phaseHandle) + +{-| Executes an IO action and evaluates its result to normal form, recording the +time required to do so in the provided 'Phase'. -} +withPhaseRunning :: NFData a => PhaseHandle -> IO a -> IO a +withPhaseRunning phase f = withPhaseRunning_ phase ((return $!!) =<< f) + +{-| Executes an IO action, recording the time required to do so in the provided +'Phase'. Unlinke 'withPhaseRunning', this function does /not/ evaluate the +action’s result. Use this function when you need finer-grained control over the +precise degree of evaluation than 'withPhaseRunning' offers. +-} +withPhaseRunning_ :: PhaseHandle -> IO a -> IO a +withPhaseRunning_ phase = bracket_ (phaseStart phase) (phaseStop phase) + + +----------------------------------- Tracers ------------------------------------ + +----- Data type ----- + +{-| Tracer state bundle. ppamltracer is fundamentally a set of stateful +operations; this data type dsecribes the state ppamltracer needs to operate +properly. A one-to-one mapping exists between 'Tracer's and trace reports, so +you will likely only need one 'Tracer' per program. -} +data Tracer + +foreign import ccall unsafe "ppaml/tracer/internal.h & ppaml_tracer_t_size" + ppaml_tracer_t_size :: Ptr CSize + +tracerSize :: Int +tracerSize = fromIntegral $ unsafeReadLibraryConstant ppaml_tracer_t_size + + +----- Initialization and finalization ----- + +type TracerHandle = Ptr Tracer + +foreign import ccall unsafe "ppaml/tracer.h ppaml_tracer_init" + ppaml_tracer_init :: TracerHandle -> CString -> IO CInt + +tracerInit :: TracerHandle -> FilePath -> IO () +tracerInit tracer reportNameBase = + withCString reportNameBase $ \cReportNameBase -> + ppaml_tracer_init tracer cReportNameBase >>= \case + 0 -> return () + 1 -> throw OTFManagerInitializationFailure + 2 -> throw OTFWriterInitializationFailure + 3 -> throw OTFTraceResolutionFailure + 4 -> throw OTFProcessDefinitionFailure + r -> unexpectedReturnCode r + +foreign import ccall unsafe "ppaml/tracer.h ppaml_tracer_done" + ppaml_tracer_done :: TracerHandle -> IO CInt + +tracerDone :: TracerHandle -> IO () +tracerDone tracer = + ppaml_tracer_done tracer >>= \case 0 -> return () + 1 -> throw OTFWriterCloseFailure + r -> unexpectedReturnCode r + + +------------------------------------ Phases ------------------------------------ + +----- Data type ----- + +-- | A phase of execution to trace and to gather timing statistics about. +data Phase + +foreign import ccall unsafe "ppaml/tracer/internal.h & ppaml_phase_t_size" + ppaml_phase_t_size :: Ptr CSize + +phaseSize :: Int +phaseSize = fromIntegral $ unsafeReadLibraryConstant ppaml_phase_t_size + + +----- Initialization and finalization ----- + +type PhaseHandle = Ptr Phase + +foreign import ccall unsafe "ppaml/tracer.h ppaml_phase_init" + ppaml_phase_init :: TracerHandle -> PhaseHandle -> CString -> IO CInt + +phaseInit :: TracerHandle -> PhaseHandle -> String -> IO () +phaseInit tracer phase name = + withCString name $ \cName -> + ppaml_phase_init tracer phase cName >>= \case + 0 -> return () + 1 -> throw OTFPhaseDefinitionFailure + r -> unexpectedReturnCode r + +foreign import ccall unsafe "ppaml/tracer.h ppaml_phase_done" + ppaml_phase_done :: PhaseHandle -> IO CInt + +phaseDone :: PhaseHandle -> IO () +phaseDone phase = + ppaml_phase_done phase >>= \case 0 -> return () + r -> unexpectedReturnCode r + + +----- Timing ----- + +foreign import ccall unsafe "ppaml/tracer.h ppaml_phase_start" + ppaml_phase_start :: PhaseHandle -> IO CInt + +phaseStart :: PhaseHandle -> IO () +phaseStart phase = + ppaml_phase_start phase >>= \case 0 -> return () + 1 -> throw ClockAcquisitionFailure + 2 -> throw OTFPhaseEntryFailure + r -> unexpectedReturnCode r + +foreign import ccall unsafe "ppaml/tracer.h ppaml_phase_stop" + ppaml_phase_stop :: PhaseHandle -> IO CInt + +phaseStop :: PhaseHandle -> IO () +phaseStop phase = + ppaml_phase_stop phase >>= \case 0 -> return () + 1 -> throw ClockAcquisitionFailure + 2 -> throw OTFPhaseExitFailure + r -> unexpectedReturnCode r + + +----------------------------------- Utility ------------------------------------ + +unsafeReadLibraryConstant :: Storable a => Ptr a -> a +unsafeReadLibraryConstant = unsafeDupablePerformIO . peek + +unexpectedReturnCode :: CInt -> a +unexpectedReturnCode code = + error $ "unexpected return code " ++ show code ++ "\n\ + \This is a bug in ppamltracer! Report it to the maintainers." -- cgit v1.2.3