Specific PlutuxTx fix for lazy || and &&

Todo: Add tests, generalize if possible.
IntersectMBO · Oct 16, 2021 · 18d6109 · 18d6109
1 parent 75ccaf4
commit 18d6109
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 0 deletions.
diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs
@@ -494,6 +494,15 @@ compileExpr e = withContextM 2 (sdToTxt $ "Compiling expr:" GHC.<+> GHC.ppr e) $
 
     let top = NE.head stack
     case e of
+        -- Lazy ||
+        -- See Note [Case expressions and laziness]
+        GHC.App (GHC.App (GHC.Var fid) a) b | GHC.getOccString fid == "||" ->
+            compileExpr $ GHC.mkIfThenElse a (GHC.Var GHC.trueDataConId) b
+        -- Lazy &&
+        -- See Note [Case expressions and laziness]
+        GHC.App (GHC.App (GHC.Var fid) a) b | GHC.getOccString fid == "&&" ->
+            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
         -- We can safely commit to this match as soon as we've seen fromString - we won't accept any applications of fromString that aren't creating literals

diff --git a/plutus-tx-plugin/src/PlutusTx/Plugin.hs b/plutus-tx-plugin/src/PlutusTx/Plugin.hs
@@ -269,6 +269,14 @@ compileMarkedExprs expr = do
             inner
           | markerName == GHC.idName fid -> compileMarkedExprOrDefer (show fs_locStr) codeTy inner
       e@(GHC.Var fid) | markerName == GHC.idName fid -> throwError . NoContext . InvalidMarkerError . GHC.showSDocUnsafe $ GHC.ppr e
+      -- Lazy ||
+      -- See Note [Case expressions and laziness]
+      GHC.App (GHC.App (GHC.Var fid) a) b | GHC.getOccString fid == "||" ->
+            compileMarkedExprs $ GHC.mkIfThenElse a (GHC.Var GHC.trueDataConId) b
+      -- Lazy &&
+      -- See Note [Case expressions and laziness]
+      GHC.App (GHC.App (GHC.Var fid) a) b | GHC.getOccString fid == "&&" ->
+            compileMarkedExprs $ GHC.mkIfThenElse a b (GHC.Var GHC.falseDataConId)
       GHC.App e a -> GHC.App <$> compileMarkedExprs e <*> compileMarkedExprs a
       GHC.Lam b e -> GHC.Lam b <$> compileMarkedExprs e
       GHC.Let bnd e -> GHC.Let <$> compileBind bnd <*> compileMarkedExprs e