Skip to content

Commit

Permalink
Compile (&&), (||) as if .. then .. else
Browse files Browse the repository at this point in the history
  • Loading branch information
@Unisay
Unisay committed Apr 2, 2024
1 parent 700a306 commit 65b2d8f
Show file tree
Hide file tree
Showing 9 changed files with 162 additions and 151 deletions.
12 changes: 12 additions & 0 deletions plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -685,6 +685,18 @@ compileExpr e = traceCompilation 2 ("Compiling expr:" GHC.<+> GHC.ppr e) $ do
_ -> throwPlain $ CompilationError "No info for ByteString builtin"

case e of
{- Note [Lazy boolean operators]
(||) and (&&) have a special treatment: we want them lazy in the second argument,
as this is the behavior in Haskell and other PLs.
Covered by this spec: plutus-tx-plugin/test/ShortCircuit/Spec.hs
-}
-- Lazy ||
GHC.App (GHC.App (GHC.Var fid) a) b | GHC.getOccString fid == "||" -> do
compileExpr $ GHC.mkIfThenElse a (GHC.Var GHC.trueDataConId) b
-- Lazy &&
GHC.App (GHC.App (GHC.Var fid) a) b | GHC.getOccString fid == "&&" -> do
compileExpr $ GHC.mkIfThenElse a b (GHC.Var GHC.falseDataConId)

-- See Note [String literals]
-- IsString has only one method, so it's enough to know that it's an IsString method
-- to know we're looking at fromString.
Expand Down
4 changes: 2 additions & 2 deletions plutus-tx-plugin/test/Budget/9.6/andWithLocal.budget.golden
View file
Original file line number Diff line number Diff line change
@@ -1,2 +1,2 @@
({cpu: 1822026
| mem: 5504})
({cpu: 1003063
| mem: 3202})
8 changes: 2 additions & 6 deletions plutus-tx-plugin/test/Budget/9.6/andWithLocal.pir.golden
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,14 +7,10 @@
ifThenElse {Bool} (lessThanInteger x y) True False
in
\(x : integer) (y : integer) ->
let
!l : Bool = lessThanInteger x 3
!r : Bool = lessThanInteger y 3
in
Bool_match
l
(lessThanInteger x 3)
{all dead. Bool}
(/\dead -> r)
(/\dead -> lessThanInteger y 3)
(/\dead -> False)
{all dead. dead})
4
Expand Down
17 changes: 10 additions & 7 deletions plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden
View file
Original file line number Diff line number Diff line change
@@ -1,12 +1,15 @@
program
1.1.0
((\x y ->
(\lessThanInteger ->
(\l ->
(\r -> force (case l [(delay r), (delay (constr 1 []))]))
(lessThanInteger y 3))
(lessThanInteger x 3))
(\x y ->
force ifThenElse (lessThanInteger x y) (constr 0 []) (constr 1 [])))
force
((\lessThanInteger ->
case
(lessThanInteger x 3)
[(delay (lessThanInteger y 3)), (delay (constr 1 []))])
(\x y ->
force ifThenElse
(lessThanInteger x y)
(constr 0 [])
(constr 1 []))))
4
4)
4 changes: 2 additions & 2 deletions plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.budget.golden
View file
Original file line number Diff line number Diff line change
@@ -1,2 +1,2 @@
({cpu: 1822026
| mem: 5504})
({cpu: 796063
| mem: 2302})
8 changes: 2 additions & 6 deletions plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.pir.golden
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,14 +75,10 @@
v)
in
\(x : integer) (y : integer) ->
let
!l : Bool = `<` {integer} `$fOrdInteger` x 3
!r : Bool = `<` {integer} `$fOrdInteger` y 3
in
Bool_match
l
(`<` {integer} `$fOrdInteger` x 3)
{all dead. Bool}
(/\dead -> r)
(/\dead -> `<` {integer} `$fOrdInteger` y 3)
(/\dead -> False)
{all dead. dead})
4
Expand Down
15 changes: 9 additions & 6 deletions plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden
View file
Original file line number Diff line number Diff line change
@@ -1,11 +1,14 @@
program
1.1.0
((\x y ->
(\cse ->
(\l ->
(\r -> force (case l [(delay r), (delay (constr 1 []))])) (cse y 3))
(cse x 3))
(\x y ->
force ifThenElse (lessThanInteger x y) (constr 0 []) (constr 1 [])))
force
(case
(force ifThenElse (lessThanInteger x 3) (constr 0 []) (constr 1 []))
[ (delay
(force ifThenElse
(lessThanInteger y 3)
(constr 0 [])
(constr 1 [])))
, (delay (constr 1 [])) ]))
4
4)
186 changes: 96 additions & 90 deletions plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden
View file
Original file line number Diff line number Diff line change
Expand Up @@ -102,27 +102,6 @@
)
equalsInteger
)
(termbind
(nonstrict)
(vardecl `&&` (fun Bool (fun Bool Bool)))
(lam
ds
Bool
(lam
x
Bool
{
[
[
{ [ Bool_match ds ] (all dead (type) Bool) } (abs dead (type) x)
]
(abs dead (type) False)
]
(all dead (type) dead)
}
)
)
)
(termbind
(nonstrict)
(vardecl
Expand Down Expand Up @@ -235,96 +214,123 @@
(abs
dead
(type)
[
{
[
`&&`
[
[
[
traceBool
(con
string
"CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 24}) True"
)
]
(con
string
"CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 24}) False"
)
]
{
[
Bool_match
[
{ (builtin trace) (all dead (type) Bool) }
(con
string
"CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 24})"
)
]
(abs
dead
(type)
[
[
traceBool
(con
string
"CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 24}) True"
)
]
(con
string
"CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 24}) False"
)
]
{
[
[
{ `==` (con integer) } `$fEqInteger`
{
(builtin trace)
(all dead (type) Bool)
}
(con
string
"CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 24})"
)
]
{
(abs
dead
(type)
[
[
[
{ `==` (con integer) }
`$fEqInteger`
]
{
(builtin trace)
(all
dead (type) (con integer)
)
[
[
{
(builtin trace)
(all
dead
(type)
(con integer)
)
}
(con
string
"CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 15, _covLocEndCol = 16})"
)
]
(abs dead (type) x)
]
(all dead (type) dead)
}
(con
string
"CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 15, _covLocEndCol = 16})"
)
]
(abs dead (type) x)
]
(all dead (type) dead)
}
]
{
[
[
{
(builtin trace)
(all dead (type) (con integer))
[
[
{
(builtin trace)
(all
dead
(type)
(con integer)
)
}
(con
string
"CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 22, _covLocEndCol = 23})"
)
]
(abs
dead (type) (con integer 5)
)
]
(all dead (type) dead)
}
(con
string
"CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 22, _covLocEndCol = 23})"
)
]
(abs dead (type) (con integer 5))
]
(all dead (type) dead)
}
]
)
)
]
(all dead (type) dead)
}
]
]
(all dead (type) dead)
(all dead (type) Bool)
}
(abs
dead
(type)
{
[
[
{
(builtin trace) (all dead (type) Bool)
}
(con
string
"CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 28, _covLocEndCol = 32})"
)
]
(abs dead (type) True)
]
(all dead (type) dead)
}
)
]
(abs dead (type) False)
]
{
[
[
{ (builtin trace) (all dead (type) Bool) }
(con
string
"CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 28, _covLocEndCol = 32})"
)
]
(abs dead (type) True)
]
(all dead (type) dead)
}
]
(all dead (type) dead)
}
)
]
(all dead (type) dead)
Expand Down
Loading

0 comments on commit 65b2d8f

Please sign in to comment.