{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Scoping.Spec where
import UntypedPlutusCore
import UntypedPlutusCore.Generators.Hedgehog.AST (genProgram, genTerm, mangleNames, runAstGen)
import UntypedPlutusCore.Mark
import UntypedPlutusCore.Rename.Internal
import UntypedPlutusCore.Transform.CaseOfCase (caseOfCase)
import UntypedPlutusCore.Transform.CaseReduce (caseReduce)
import UntypedPlutusCore.Transform.Cse (cse)
import UntypedPlutusCore.Transform.FloatDelay (floatDelay)
import UntypedPlutusCore.Transform.ForceDelay (forceDelay)
import UntypedPlutusCore.Transform.Inline (inline)
import PlutusCore.Generators.Hedgehog.Utils
import PlutusCore.Quote
import PlutusCore.Rename
import PlutusCore.Test qualified as T
import Hedgehog
import Test.Tasty
import Test.Tasty.Hedgehog
import Test.Tasty.HUnit
test_mangle :: TestTree
test_mangle :: TestTree
test_mangle =
TestName -> PropertyName -> Property -> TestTree
testPropertyNamed TestName
"equality does not survive mangling" PropertyName
"equality_mangling" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
DiscardLimit -> Property -> Property
withDiscards DiscardLimit
1000000 (Property -> Property)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestLimit -> (TestLimit -> TestLimit) -> Property -> Property
T.mapTestLimitAtLeast TestLimit
300 (TestLimit -> TestLimit -> TestLimit
forall a. Integral a => a -> a -> a
`div` TestLimit
3) (Property -> Property)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
(Term Name DefaultUni DefaultFun ()
term, Term Name DefaultUni DefaultFun ()
termMangled) <- Gen
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ())
-> PropertyT
IO
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ())
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ())
-> PropertyT
IO
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ()))
-> (AstGen
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ())
-> Gen
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ()))
-> AstGen
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ())
-> PropertyT
IO
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstGen
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ())
-> Gen
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ())
forall (m :: * -> *) a. MonadGen m => AstGen a -> m a
runAstGen (AstGen
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ())
-> PropertyT
IO
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ()))
-> AstGen
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ())
-> PropertyT
IO
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ do
Term Name DefaultUni DefaultFun ()
term <- AstGen (Term Name DefaultUni DefaultFun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term Name DefaultUni fun ())
genTerm
(,) Term Name DefaultUni DefaultFun ()
term (Term Name DefaultUni DefaultFun ()
-> (Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ()))
-> AstGen (Term Name DefaultUni DefaultFun ())
-> AstGen
(Term Name DefaultUni DefaultFun (),
Term Name DefaultUni DefaultFun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term Name DefaultUni DefaultFun ()
-> AstGen (Term Name DefaultUni DefaultFun ())
mangleNames Term Name DefaultUni DefaultFun ()
term
Term Name DefaultUni DefaultFun ()
term Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun () -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
/== Term Name DefaultUni DefaultFun ()
termMangled
Term Name DefaultUni DefaultFun ()
termMangled Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun () -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
/== Term Name DefaultUni DefaultFun ()
term
prop_equalityFor
:: program ~ Program Name DefaultUni DefaultFun ()
=> (program -> Quote program)
-> Property
prop_equalityFor :: forall program.
(program ~ Program Name DefaultUni DefaultFun ()) =>
(program -> Quote program) -> Property
prop_equalityFor program -> Quote program
ren = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
Program Name DefaultUni DefaultFun ()
prog <- Gen (Program Name DefaultUni DefaultFun ())
-> PropertyT IO (Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) a.
(Monad m, Pretty a) =>
Gen a -> PropertyT m a
forAllPretty (Gen (Program Name DefaultUni DefaultFun ())
-> PropertyT IO (Program Name DefaultUni DefaultFun ()))
-> Gen (Program Name DefaultUni DefaultFun ())
-> PropertyT IO (Program Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ AstGen (Program Name DefaultUni DefaultFun ())
-> Gen (Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) a. MonadGen m => AstGen a -> m a
runAstGen AstGen (Program Name DefaultUni DefaultFun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Program Name DefaultUni fun ())
genProgram
let progRen :: program
progRen = Quote program -> program
forall a. Quote a -> a
runQuote (Quote program -> program) -> Quote program -> program
forall a b. (a -> b) -> a -> b
$ program -> Quote program
ren program
Program Name DefaultUni DefaultFun ()
prog
program
progRen program -> program -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== program
Program Name DefaultUni DefaultFun ()
prog
Program Name DefaultUni DefaultFun ()
prog Program Name DefaultUni DefaultFun ()
-> Program Name DefaultUni DefaultFun () -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== program
Program Name DefaultUni DefaultFun ()
progRen
test_equalityRename :: TestTree
test_equalityRename :: TestTree
test_equalityRename =
TestName -> PropertyName -> Property -> TestTree
testPropertyNamed TestName
"equality survives renaming" PropertyName
"equality_renaming" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
(Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ()))
-> Property
forall program.
(program ~ Program Name DefaultUni DefaultFun ()) =>
(program -> Quote program) -> Property
prop_equalityFor Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ())
forall a (m :: * -> *). (Rename a, MonadQuote m) => a -> m a
forall (m :: * -> *).
MonadQuote m =>
Program Name DefaultUni DefaultFun ()
-> m (Program Name DefaultUni DefaultFun ())
rename
test_equalityBrokenRename :: TestTree
test_equalityBrokenRename :: TestTree
test_equalityBrokenRename =
TestName -> Assertion -> TestTree
testCase TestName
"equality does not survive wrong renaming" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Assertion
T.checkFails (Property -> Assertion)
-> ((Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ()))
-> Property)
-> (Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ()))
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ()))
-> Property
forall program.
(program ~ Program Name DefaultUni DefaultFun ()) =>
(program -> Quote program) -> Property
prop_equalityFor ((Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ()))
-> Assertion)
-> (Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ()))
-> Assertion
forall a b. (a -> b) -> a -> b
$
(Program Name DefaultUni DefaultFun () -> QuoteT Identity ())
-> (Program Name DefaultUni DefaultFun ()
-> BrokenRenameT
(Renaming TermUnique)
(QuoteT Identity)
(Program Name DefaultUni DefaultFun ()))
-> Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) ren t.
(MonadQuote m, Monoid ren) =>
(t -> m ()) -> (t -> BrokenRenameT ren m t) -> t -> m t
T.brokenRename Program Name DefaultUni DefaultFun () -> QuoteT Identity ()
forall name (m :: * -> *) (uni :: * -> *) fun ann.
(HasUnique name TermUnique, MonadQuote m) =>
Program name uni fun ann -> m ()
markNonFreshProgram Program Name DefaultUni DefaultFun ()
-> BrokenRenameT
(Renaming TermUnique)
(QuoteT Identity)
(Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Program name uni fun ann)) =>
Program name uni fun ann -> m (Program name uni fun ann)
renameProgramM
test_equalityNoMarkRename :: TestTree
test_equalityNoMarkRename :: TestTree
test_equalityNoMarkRename =
TestName -> Assertion -> TestTree
testCase TestName
"equality does not survive renaming without marking" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
Property -> Assertion
T.checkFails (Property -> Assertion)
-> ((Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ()))
-> Property)
-> (Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ()))
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ()))
-> Property
forall program.
(program ~ Program Name DefaultUni DefaultFun ()) =>
(program -> Quote program) -> Property
prop_equalityFor ((Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ()))
-> Assertion)
-> (Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ()))
-> Assertion
forall a b. (a -> b) -> a -> b
$
(Program Name DefaultUni DefaultFun ()
-> NoMarkRenameT
(Renaming TermUnique)
(QuoteT Identity)
(Program Name DefaultUni DefaultFun ()))
-> Program Name DefaultUni DefaultFun ()
-> Quote (Program Name DefaultUni DefaultFun ())
forall ren t (m :: * -> *).
Monoid ren =>
(t -> NoMarkRenameT ren m t) -> t -> m t
T.noMarkRename Program Name DefaultUni DefaultFun ()
-> NoMarkRenameT
(Renaming TermUnique)
(QuoteT Identity)
(Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Program name uni fun ann)) =>
Program name uni fun ann -> m (Program name uni fun ann)
renameProgramM
test_names :: TestTree
test_names :: TestTree
test_names = TestName -> [TestTree] -> TestTree
testGroup TestName
"names"
[ TestName
-> AstGen (Program Name DefaultUni DefaultFun ())
-> BindingRemoval
-> Prerename
-> (Program Name DefaultUni DefaultFun NameAnn
-> Quote (Program Name DefaultUni DefaultFun NameAnn))
-> TestTree
forall (t :: * -> *) ann.
(PrettyPlc (t NameAnn), Rename (t NameAnn), Scoping t) =>
TestName
-> AstGen (t ann)
-> BindingRemoval
-> Prerename
-> (t NameAnn -> Quote (t NameAnn))
-> TestTree
T.test_scopingGood TestName
"renaming" (forall fun.
(Bounded fun, Enum fun) =>
AstGen (Program Name DefaultUni fun ())
genProgram @DefaultFun) BindingRemoval
T.BindingRemovalNotOk Prerename
T.PrerenameNo
Program Name DefaultUni DefaultFun NameAnn
-> Quote (Program Name DefaultUni DefaultFun NameAnn)
forall a (m :: * -> *). (Rename a, MonadQuote m) => a -> m a
forall (m :: * -> *).
MonadQuote m =>
Program Name DefaultUni DefaultFun NameAnn
-> m (Program Name DefaultUni DefaultFun NameAnn)
rename
, AstGen (Program Name DefaultUni DefaultFun ())
-> (Program Name DefaultUni DefaultFun NameAnn
-> QuoteT Identity ())
-> (forall (m :: * -> *).
(MonadQuote m, MonadReader (Renaming TermUnique) m) =>
Program Name DefaultUni DefaultFun NameAnn
-> m (Program Name DefaultUni DefaultFun NameAnn))
-> TestTree
forall (t :: * -> *) ren ann.
(PrettyPlc (t NameAnn), Rename (t NameAnn), Scoping t,
Monoid ren) =>
AstGen (t ann)
-> (t NameAnn -> QuoteT Identity ())
-> (forall (m :: * -> *).
(MonadQuote m, MonadReader ren m) =>
t NameAnn -> m (t NameAnn))
-> TestTree
T.test_scopingSpoilRenamer (forall fun.
(Bounded fun, Enum fun) =>
AstGen (Program Name DefaultUni fun ())
genProgram @DefaultFun) Program Name DefaultUni DefaultFun NameAnn -> QuoteT Identity ()
forall name (m :: * -> *) (uni :: * -> *) fun ann.
(HasUnique name TermUnique, MonadQuote m) =>
Program name uni fun ann -> m ()
markNonFreshProgram
Program Name DefaultUni DefaultFun NameAnn
-> m (Program Name DefaultUni DefaultFun NameAnn)
forall (m :: * -> *).
(MonadQuote m, MonadReader (Renaming TermUnique) m) =>
Program Name DefaultUni DefaultFun NameAnn
-> m (Program Name DefaultUni DefaultFun NameAnn)
forall (m :: * -> *) name (uni :: * -> *) fun ann.
(MonadRename m, HasUniques (Program name uni fun ann)) =>
Program name uni fun ann -> m (Program name uni fun ann)
renameProgramM
, TestName
-> AstGen (Term Name DefaultUni DefaultFun ())
-> BindingRemoval
-> Prerename
-> (Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> TestTree
forall (t :: * -> *) ann.
(PrettyPlc (t NameAnn), Rename (t NameAnn), Scoping t) =>
TestName
-> AstGen (t ann)
-> BindingRemoval
-> Prerename
-> (t NameAnn -> Quote (t NameAnn))
-> TestTree
T.test_scopingGood TestName
"case-of-case" (forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term Name DefaultUni fun ())
genTerm @DefaultFun) BindingRemoval
T.BindingRemovalOk Prerename
T.PrerenameYes ((Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> TestTree)
-> (Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> TestTree
forall a b. (a -> b) -> a -> b
$
SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
-> Quote (Term Name DefaultUni DefaultFun NameAnn)
forall (m :: * -> *) name (uni :: * -> *) fun ann a.
Monad m =>
SimplifierT name uni fun ann m a -> m a
evalSimplifierT (SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> (Term Name DefaultUni DefaultFun NameAnn
-> SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn))
-> Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term Name DefaultUni DefaultFun NameAnn
-> SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
forall fun (m :: * -> *) (uni :: * -> *) name a.
(fun ~ DefaultFun, Monad m, CaseBuiltin uni, GEq uni, Closed uni,
Everywhere uni Eq) =>
Term name uni fun a
-> SimplifierT name uni fun a m (Term name uni fun a)
caseOfCase
,
TestName
-> AstGen (Term Name DefaultUni DefaultFun ())
-> BindingRemoval
-> Prerename
-> (Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> TestTree
forall (t :: * -> *) ann.
(PrettyPlc (t NameAnn), Rename (t NameAnn), Scoping t) =>
TestName
-> AstGen (t ann)
-> BindingRemoval
-> Prerename
-> (t NameAnn -> Quote (t NameAnn))
-> TestTree
T.test_scopingGood TestName
"case-of-known-constructor"
(forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term Name DefaultUni fun ())
genTerm @DefaultFun)
BindingRemoval
T.BindingRemovalOk
Prerename
T.PrerenameYes
(SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
-> Quote (Term Name DefaultUni DefaultFun NameAnn)
forall (m :: * -> *) name (uni :: * -> *) fun ann a.
Monad m =>
SimplifierT name uni fun ann m a -> m a
evalSimplifierT (SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> (Term Name DefaultUni DefaultFun NameAnn
-> SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn))
-> Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term Name DefaultUni DefaultFun NameAnn
-> SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
forall (m :: * -> *) (uni :: * -> *) name fun a.
(Monad m, CaseBuiltin uni) =>
Term name uni fun a
-> SimplifierT name uni fun a m (Term name uni fun a)
caseReduce)
,
TestName
-> AstGen (Term Name DefaultUni DefaultFun ())
-> BindingRemoval
-> Prerename
-> (Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> TestTree
forall (t :: * -> *) ann.
(PrettyPlc (t NameAnn), Rename (t NameAnn), Scoping t) =>
TestName
-> AstGen (t ann)
-> BindingRemoval
-> Prerename
-> (t NameAnn -> Quote (t NameAnn))
-> TestTree
T.test_scopingBad TestName
"cse"
(forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term Name DefaultUni fun ())
genTerm @DefaultFun)
BindingRemoval
T.BindingRemovalOk
Prerename
T.PrerenameYes
(SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
-> Quote (Term Name DefaultUni DefaultFun NameAnn)
forall (m :: * -> *) name (uni :: * -> *) fun ann a.
Monad m =>
SimplifierT name uni fun ann m a -> m a
evalSimplifierT (SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> (Term Name DefaultUni DefaultFun NameAnn
-> SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn))
-> Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinSemanticsVariant DefaultFun
-> Term Name DefaultUni DefaultFun NameAnn
-> SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
forall (m :: * -> *) (uni :: * -> *) fun ann.
(MonadQuote m, Hashable (Term Name uni fun ()),
Rename (Term Name uni fun ann), ToBuiltinMeaning uni fun) =>
BuiltinSemanticsVariant fun
-> Term Name uni fun ann
-> SimplifierT Name uni fun ann m (Term Name uni fun ann)
cse BuiltinSemanticsVariant DefaultFun
forall a. Bounded a => a
maxBound)
, TestName
-> AstGen (Term Name DefaultUni DefaultFun ())
-> BindingRemoval
-> Prerename
-> (Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> TestTree
forall (t :: * -> *) ann.
(PrettyPlc (t NameAnn), Rename (t NameAnn), Scoping t) =>
TestName
-> AstGen (t ann)
-> BindingRemoval
-> Prerename
-> (t NameAnn -> Quote (t NameAnn))
-> TestTree
T.test_scopingGood TestName
"float-delay"
(forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term Name DefaultUni fun ())
genTerm @DefaultFun)
BindingRemoval
T.BindingRemovalNotOk
Prerename
T.PrerenameNo
(SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
-> Quote (Term Name DefaultUni DefaultFun NameAnn)
forall (m :: * -> *) name (uni :: * -> *) fun ann a.
Monad m =>
SimplifierT name uni fun ann m a -> m a
evalSimplifierT (SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> (Term Name DefaultUni DefaultFun NameAnn
-> SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn))
-> Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term Name DefaultUni DefaultFun NameAnn
-> SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
forall (m :: * -> *) name (uni :: * -> *) fun a.
(MonadQuote m, Rename (Term name uni fun a),
HasUnique name TermUnique) =>
Term name uni fun a
-> SimplifierT name uni fun a m (Term name uni fun a)
floatDelay)
, TestName
-> AstGen (Term Name DefaultUni DefaultFun ())
-> BindingRemoval
-> Prerename
-> (Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> TestTree
forall (t :: * -> *) ann.
(PrettyPlc (t NameAnn), Rename (t NameAnn), Scoping t) =>
TestName
-> AstGen (t ann)
-> BindingRemoval
-> Prerename
-> (t NameAnn -> Quote (t NameAnn))
-> TestTree
T.test_scopingGood TestName
"force-delay"
(forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term Name DefaultUni fun ())
genTerm @DefaultFun)
BindingRemoval
T.BindingRemovalNotOk
Prerename
T.PrerenameYes
(SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
-> Quote (Term Name DefaultUni DefaultFun NameAnn)
forall (m :: * -> *) name (uni :: * -> *) fun ann a.
Monad m =>
SimplifierT name uni fun ann m a -> m a
evalSimplifierT (SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> (Term Name DefaultUni DefaultFun NameAnn
-> SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn))
-> Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinSemanticsVariant DefaultFun
-> Term Name DefaultUni DefaultFun NameAnn
-> SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
forall (uni :: * -> *) fun (m :: * -> *) name a.
(uni ~ DefaultUni, fun ~ DefaultFun, Monad m) =>
BuiltinSemanticsVariant fun
-> Term name uni fun a
-> SimplifierT name uni fun a m (Term name uni fun a)
forceDelay BuiltinSemanticsVariant DefaultFun
forall a. Bounded a => a
maxBound)
, TestName
-> AstGen (Term Name DefaultUni DefaultFun ())
-> BindingRemoval
-> Prerename
-> (Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> TestTree
forall (t :: * -> *) ann.
(PrettyPlc (t NameAnn), Rename (t NameAnn), Scoping t) =>
TestName
-> AstGen (t ann)
-> BindingRemoval
-> Prerename
-> (t NameAnn -> Quote (t NameAnn))
-> TestTree
T.test_scopingGood TestName
"inline"
(forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term Name DefaultUni fun ())
genTerm @DefaultFun)
BindingRemoval
T.BindingRemovalOk
Prerename
T.PrerenameYes
(SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
-> Quote (Term Name DefaultUni DefaultFun NameAnn)
forall (m :: * -> *) name (uni :: * -> *) fun ann a.
Monad m =>
SimplifierT name uni fun ann m a -> m a
evalSimplifierT (SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
-> Quote (Term Name DefaultUni DefaultFun NameAnn))
-> (Term Name DefaultUni DefaultFun NameAnn
-> SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn))
-> Term Name DefaultUni DefaultFun NameAnn
-> Quote (Term Name DefaultUni DefaultFun NameAnn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Size
-> Bool
-> Bool
-> InlineHints Name NameAnn
-> BuiltinSemanticsVariant DefaultFun
-> Term Name DefaultUni DefaultFun NameAnn
-> SimplifierT
Name
DefaultUni
DefaultFun
NameAnn
(QuoteT Identity)
(Term Name DefaultUni DefaultFun NameAnn)
forall name (uni :: * -> *) fun (m :: * -> *) a.
ExternalConstraints name uni fun m =>
Size
-> Bool
-> Bool
-> InlineHints name a
-> BuiltinSemanticsVariant fun
-> Term name uni fun a
-> SimplifierT name uni fun a m (Term name uni fun a)
inline Size
0
Bool
True
(SimplifyOpts Any Any -> Bool
forall name a. SimplifyOpts name a -> Bool
_soPreserveLogging SimplifyOpts Any Any
forall name a. SimplifyOpts name a
defaultSimplifyOpts)
(SimplifyOpts Name NameAnn -> InlineHints Name NameAnn
forall name a. SimplifyOpts name a -> InlineHints name a
_soInlineHints SimplifyOpts Name NameAnn
forall name a. SimplifyOpts name a
defaultSimplifyOpts)
BuiltinSemanticsVariant DefaultFun
forall a. Bounded a => a
maxBound )
, TestTree
test_mangle
, TestTree
test_equalityRename
, TestTree
test_equalityBrokenRename
, TestTree
test_equalityNoMarkRename
]