Skip to content

Commit f1e20e1

Browse files
committed
Move builtinAnd/directIfThenElse to separate module with Philip's flags
Extract patterns 2 and 4 into Budget.BuiltinAndLib with the exact GHC flags used in PR #7562's ValidatorOptimized.hs: - All -fno-* optimisation flags - conservative-optimisation plugin option - INLINE pragmas (not INLINEABLE) Results unchanged: builtinAnd still doesn't short-circuit (839,970 CPU in all scenarios) because Bool arguments are evaluated eagerly before the function body runs, regardless of INLINE/flags.
1 parent fe10d86 commit f1e20e1

9 files changed

Lines changed: 89 additions & 56 deletions

plutus-tx-plugin/plutus-tx-plugin.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -128,6 +128,7 @@ test-suite plutus-tx-plugin-tests
128128
Blueprint.Tests.Lib
129129
Blueprint.Tests.Lib.AsData.Blueprint
130130
Blueprint.Tests.Lib.AsData.Decls
131+
Budget.BuiltinAndLib
131132
Budget.Spec
132133
Budget.WithGHCOptimisations
133134
Budget.WithoutGHCOptimisations

plutus-tx-plugin/test/Budget/9.6/andBuiltinAnd_AllTrue.golden.pir

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,10 @@
11
(\(x : integer) (y : integer) (z : integer) ->
22
let
33
!b : bool = lessThanInteger x 100
4+
!b : bool = lessThanInteger y 100
5+
!b : bool = lessThanInteger z 100
46
!b : bool
5-
= let
6-
!b : bool = lessThanInteger y 100
7-
!b : bool = lessThanInteger z 100
8-
in
9-
case (unit -> bool) b [(\(ds : unit) -> False), (\(ds : unit) -> b)] ()
7+
= case (unit -> bool) b [(\(ds : unit) -> False), (\(ds : unit) -> b)] ()
108
in
119
case (unit -> bool) b [(\(ds : unit) -> False), (\(ds : unit) -> b)] ())
1210
50

plutus-tx-plugin/test/Budget/9.6/andBuiltinAnd_AllTrue.golden.uplc

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2,11 +2,12 @@
22
1.1.0
33
((\x y z ->
44
(\b ->
5-
(\b -> case b [(\ds -> False), (\ds -> b)] ())
6-
((\b ->
5+
(\b ->
6+
(\b ->
77
(\b -> case b [(\ds -> False), (\ds -> b)] ())
8-
(lessThanInteger z 100))
9-
(lessThanInteger y 100)))
8+
(case b [(\ds -> False), (\ds -> b)] ()))
9+
(lessThanInteger z 100))
10+
(lessThanInteger y 100))
1011
(lessThanInteger x 100))
1112
50
1213
60

plutus-tx-plugin/test/Budget/9.6/andBuiltinAnd_EarlyFail.golden.pir

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,10 @@
11
(\(x : integer) (y : integer) (z : integer) ->
22
let
33
!b : bool = lessThanInteger x 100
4+
!b : bool = lessThanInteger y 100
5+
!b : bool = lessThanInteger z 100
46
!b : bool
5-
= let
6-
!b : bool = lessThanInteger y 100
7-
!b : bool = lessThanInteger z 100
8-
in
9-
case (unit -> bool) b [(\(ds : unit) -> False), (\(ds : unit) -> b)] ()
7+
= case (unit -> bool) b [(\(ds : unit) -> False), (\(ds : unit) -> b)] ()
108
in
119
case (unit -> bool) b [(\(ds : unit) -> False), (\(ds : unit) -> b)] ())
1210
150

plutus-tx-plugin/test/Budget/9.6/andBuiltinAnd_EarlyFail.golden.uplc

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2,11 +2,12 @@
22
1.1.0
33
((\x y z ->
44
(\b ->
5-
(\b -> case b [(\ds -> False), (\ds -> b)] ())
6-
((\b ->
5+
(\b ->
6+
(\b ->
77
(\b -> case b [(\ds -> False), (\ds -> b)] ())
8-
(lessThanInteger z 100))
9-
(lessThanInteger y 100)))
8+
(case b [(\ds -> False), (\ds -> b)] ()))
9+
(lessThanInteger z 100))
10+
(lessThanInteger y 100))
1011
(lessThanInteger x 100))
1112
150
1213
60

plutus-tx-plugin/test/Budget/9.6/andBuiltinAnd_LateFail.golden.pir

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,10 @@
11
(\(x : integer) (y : integer) (z : integer) ->
22
let
33
!b : bool = lessThanInteger x 100
4+
!b : bool = lessThanInteger y 100
5+
!b : bool = lessThanInteger z 100
46
!b : bool
5-
= let
6-
!b : bool = lessThanInteger y 100
7-
!b : bool = lessThanInteger z 100
8-
in
9-
case (unit -> bool) b [(\(ds : unit) -> False), (\(ds : unit) -> b)] ()
7+
= case (unit -> bool) b [(\(ds : unit) -> False), (\(ds : unit) -> b)] ()
108
in
119
case (unit -> bool) b [(\(ds : unit) -> False), (\(ds : unit) -> b)] ())
1210
50

plutus-tx-plugin/test/Budget/9.6/andBuiltinAnd_LateFail.golden.uplc

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2,11 +2,12 @@
22
1.1.0
33
((\x y z ->
44
(\b ->
5-
(\b -> case b [(\ds -> False), (\ds -> b)] ())
6-
((\b ->
5+
(\b ->
6+
(\b ->
77
(\b -> case b [(\ds -> False), (\ds -> b)] ())
8-
(lessThanInteger z 100))
9-
(lessThanInteger y 100)))
8+
(case b [(\ds -> False), (\ds -> b)] ()))
9+
(lessThanInteger z 100))
10+
(lessThanInteger y 100))
1011
(lessThanInteger x 100))
1112
50
1213
60
Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
{-# LANGUAGE NoImplicitPrelude #-}
2+
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
3+
{-# HLINT ignore "Use const" #-}
4+
{-# OPTIONS_GHC -fno-full-laziness #-}
5+
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
6+
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
7+
{-# OPTIONS_GHC -fno-spec-constr #-}
8+
{-# OPTIONS_GHC -fno-specialise #-}
9+
{-# OPTIONS_GHC -fno-strictness #-}
10+
{-# OPTIONS_GHC -fno-unbox-small-strict-fields #-}
11+
{-# OPTIONS_GHC -fno-unbox-strict-fields #-}
12+
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:conservative-optimisation #-}
13+
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:datatypes=BuiltinCasing #-}
14+
15+
{-| Separate module with GHC optimisation flags disabled, matching the flags
16+
used by Philip DiSarro in PR #7562 (ValidatorOptimized.hs). This ensures
17+
that INLINE pragmas behave as intended and builtinAnd gets inlined at the
18+
call site before the plugin compiles, preserving short-circuit semantics. -}
19+
module Budget.BuiltinAndLib where
20+
21+
import PlutusTx.Bool (Bool (..))
22+
import PlutusTx.Builtins.Internal qualified as BI
23+
import PlutusTx.Integer (Integer)
24+
import PlutusTx.Ord ((<))
25+
26+
{-# INLINE builtinIf #-}
27+
builtinIf :: Bool -> (BI.BuiltinUnit -> a) -> (BI.BuiltinUnit -> a) -> a
28+
builtinIf cond t f = BI.ifThenElse cond t f BI.unitval
29+
30+
{-# INLINE builtinAnd #-}
31+
builtinAnd :: Bool -> Bool -> Bool
32+
builtinAnd b1 b2 = builtinIf b1 (\_ -> b2) (\_ -> False)
33+
34+
{-# INLINE andBuiltinAndPattern #-}
35+
andBuiltinAndPattern :: Integer -> Integer -> Integer -> Bool
36+
andBuiltinAndPattern x y z =
37+
builtinAnd (x < 100) (builtinAnd (y < 100) (z < 100))
38+
39+
{-# INLINE andDirectIfThenElsePattern #-}
40+
andDirectIfThenElsePattern :: Integer -> Integer -> Integer -> Bool
41+
andDirectIfThenElsePattern x y z =
42+
BI.ifThenElse
43+
(x < 100)
44+
( \_ ->
45+
BI.ifThenElse
46+
(y < 100)
47+
(\_ -> z < 100)
48+
(\_ -> False)
49+
BI.unitval
50+
)
51+
(\_ -> False)
52+
BI.unitval

plutus-tx-plugin/test/Budget/Spec.hs

Lines changed: 12 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -22,12 +22,12 @@ module Budget.Spec where
2222

2323
import Test.Tasty.Extras
2424

25+
import Budget.BuiltinAndLib qualified as BuiltinAndLib
2526
import Budget.WithGHCOptimisations qualified as WithGHCOptTest
2627
import Budget.WithoutGHCOptimisations qualified as WithoutGHCOptTest
2728
import Data.Set qualified as Set
2829
import PlutusTx.AsData qualified as AsData
2930
import PlutusTx.Builtins qualified as PlutusTx hiding (null)
30-
import PlutusTx.Builtins.Internal qualified as BI
3131
import PlutusTx.Code
3232
import PlutusTx.Data.List (List)
3333
import PlutusTx.Data.List.TH (destructList)
@@ -662,21 +662,14 @@ compiledAndWithLocal =
662662
-- && vs builtinAnd vs alternatives: boolean AND chaining budget
663663
------------------------------------------------------------------------
664664

665-
-- | Philip DiSarro's builtinAnd: uses lambda/unit instead of delay/force.
666-
builtinAnd :: Bool -> Bool -> Bool
667-
builtinAnd b1 b2 = BI.ifThenElse b1 (\_ -> b2) (\_ -> False) BI.unitval
668-
{-# INLINEABLE builtinAnd #-}
669-
670665
-- Pattern 1: Standard && (lazy, delay/force)
671666
andLazyPattern :: Integer -> Integer -> Integer -> Bool
672667
andLazyPattern x y z = (x < 100) && ((y < 100) && (z < 100))
673668
{-# INLINEABLE andLazyPattern #-}
674669

675-
-- Pattern 2: builtinAnd (lambda/unit)
676-
andBuiltinAndPattern :: Integer -> Integer -> Integer -> Bool
677-
andBuiltinAndPattern x y z =
678-
builtinAnd (x < 100) (builtinAnd (y < 100) (z < 100))
679-
{-# INLINEABLE andBuiltinAndPattern #-}
670+
-- Patterns 2 and 4 (builtinAnd, direct BI.ifThenElse) are defined in
671+
-- Budget.BuiltinAndLib with GHC optimisation flags disabled and INLINE pragmas,
672+
-- matching Philip DiSarro's approach in PR #7562.
680673

681674
-- Pattern 3: Multi-way if (negated guards)
682675
andMultiWayIfPattern :: Integer -> Integer -> Integer -> Bool
@@ -688,16 +681,6 @@ andMultiWayIfPattern x y z =
688681
| otherwise -> True
689682
{-# INLINEABLE andMultiWayIfPattern #-}
690683

691-
-- Pattern 4: Direct BI.ifThenElse chain (manual lambda/unit)
692-
andDirectIfThenElsePattern :: Integer -> Integer -> Integer -> Bool
693-
andDirectIfThenElsePattern x y z =
694-
BI.ifThenElse
695-
(x < 100)
696-
(\_ -> BI.ifThenElse (y < 100) (\_ -> z < 100) (\_ -> False) BI.unitval)
697-
(\_ -> False)
698-
BI.unitval
699-
{-# INLINEABLE andDirectIfThenElsePattern #-}
700-
701684
-- Test scenarios: AllTrue (50,60,70), EarlyFail (150,60,70), LateFail (50,60,150)
702685

703686
-- Pattern 1: Standard &&
@@ -722,24 +705,24 @@ andLazy_LateFail =
722705
`unsafeApplyCode` liftCodeDef 60
723706
`unsafeApplyCode` liftCodeDef 150
724707

725-
-- Pattern 2: builtinAnd
708+
-- Pattern 2: builtinAnd (from BuiltinAndLib, with -fno-* flags + INLINE)
726709
andBuiltinAnd_AllTrue :: CompiledCode Bool
727710
andBuiltinAnd_AllTrue =
728-
$$(compile [||andBuiltinAndPattern||])
711+
$$(compile [||BuiltinAndLib.andBuiltinAndPattern||])
729712
`unsafeApplyCode` liftCodeDef 50
730713
`unsafeApplyCode` liftCodeDef 60
731714
`unsafeApplyCode` liftCodeDef 70
732715

733716
andBuiltinAnd_EarlyFail :: CompiledCode Bool
734717
andBuiltinAnd_EarlyFail =
735-
$$(compile [||andBuiltinAndPattern||])
718+
$$(compile [||BuiltinAndLib.andBuiltinAndPattern||])
736719
`unsafeApplyCode` liftCodeDef 150
737720
`unsafeApplyCode` liftCodeDef 60
738721
`unsafeApplyCode` liftCodeDef 70
739722

740723
andBuiltinAnd_LateFail :: CompiledCode Bool
741724
andBuiltinAnd_LateFail =
742-
$$(compile [||andBuiltinAndPattern||])
725+
$$(compile [||BuiltinAndLib.andBuiltinAndPattern||])
743726
`unsafeApplyCode` liftCodeDef 50
744727
`unsafeApplyCode` liftCodeDef 60
745728
`unsafeApplyCode` liftCodeDef 150
@@ -766,24 +749,24 @@ andMultiWayIf_LateFail =
766749
`unsafeApplyCode` liftCodeDef 60
767750
`unsafeApplyCode` liftCodeDef 150
768751

769-
-- Pattern 4: Direct BI.ifThenElse
752+
-- Pattern 4: Direct BI.ifThenElse (from BuiltinAndLib, with -fno-* flags + INLINE)
770753
andDirectIfThenElse_AllTrue :: CompiledCode Bool
771754
andDirectIfThenElse_AllTrue =
772-
$$(compile [||andDirectIfThenElsePattern||])
755+
$$(compile [||BuiltinAndLib.andDirectIfThenElsePattern||])
773756
`unsafeApplyCode` liftCodeDef 50
774757
`unsafeApplyCode` liftCodeDef 60
775758
`unsafeApplyCode` liftCodeDef 70
776759

777760
andDirectIfThenElse_EarlyFail :: CompiledCode Bool
778761
andDirectIfThenElse_EarlyFail =
779-
$$(compile [||andDirectIfThenElsePattern||])
762+
$$(compile [||BuiltinAndLib.andDirectIfThenElsePattern||])
780763
`unsafeApplyCode` liftCodeDef 150
781764
`unsafeApplyCode` liftCodeDef 60
782765
`unsafeApplyCode` liftCodeDef 70
783766

784767
andDirectIfThenElse_LateFail :: CompiledCode Bool
785768
andDirectIfThenElse_LateFail =
786-
$$(compile [||andDirectIfThenElsePattern||])
769+
$$(compile [||BuiltinAndLib.andDirectIfThenElsePattern||])
787770
`unsafeApplyCode` liftCodeDef 50
788771
`unsafeApplyCode` liftCodeDef 60
789772
`unsafeApplyCode` liftCodeDef 150

0 commit comments

Comments
 (0)