{-# LANGUAGE CPP           #-}
{-# LANGUAGE TypeOperators #-}
-- |
-- Module      : Data.Array.Accelerate.LLVM.Native.Debug
-- Copyright   : [2014..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.LLVM.Native.Debug (

  module Data.Array.Accelerate.Debug,
  module Data.Array.Accelerate.LLVM.Native.Debug,

) where

import Data.Array.Accelerate.Debug                                  hiding ( elapsed )
import qualified Data.Array.Accelerate.Debug                        as Debug

import Text.Printf


-- | Display elapsed wall and CPU time, together with speedup fraction
--
{-# INLINEABLE elapsedP #-}
elapsedP :: Double -> Double -> String
elapsedP :: Double -> Double -> String
elapsedP Double
wallTime Double
cpuTime =
  String -> String -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%s (wall), %s (cpu), %.2f x speedup"
    (Maybe Int -> Double -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> a -> ShowS
showFFloatSIBase (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) Double
1000 Double
wallTime String
"s")
    (Maybe Int -> Double -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> a -> ShowS
showFFloatSIBase (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) Double
1000 Double
cpuTime  String
"s")
    (Double
cpuTime Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
wallTime)

-- | Display elapsed wall and CPU time
--
{-# INLINEABLE elapsedS #-}
elapsedS :: Double -> Double -> String
elapsedS :: Double -> Double -> String
elapsedS = Double -> Double -> String
Debug.elapsed