Skip to content

Commit 6d75987

Browse files
UnisayUnisay
committed
experiment: replace builtinIf with standard guards in optimized validator
Replace all builtinIf/builtinNot/builtinAnd (lambda/unit pattern) with standard if/then/else and multi-way if guards, while keeping all BI.* low-level operations identical. This isolates the cost of the builtinIf pattern vs standard Haskell conditionals.
1 parent c29e553 commit 6d75987

1 file changed

Lines changed: 96 additions & 158 deletions

File tree

‎plutus-benchmark/linear-vesting/src/LinearVesting/ValidatorOptimized.hs‎

Lines changed: 96 additions & 158 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE BangPatterns #-}
22
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE MultiWayIf #-}
34
{-# LANGUAGE OverloadedStrings #-}
45
{-# LANGUAGE TemplateHaskell #-}
56
{-# LANGUAGE NoImplicitPrelude #-}
@@ -21,23 +22,11 @@
2122
module LinearVesting.ValidatorOptimized where
2223

2324
import PlutusTx (CompiledCode, compile)
24-
import PlutusTx.Bool (Bool (..))
25+
import PlutusTx.Bool (Bool (..), not, otherwise)
2526
import PlutusTx.Builtins.HasOpaque ()
2627
import PlutusTx.Builtins.Internal qualified as BI
2728
import PlutusTx.Trace (traceError)
2829

29-
{-# INLINE builtinIf #-}
30-
builtinIf :: Bool -> (BI.BuiltinUnit -> a) -> (BI.BuiltinUnit -> a) -> a
31-
builtinIf cond t f = BI.ifThenElse cond t f BI.unitval
32-
33-
{-# INLINE builtinNot #-}
34-
builtinNot :: Bool -> Bool
35-
builtinNot b = builtinIf b (\_ -> False) (\_ -> True)
36-
37-
{-# INLINE builtinAnd #-}
38-
builtinAnd :: Bool -> Bool -> Bool
39-
builtinAnd b1 b2 = builtinIf b1 (\_ -> b2) (\_ -> False)
40-
4130
{-# INLINE divCeil #-}
4231
divCeil :: BI.BuiltinInteger -> BI.BuiltinInteger -> BI.BuiltinInteger
4332
divCeil x y = BI.addInteger 1 (BI.divideInteger (BI.subtractInteger x 1) y)
@@ -55,14 +44,10 @@ lowerInclusiveTime iv =
5544
extTag = BI.fst extCon
5645
extFields = BI.snd extCon
5746
offset =
58-
builtinIf
59-
(BI.equalsInteger closureTag 1)
60-
(\_ -> 0)
61-
(\_ -> 1)
62-
in builtinIf
63-
(BI.equalsInteger extTag 1)
64-
(\_ -> BI.addInteger (BI.unsafeDataAsI (BI.head extFields)) offset)
65-
(\_ -> traceError "Time range not Finite")
47+
if BI.equalsInteger closureTag 1 then 0 else 1
48+
in if BI.equalsInteger extTag 1
49+
then BI.addInteger (BI.unsafeDataAsI (BI.head extFields)) offset
50+
else traceError "Time range not Finite"
6651

6752
{-# INLINE txSignedByOptimized #-}
6853
txSignedByOptimized :: BI.BuiltinList BI.BuiltinData -> BI.BuiltinByteString -> Bool
@@ -71,10 +56,9 @@ txSignedByOptimized signatories pkh =
7156
False
7257
( \s ss ->
7358
let sBytes = BI.unsafeDataAsB s
74-
in builtinIf
75-
(BI.equalsByteString sBytes pkh)
76-
(\_ -> True)
77-
(\_ -> txSignedByOptimized ss pkh)
59+
in if BI.equalsByteString sBytes pkh
60+
then True
61+
else txSignedByOptimized ss pkh
7862
)
7963
signatories
8064

@@ -86,10 +70,9 @@ findInputByOutRef ref inputs =
8670
( \txIn txIns ->
8771
let txInFields = BI.snd (BI.unsafeDataAsConstr txIn)
8872
txInRef = BI.head txInFields
89-
in builtinIf
90-
(BI.equalsData txInRef ref)
91-
(\_ -> txIn)
92-
(\_ -> findInputByOutRef ref txIns)
73+
in if BI.equalsData txInRef ref
74+
then txIn
75+
else findInputByOutRef ref txIns
9376
)
9477
inputs
9578

@@ -101,10 +84,9 @@ findOutputByAddress addr outputs =
10184
( \out outs ->
10285
let outFields = BI.snd (BI.unsafeDataAsConstr out)
10386
outAddr = BI.head outFields
104-
in builtinIf
105-
(BI.equalsData outAddr addr)
106-
(\_ -> out)
107-
(\_ -> findOutputByAddress addr outs)
87+
in if BI.equalsData outAddr addr
88+
then out
89+
else findOutputByAddress addr outs
10890
)
10991
outputs
11092

@@ -124,16 +106,13 @@ countInputsAtScript scriptHash inputs =
124106
credTag = BI.fst credCon
125107
credFields = BI.snd credCon
126108
rest = countInputsAtScript scriptHash txIns
127-
in builtinIf
128-
(BI.equalsInteger credTag 1)
129-
( \_ ->
130-
let vh = BI.unsafeDataAsB (BI.head credFields)
131-
in builtinIf
132-
(BI.equalsByteString vh scriptHash)
133-
(\_ -> BI.addInteger 1 rest)
134-
(\_ -> rest)
135-
)
136-
(\_ -> rest)
109+
in if BI.equalsInteger credTag 1
110+
then
111+
let vh = BI.unsafeDataAsB (BI.head credFields)
112+
in if BI.equalsByteString vh scriptHash
113+
then BI.addInteger 1 rest
114+
else rest
115+
else rest
137116
)
138117
inputs
139118

@@ -145,31 +124,25 @@ valueOf valueData cs tn =
145124
where
146125
findCurrency :: BI.BuiltinList (BI.BuiltinPair BI.BuiltinData BI.BuiltinData) -> BI.BuiltinInteger
147126
findCurrency pairs =
148-
builtinIf
149-
(BI.null pairs)
150-
(\_ -> 0)
151-
( \_ ->
152-
let pair = BI.head pairs
153-
key = BI.unsafeDataAsB (BI.fst pair)
154-
in builtinIf
155-
(BI.equalsByteString key cs)
156-
(\_ -> findToken (BI.unsafeDataAsMap (BI.snd pair)))
157-
(\_ -> findCurrency (BI.tail pairs))
158-
)
127+
if BI.null pairs
128+
then 0
129+
else
130+
let pair = BI.head pairs
131+
key = BI.unsafeDataAsB (BI.fst pair)
132+
in if BI.equalsByteString key cs
133+
then findToken (BI.unsafeDataAsMap (BI.snd pair))
134+
else findCurrency (BI.tail pairs)
159135

160136
findToken :: BI.BuiltinList (BI.BuiltinPair BI.BuiltinData BI.BuiltinData) -> BI.BuiltinInteger
161137
findToken pairs =
162-
builtinIf
163-
(BI.null pairs)
164-
(\_ -> 0)
165-
( \_ ->
166-
let pair = BI.head pairs
167-
key = BI.unsafeDataAsB (BI.fst pair)
168-
in builtinIf
169-
(BI.equalsByteString key tn)
170-
(\_ -> BI.unsafeDataAsI (BI.snd pair))
171-
(\_ -> findToken (BI.tail pairs))
172-
)
138+
if BI.null pairs
139+
then 0
140+
else
141+
let pair = BI.head pairs
142+
key = BI.unsafeDataAsB (BI.fst pair)
143+
in if BI.equalsByteString key tn
144+
then BI.unsafeDataAsI (BI.snd pair)
145+
else findToken (BI.tail pairs)
173146

174147
{-# INLINE getScriptHashFromAddress #-}
175148
getScriptHashFromAddress :: BI.BuiltinData -> BI.BuiltinByteString
@@ -179,10 +152,9 @@ getScriptHashFromAddress addr =
179152
!credCon = BI.unsafeDataAsConstr cred
180153
credTag = BI.fst credCon
181154
credFields = BI.snd credCon
182-
in builtinIf
183-
(BI.equalsInteger credTag 1)
184-
(\_ -> BI.unsafeDataAsB (BI.head credFields))
185-
(\_ -> traceError "Expected ScriptCredential")
155+
in if BI.equalsInteger credTag 1
156+
then BI.unsafeDataAsB (BI.head credFields)
157+
else traceError "Expected ScriptCredential"
186158

187159
{-# INLINE getPubKeyHashFromAddress #-}
188160
getPubKeyHashFromAddress :: BI.BuiltinData -> BI.BuiltinByteString
@@ -192,31 +164,27 @@ getPubKeyHashFromAddress addr =
192164
!credCon = BI.unsafeDataAsConstr cred
193165
credTag = BI.fst credCon
194166
credFields = BI.snd credCon
195-
in builtinIf
196-
(BI.equalsInteger credTag 0)
197-
(\_ -> BI.unsafeDataAsB (BI.head credFields))
198-
(\_ -> traceError "Expected PubKeyCredential")
167+
in if BI.equalsInteger credTag 0
168+
then BI.unsafeDataAsB (BI.head credFields)
169+
else traceError "Expected PubKeyCredential"
199170

200171
{-# INLINE getSpendingInfo #-}
201172
getSpendingInfo :: BI.BuiltinData -> BI.BuiltinPair BI.BuiltinData BI.BuiltinData
202173
getSpendingInfo scriptInfo =
203174
let con = BI.unsafeDataAsConstr scriptInfo
204175
tag = BI.fst con
205176
fields = BI.snd con
206-
in builtinIf
207-
(BI.equalsInteger tag 1)
208-
( \_ ->
209-
let ownRef = BI.head fields
210-
maybeDatum = BI.head (BI.tail fields)
211-
!mdCon = BI.unsafeDataAsConstr maybeDatum
212-
mdTag = BI.fst mdCon
213-
mdFields = BI.snd mdCon
214-
in builtinIf
215-
(BI.equalsInteger mdTag 0)
216-
(\_ -> BI.mkPairData ownRef (BI.head mdFields))
217-
(\_ -> traceError "Missing datum")
218-
)
219-
(\_ -> traceError "Not spending script")
177+
in if BI.equalsInteger tag 1
178+
then
179+
let ownRef = BI.head fields
180+
maybeDatum = BI.head (BI.tail fields)
181+
!mdCon = BI.unsafeDataAsConstr maybeDatum
182+
mdTag = BI.fst mdCon
183+
mdFields = BI.snd mdCon
184+
in if BI.equalsInteger mdTag 0
185+
then BI.mkPairData ownRef (BI.head mdFields)
186+
else traceError "Missing datum"
187+
else traceError "Not spending script"
220188

221189
{-# INLINE validateVestingPartialUnlockOptimized #-}
222190
validateVestingPartialUnlockOptimized
@@ -275,40 +243,22 @@ validateVestingPartialUnlockOptimized txInputs txOutputs txValidRange txSignator
275243

276244
beneficiaryHash = getPubKeyHashFromAddress beneficiaryAddr
277245
signed = txSignedByOptimized txSignatories beneficiaryHash
278-
in builtinIf
279-
(builtinNot signed)
280-
(\_ -> traceError "Missing beneficiary signature")
281-
( \_ ->
282-
builtinIf
283-
(BI.lessThanEqualsInteger currentTimeApproximation firstUnlockPossibleAfter)
284-
(\_ -> traceError "Unlock not permitted until firstUnlockPossibleAfter time")
285-
( \_ ->
286-
builtinIf
287-
(BI.lessThanEqualsInteger newRemainingQty 0)
288-
(\_ -> traceError "Zero remaining assets not allowed")
289-
( \_ ->
290-
builtinIf
291-
(BI.lessThanEqualsInteger oldRemainingQty newRemainingQty)
292-
(\_ -> traceError "Remaining asset is not decreasing")
293-
( \_ ->
294-
builtinIf
295-
(builtinNot (BI.equalsInteger expectedRemainingQty newRemainingQty))
296-
(\_ -> traceError "Mismatched remaining asset")
297-
( \_ ->
298-
builtinIf
299-
(builtinNot (BI.equalsData resolvedDatum outputDatum))
300-
(\_ -> traceError "Datum Modification Prohibited")
301-
( \_ ->
302-
builtinIf
303-
(builtinNot (BI.equalsInteger (countInputsAtScript scriptHash txInputs) 1))
304-
(\_ -> traceError "Double satisfaction")
305-
(\_ -> True)
306-
)
307-
)
308-
)
309-
)
310-
)
311-
)
246+
in if
247+
| not signed ->
248+
traceError "Missing beneficiary signature"
249+
| BI.lessThanEqualsInteger currentTimeApproximation firstUnlockPossibleAfter ->
250+
traceError "Unlock not permitted until firstUnlockPossibleAfter time"
251+
| BI.lessThanEqualsInteger newRemainingQty 0 ->
252+
traceError "Zero remaining assets not allowed"
253+
| BI.lessThanEqualsInteger oldRemainingQty newRemainingQty ->
254+
traceError "Remaining asset is not decreasing"
255+
| not (BI.equalsInteger expectedRemainingQty newRemainingQty) ->
256+
traceError "Mismatched remaining asset"
257+
| not (BI.equalsData resolvedDatum outputDatum) ->
258+
traceError "Datum Modification Prohibited"
259+
| not (BI.equalsInteger (countInputsAtScript scriptHash txInputs) 1) ->
260+
traceError "Double satisfaction"
261+
| otherwise -> True
312262

313263
{-# INLINE validateVestingFullUnlockOptimized #-}
314264
validateVestingFullUnlockOptimized
@@ -327,15 +277,12 @@ validateVestingFullUnlockOptimized txValidRange txSignatories vestingDatum =
327277
vestingPeriodEnd = BI.unsafeDataAsI (BI.head vdFields4)
328278
currentTimeApproximation = lowerInclusiveTime txValidRange
329279
beneficiaryHash = getPubKeyHashFromAddress beneficiaryAddr
330-
in builtinIf
331-
(builtinNot (txSignedByOptimized txSignatories beneficiaryHash))
332-
(\_ -> traceError "Missing beneficiary signature")
333-
( \_ ->
334-
builtinIf
335-
(BI.lessThanEqualsInteger currentTimeApproximation vestingPeriodEnd)
336-
(\_ -> traceError "Unlock not permitted until vestingPeriodEnd time")
337-
(\_ -> True)
338-
)
280+
in if
281+
| not (txSignedByOptimized txSignatories beneficiaryHash) ->
282+
traceError "Missing beneficiary signature"
283+
| BI.lessThanEqualsInteger currentTimeApproximation vestingPeriodEnd ->
284+
traceError "Unlock not permitted until vestingPeriodEnd time"
285+
| otherwise -> True
339286

340287
{-# INLINEABLE untypedValidatorOptimized #-}
341288
untypedValidatorOptimized :: BI.BuiltinData -> BI.BuiltinUnit
@@ -372,36 +319,27 @@ untypedValidatorOptimized scriptContextData =
372319
"Parsed ScriptContext"
373320
( BI.trace
374321
"Parsed Redeemer"
375-
( builtinIf
376-
(BI.equalsInteger redeemerTag 1)
377-
( \_ ->
378-
BI.trace
379-
"Full unlock requested"
380-
(validateVestingFullUnlockOptimized txValidRange txSignatories datumData)
381-
)
382-
( \_ ->
383-
builtinIf
384-
(BI.equalsInteger redeemerTag 0)
385-
( \_ ->
386-
BI.trace
387-
"Partial unlock requested"
388-
( validateVestingPartialUnlockOptimized
389-
txInputs
390-
txOutputs
391-
txValidRange
392-
txSignatories
393-
ownRef
394-
datumData
395-
)
396-
)
397-
(\_ -> traceError "Failed to parse Redeemer")
398-
)
322+
( BI.caseInteger
323+
redeemerTag
324+
[ BI.trace
325+
"Partial unlock requested"
326+
( validateVestingPartialUnlockOptimized
327+
txInputs
328+
txOutputs
329+
txValidRange
330+
txSignatories
331+
ownRef
332+
datumData
333+
)
334+
, BI.trace
335+
"Full unlock requested"
336+
(validateVestingFullUnlockOptimized txValidRange txSignatories datumData)
337+
]
399338
)
400339
)
401-
in builtinIf
402-
result
403-
(\_ -> BI.trace "Validation completed" BI.unitval)
404-
(\_ -> traceError "Validation failed")
340+
in if result
341+
then BI.trace "Validation completed" BI.unitval
342+
else traceError "Validation failed"
405343

406344
validatorOptimizedCode :: CompiledCode (BI.BuiltinData -> BI.BuiltinUnit)
407345
validatorOptimizedCode = $$(compile [||untypedValidatorOptimized||])

0 commit comments

Comments
 (0)