From 65b2d8f50aee4a5e13b5d617deefd0af2981d7b8 Mon Sep 17 00:00:00 2001 From: Yura Lazaryev Date: Tue, 2 Apr 2024 14:22:28 +0200 Subject: [PATCH] Compile (&&), (||) as if .. then .. else --- .../src/PlutusTx/Compiler/Expr.hs | 12 ++ .../Budget/9.6/andWithLocal.budget.golden | 4 +- .../test/Budget/9.6/andWithLocal.pir.golden | 8 +- .../test/Budget/9.6/andWithLocal.uplc.golden | 17 +- .../9.6/andWithoutGHCOpts.budget.golden | 4 +- .../Budget/9.6/andWithoutGHCOpts.pir.golden | 8 +- .../Budget/9.6/andWithoutGHCOpts.uplc.golden | 15 +- .../Coverage/9.6/coverageCode.pir.golden | 186 +++++++++--------- .../Typeclasses/9.6/multiFunction.pir.golden | 59 +++--- 9 files changed, 162 insertions(+), 151 deletions(-) diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs index 70329ce2ac9..abb0a3e8243 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs @@ -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. diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.budget.golden b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.budget.golden index af89e05680d..057dce64a64 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1822026 -| mem: 5504}) \ No newline at end of file +({cpu: 1003063 +| mem: 3202}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.pir.golden b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.pir.golden index 8ac34d3a877..805dfd6aed2 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.pir.golden @@ -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 diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden index d01e7c206d6..6698c4406e8 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden @@ -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) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.budget.golden b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.budget.golden index af89e05680d..e2a4b08fcd4 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.budget.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.budget.golden @@ -1,2 +1,2 @@ -({cpu: 1822026 -| mem: 5504}) \ No newline at end of file +({cpu: 796063 +| mem: 2302}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.pir.golden b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.pir.golden index af70d9872d8..640e976e461 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.pir.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.pir.golden @@ -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 diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden index a346dd5b119..d35e63fd029 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden @@ -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) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden b/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden index 5062a03adda..66656738831 100644 --- a/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden @@ -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 @@ -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) diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden index a2f29844d04..480c779c5c1 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden @@ -4,39 +4,18 @@ (nonrec) (datatypebind (datatype - (tyvardecl Bool (type)) + (tyvardecl Animal (type)) - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (nonstrict) - (vardecl `&&` (fun Bool (fun Bool Bool))) - (lam - l - Bool - (lam - r - Bool - { - [ - [ - { [ Bool_match l ] (all dead (type) Bool) } (abs dead (type) r) - ] - (abs dead (type) False) - ] - (all dead (type) dead) - } - ) + Animal_match + (vardecl Cat Animal) (vardecl Dog Animal) ) ) (datatypebind (datatype - (tyvardecl Animal (type)) + (tyvardecl Bool (type)) - Animal_match - (vardecl Cat Animal) (vardecl Dog Animal) + Bool_match + (vardecl True Bool) (vardecl False Bool) ) ) (datatypebind @@ -139,13 +118,29 @@ (let (nonrec) (termbind (strict) (vardecl p p) p) - [ - [ `&&` [ [ [ { likesAnimal p } `$dPersonLike` ] p ] Cat ] ] + { [ - [ lessThanInteger [ [ { age p } `$dPersonLike` ] p ] ] - (con integer 30) + [ + { + [ + Bool_match + [ [ [ { likesAnimal p } `$dPersonLike` ] p ] Cat ] + ] + (all dead (type) Bool) + } + (abs + dead + (type) + [ + [ lessThanInteger [ [ { age p } `$dPersonLike` ] p ] ] + (con integer 30) + ] + ) + ] + (abs dead (type) False) ] - ] + (all dead (type) dead) + } ) ) )