Skip to content

Commit ef1fa2e

Browse files
SeungheonOhSeungheonOh
authored
Add data construction bench (#7360)
1 parent 2544c0c commit ef1fa2e

File tree

3 files changed

+295
-0
lines changed

3 files changed

+295
-0
lines changed

‎plutus-benchmark/data/bench/Bench.hs‎

Lines changed: 45 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
{-# LANGUAGE BangPatterns #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
4+
{- | This benchmark cases measures efficiency of 'Data' construction.
5+
-}
6+
7+
module Main (main) where
8+
9+
import Criterion.Main
10+
11+
import PlutusBenchmark.Common (benchTermCek, getConfig, mkMostRecentEvalCtx)
12+
import PlutusLedgerApi.Common (EvaluationContext)
13+
14+
import PlutusBenchmark.Data qualified as Data
15+
16+
import Control.Exception
17+
import Data.ByteString as BS
18+
import Data.Functor
19+
20+
benchmarks :: EvaluationContext -> [Benchmark]
21+
benchmarks ctx =
22+
[ bgroup "data"
23+
[ mkBMs "conDeconI" Data.conDeconI
24+
, mkBMs "conI" Data.conI
25+
, mkBMs "conDeconB - short" (Data.conDeconB "helloworld")
26+
, mkBMs "conB - short" (Data.conB "helloworld")
27+
, mkBMs "conDeconB - long" (Data.conDeconB $ BS.replicate 10000 97)
28+
, mkBMs "conB - long" (Data.conB $ BS.replicate 10000 97)
29+
, mkBMs "constr no release, 2000 chuck size" (Data.constrDataNoRelease 2000)
30+
, mkBMs "constr with release, 2000 chuck size" (Data.constrDataWithRelease 2000)
31+
, mkBMs "list no release, 2000 chuck size" (Data.listDataNoRelease 2000)
32+
, mkBMs "list with release, 2000 chuck size" (Data.listDataWithRelease 2000)
33+
]
34+
]
35+
where
36+
mkBMs name f =
37+
bgroup name $ [2000, 4000..12000] <&> \n ->
38+
bench (show n) $ benchTermCek ctx (f n)
39+
40+
main :: IO ()
41+
main = do
42+
-- Run each benchmark for at least 15 seconds. Change this with -L or --timeout.
43+
config <- getConfig 15.0
44+
evalCtx <- evaluate mkMostRecentEvalCtx
45+
defaultMainWith config $ benchmarks evalCtx

‎plutus-benchmark/data/src/PlutusBenchmark/Data.hs‎

Lines changed: 224 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,224 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE TypeApplications #-}
3+
4+
module PlutusBenchmark.Data where
5+
6+
import Control.Monad.Except
7+
import Data.ByteString (ByteString)
8+
import Data.Either
9+
import PlutusBenchmark.Common (Term)
10+
import PlutusCore (freshName, runQuote)
11+
import PlutusCore qualified as PLC
12+
import PlutusCore.Builtin qualified as PLC
13+
import PlutusCore.Data qualified as PLC
14+
import PlutusCore.MkPlc
15+
import UntypedPlutusCore qualified as UPLC
16+
17+
debruijnTermUnsafe :: UPLC.Term UPLC.Name UPLC.DefaultUni UPLC.DefaultFun ann
18+
-> UPLC.Term UPLC.NamedDeBruijn UPLC.DefaultUni UPLC.DefaultFun ann
19+
debruijnTermUnsafe =
20+
fromRight (Prelude.error "debruijnTermUnsafe") . runExcept @UPLC.FreeVariableError . UPLC.deBruijnTerm
21+
22+
conDeconI :: Integer -> Term
23+
conDeconI i =
24+
debruijnTermUnsafe $
25+
foldr (const comp) (mkConstant @Integer () 0) [1..i]
26+
where
27+
intTy = PLC.mkTyBuiltin @_ @Integer ()
28+
comp t = runQuote $ do
29+
x <- freshName "x"
30+
pure $
31+
apply ()
32+
(lamAbs () x intTy t)
33+
(apply ()
34+
(builtin () PLC.UnIData)
35+
(apply () (builtin () PLC.IData) (mkConstant @Integer () 42)))
36+
37+
conI :: Integer -> Term
38+
conI i =
39+
debruijnTermUnsafe $
40+
foldr (const comp) (mkConstant @Integer () 0) [1..i]
41+
where
42+
intTy = PLC.mkTyBuiltin @_ @Integer ()
43+
comp t = runQuote $ do
44+
x <- freshName "x"
45+
pure $
46+
apply ()
47+
(lamAbs () x intTy t)
48+
(apply () (builtin () PLC.IData) (mkConstant @Integer () 42))
49+
50+
conDeconB :: ByteString -> Integer -> Term
51+
conDeconB bs i =
52+
debruijnTermUnsafe $
53+
foldr (const comp) (mkConstant @Integer () 0) [1..i]
54+
where
55+
intTy = PLC.mkTyBuiltin @_ @Integer ()
56+
comp t = runQuote $ do
57+
x <- freshName "x"
58+
pure $
59+
apply ()
60+
(lamAbs () x intTy t)
61+
(apply ()
62+
(builtin () PLC.UnBData)
63+
(apply () (builtin () PLC.BData) (mkConstant @ByteString () bs)))
64+
65+
conB :: ByteString -> Integer -> Term
66+
conB bs i =
67+
debruijnTermUnsafe $
68+
foldr (const comp) (mkConstant @Integer () 0) [1..i]
69+
where
70+
intTy = PLC.mkTyBuiltin @_ @Integer ()
71+
comp t = runQuote $ do
72+
x <- freshName "x"
73+
pure $
74+
apply ()
75+
(lamAbs () x intTy t)
76+
(apply () (builtin () PLC.BData) (mkConstant @ByteString () bs))
77+
78+
{-
79+
Given amount "i" and chuck size,
80+
81+
[ (\x ->
82+
[ (\x ->
83+
<repeat (i / chuckSize) times>
84+
)
85+
(Constr 1 [Constr 1 [Constr 1 [Constr 1 ...chuck size amount...]]])
86+
])
87+
(Constr 1 [Constr 1 [Constr 1 [Constr 1 ...chuck size amount...]]])
88+
]
89+
-}
90+
constrDataWithRelease :: Integer -> Integer -> Term
91+
constrDataWithRelease chuckSize i =
92+
debruijnTermUnsafe $ comp (i-1) d
93+
where
94+
dataTy = PLC.mkTyBuiltin @_ @PLC.Data ()
95+
nilData = mkConstant @[PLC.Data] () []
96+
d = mkConstant @PLC.Data () (PLC.I 42)
97+
work t =
98+
(apply ()
99+
(apply ()
100+
(builtin () PLC.ConstrData)
101+
(mkConstant @Integer () 1))
102+
(apply () (apply () (tyInst () (builtin () PLC.MkCons) dataTy) t) nilData))
103+
comp 0 t = work t
104+
comp n t
105+
| n `mod` chuckSize == 0 = runQuote $ do
106+
x <- freshName "x"
107+
pure $
108+
apply ()
109+
(lamAbs () x dataTy (comp (n - 1) d))
110+
(work t)
111+
| otherwise = runQuote $ do
112+
pure $ comp (n - 1) $ work t
113+
114+
{-
115+
Given amount "i" and chuck size,
116+
117+
[ (\x ->
118+
[ (\x ->
119+
...<repeat (i / chuckSize) times>...
120+
[ (\x -> (Constr 1 [Constr 1 [Constr 1 [Constr 1 ..."i" times...]]]))
121+
()
122+
])
123+
()
124+
])
125+
()
126+
]
127+
128+
We make these lambda abstractions and unit binds to keep it fair against 'constrDataWithRelease'
129+
-}
130+
constrDataNoRelease :: Integer -> Integer -> Term
131+
constrDataNoRelease chuckSize i =
132+
debruijnTermUnsafe $ comp (i-1) d
133+
where
134+
dataTy = PLC.mkTyBuiltin @_ @PLC.Data ()
135+
nilData = mkConstant @[PLC.Data] () []
136+
d = mkConstant @PLC.Data () (PLC.I 42)
137+
work t =
138+
(apply ()
139+
(apply ()
140+
(builtin () PLC.ConstrData)
141+
(mkConstant @Integer () 1))
142+
(apply () (apply () (tyInst () (builtin () PLC.MkCons) dataTy) t) nilData))
143+
comp 0 t = work t
144+
comp n t
145+
| n `mod` chuckSize == 0 = runQuote $ do
146+
x <- freshName "x"
147+
pure $
148+
apply ()
149+
(lamAbs () x dataTy (comp (n - 1) $ work t))
150+
(mkConstant @() () ())
151+
| otherwise = runQuote $ do
152+
pure $ comp (n - 1) $ work t
153+
154+
{-
155+
Given amount "i" and chuck size,
156+
157+
[ (\x ->
158+
[ (\x ->
159+
<repeat (i / chuckSize) times>
160+
)
161+
(List [List [List [List ...chuck size amount...]]])
162+
])
163+
(List [List [List [List ...chuck size amount...]]])
164+
]
165+
-}
166+
listDataWithRelease :: Integer -> Integer -> Term
167+
listDataWithRelease chuckSize i =
168+
debruijnTermUnsafe $ comp (i-1) d
169+
where
170+
dataTy = PLC.mkTyBuiltin @_ @PLC.Data ()
171+
nilData = mkConstant @[PLC.Data] () []
172+
d = mkConstant @PLC.Data () (PLC.I 42)
173+
work t =
174+
(apply ()
175+
(builtin () PLC.ListData)
176+
(apply () (apply () (tyInst () (builtin () PLC.MkCons) dataTy) t) nilData))
177+
comp 0 t = work t
178+
comp n t
179+
| n `mod` chuckSize == 0 = runQuote $ do
180+
x <- freshName "x"
181+
pure $
182+
apply ()
183+
(lamAbs () x dataTy (comp (n - 1) d))
184+
(work t)
185+
| otherwise = runQuote $ do
186+
pure $ comp (n - 1) $ work t
187+
188+
{-
189+
Given amount "i" and chuck size,
190+
191+
[ (\x ->
192+
[ (\x ->
193+
...<repeat (i / chuckSize) times>...
194+
[ (\x -> (List [List [List [List ..."i" times...]]]))
195+
()
196+
])
197+
()
198+
])
199+
()
200+
]
201+
202+
We make these lambda abstractions and unit binds to keep it fair against 'listDataWithRelease'
203+
-}
204+
listDataNoRelease :: Integer -> Integer -> Term
205+
listDataNoRelease chuckSize i =
206+
debruijnTermUnsafe $ comp (i-1) d
207+
where
208+
dataTy = PLC.mkTyBuiltin @_ @PLC.Data ()
209+
nilData = mkConstant @[PLC.Data] () []
210+
d = mkConstant @PLC.Data () (PLC.I 42)
211+
work t =
212+
(apply ()
213+
(builtin () PLC.ListData)
214+
(apply () (apply () (tyInst () (builtin () PLC.MkCons) dataTy) t) nilData))
215+
comp 0 t = work t
216+
comp n t
217+
| n `mod` chuckSize == 0 = runQuote $ do
218+
x <- freshName "x"
219+
pure $
220+
apply ()
221+
(lamAbs () x dataTy (comp (n - 1) $ work t))
222+
(mkConstant @() () ())
223+
| otherwise = runQuote $ do
224+
pure $ comp (n - 1) $ work t

‎plutus-benchmark/plutus-benchmark.cabal‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -277,6 +277,32 @@ benchmark casing
277277
, plutus-benchmark-common
278278
, plutus-ledger-api ^>=1.54
279279

280+
---------------- data ----------------
281+
282+
library data-internal
283+
import: lang, ghc-version-support, os-support
284+
hs-source-dirs: data/src
285+
exposed-modules: PlutusBenchmark.Data
286+
build-depends:
287+
, base >=4.9 && <5
288+
, bytestring
289+
, mtl
290+
, plutus-benchmark-common
291+
, plutus-core ^>=1.54
292+
293+
benchmark data
294+
import: lang, ghc-version-support, os-support
295+
type: exitcode-stdio-1.0
296+
main-is: Bench.hs
297+
hs-source-dirs: data/bench
298+
build-depends:
299+
, base >=4.9 && <5
300+
, bytestring
301+
, criterion >=1.5.9.0
302+
, data-internal
303+
, plutus-benchmark-common
304+
, plutus-ledger-api ^>=1.54
305+
280306
---------------- validation ----------------
281307

282308
library validation-internal

0 commit comments

Comments
 (0)