diff --git a/plutus-core/plutus-ir/src/PlutusIR/Transform/EvaluateBuiltins.hs b/plutus-core/plutus-ir/src/PlutusIR/Transform/EvaluateBuiltins.hs index 01a0c4021ce..cd6df1b4109 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Transform/EvaluateBuiltins.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Transform/EvaluateBuiltins.hs @@ -28,10 +28,10 @@ evaluateBuiltinsPass :: (PLC.Typecheckable uni fun, PLC.GEq uni, Applicative m) -> BuiltinsInfo uni fun -> CostingPart uni fun -> Pass m TyName Name uni fun a -evaluateBuiltinsPass tcconfig conservative binfo costModel = +evaluateBuiltinsPass tcconfig preserveLogging binfo costModel = NamedPass "evaluate builtins" $ Pass - (pure . evaluateBuiltins conservative binfo costModel) + (pure . evaluateBuiltins preserveLogging binfo costModel) [Typechecks tcconfig] [ConstCondition (Typechecks tcconfig)] @@ -46,7 +46,7 @@ evaluateBuiltins -> CostingPart uni fun -> Term tyname name uni fun a -> Term tyname name uni fun a -evaluateBuiltins conservative binfo costModel = transformOf termSubterms processTerm +evaluateBuiltins preserveLogging binfo costModel = transformOf termSubterms processTerm where -- Nothing means "leave the original term as it was" eval @@ -55,18 +55,18 @@ evaluateBuiltins conservative binfo costModel = transformOf termSubterms process -> Maybe (Term tyname name uni fun ()) eval (BuiltinCostedResult _ getX) AppContextEnd = case getX of - BuiltinSuccess v -> Just v + BuiltinSuccess term -> Just term -- Evaluates successfully, but does logging. If we're being conservative -- then we should leave these in, so we don't remove people's logging! -- Otherwise `trace "hello" x` is a prime candidate for evaluation! - BuiltinSuccessWithLogs _ v -> if conservative then Nothing else Just v + BuiltinSuccessWithLogs _ term -> if preserveLogging then Nothing else Just term -- Evaluation failure. This can mean that the evaluation legitimately -- failed (e.g. `divideInteger 1 0`), or that it failed because the -- argument terms are not currently in the right form (because they're -- not evaluated, we're in the middle of a term here!). Since we can't -- distinguish these, we have to assume it's the latter case and just leave -- things alone. - BuiltinFailure{} -> Nothing + BuiltinFailure{} -> Nothing eval (BuiltinExpectArgument toRuntime) (TermAppContext arg _ ctx) = -- Builtin evaluation does not work with annotations, so we have to throw -- the argument annotation away here diff --git a/plutus-tx-plugin/plutus-tx-plugin.cabal b/plutus-tx-plugin/plutus-tx-plugin.cabal index 61975f056fb..4294eab9476 100644 --- a/plutus-tx-plugin/plutus-tx-plugin.cabal +++ b/plutus-tx-plugin/plutus-tx-plugin.cabal @@ -155,6 +155,7 @@ test-suite plutus-tx-plugin-tests Plugin.NoTrace.Lib Plugin.NoTrace.Spec Plugin.NoTrace.WithoutTraces + Plugin.NoTrace.WithPreservedLogging Plugin.NoTrace.WithTraces Plugin.Optimization.Spec Plugin.Patterns.Spec diff --git a/plutus-tx-plugin/test/Plugin/NoTrace/Spec.hs b/plutus-tx-plugin/test/Plugin/NoTrace/Spec.hs index 7d3862ff9af..a062b1a5980 100644 --- a/plutus-tx-plugin/test/Plugin/NoTrace/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/NoTrace/Spec.hs @@ -11,15 +11,16 @@ import Prelude import Plugin.NoTrace.Lib (countTraces) import Plugin.NoTrace.Lib qualified as Lib import Plugin.NoTrace.WithoutTraces qualified as WithoutTraces +import Plugin.NoTrace.WithPreservedLogging qualified as WithPreservedLogging import Plugin.NoTrace.WithTraces qualified as WithTraces import Test.Tasty (testGroup) import Test.Tasty.Extras (TestNested, embed) import Test.Tasty.HUnit (assertBool, testCase, (@=?)) noTrace :: TestNested -noTrace = embed $ do +noTrace = embed do testGroup "remove-trace" - [ testGroup "Trace calls are preserved" + [ testGroup "Trace calls are preserved (no-remove-trace)" [ testCase "trace-argument" $ 1 @=? countTraces WithTraces.traceArgument , testCase "trace-show" $ @@ -37,8 +38,26 @@ noTrace = embed $ do , testCase "trace-impure with effect" $ -- See Note [Impure trace messages] assertBool "Effect is missing" (Lib.evaluatesToError WithTraces.traceImpure) ] + , testGroup "Trace calls are preserved (preserve-logging)" + [ testCase "trace-argument" $ + 1 @=? countTraces WithPreservedLogging.traceArgument + , testCase "trace-show" $ + 1 @=? countTraces WithPreservedLogging.traceShow + , testCase "trace-complex" $ + 2 @=? countTraces WithPreservedLogging.traceComplex + , testCase "trace-direct" $ + 1 @=? countTraces WithPreservedLogging.traceDirect + , testCase "trace-non-constant" $ + 1 @=? countTraces WithPreservedLogging.traceNonConstant + , testCase "trace-repeatedly" $ + 3 @=? countTraces WithPreservedLogging.traceRepeatedly + , testCase "trace-impure" $ + 1 @=? countTraces WithPreservedLogging.traceImpure + , testCase "trace-impure with effect" $ -- See Note [Impure trace messages] + assertBool "Effect is missing" (Lib.evaluatesToError WithPreservedLogging.traceImpure) + ] , testGroup - "Trace calls are removed" + "Trace calls are removed (remove-trace)" [ testCase "trace-argument" $ 0 @=? countTraces WithoutTraces.traceArgument , testCase "trace-show" $ diff --git a/plutus-tx-plugin/test/Plugin/NoTrace/WithPreservedLogging.hs b/plutus-tx-plugin/test/Plugin/NoTrace/WithPreservedLogging.hs new file mode 100644 index 00000000000..4f586c2120d --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/NoTrace/WithPreservedLogging.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:no-conservative-optimisation #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:preserve-logging #-} + +module Plugin.NoTrace.WithPreservedLogging where + +import Data.Proxy (Proxy (..)) +import Plugin.NoTrace.Lib qualified as Lib +import PlutusTx.Bool (Bool) +import PlutusTx.Builtins (BuiltinString, Integer) +import PlutusTx.Code (CompiledCode) +import PlutusTx.Plugin (plc) + +traceArgument :: CompiledCode (BuiltinString -> ()) +traceArgument = plc (Proxy @"traceArgument") Lib.traceArgument + +traceShow :: CompiledCode () +traceShow = plc (Proxy @"traceShow") Lib.traceShow + +traceDirect :: CompiledCode () +traceDirect = plc (Proxy @"traceDirect") Lib.traceDirect + +traceNonConstant :: CompiledCode (BuiltinString -> BuiltinString) +traceNonConstant = plc (Proxy @"traceNonConstant") Lib.traceNonConstant + +traceComplex :: CompiledCode (Bool -> ()) +traceComplex = plc (Proxy @"traceComplex") Lib.traceComplex + +traceRepeatedly :: CompiledCode Integer +traceRepeatedly = plc (Proxy @"traceRepeatedly") Lib.traceRepeatedly + +traceImpure :: CompiledCode () +traceImpure = plc (Proxy @"traceImpure") Lib.traceImpure