New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Kwxm/improve plc timing (SCP-1872) #2738
Changes from 5 commits
8b84093
34b57e9
bd16d81
7b920bd
f7dcf56
fa5d4db
9175d64
21f935e
391e4f8
c14b7ad
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,3 +1,4 @@ | ||
{-# LANGUAGE BangPatterns #-} | ||
{-# LANGUAGE LambdaCase #-} | ||
{-# LANGUAGE MultiParamTypeClasses #-} | ||
{-# LANGUAGE OverloadedStrings #-} | ||
|
@@ -21,8 +22,7 @@ import qualified Language.UntypedPlutusCore as UPLC | |
import qualified Language.UntypedPlutusCore.Evaluation.Machine.Cek as UPLC | ||
|
||
import Codec.Serialise | ||
import Control.DeepSeq (rnf) | ||
import qualified Control.Exception as Exn (evaluate) | ||
import Control.DeepSeq (NFData, rnf) | ||
import Control.Monad | ||
import Control.Monad.Trans.Except (runExceptT) | ||
import Data.Bifunctor (second) | ||
|
@@ -82,7 +82,7 @@ type PlcParserError = PLC.Error PLC.DefaultUni PLC.DefaultFun PLC.AlexPosn | |
data Input = FileInput FilePath | StdInput | ||
data Output = FileOutput FilePath | StdOutput | ||
data Language = TypedPLC | UntypedPLC | ||
data Timing = NoTiming | Timing deriving (Eq) -- Report program execution time? | ||
data TimingMode = NoTiming | Timing Integer deriving (Eq) -- Report program execution time? | ||
data PrintMode = Classic | Debug | Readable | ReadableDebug deriving (Show, Read) | ||
type ExampleName = T.Text | ||
data ExampleMode = ExampleSingle ExampleName | ExampleAvailable | ||
|
@@ -103,7 +103,7 @@ data ConvertOptions = ConvertOptions Language Input Format Output Format Print | |
data PrintOptions = PrintOptions Language Input PrintMode | ||
data ExampleOptions = ExampleOptions Language ExampleMode | ||
data EraseOptions = EraseOptions Input Format Output Format PrintMode | ||
data EvalOptions = EvalOptions Language Input Format EvalMode PrintMode Timing | ||
data EvalOptions = EvalOptions Language Input Format EvalMode PrintMode TimingMode | ||
data ApplyOptions = ApplyOptions Language Files Format Output Format PrintMode | ||
|
||
-- Main commands | ||
|
@@ -125,8 +125,8 @@ untypedPLC :: Parser Language | |
untypedPLC = flag UntypedPLC UntypedPLC (long "untyped" <> short 'u' <> help "Use untyped Plutus Core (default)") | ||
-- ^ NB: default is always UntypedPLC | ||
|
||
languageMode :: Parser Language | ||
languageMode = typedPLC <|> untypedPLC | ||
languagemode :: Parser Language | ||
languagemode = typedPLC <|> untypedPLC | ||
|
||
-- | Parser for an input stream. If none is specified, default to stdin: this makes use in pipelines easier | ||
input :: Parser Input | ||
|
@@ -193,18 +193,30 @@ outputformat = option (maybeReader formatReader) | |
<> showDefault | ||
<> help ("Output format: " ++ formatHelp)) | ||
|
||
timing :: Parser Timing | ||
timing = flag NoTiming Timing | ||
( long "time-execution" | ||
<> short 'x' | ||
<> help "Report execution time of program" | ||
-- -x -> run 100 times and print the mean time | ||
timing1 :: Parser TimingMode | ||
timing1 = flag NoTiming (Timing 100) | ||
kwxm marked this conversation as resolved.
Show resolved
Hide resolved
|
||
( short 'x' | ||
<> help "Report mean execution time of program over 100 repetitions" | ||
) | ||
|
||
-- -X N -> run N times and print the mean time | ||
timing2 :: Parser TimingMode | ||
timing2 = Timing <$> option auto | ||
( long "time-execution" | ||
<> short 'X' | ||
<> metavar "N" | ||
<> help "Report mean execution time of program over N repetitions. Use a large value of N if possible to get accurate results." | ||
) | ||
|
||
timingmode :: Parser TimingMode | ||
timingmode = timing1 <|> timing2 | ||
|
||
files :: Parser Files | ||
files = some (argument str (metavar "[FILES...]")) | ||
|
||
applyOpts :: Parser ApplyOptions | ||
applyOpts = ApplyOptions <$> languageMode <*> files <*> inputformat <*> output <*> outputformat <*> printmode | ||
applyOpts = ApplyOptions <$> languagemode <*> files <*> inputformat <*> output <*> outputformat <*> printmode | ||
|
||
typecheckOpts :: Parser TypecheckOptions | ||
typecheckOpts = TypecheckOptions <$> input <*> inputformat | ||
|
@@ -219,10 +231,10 @@ printmode = option auto | |
++ "Readable -> prettyPlcReadableDef, ReadableDebug -> prettyPlcReadableDebug" )) | ||
|
||
printOpts :: Parser PrintOptions | ||
printOpts = PrintOptions <$> languageMode <*> input <*> printmode | ||
printOpts = PrintOptions <$> languagemode <*> input <*> printmode | ||
|
||
convertOpts :: Parser ConvertOptions | ||
convertOpts = ConvertOptions <$> languageMode <*> input <*> inputformat <*> output <*> outputformat <*> printmode | ||
convertOpts = ConvertOptions <$> languagemode <*> input <*> inputformat <*> output <*> outputformat <*> printmode | ||
|
||
exampleMode :: Parser ExampleMode | ||
exampleMode = exampleAvailable <|> exampleSingle | ||
|
@@ -244,7 +256,7 @@ exampleSingle :: Parser ExampleMode | |
exampleSingle = ExampleSingle <$> exampleName | ||
|
||
exampleOpts :: Parser ExampleOptions | ||
exampleOpts = ExampleOptions <$> languageMode <*> exampleMode | ||
exampleOpts = ExampleOptions <$> languagemode <*> exampleMode | ||
|
||
eraseOpts :: Parser EraseOptions | ||
eraseOpts = EraseOptions <$> input <*> inputformat <*> output <*> outputformat <*> printmode | ||
|
@@ -259,7 +271,7 @@ evalmode = option auto | |
<> help "Evaluation mode (CK or CEK)" ) | ||
|
||
evalOpts :: Parser EvalOptions | ||
evalOpts = EvalOptions <$> languageMode <*> input <*> inputformat <*> evalmode <*> printmode <*> timing | ||
evalOpts = EvalOptions <$> languagemode <*> input <*> inputformat <*> evalmode <*> printmode <*> timingmode | ||
|
||
helpText :: String | ||
helpText = | ||
|
@@ -636,8 +648,35 @@ runTypecheck (TypecheckOptions inp fmt) = do | |
|
||
---------------- Evaluation ---------------- | ||
|
||
-- Convert a time in picoseconds into a readble format with appropriate units | ||
formatTime :: Double -> String | ||
formatTime t | ||
| t >= 1e12 = printf "%.3f s" (t/1e12) | ||
| t >= 1e9 = printf "%.3f ms" (t/1e9) | ||
| t >= 1e6 = printf "%.3f μs" (t/1e6) | ||
| t >= 1e3 = printf "%.3f ns" (t/1e3) | ||
| otherwise = printf "%f ps" t | ||
|
||
{- Apply an evaluator to a program a number of times and report the mean execution | ||
kwxm marked this conversation as resolved.
Show resolved
Hide resolved
|
||
time. The first measurement is often significantly larger than the rest | ||
(perhaps due to warm-up effects), and this can distort the mean. To avoid this | ||
we measure the evaluation time (n+1) times and discard the first result. -} | ||
timeEval :: NFData a => Integer -> (t -> a) -> t -> IO () | ||
timeEval n evaluate prog = | ||
if n <= 0 then error "Error: the number of repetitions should be at least 1" | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Style nit: I'd probably use two clauses with the first one having a There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I'm not sure that that helped. Having the guards is a bit clearer, but then emacs indented it like this:
It looks a bit odd with the stuff inside the do-block to the left of the guard. I can cope with that though. |
||
else do | ||
times <- tail <$> mapM (timeOnce evaluate) (replicate (fromIntegral (n+1)) prog) | ||
kwxm marked this conversation as resolved.
Show resolved
Hide resolved
|
||
let mean = (fromIntegral $ sum times) / (fromIntegral n) :: Double | ||
runs :: String = if n==1 then "run" else "runs" | ||
printf "Mean evaluation time (%d %s): %s\n" n runs (formatTime mean) | ||
where timeOnce eval prg = do | ||
start <- performGC >> getCPUTime | ||
let !_ = rnf $ eval prg | ||
end <- getCPUTime | ||
pure $ end - start | ||
|
||
runEval :: EvalOptions -> IO () | ||
runEval (EvalOptions language inp ifmt evalMode printMode printtime) = | ||
runEval (EvalOptions language inp ifmt evalMode printMode timingMode) = | ||
case language of | ||
|
||
TypedPLC -> do | ||
|
@@ -647,13 +686,14 @@ runEval (EvalOptions language inp ifmt evalMode printMode printtime) = | |
CK -> PLC.unsafeEvaluateCk PLC.defBuiltinsRuntime | ||
CEK -> PLC.unsafeEvaluateCek PLC.defBuiltinsRuntime | ||
body = void . PLC.toTerm $ prog | ||
() <- Exn.evaluate $ rnf body | ||
!_ = rnf body | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This seems to give more consistent results than There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. It really shouldn't. Even with There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I tried again and maybe I was imagining it, or there was something else going on. I'll take another look later just to be sure. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Yeah, not sure if there's really any difference. There do seem to be slight differences for very fast programs, but it could just be statistical noise. If there is a difference I don't think it's terribly significant. |
||
-- Force evaluation of body to ensure that we're not timing parsing/deserialisation. | ||
-- The parser apparently returns a fully-evaluated AST, but let's be on the safe side. | ||
start <- performGC >> getCPUTime | ||
case evaluate body of | ||
PLC.EvaluationSuccess v -> succeed start v | ||
PLC.EvaluationFailure -> exitFailure | ||
case timingMode of | ||
NoTiming -> case evaluate body of | ||
PLC.EvaluationSuccess v -> succeed v | ||
PLC.EvaluationFailure -> exitFailure | ||
Timing n -> timeEval n evaluate body >> exitSuccess | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Seems like we should still use the exit status? Which I guess will be the same every time, but still. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Yeah. I was too lazy to do that, but since you spotted it I'll fix it. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Done. |
||
|
||
UntypedPLC -> | ||
case evalMode of | ||
|
@@ -662,21 +702,19 @@ runEval (EvalOptions language inp ifmt evalMode printMode printtime) = | |
UntypedProgram prog <- getProgram UntypedPLC ifmt inp | ||
let evaluate = UPLC.unsafeEvaluateCek PLC.defBuiltinsRuntime | ||
body = void . UPLC.toTerm $ prog | ||
() <- Exn.evaluate $ rnf body | ||
start <- getCPUTime | ||
case evaluate body of | ||
UPLC.EvaluationSuccess v -> succeed start v | ||
UPLC.EvaluationFailure -> exitFailure | ||
|
||
where succeed start v = do | ||
end <- getCPUTime | ||
!_ = rnf body | ||
case timingMode of | ||
NoTiming -> case evaluate body of | ||
UPLC.EvaluationSuccess v -> succeed v | ||
UPLC.EvaluationFailure -> exitFailure | ||
Timing n -> timeEval n evaluate body >> exitSuccess | ||
|
||
where succeed v = do | ||
print $ getPrintMethod printMode v | ||
let ms = 1e9 :: Double | ||
diff = (fromIntegral (end - start)) / ms | ||
when (printtime == Timing) $ printf "Evaluation time: %0.2f ms\n" diff | ||
exitSuccess | ||
|
||
|
||
|
||
---------------- Driver ---------------- | ||
|
||
main :: IO () | ||
|
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I liked the previous version more, but whatever.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Yeah, the others are camel case too
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I did that because we've got types with names like
LanguageMode
, parsers for them with names likelangaugeMode
, and variables with names likelanguagemode
, and there was some inconsistency in how the latter two were capitalised. It might be less confusing to havelanguageModeParser
and so on.