Skip to content

Commit

Permalink
[Test] Dump UPLC for 'strictLetRec' (#5963)
Browse files Browse the repository at this point in the history
  • Loading branch information
@effectfully
effectfully authored May 30, 2024
1 parent 20e418e commit cd20770
Show file tree
Hide file tree
Showing 2 changed files with 18 additions and 163 deletions.
26 changes: 17 additions & 9 deletions plutus-core/plutus-ir/test/PlutusIR/Transform/StrictLetRec/Tests.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,24 +5,30 @@ module PlutusIR.Transform.StrictLetRec.Tests where

import PlutusPrelude

import Control.Monad.Except (runExcept)
import Control.Monad.Reader (runReaderT)
import PlutusCore.Default (someValue)
import PlutusCore.MkPlc (constant)
import PlutusCore.Pretty (AsReadable (..))
import PlutusCore.Quote (runQuoteT)
import PlutusCore.Version (latestVersion)
import PlutusIR.Compiler.Let (LetKind (RecTerms), compileLetsPassSC)
import PlutusIR.Compiler.Provenance (noProvenance)
import PlutusIR.Core qualified as PIR
import PlutusIR.Parser (pTerm)
import PlutusIR.Pass.Test (runTestPass)
import PlutusIR.Test (goldenPirM)
import PlutusIR.Transform.StrictLetRec.Tests.Lib (defaultCompilationCtx,
import PlutusIR.Transform.StrictLetRec.Tests.Lib (compilePirProgramOrFail, compileTplcProgramOrFail,
defaultCompilationCtx,
evalPirProgramWithTracesOrFail, pirTermAsProgram,
pirTermFromFile)
import UntypedPlutusCore qualified as UPLC
import UntypedPlutusCore.Evaluation.Machine.Cek (EvaluationResult (..))

import Control.Monad.Except (runExcept)
import Control.Monad.Reader (runReaderT)
import System.FilePath.Posix (joinPath, (</>))
import Test.Tasty (TestTree)
import Test.Tasty.Extras (embed, runTestNested, testNested)
import Test.Tasty.HUnit (testCase, (@?=))
import UntypedPlutusCore.Evaluation.Machine.Cek (EvaluationResult (..))

path :: [FilePath]
path = ["plutus-ir", "test", "PlutusIR", "Transform"]
Expand All @@ -33,11 +39,13 @@ test_letRec = runTestNested path . pure $ testNested "StrictLetRec"
runCompilationM m = either (fail . show) pure do
ctx <- defaultCompilationCtx
runExcept . runQuoteT $ runReaderT m ctx
in
goldenPirM
(runCompilationM . runTestPass (`compileLetsPassSC` RecTerms))
(const noProvenance <<$>> pTerm)
"strictLetRec"
dumpUplc pirTermBefore = do
pirTermAfter <- runCompilationM $
fmap void . runTestPass (`compileLetsPassSC` RecTerms) $ noProvenance <$ pirTermBefore
tplcProg <- compilePirProgramOrFail $ PIR.Program () latestVersion pirTermAfter
uplcProg <- compileTplcProgramOrFail tplcProg
pure . AsReadable $ UPLC._progTerm uplcProg
in goldenPirM dumpUplc pTerm "strictLetRec"
, embed $ testCase "traces" do
(result, traces) <- do
pirTerm <- pirTermFromFile (joinPath path </> "StrictLetRec" </> "strictLetRec")
Expand Down
155 changes: 1 addition & 154 deletions plutus-core/plutus-ir/test/PlutusIR/Transform/StrictLetRec/strictLetRec.golden
View file
Original file line number Diff line number Diff line change
@@ -1,154 +1 @@
(let
(nonrec)
(termbind
(strict)
(vardecl
fix1
(all a (type) (all b (type) (fun (fun (fun a b) (fun a b)) (fun a b))))
)
(abs
a
(type)
(abs
b
(type)
(lam
f
(fun (fun a b) (fun a b))
[
{
(abs
a
(type)
(lam
s
[
(lam
a
(type)
(ifix
(lam
self
(fun (type) (type))
(lam a (type) (fun [ self a ] a))
)
a
)
)
a
]
[ (unwrap s) s ]
)
)
(fun a b)
}
(iwrap
(lam self (fun (type) (type)) (lam a (type) (fun [ self a ] a)))
(fun a b)
(lam
s
[
(lam
a
(type)
(ifix
(lam
self
(fun (type) (type))
(lam a (type) (fun [ self a ] a))
)
a
)
)
(fun a b)
]
[
f
(lam
x
a
[
[
{
(abs
a
(type)
(lam
s
[
(lam
a
(type)
(ifix
(lam
self
(fun (type) (type))
(lam a (type) (fun [ self a ] a))
)
a
)
)
a
]
[ (unwrap s) s ]
)
)
(fun a b)
}
s
]
x
]
)
]
)
)
]
)
)
)
)
[
(lam
tup
(all r (type) (fun (fun (fun (con integer) (con integer)) r) r))
(let
(nonrec)
(termbind
(strict)
(vardecl xxx (fun (con integer) (con integer)))
[
{ tup (fun (con integer) (con integer)) }
(lam arg_0 (fun (con integer) (con integer)) arg_0)
]
)
(con integer 1)
)
)
(abs
r
(type)
(lam
f
(fun (fun (con integer) (con integer)) r)
[
f
[
{ { fix1 (con integer) } (con integer) }
(lam
xxx
(fun (con integer) (con integer))
[
[
{ (builtin trace) (fun (con integer) (con integer)) }
(con string "hello")
]
(lam z (con integer) [ xxx z ])
]
)
]
]
)
)
]
)
(\xxx -> 1) ((\s -> s s) (\s -> force trace "hello" (\z -> s s z)))

1 comment on commit cd20770

@github-actions
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

⚠️ Performance Alert ⚠️

Possible performance regression was detected for benchmark 'Plutus Benchmarks'.
Benchmark result of this commit is worse than the previous benchmark result exceeding threshold 1.05.

Benchmark suite Current: cd20770 Previous: 20e418e Ratio
validation-decode-escrow-redeem_1-1 322 μs 305.5 μs 1.05
validation-decode-future-pay-out-3 331.3 μs 308.1 μs 1.08
validation-decode-prism-3 245.9 μs 224.8 μs 1.09
validation-decode-pubkey-1 168.4 μs 157.5 μs 1.07

This comment was automatically generated by workflow using github-action-benchmark.

CC: @input-output-hk/plutus-core

Please sign in to comment.