Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix boolean functions not short circuiting #84

Merged
merged 3 commits into from
Jan 10, 2022
Merged

Fix boolean functions not short circuiting #84

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
ca0b1ef
Fix boolean functions not short circuiting
TotallyNotChase Jan 10, 2022
a54e018
[breaking] optimise p{and,or}{,'}
L-as Jan 10, 2022
acc1b0a
Add some tests for booleans
L-as Jan 10, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 8 additions & 16 deletions Plutarch/Bool.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -62,34 +62,26 @@ pnot = phoistAcyclic $ plam $ \x -> pif x (pcon PFalse) $ pcon PTrue
infixr 3 #&&

(#&&) :: Term s PBool -> Term s PBool -> Term s PBool
x #&& y = pand # pdelay x # pdelay y
x #&& y = pforce $ pand # x # pdelay y

-- | Lazily evaluated boolean or for 'PBool' terms.
infixr 2 #||

(#||) :: Term s PBool -> Term s PBool -> Term s PBool
x #|| y = por # pdelay x # pdelay y
x #|| y = pforce $ por # x # pdelay y

-- | Hoisted, Plutarch level, lazily evaluated boolean and function.
pand :: Term s (PDelayed PBool :--> PDelayed PBool :--> PBool)
pand = phoistAcyclic $
plam $
\x y -> pif' # pforce x # (pif' # pforce y # pcon PTrue # pcon PFalse) # pcon PFalse
pand :: Term s (PBool :--> PDelayed PBool :--> PDelayed PBool)
pand = phoistAcyclic $ plam $ \x y -> pif' # x # y # (phoistAcyclic $ pdelay $ pcon PFalse)
srid marked this conversation as resolved.
Show resolved Hide resolved

-- | Hoisted, Plutarch level, strictly evaluated boolean and function.
pand' :: Term s (PBool :--> PBool :--> PBool)
pand' = phoistAcyclic $
plam $
\x y -> pif' # x # (pif' # y # pcon PTrue # pcon PFalse) # pcon PFalse
pand' = phoistAcyclic $ plam $ \x y -> pif' # x # y # (pcon PFalse)

-- | Hoisted, Plutarch level, lazily evaluated boolean or function.
por :: Term s (PDelayed PBool :--> PDelayed PBool :--> PBool)
por = phoistAcyclic $
plam $
\x y -> pif' # pforce x # pcon PTrue #$ pif' # pforce y # pcon PTrue # pcon PFalse
por :: Term s (PBool :--> PDelayed PBool :--> PDelayed PBool)
por = phoistAcyclic $ plam $ \x y -> pif' # x # (phoistAcyclic $ pdelay $ pcon PTrue) # y

-- | Hoisted, Plutarch level, strictly evaluated boolean or function.
por' :: Term s (PBool :--> PBool :--> PBool)
por' = phoistAcyclic $
plam $
\x y -> pif' # x # pcon PTrue #$ pif' # y # pcon PTrue # pcon PFalse
por' = phoistAcyclic $ plam $ \x y -> pif' # x # (pcon PTrue) # y
15 changes: 14 additions & 1 deletion examples/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ import Data.Maybe (fromJust)
import qualified Examples.List as List
import Examples.Tracing (traceTests)
import Plutarch (POpaque, pconstant, plift', popaque, printTerm, punsafeBuiltin)
import Plutarch.Bool (PBool (PFalse, PTrue), pif, pnot, (#&&), (#<), (#<=), (#==), (#||))
import Plutarch.Bool (PBool (PFalse, PTrue), pand, pif, pnot, por, (#&&), (#<), (#<=), (#==), (#||))
import Plutarch.Builtin (PAsData, PBuiltinList (..), PBuiltinPair, PData, pdata)
import Plutarch.ByteString (PByteString, pconsBS, phexByteStr, pindexBS, plengthBS, psliceBS)
import Plutarch.Either (PEither (PLeft, PRight))
Expand Down Expand Up @@ -250,6 +250,19 @@ plutarchTests =
let v2 = [("IOHK", [1, 2, 3]), ("Plutus", [9, 8, 7])]
plift' (pconstant @(PBuiltinList (PBuiltinPair PString (PBuiltinList PInteger))) v2) @?= Right v2
]
, testGroup
"Boolean operations"
[ testCase "True && False ≡ False" $ equal (pcon PTrue #&& pcon PFalse) (pcon PFalse)
, testCase "False && True ≡ False" $ equal (pcon PFalse #&& pcon PTrue) (pcon PFalse)
, testCase "False && perror ≡ False" $ equal (pcon PFalse #&& perror) (pcon PFalse)
, testCase "fails: pand False perror" $ fails $ pand # pcon PFalse # perror
, testCase "pand False (pdelay perror) ≡ False" $ equal (pand # pcon PFalse # pdelay perror) (pdelay $ pcon PFalse)
, testCase "True || False ≡ True" $ equal (pcon PTrue #|| pcon PFalse) (pcon PTrue)
, testCase "False || True ≡ True" $ equal (pcon PFalse #|| pcon PTrue) (pcon PTrue)
, testCase "True || perror ≡ True" $ equal (pcon PTrue #|| perror) (pcon PTrue)
, testCase "fails: por True perror" $ fails $ por # pcon PFalse # perror
, testCase "por True (pdelay perror) ≡ True" $ equal (por # pcon PTrue # pdelay perror) (pdelay $ pcon PTrue)
]
]

-- | Tests for the behaviour of UPLC itself.
Expand Down