-
Notifications
You must be signed in to change notification settings - Fork 63
/
Bool.hs
96 lines (76 loc) · 2.67 KB
/
Bool.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Plutarch.Bool (
PBool (..),
PEq (..),
POrd (..),
pif,
pif',
pnot,
(#&&),
(#||),
por,
pand,
pand',
por',
) where
import Plutarch (PlutusType (PInner, pcon', pmatch'), punsafeBuiltin)
import Plutarch.Lift (
DerivePConstantViaCoercible (DerivePConstantViaCoercible),
PConstant,
PLifted,
PUnsafeLiftDecl,
pconstant,
)
import Plutarch.Prelude
import qualified PlutusCore as PLC
-- | Plutus 'BuiltinBool'
data PBool (s :: S) = PTrue | PFalse
instance PUnsafeLiftDecl PBool where type PLifted PBool = Bool
deriving via (DerivePConstantViaCoercible Bool PBool Bool) instance (PConstant Bool)
instance PlutusType PBool where
type PInner PBool _ = PBool
pcon' PTrue = pconstant True
pcon' PFalse = pconstant False
pmatch' b f = pforce $ pif' # b # pdelay (f PTrue) # pdelay (f PFalse)
class PEq t where
(#==) :: Term s t -> Term s t -> Term s PBool
infix 4 #==
class POrd t where
(#<=) :: Term s t -> Term s t -> Term s PBool
(#<) :: Term s t -> Term s t -> Term s PBool
infix 4 #<=
infix 4 #<
{- | Strict version of 'pif'.
Emits slightly less code.
-}
pif' :: Term s (PBool :--> a :--> a :--> a)
pif' = phoistAcyclic $ pforce $ punsafeBuiltin PLC.IfThenElse
-- | Lazy if-then-else.
pif :: Term s PBool -> Term s a -> Term s a -> Term s a
pif b case_true case_false = pmatch b $ \case
PTrue -> case_true
PFalse -> case_false
-- | Boolean negation for 'PBool' terms.
pnot :: Term s (PBool :--> PBool)
pnot = phoistAcyclic $ plam $ \x -> pif x (pcon PFalse) $ pcon PTrue
-- | Lazily evaluated boolean and for 'PBool' terms.
infixr 3 #&&
(#&&) :: Term s PBool -> Term s PBool -> Term s PBool
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 = pforce $ por # x # pdelay y
-- | Hoisted, Plutarch level, lazily evaluated boolean and function.
pand :: Term s (PBool :--> PDelayed PBool :--> PDelayed PBool)
pand = phoistAcyclic $ plam $ \x y -> pif' # x # y # (phoistAcyclic $ pdelay $ pcon PFalse)
-- | Hoisted, Plutarch level, strictly evaluated boolean and function.
pand' :: Term s (PBool :--> PBool :--> PBool)
pand' = phoistAcyclic $ plam $ \x y -> pif' # x # y # (pcon PFalse)
-- | Hoisted, Plutarch level, lazily evaluated boolean or function.
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) # y