Skip to content

Commit

Permalink
[Test] Dump UPLC for 'strictLetRec'
Browse files Browse the repository at this point in the history
  • Loading branch information
@effectfully
effectfully committed May 7, 2024
1 parent 16be7da commit f8967ac
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 165 deletions.
31 changes: 20 additions & 11 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 (runTestNestedIn, testNested)
import Test.Tasty.HUnit (testCase, (@?=))
import UntypedPlutusCore.Evaluation.Machine.Cek (EvaluationResult (..))

path :: [FilePath]
path = ["plutus-ir", "test", "PlutusIR", "Transform"]
Expand All @@ -32,14 +38,17 @@ test_letRec = runTestNestedIn path do
testNested
"StrictLetRec"
[ let
runCompilationM m = either (fail . show) pure do
ctx <- defaultCompilationCtx
runExcept . runQuoteT $ runReaderT m ctx
op pirTermBefore = do
pirTermAfter <- either (fail . show) pure do
ctx <- defaultCompilationCtx
let action = fmap void . runTestPass (`compileLetsPassSC` RecTerms) $
noProvenance <$ pirTermBefore
runExcept . runQuoteT $ runReaderT action ctx
tplcProg <- compilePirProgramOrFail $ PIR.Program () latestVersion pirTermAfter
uplcProg <- compileTplcProgramOrFail tplcProg
pure . AsReadable $ UPLC._progTerm uplcProg
in
goldenPirM
(runCompilationM . runTestPass (`compileLetsPassSC` RecTerms))
(const noProvenance <<$>> pTerm)
"strictLetRec"
goldenPirM op pTerm "strictLetRec"
, pure $ 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)))

0 comments on commit f8967ac

Please sign in to comment.