diff options
Diffstat (limited to 'bindings/haskell')
| -rw-r--r-- | bindings/haskell/.gitignore | 7 | ||||
| -rw-r--r-- | bindings/haskell/README | 8 | ||||
| -rw-r--r-- | bindings/haskell/Setup.hs | 22 | ||||
| -rw-r--r-- | bindings/haskell/examples/simple.hs | 46 | ||||
| -rw-r--r-- | bindings/haskell/ppamltracer.cabal | 62 | ||||
| -rw-r--r-- | bindings/haskell/src/PPAML/Tracer.hs | 268 | ||||
| -rw-r--r-- | bindings/haskell/src/PPAML/Tracer/Exception.hs | 78 |
7 files changed, 491 insertions, 0 deletions
diff --git a/bindings/haskell/.gitignore b/bindings/haskell/.gitignore new file mode 100644 index 0000000..805d057 --- /dev/null +++ b/bindings/haskell/.gitignore @@ -0,0 +1,7 @@ +# .gitignore for ppamltracer-haskell -*- conf -*- + +*.hi +*.o +dist*/ + +examples/simple diff --git a/bindings/haskell/README b/bindings/haskell/README new file mode 100644 index 0000000..3d9cf39 --- /dev/null +++ b/bindings/haskell/README @@ -0,0 +1,8 @@ + ppamltracer-haskell, v0.1.0 + +This package contains Haskell bindings to ppamltracer. They require GHC 7.6 or +later. + +This package uses the Cabal build system; normal Cabal build procedure applies. + +For examples of use, see the examples directory. diff --git a/bindings/haskell/Setup.hs b/bindings/haskell/Setup.hs new file mode 100644 index 0000000..fa38bd0 --- /dev/null +++ b/bindings/haskell/Setup.hs @@ -0,0 +1,22 @@ +{- Setup -- Cabal setup file for ppamltracer +Copyright (C) 2014 Galois, Inc. + +This program 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 program 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 program. If not, see <http://www.gnu.org/licenses/>. + +To contact Galois, complete the Web form at <http://corp.galois.com/contact/> or +write to Galois, Inc., 421 Southwest 6th Avenue, Suite 300, Portland, Oregon, +97204-1622. -} + +import Distribution.Simple + +main = defaultMain diff --git a/bindings/haskell/examples/simple.hs b/bindings/haskell/examples/simple.hs new file mode 100644 index 0000000..478f25b --- /dev/null +++ b/bindings/haskell/examples/simple.hs @@ -0,0 +1,46 @@ +{- simple.hs -- basic ppamltracer example +This file is in the public domain. + +Compile this with + ghc --make simple.hs +-} + +{-# LANGUAGE LambdaCase #-} +module Main where + +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (liftM) + +import PPAML.Tracer + +main :: IO () +main = do + -- Start ppamltracer. + withTracer "/tmp/simple_report" $ \tracer -> do + -- Register the factorial phase. + withPhase tracer "fact" $ \phase -> do + -- Print factorials. + putStr "Factorials:" + mapM_ (putStr . (' ':) . show) =<< mapM (fact phase) [0 .. 40] + putStrLn "" + -- Register the Fibonacci phase. + withPhase tracer "fib" $ \phase -> do + -- Print Fibonacci numbers. + putStr "Fibonacci numbers:" + mapM_ (putStr . (' ':) . show) =<< mapM (fib phase) [0 .. 25] + putStrLn "" + +{- Records that we're running inside the provided phase and computes a +factorial. -} +fact :: PhaseHandle -> Integer -> IO Integer +fact phase = withPhaseRunning phase . \case + 0 -> return 1 + n -> liftM (n*) $ fact phase (n - 1) + +{- Records that we're running inside the provided phase and computes a Fibonacci +number. -} +fib :: PhaseHandle -> Integer -> IO Integer +fib phase = withPhaseRunning phase . \case + 0 -> return 0 + 1 -> return 1 + n -> (+) <$> fib phase (n - 1) <*> fib phase (n - 2) diff --git a/bindings/haskell/ppamltracer.cabal b/bindings/haskell/ppamltracer.cabal new file mode 100644 index 0000000..5b6918e --- /dev/null +++ b/bindings/haskell/ppamltracer.cabal @@ -0,0 +1,62 @@ +-- ppamltracer.cabal -- Cabal build file for ppamltracer +-- Copyright (C) 2014 Galois, Inc. +-- +-- This program 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 program 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 program. If not, see <http://www.gnu.org/licenses/>. +-- +-- To contact Galois, complete the Web form at <http://corp.galois.com/contact/> +-- or write to Galois, Inc., 421 Southwest 6th Avenue, Suite 300, Portland, +-- Oregon, 97204-1622. + +cabal-version: >=1.10 +name: ppamltracer +version: 0.1.0 +synopsis: A lightweight tracing library +description: ppamltracer is a lightweight tracing library designed for explicit + instrumention of generated code. If you’re writing a compiler and need hard + data on your optimizer’s efficacy, ppamltracer is the library for you. This + package uses Haskell’s foreign function interface to wrap the C libppamltracer + API. + . + ppamltracer writes trace logs in the + <http://tu-dresden.de/zih/otf/ Open Trace Format>, a free and open standard + developed by the Zentrum für Informationsdienste und Hochleistungsrechnen + (Center for Information Services and High-Performance Computing) at the + Technical University of Dresden. + . + We developed ppamltracer as part of DARPA’s + <http://darpa.mil/Our_Work/I2O/Programs/Probabilistic_Programming_for_Advanced_Machine_Learning_(PPAML%29.aspx Probabilistic Programming for Advancing Machine Learning> + (PPAML) project. +copyright: © 2014 Galois, Inc. +license: GPL-3 +author: Benjamin Barenblat +maintainer: bbarenblat@galois.com +category: Language +build-type: Simple +extra-source-files: examples/simple.hs +tested-with: GHC==7.6.3 + +library + hs-source-dirs: src + default-language: Haskell2010 + other-extensions: DeriveDataTypeable + , EmptyDataDecls + , ExistentialQuantification + , TemplateHaskell + build-depends: base + , deepseq >=1.2.0.0 && <2 + , hierarchical-exceptions <2 + extra-libraries: ppamltracer + exposed-modules: PPAML.Tracer + other-modules: PPAML.Tracer.Exception + ghc-options: -Wall -O2 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 <http://www.gnu.org/licenses/>. + +To contact Galois, complete the Web form at <http://corp.galois.com/contact/> 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." diff --git a/bindings/haskell/src/PPAML/Tracer/Exception.hs b/bindings/haskell/src/PPAML/Tracer/Exception.hs new file mode 100644 index 0000000..ba77c84 --- /dev/null +++ b/bindings/haskell/src/PPAML/Tracer/Exception.hs @@ -0,0 +1,78 @@ +{- PPAML.Tracer.Exception -- exceptions used by ppamltracer +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 <http://www.gnu.org/licenses/>. + +To contact Galois, complete the Web form at <http://corp.galois.com/contact/> or +write to Galois, Inc., 421 Southwest 6th Avenue, Suite 300, Portland, Oregon, +97204-1622. -} + +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE TemplateHaskell #-} +module PPAML.Tracer.Exception where + +import Control.Exception (SomeException(SomeException)) +import Control.Exception.Hierarchical (mkAbstractException, mkException) + +-- | A generic ppamltracer error. Extends 'SomeException'. +mkAbstractException 'SomeException "TracerException" + + +-------------------------------- OTF exceptions -------------------------------- + +{-| An error related to Open Trace Format input and output. Extends +'TracerException'. -} +mkAbstractException 'TracerException "OTFException" + +-- | An error caused by the Open Trace Fromat manager. Extends 'OTFException'. +mkAbstractException 'OTFException "OTFManagerException" + +{-| Failure to initialize the Open Trace Format manager. Extends +'OTFManagerException'. -} +mkException 'OTFManagerException "OTFManagerInitializationFailure" + +-- | An error caused by the Open Trace Format writer. Extends 'OTFException'. +mkAbstractException 'OTFException "OTFWriterException" + +{-| Failure to initialize the Open Trace Format writer. Extends +'OTFWriterException'. -} +mkException 'OTFWriterException "OTFWriterInitializationFailure" + +-- | Failure to define a phase. Extends 'OTFWriterException'. +mkException 'OTFWriterException "OTFPhaseDefinitionFailure" + +-- | Failure to record entry into a phase. Extends 'OTFWriterException'. +mkException 'OTFWriterException "OTFPhaseEntryFailure" + +-- | Failure to record exit from a phase. Extends 'OTFWriterException'. +mkException 'OTFWriterException "OTFPhaseExitFailure" + +{-| Failure to close the Open Trace Format writer. Extends +'OTFWriterException'. -} +mkException 'OTFWriterException "OTFWriterCloseFailure" + +-- | Failure to set the tracer resolution. Extends 'OTFWriterException'. +mkException 'OTFWriterException "OTFTraceResolutionFailure" + +-- | Failure to define a process (i.e., a thread). Extends 'OTFWriterException'. +mkException 'OTFWriterException "OTFProcessDefinitionFailure" + + +------------------------------ Timing exceptions ------------------------------- + +-- | An error related to system timers. Extends 'TracerException'. +mkAbstractException 'TracerException "TimingException" + +-- | A failure to get the current clock time. Extends 'TimingException'. +mkException 'TimingException "ClockAcquisitionFailure" |