From 2ae7a0293f0cfcbfb1d1a35ac84097239639a3fe Mon Sep 17 00:00:00 2001 From: Kenneth MacKenzie Date: Fri, 25 Jun 2021 15:00:41 +0100 Subject: [PATCH] Use FilePath for cost model paths (#3429) * Use FilePath for cost model paths * updateMaterialzed * Remove filepath dependency * updateMaterialzed * Address PR comments * updateMaterialzed --- .../.plan.nix/plutus-core.nix | 2 +- .../.plan.nix/plutus-core.nix | 2 +- .../cost-model/budgeting-bench/Bench.hs | 16 ++++------ .../create-cost-model/CostModelCreation.hs | 6 ++-- .../create-cost-model/UpdateCostModel.hs | 4 ++- plutus-core/plutus-core.cabal | 2 +- .../src/PlutusCore/DataFilePaths.hs | 32 +++++++++++++++++++ .../Evaluation/Machine/ExBudgetingDefaults.hs | 6 ++-- 8 files changed, 52 insertions(+), 18 deletions(-) create mode 100644 plutus-core/plutus-core/src/PlutusCore/DataFilePaths.hs diff --git a/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-core.nix b/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-core.nix index efdfc83e7f9..00de38e41e6 100644 --- a/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-core.nix +++ b/nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-core.nix @@ -196,6 +196,7 @@ "PlutusCore/Constant" "PlutusCore/Constant/Dynamic/Emit" "PlutusCore/Core" + "PlutusCore/DataFilePaths" "PlutusCore/DeBruijn" "PlutusCore/Default" "PlutusCore/Error" @@ -438,7 +439,6 @@ (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) (hsPkgs."criterion" or (errorHandler.buildDepError "criterion")) (hsPkgs."directory" or (errorHandler.buildDepError "directory")) - (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) (hsPkgs."hedgehog" or (errorHandler.buildDepError "hedgehog")) (hsPkgs."random" or (errorHandler.buildDepError "random")) ]; diff --git a/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-core.nix b/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-core.nix index efdfc83e7f9..00de38e41e6 100644 --- a/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-core.nix +++ b/nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-core.nix @@ -196,6 +196,7 @@ "PlutusCore/Constant" "PlutusCore/Constant/Dynamic/Emit" "PlutusCore/Core" + "PlutusCore/DataFilePaths" "PlutusCore/DeBruijn" "PlutusCore/Default" "PlutusCore/Error" @@ -438,7 +439,6 @@ (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) (hsPkgs."criterion" or (errorHandler.buildDepError "criterion")) (hsPkgs."directory" or (errorHandler.buildDepError "directory")) - (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) (hsPkgs."hedgehog" or (errorHandler.buildDepError "hedgehog")) (hsPkgs."random" or (errorHandler.buildDepError "random")) ]; diff --git a/plutus-core/cost-model/budgeting-bench/Bench.hs b/plutus-core/cost-model/budgeting-bench/Bench.hs index 7b7e48a669e..a982d58d8fd 100644 --- a/plutus-core/cost-model/budgeting-bench/Bench.hs +++ b/plutus-core/cost-model/budgeting-bench/Bench.hs @@ -5,6 +5,7 @@ module Main (main) where import PlutusCore as PLC +import qualified PlutusCore.DataFilePaths as DFP import PlutusCore.Evaluation.Machine.ExMemory import PlutusCore.MkPlc import UntypedPlutusCore as UPLC @@ -19,7 +20,6 @@ import qualified Hedgehog.Internal.Gen as HH import qualified Hedgehog.Internal.Tree as HH import qualified Hedgehog.Range as HH.Range import System.Directory -import System.FilePath import System.Random (StdGen, getStdGen, randomR) type PlainTerm = UPLC.Term Name DefaultUni DefaultFun () @@ -325,14 +325,11 @@ benchNop3 gen = main :: IO () main = do gen <- System.Random.getStdGen -- We use the initial state of gen repeatedly below, but that doesn't matter. - let dataDir = "cost-model" "data" - csvFile = dataDir "benching.csv" - backupFile = dataDir "benching.csv.backup" - createDirectoryIfMissing True dataDir - csvExists <- doesFileExist csvFile - if csvExists then renameFile csvFile backupFile else pure () - - defaultMainWith (defaultConfig { C.csvFile = Just csvFile }) $ + createDirectoryIfMissing True DFP.costModelDataDir + csvExists <- doesFileExist DFP.benchingResultsFile + if csvExists then renameFile DFP.benchingResultsFile DFP.backupBenchingResultsFile else pure () + + defaultMainWith (defaultConfig { C.csvFile = Just DFP.benchingResultsFile }) $ [benchNop1 gen, benchNop2 gen, benchNop3 gen] <> (benchTwoIntegers gen <$> [ AddInteger , MultiplyInteger @@ -349,3 +346,4 @@ main = do , LtByteString ]) <> [benchVerifySignature] + diff --git a/plutus-core/cost-model/create-cost-model/CostModelCreation.hs b/plutus-core/cost-model/create-cost-model/CostModelCreation.hs index 9866cadaca2..f480fcc1152 100644 --- a/plutus-core/cost-model/create-cost-model/CostModelCreation.hs +++ b/plutus-core/cost-model/create-cost-model/CostModelCreation.hs @@ -30,7 +30,6 @@ import Foreign.R import H.Prelude (MonadR, Region, r) import Language.R - -- | Convert milliseconds represented as a float to picoseconds represented as a -- CostingInteger. We round up to be sure we don't underestimate anything. msToPs :: Double -> CostingInteger @@ -75,8 +74,11 @@ costModelsR = do source("cost-model/data/models.R") modelFun("cost-model/data/benching.csv") |] - -- TODO use btraverse instead + -- Unfortunately we can't use the paths defined in DataFilePaths inside [r|...]. + -- The above code may not work on Windows because of that, but we only ever + -- want to run this on a Linux reference machine anyway. bsequence $ bmap (\name -> let n = getConst name in Compose $ fmap Const $ [r| list_hs[[n_hs]] |]) builtinCostModelNames + -- TODO ^ use btraverse instead -- Creates the cost model from the csv benchmarking files createBuiltinCostModel :: IO BuiltinCostModel diff --git a/plutus-core/cost-model/create-cost-model/UpdateCostModel.hs b/plutus-core/cost-model/create-cost-model/UpdateCostModel.hs index c9fc3ac0c49..f29c6e1d773 100644 --- a/plutus-core/cost-model/create-cost-model/UpdateCostModel.hs +++ b/plutus-core/cost-model/create-cost-model/UpdateCostModel.hs @@ -1,5 +1,7 @@ module Main where +import PlutusCore.DataFilePaths + import Data.Aeson.Encode.Pretty import qualified Data.ByteString.Lazy as BSL @@ -10,4 +12,4 @@ import CostModelCreation main :: IO () main = do model <- createBuiltinCostModel - BSL.writeFile "cost-model/data/builtinCostModel.json" $ encodePretty' (defConfig { confCompare = \_ _-> EQ }) model + BSL.writeFile builtinCostModelFile $ encodePretty' (defConfig { confCompare = \_ _-> EQ }) model diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index e700f599713..acd0abe9cba 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -47,6 +47,7 @@ library PlutusCore.Constant PlutusCore.Constant.Dynamic.Emit PlutusCore.Core + PlutusCore.DataFilePaths PlutusCore.DeBruijn PlutusCore.Default PlutusCore.Error @@ -437,7 +438,6 @@ benchmark cost-model-budgeting-bench bytestring -any, criterion -any, directory -any, - filepath -any, hedgehog -any, random -any diff --git a/plutus-core/plutus-core/src/PlutusCore/DataFilePaths.hs b/plutus-core/plutus-core/src/PlutusCore/DataFilePaths.hs new file mode 100644 index 00000000000..5f1fa1be63f --- /dev/null +++ b/plutus-core/plutus-core/src/PlutusCore/DataFilePaths.hs @@ -0,0 +1,32 @@ +-- | Various file paths used in plutus-core, currently all to do with the cost +-- model. + +-- Note that a couple of these paths are also used inside an inline-r splice in +-- CostModelCreation.hs but we have to use literal strings there, not the +-- versions defined here. Those strings will also have to be updated if things +-- change here. + +module PlutusCore.DataFilePaths +where + +import System.FilePath + +costModelDataDir :: FilePath +costModelDataDir = "cost-model" "data" + +-- A literal version of this is also used in CostModelCreation.hs +modelFile :: FilePath +modelFile = costModelDataDir "models" <.> "R" + +-- A literal version of this is also used in CostModelCreation.hs +benchingResultsFile :: FilePath +benchingResultsFile = costModelDataDir "benching" <.> "csv" + +backupBenchingResultsFile :: FilePath +backupBenchingResultsFile = benchingResultsFile <.> "backup" + +builtinCostModelFile :: FilePath +builtinCostModelFile = costModelDataDir "builtinCostModel" <.> "json" + +cekMachineCostsFile :: FilePath +cekMachineCostsFile = costModelDataDir "cekMachineCosts" <.> "json" diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs index 1a7ba49a64a..fcca9e0d319 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs @@ -19,6 +19,7 @@ import Data.Aeson.THReader import PlutusCore.Constant +import qualified PlutusCore.DataFilePaths as DFP import PlutusCore.Default import PlutusCore.Evaluation.Machine.BuiltinCostModel import PlutusCore.Evaluation.Machine.CostModelInterface @@ -29,11 +30,10 @@ import PlutusCore.Evaluation.Machine.MachineParameters import UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts import UntypedPlutusCore.Evaluation.Machine.Cek.Internal - -- | The default cost model for built-in functions. defaultBuiltinCostModel :: BuiltinCostModel defaultBuiltinCostModel = - $$(readJSONFromFile "cost-model/data/builtinCostModel.json") + $$(readJSONFromFile DFP.builtinCostModelFile) -- Use this one when you've changed the type of `CostModel` and you can't load the json. -- Then rerun @@ -45,7 +45,7 @@ defaultBuiltinCostModel = -- | Default costs for CEK machine instructions. defaultCekMachineCosts :: CekMachineCosts defaultCekMachineCosts = - $$(readJSONFromFile "cost-model/data/cekMachineCosts.json") + $$(readJSONFromFile DFP.cekMachineCostsFile) defaultCekCostModel :: CostModel CekMachineCosts BuiltinCostModel defaultCekCostModel = CostModel defaultCekMachineCosts defaultBuiltinCostModel