From e2ec7986be70c36104a28f56e3088ff47f67867a Mon Sep 17 00:00:00 2001 From: kwxm Date: Fri, 5 Jul 2024 22:24:43 +0100 Subject: [PATCH] Realignment --- .../budgeting-bench/Benchmarks/Bitwise.hs | 2 +- .../cost-model/budgeting-bench/Common.hs | 20 ++++++------- .../src/PlutusCore/Default/Builtins.hs | 25 ++++++++-------- .../src/PlutusCore/Default/Universe.hs | 17 ++++++----- .../Evaluation/Machine/ExMemoryUsage.hs | 29 +++++++++++-------- .../plutus-core/test/CostModelSafety/Spec.hs | 4 +-- .../PlutusCore/Generators/Hedgehog/Builtin.hs | 6 ++-- 7 files changed, 55 insertions(+), 48 deletions(-) diff --git a/plutus-core/cost-model/budgeting-bench/Benchmarks/Bitwise.hs b/plutus-core/cost-model/budgeting-bench/Benchmarks/Bitwise.hs index f4a7bb8cd4c..690c679465d 100644 --- a/plutus-core/cost-model/budgeting-bench/Benchmarks/Bitwise.hs +++ b/plutus-core/cost-model/budgeting-bench/Benchmarks/Bitwise.hs @@ -87,7 +87,7 @@ benchIntegerToByteString = -- Widths are in words: we need to convert those to widths in bytes for the implementation let width' = 8 * fromIntegral width in bgroup (showMemoryUsage e) [ - bgroup (showMemoryUsage (LiteralByteSize width')) [mkBM e width' n] + bgroup (showMemoryUsage (IntegerCostedAsByteSize width')) [mkBM e width' n] ] where mkBM x y z = benchDefault (showMemoryUsage z) $ mkApp3 b [] x y z in bgroup (show b) $ fmap mkOneBM l diff --git a/plutus-core/cost-model/budgeting-bench/Common.hs b/plutus-core/cost-model/budgeting-bench/Common.hs index 0eba962d7b7..7d4b9968bc4 100644 --- a/plutus-core/cost-model/budgeting-bench/Common.hs +++ b/plutus-core/cost-model/budgeting-bench/Common.hs @@ -192,7 +192,7 @@ createOneTermBuiltinBench -> Benchmark createOneTermBuiltinBench name tys xs = bgroup (show name) $ [mkBM x | x <- xs] - where mkBM x = benchDefault (showMemoryUsage x) $ mkApp1 name tys x + where mkBM x = benchDefault (showMemoryUsage x) $ mkApp1 name tys x {- | Given a builtin function f of type a * b -> _ together with lists xs::[a] and ys::[b], create a collection of benchmarks which run f on all pairs in @@ -210,7 +210,7 @@ createTwoTermBuiltinBench -> Benchmark createTwoTermBuiltinBench name tys xs ys = bgroup (show name) $ [bgroup (showMemoryUsage x) [mkBM x y | y <- ys] | x <- xs] - where mkBM x y = benchDefault (showMemoryUsage y) $ mkApp2 name tys x y + where mkBM x y = benchDefault (showMemoryUsage y) $ mkApp2 name tys x y createTwoTermBuiltinBenchLiteralInY :: ( fun ~ DefaultFun, uni ~ DefaultUni @@ -225,8 +225,8 @@ createTwoTermBuiltinBenchLiteralInY -> Benchmark createTwoTermBuiltinBenchLiteralInY fun tys xs ns = bgroup (show fun) $ [bgroup (showMemoryUsage x) [mkBM x n | n <- ns] | x <- xs] - where mkBM x n = - benchDefault (showMemoryUsage (LiteralInteger n)) $ mkApp2 fun tys x n + where mkBM x n = + benchDefault (showMemoryUsage (IntegerCostedLiterally n)) $ mkApp2 fun tys x n createTwoTermBuiltinBenchWithFlag :: ( fun ~ DefaultFun, uni ~ DefaultUni @@ -242,7 +242,7 @@ createTwoTermBuiltinBenchWithFlag -> Benchmark createTwoTermBuiltinBenchWithFlag fun tys flag xs ys = bgroup (show fun) $ [bgroup (showMemoryUsage x) [mkBM x y | y <- ys] | x <- xs] - where mkBM x y = benchDefault (showMemoryUsage y) $ mkApp3 fun tys flag x y + where mkBM x y = benchDefault (showMemoryUsage y) $ mkApp3 fun tys flag x y {- | Given a builtin function f of type a * b -> _ together with lists xs::[a] and ys::[b], create a collection of benchmarks which run f on all pairs in 'zip @@ -267,7 +267,7 @@ createTwoTermBuiltinBenchElementwise -> Benchmark createTwoTermBuiltinBenchElementwise name tys xs ys = bgroup (show name) $ zipWith (\x y -> bgroup (showMemoryUsage x) [mkBM x y]) xs ys - where mkBM x y = benchDefault (showMemoryUsage y) $ mkApp2 name tys x y + where mkBM x y = benchDefault (showMemoryUsage y) $ mkApp2 name tys x y -- TODO: throw an error if xmem != ymem? That would suggest that the caller has -- done something wrong. @@ -284,8 +284,8 @@ createTwoTermBuiltinBenchElementwiseLiteralInX -> Benchmark createTwoTermBuiltinBenchElementwiseLiteralInX name tys xs ys = bgroup (show name) $ - zipWith (\x y -> bgroup (showMemoryUsage (LiteralInteger x)) [mkBM x y]) xs ys - where mkBM x y = benchDefault (showMemoryUsage y) $ mkApp2 name tys x y + zipWith (\x y -> bgroup (showMemoryUsage (IntegerCostedLiterally x)) [mkBM x y]) xs ys + where mkBM x y = benchDefault (showMemoryUsage y) $ mkApp2 name tys x y -- TODO: throw an error if xmem != ymem? That would suggest that the caller has -- done something wrong. @@ -303,7 +303,7 @@ createTwoTermBuiltinBenchElementwiseLiteralInY createTwoTermBuiltinBenchElementwiseLiteralInY name tys xs ys = bgroup (show name) $ zipWith (\x y -> bgroup (showMemoryUsage x) [mkBM x y]) xs ys - where mkBM x y = benchDefault (showMemoryUsage (LiteralInteger y)) $ mkApp2 name tys x y + where mkBM x y = benchDefault (showMemoryUsage (IntegerCostedLiterally y)) $ mkApp2 name tys x y {- | Given a builtin function f of type a * b * c -> _ together with a list of inputs of type (a,b,c), create a collection of benchmarks which run f on all @@ -324,6 +324,6 @@ createThreeTermBuiltinBenchElementwise name tys inputs = map (\(x, y, z) -> bgroup (showMemoryUsage x) [bgroup (showMemoryUsage y) [mkBM x y z]]) inputs - where mkBM x y z = benchDefault (showMemoryUsage z) $ mkApp3 name tys x y z + where mkBM x y z = benchDefault (showMemoryUsage z) $ mkApp3 name tys x y z -- TODO: throw an error if xmem != ymem? That would suggest that the caller has -- done something wrong. diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs index 278cc21cf97..3697d1cfce6 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs @@ -21,9 +21,10 @@ import PlutusCore.Data (Data (..)) import PlutusCore.Default.Universe import PlutusCore.Evaluation.Machine.BuiltinCostModel import PlutusCore.Evaluation.Machine.ExBudgetStream (ExBudgetStream) -import PlutusCore.Evaluation.Machine.ExMemoryUsage (ExMemoryUsage, ListCostedByLength (..), - LiteralByteSize (..), LiteralInteger (..), - memoryUsage, singletonRose) +import PlutusCore.Evaluation.Machine.ExMemoryUsage (ExMemoryUsage, IntegerCostedAsByteSize (..), + IntegerCostedLiterally (..), + ListCostedByLength (..), memoryUsage, + singletonRose) import PlutusCore.Pretty (PrettyConfigPlc) import PlutusCore.Bitwise qualified as Bitwise @@ -1867,10 +1868,10 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where -- Conversions {- See Note [Input length limitation for IntegerToByteString] -} toBuiltinMeaning _semvar IntegerToByteString = - let integerToByteStringDenotation :: Bool -> LiteralByteSize -> Integer -> BuiltinResult BS.ByteString - {- The second argument is wrapped in a LiteralByteSize to allow us to interpret it as a size during + let integerToByteStringDenotation :: Bool -> IntegerCostedAsByteSize -> Integer -> BuiltinResult BS.ByteString + {- The second argument is wrapped in a IntegerCostedAsByteSize to allow us to interpret it as a size during costing. It appears as an integer in UPLC: see Note [Integral types as Integer]. -} - integerToByteStringDenotation b (LiteralByteSize w) = Bitwise.integerToByteStringWrapper b w + integerToByteStringDenotation b (IntegerCostedAsByteSize w) = Bitwise.integerToByteStringWrapper b w {-# INLINE integerToByteStringDenotation #-} in makeBuiltinMeaning integerToByteStringDenotation @@ -1936,8 +1937,8 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where (runCostingFunTwoArguments . paramWriteBits) toBuiltinMeaning _semvar ReplicateByte = - let replicateByteDenotation :: LiteralInteger -> Word8 -> BuiltinResult BS.ByteString - replicateByteDenotation (LiteralInteger n) w = Bitwise.replicateByte n w + let replicateByteDenotation :: IntegerCostedLiterally -> Word8 -> BuiltinResult BS.ByteString + replicateByteDenotation (IntegerCostedLiterally n) w = Bitwise.replicateByte n w -- FIXME: be careful about the coercion inreplicateByte {-# INLINE replicateByteDenotation #-} in makeBuiltinMeaning @@ -1945,16 +1946,16 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where (runCostingFunTwoArguments . paramReplicateByte) toBuiltinMeaning _semvar ShiftByteString = - let shiftByteStringDenotation :: BS.ByteString -> LiteralInteger -> BS.ByteString - shiftByteStringDenotation s (LiteralInteger n) = Bitwise.shiftByteString s (fromIntegral n) + let shiftByteStringDenotation :: BS.ByteString -> IntegerCostedLiterally -> BS.ByteString + shiftByteStringDenotation s (IntegerCostedLiterally n) = Bitwise.shiftByteString s (fromIntegral n) {-# INLINE shiftByteStringDenotation #-} in makeBuiltinMeaning shiftByteStringDenotation (runCostingFunTwoArguments . paramShiftByteString) toBuiltinMeaning _semvar RotateByteString = - let rotateByteStringDenotation :: BS.ByteString -> LiteralInteger -> BS.ByteString - rotateByteStringDenotation s (LiteralInteger n) = Bitwise.rotateByteString s (fromIntegral n) + let rotateByteStringDenotation :: BS.ByteString -> IntegerCostedLiterally -> BS.ByteString + rotateByteStringDenotation s (IntegerCostedLiterally n) = Bitwise.rotateByteString s (fromIntegral n) {-# INLINE rotateByteStringDenotation #-} in makeBuiltinMeaning rotateByteStringDenotation diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs index 14baca058ec..f6e252d5106 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs @@ -49,8 +49,9 @@ import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1 import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2 import PlutusCore.Crypto.BLS12_381.Pairing qualified as BLS12_381.Pairing import PlutusCore.Data -import PlutusCore.Evaluation.Machine.ExMemoryUsage (ListCostedByLength (..), LiteralByteSize (..), - LiteralInteger (..)) +import PlutusCore.Evaluation.Machine.ExMemoryUsage (IntegerCostedAsByteSize (..), + IntegerCostedLiterally (..), + ListCostedByLength (..)) import PlutusCore.Pretty.Extra import Data.ByteString (ByteString) @@ -469,18 +470,18 @@ deriving via AsInteger Word64 instance HasConstantIn DefaultUni term => ReadKnownIn DefaultUni term Word64 deriving newtype instance - KnownTypeAst tyname DefaultUni LiteralByteSize + KnownTypeAst tyname DefaultUni IntegerCostedAsByteSize deriving newtype instance HasConstantIn DefaultUni term => - MakeKnownIn DefaultUni term LiteralByteSize + MakeKnownIn DefaultUni term IntegerCostedAsByteSize deriving newtype instance HasConstantIn DefaultUni term => - ReadKnownIn DefaultUni term LiteralByteSize + ReadKnownIn DefaultUni term IntegerCostedAsByteSize deriving newtype instance - KnownTypeAst tyname DefaultUni LiteralInteger + KnownTypeAst tyname DefaultUni IntegerCostedLiterally deriving newtype instance HasConstantIn DefaultUni term => - MakeKnownIn DefaultUni term LiteralInteger + MakeKnownIn DefaultUni term IntegerCostedLiterally deriving newtype instance HasConstantIn DefaultUni term => - ReadKnownIn DefaultUni term LiteralInteger + ReadKnownIn DefaultUni term IntegerCostedLiterally deriving newtype instance forall tyname a . diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs index ae9854bc37b..c3709019c7c 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExMemoryUsage.hs @@ -10,8 +10,8 @@ module PlutusCore.Evaluation.Machine.ExMemoryUsage , singletonRose , ExMemoryUsage(..) , flattenCostRose - , LiteralByteSize(..) - , LiteralInteger(..) + , IntegerCostedAsByteSize(..) + , IntegerCostedLiterally(..) , ListCostedByLength(..) ) where @@ -170,24 +170,29 @@ instance ExMemoryUsage () where memoryUsage () = singletonRose 1 {-# INLINE memoryUsage #-} -{- | When invoking a built-in function, a value of type LiteralByteSize can be - used transparently as a built-in Integer but with a different size measure: - see Note [Integral types as Integer]. This is required by the +{- | When invoking a built-in function, a value of type `IntegerCostedAsByteSize` + can be used transparently as a built-in Integer but with a different size + measure: see Note [Integral types as Integer]. This is required by the `integerToByteString` builtin, which takes an argument `w` specifying the width (in bytes) of the output bytestring (zero-padded to the desired size). The memory consumed by the function is given by `w`, *not* the size of `w`. - The `LiteralByteSize` type wraps an Integer `w` in a newtype whose + The `IntegerCostedAsByteSize` type wraps an Integer `w` in a newtype whose `ExMemoryUsage` is equal to the number of eight-byte words required to contain `w` bytes, allowing its costing function to work properly. -} -newtype LiteralByteSize = LiteralByteSize { unLiteralByteSize :: Integer } -instance ExMemoryUsage LiteralByteSize where - memoryUsage (LiteralByteSize n) = singletonRose . fromIntegral $ ((n-1) `div` 8) + 1 +newtype IntegerCostedAsByteSize = IntegerCostedAsByteSize { unIntegerCostedAsByteSize :: Integer } +instance ExMemoryUsage IntegerCostedAsByteSize where + memoryUsage (IntegerCostedAsByteSize n) = singletonRose . fromIntegral $ ((n-1) `div` 8) + 1 {-# INLINE memoryUsage #-} -newtype LiteralInteger = LiteralInteger { unLiteralInteger :: Integer } -instance ExMemoryUsage LiteralInteger where - memoryUsage (LiteralInteger n) = singletonRose . fromIntegral $ abs n +{- | A wrapper for Integers whose "memory usage" for costing purposes is the + absolute value of the integer. This is used for costing built-in functions + such as `shiftByteString` and `rotateByteString`, where the cost may depend + on the actual value of the shift argument, not its size. +-} +newtype IntegerCostedLiterally = IntegerCostedLiterally { unIntegerCostedLiterally :: Integer } +instance ExMemoryUsage IntegerCostedLiterally where + memoryUsage (IntegerCostedLiterally n) = singletonRose . fromIntegral $ abs n {-# INLINE memoryUsage #-} {- | A wrappper for lists whose "memory usage" for costing purposes is just the diff --git a/plutus-core/plutus-core/test/CostModelSafety/Spec.hs b/plutus-core/plutus-core/test/CostModelSafety/Spec.hs index 7eef782ac00..d0742b18698 100644 --- a/plutus-core/plutus-core/test/CostModelSafety/Spec.hs +++ b/plutus-core/plutus-core/test/CostModelSafety/Spec.hs @@ -37,7 +37,7 @@ import PlutusCore.Evaluation.Machine.BuiltinCostModel (BuiltinCostModel) import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (ExBudget)) import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (cekCostModelForVariant) import PlutusCore.Evaluation.Machine.ExBudgetStream (sumExBudgetStream) -import PlutusCore.Evaluation.Machine.ExMemoryUsage (LiteralByteSize) +import PlutusCore.Evaluation.Machine.ExMemoryUsage (IntegerCostedAsByteSize) import PlutusCore.Evaluation.Machine.MachineParameters (CostModel (..)) import UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts (CekMachineCosts, CekMachineCostsBase (..)) @@ -109,7 +109,7 @@ smallConstant tr | Just HRefl <- eqTypeRep tr (typeRep @Integer) = SomeConst (0 :: Integer) | Just HRefl <- eqTypeRep tr (typeRep @Int) = SomeConst (0 :: Integer) | Just HRefl <- eqTypeRep tr (typeRep @Word8) = SomeConst (0 :: Integer) - | Just HRefl <- eqTypeRep tr (typeRep @LiteralByteSize) = SomeConst (0 :: Integer) + | Just HRefl <- eqTypeRep tr (typeRep @IntegerCostedAsByteSize) = SomeConst (0 :: Integer) | Just HRefl <- eqTypeRep tr (typeRep @Bool) = SomeConst False | Just HRefl <- eqTypeRep tr (typeRep @BS.ByteString) = SomeConst $ BS.pack [] | Just HRefl <- eqTypeRep tr (typeRep @Text) = SomeConst ("" :: Text) diff --git a/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Builtin.hs b/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Builtin.hs index 62efd5a2d6c..c067a4f3c6b 100644 --- a/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Builtin.hs +++ b/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Builtin.hs @@ -29,7 +29,7 @@ import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1 import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2 import PlutusCore.Crypto.BLS12_381.Pairing qualified as BLS12_381.Pairing import PlutusCore.Data (Data (..)) -import PlutusCore.Evaluation.Machine.ExMemoryUsage (LiteralByteSize, LiteralInteger) +import PlutusCore.Evaluation.Machine.ExMemoryUsage (IntegerCostedAsByteSize, IntegerCostedLiterally) import PlutusCore.Generators.Hedgehog.AST hiding (genConstant) import Data.ByteString qualified as BS @@ -81,8 +81,8 @@ genConstant tr | Just HRefl <- eqTypeRep tr (typeRep @Integer) = SomeGen genInteger | Just HRefl <- eqTypeRep tr (typeRep @Int) = SomeGen genInteger | Just HRefl <- eqTypeRep tr (typeRep @Word8) = SomeGen genInteger - | Just HRefl <- eqTypeRep tr (typeRep @LiteralByteSize) = SomeGen genInteger --- | Just HRefl <- eqTypeRep tr (typeRep @LiteralInteger) = SomeGen genInteger + | Just HRefl <- eqTypeRep tr (typeRep @IntegerCostedAsByteSize) = SomeGen genInteger +-- | Just HRefl <- eqTypeRep tr (typeRep @IntegerCostedLiterally) = SomeGen genInteger | Just HRefl <- eqTypeRep tr (typeRep @Bool) = SomeGen Gen.bool | Just HRefl <- eqTypeRep tr (typeRep @BS.ByteString) = SomeGen genByteString | Just HRefl <- eqTypeRep tr (typeRep @Text) = SomeGen genText