Skip to content
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.

Sign up for GitHub

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

Jump to bottom

Kwxm/improve plc timing (SCP-1872) #2738

Merged
merged 10 commits into from Feb 17, 2021
Merged

Kwxm/improve plc timing (SCP-1872) #2738

Changes from 3 commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
8b84093
Add parser code for plc timing options
kwxm Feb 15, 2021
34b57e9
WIP: use own timing code
kwxm Feb 16, 2021
bd16d81
Improve timing feature in plc command
kwxm Feb 16, 2021
7b920bd
Remove debug code
kwxm Feb 16, 2021
f7dcf56
Correct spacing
kwxm Feb 16, 2021
fa5d4db
Update plutus-core/exe/Main.hs
kwxm Feb 16, 2021
9175d64
Update plutus-core/exe/Main.hs
kwxm Feb 16, 2021
21f935e
Address review comments
kwxm Feb 17, 2021
391e4f8
Address review comments
kwxm Feb 17, 2021
c14b7ad
Address review comments
kwxm Feb 17, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
105 changes: 72 additions & 33 deletions plutus-core/exe/Main.hs
View file
Open in desktop
@@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Comment on lines -128 to +132
Copy link
Contributor

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.

Copy link
Contributor

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

Copy link
Contributor Author

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 like langaugeMode, and variables with names like languagemode, and there was some inconsistency in how the latter two were capitalised. It might be less confusing to have languageModeParser and so on.


-- | Parser for an input stream. If none is specified, default to stdin: this makes use in pipelines easier
input :: Parser Input
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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 =
Expand Down Expand Up @@ -636,8 +648,36 @@ 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 <= 0then error "Error: the number of repetitions should be at least 1"
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
_ <- mapM print times
let 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
Expand All @@ -647,13 +687,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
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This seems to give more consistent results than Exn.evaluate. Is it causing deeper evaluation?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It really shouldn't. Even with Exn.evaluate removed the original line should be forcing the program fully.

Copy link
Contributor Author

Choose a reason for hiding this comment

The 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.

Copy link
Contributor Author

@kwxm kwxm Feb 17, 2021 •
edited

Choose a reason for hiding this comment

The 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
Copy link
Contributor

Choose a reason for hiding this comment

The 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.

Copy link
Contributor Author

Choose a reason for hiding this comment

The 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.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Done.


UntypedPLC ->
case evalMode of
Expand All @@ -662,21 +703,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 ()
Expand Down