{-# LANGUAGE BlockArguments      #-}
{-# LANGUAGE NumericUnderscores  #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Transform.Inline.Spec where

import Control.Monad.Reader (runReaderT)
import Control.Monad.State (runStateT)
import Data.Text qualified as Text
import GHC.Exts (fromList)
import PlutusCore.Annotation (Inline (MayInline))
import PlutusCore.Default (DefaultFun (..), DefaultUni)
import PlutusCore.Name.Unique (Name (..), Unique (..))
import PlutusCore.Quote (runQuote)
import PlutusPrelude (def)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, assertBool, testCase)
import UntypedPlutusCore.Core (Term (..))
import UntypedPlutusCore.Size (Size (..))
import UntypedPlutusCore.Transform.Inline (InlineHints (..), InlineInfo (..), InlineM, S (..),
                                           Subst (..), TermEnv (..), effectSafe,
                                           isFirstVarBeforeEffects, isStrictIn)

test_inline :: TestTree
test_inline :: TestTree
test_inline =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Inline"
    [ TestName -> Assertion -> TestTree
testCase
        TestName
"var is before or after effects"
        Assertion
testVarBeforeAfterEffects
    , TestName -> [TestTree] -> TestTree
testGroup
        TestName
"isStrictIn"
        [ TestName -> Assertion -> TestTree
testCase
            TestName
"a var is delayed if it's inside a delay"
            Assertion
testVarIsEventuallyEvaluatedDelay
        , TestName -> Assertion -> TestTree
testCase
            TestName
"a var is delayed if it's inside a lambda"
            Assertion
testVarIsEventuallyEvaluatedLambda
        , TestName -> Assertion -> TestTree
testCase
            TestName
"a var is delayed if it's inside a case branch"
            Assertion
testVarIsEventuallyEvaluatedCaseBranch
        ]
    , TestName -> [TestTree] -> TestTree
testGroup
        TestName
"effectSafe"
        [ TestName -> Assertion -> TestTree
testCase TestName
"with preserved logs" Assertion
testEffectSafePreservedLogs
        , TestName -> Assertion -> TestTree
testCase TestName
"without preserved logs" Assertion
testEffectSafeWithoutPreservedLogs
        ]
    ]

testVarBeforeAfterEffects :: Assertion
testVarBeforeAfterEffects :: Assertion
testVarBeforeAfterEffects = do
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"a is evaluated before effects" do
    BuiltinSemanticsVariant DefaultFun
-> Name -> Term Name DefaultUni DefaultFun () -> Bool
forall name (uni :: * -> *) fun ann.
InliningConstraints name uni fun =>
BuiltinSemanticsVariant fun
-> name -> Term name uni fun ann -> Bool
isFirstVarBeforeEffects BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def Name
a Term Name DefaultUni DefaultFun ()
term
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"b is evaluated before effects" do
    BuiltinSemanticsVariant DefaultFun
-> Name -> Term Name DefaultUni DefaultFun () -> Bool
forall name (uni :: * -> *) fun ann.
InliningConstraints name uni fun =>
BuiltinSemanticsVariant fun
-> name -> Term name uni fun ann -> Bool
isFirstVarBeforeEffects BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def Name
b Term Name DefaultUni DefaultFun ()
term
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"c is not evaluated before effects" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not do
    BuiltinSemanticsVariant DefaultFun
-> Name -> Term Name DefaultUni DefaultFun () -> Bool
forall name (uni :: * -> *) fun ann.
InliningConstraints name uni fun =>
BuiltinSemanticsVariant fun
-> name -> Term name uni fun ann -> Bool
isFirstVarBeforeEffects BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def Name
c Term Name DefaultUni DefaultFun ()
term
 where
  term :: Term Name DefaultUni DefaultFun ()
  term :: Term Name DefaultUni DefaultFun ()
term =
    {- Evaluation order:

      1. pure work-free: a
      2. pure work-free: b
      3. impure? maybe work?: addInteger a b
      4. pure work-free: c
      5. impure? maybe work?: addInteger (addInteger a b) c
    -}
    Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
addInteger (Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
addInteger (Name -> Term Name DefaultUni DefaultFun ()
var Name
a) (Name -> Term Name DefaultUni DefaultFun ()
var Name
b)) (Name -> Term Name DefaultUni DefaultFun ()
var Name
c)
  (Name
a, Name
b, Name
c, Name
_) = (Name, Name, Name, Name)
makeUniqueNames

testVarIsEventuallyEvaluatedDelay :: Assertion
testVarIsEventuallyEvaluatedDelay :: Assertion
testVarIsEventuallyEvaluatedDelay = do
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"var 'a' is not eventually evaluated in delay" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    Bool -> Bool
not (Name -> Term Name DefaultUni DefaultFun () -> Bool
forall name (uni :: * -> *) fun a.
Eq name =>
name -> Term name uni fun a -> Bool
isStrictIn Name
a Term Name DefaultUni DefaultFun ()
term)
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"var 'b' is eventually evaluated outside of the delay" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    Name -> Term Name DefaultUni DefaultFun () -> Bool
forall name (uni :: * -> *) fun a.
Eq name =>
name -> Term name uni fun a -> Bool
isStrictIn Name
b Term Name DefaultUni DefaultFun ()
term
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"it's not known if var 'c' is eventually evaluated" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    Bool -> Bool
not (Name -> Term Name DefaultUni DefaultFun () -> Bool
forall name (uni :: * -> *) fun a.
Eq name =>
name -> Term name uni fun a -> Bool
isStrictIn Name
c Term Name DefaultUni DefaultFun ()
term)
 where
  term :: Term Name DefaultUni DefaultFun ()
  term :: Term Name DefaultUni DefaultFun ()
term = Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
delay (Name -> Term Name DefaultUni DefaultFun ()
var Name
a Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
`addInteger` Name -> Term Name DefaultUni DefaultFun ()
var Name
b) Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
`addInteger` Name -> Term Name DefaultUni DefaultFun ()
var Name
b

  (Name
a, Name
b, Name
c, Name
_) = (Name, Name, Name, Name)
makeUniqueNames

testVarIsEventuallyEvaluatedLambda :: Assertion
testVarIsEventuallyEvaluatedLambda :: Assertion
testVarIsEventuallyEvaluatedLambda = do
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"var 'a' is not eventually evaluated in lambda body" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    Bool -> Bool
not (Name -> Term Name DefaultUni DefaultFun () -> Bool
forall name (uni :: * -> *) fun a.
Eq name =>
name -> Term name uni fun a -> Bool
isStrictIn Name
a Term Name DefaultUni DefaultFun ()
term)
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"var 'c' is eventually evaluated outside of the lambda" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    Name -> Term Name DefaultUni DefaultFun () -> Bool
forall name (uni :: * -> *) fun a.
Eq name =>
name -> Term name uni fun a -> Bool
isStrictIn Name
c Term Name DefaultUni DefaultFun ()
term
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"it's not known if var 'd' is eventually evaluated" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    Bool -> Bool
not (Name -> Term Name DefaultUni DefaultFun () -> Bool
forall name (uni :: * -> *) fun a.
Eq name =>
name -> Term name uni fun a -> Bool
isStrictIn Name
d Term Name DefaultUni DefaultFun ()
term)
 where
  term :: Term Name DefaultUni DefaultFun ()
  term :: Term Name DefaultUni DefaultFun ()
term = Name
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
lam Name
b (Name -> Term Name DefaultUni DefaultFun ()
var Name
a Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
`addInteger` Name -> Term Name DefaultUni DefaultFun ()
var Name
c) Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
`app` Name -> Term Name DefaultUni DefaultFun ()
var Name
c

  (Name
a, Name
b, Name
c, Name
d) = (Name, Name, Name, Name)
makeUniqueNames

testVarIsEventuallyEvaluatedCaseBranch :: Assertion
testVarIsEventuallyEvaluatedCaseBranch :: Assertion
testVarIsEventuallyEvaluatedCaseBranch = do
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"var 'a' is not eventually evaluated in case branch" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    Bool -> Bool
not (Name -> Term Name DefaultUni DefaultFun () -> Bool
forall name (uni :: * -> *) fun a.
Eq name =>
name -> Term name uni fun a -> Bool
isStrictIn Name
a Term Name DefaultUni DefaultFun ()
term)
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"var 'b' is eventually evaluated outside of the case branch" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    Name -> Term Name DefaultUni DefaultFun () -> Bool
forall name (uni :: * -> *) fun a.
Eq name =>
name -> Term name uni fun a -> Bool
isStrictIn Name
b Term Name DefaultUni DefaultFun ()
term
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"it is not known if var 'd' is eventually evaluated" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    Bool -> Bool
not (Name -> Term Name DefaultUni DefaultFun () -> Bool
forall name (uni :: * -> *) fun a.
Eq name =>
name -> Term name uni fun a -> Bool
isStrictIn Name
d Term Name DefaultUni DefaultFun ()
term)
 where
  term :: Term Name DefaultUni DefaultFun ()
  term :: Term Name DefaultUni DefaultFun ()
term = Term Name DefaultUni DefaultFun ()
-> [Term Name DefaultUni DefaultFun ()]
-> Term Name DefaultUni DefaultFun ()
case_ (Name -> Term Name DefaultUni DefaultFun ()
var Name
b) [Name -> Term Name DefaultUni DefaultFun ()
var Name
a, Name -> Term Name DefaultUni DefaultFun ()
var Name
b, Name -> Term Name DefaultUni DefaultFun ()
var Name
c]

  (Name
a, Name
b, Name
c, Name
d) = (Name, Name, Name, Name)
makeUniqueNames

testEffectSafePreservedLogs :: Assertion
testEffectSafePreservedLogs :: Assertion
testEffectSafePreservedLogs = do
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"an immediately eval'd var is not \"effect safe\"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    InlineM Name DefaultUni DefaultFun () Bool -> Bool
forall r. InlineM Name DefaultUni DefaultFun () r -> r
runInlineWithLogging (Bool -> Bool
not (Bool -> Bool)
-> InlineM Name DefaultUni DefaultFun () Bool
-> InlineM Name DefaultUni DefaultFun () Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term Name DefaultUni DefaultFun ()
-> Name -> Bool -> InlineM Name DefaultUni DefaultFun () Bool
forall name (uni :: * -> *) fun a.
InliningConstraints name uni fun =>
Term name uni fun a -> name -> Bool -> InlineM name uni fun a Bool
effectSafe Term Name DefaultUni DefaultFun ()
term Name
c Bool
False)
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"a var before effects is \"effect safe\"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    InlineM Name DefaultUni DefaultFun () Bool -> Bool
forall r. InlineM Name DefaultUni DefaultFun () r -> r
runInlineWithLogging (Term Name DefaultUni DefaultFun ()
-> Name -> Bool -> InlineM Name DefaultUni DefaultFun () Bool
forall name (uni :: * -> *) fun a.
InliningConstraints name uni fun =>
Term name uni fun a -> name -> Bool -> InlineM name uni fun a Bool
effectSafe Term Name DefaultUni DefaultFun ()
term Name
a Bool
False)
 where
  term :: Term Name DefaultUni DefaultFun ()
  term :: Term Name DefaultUni DefaultFun ()
term = (Name -> Term Name DefaultUni DefaultFun ()
var Name
a Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
`addInteger` Name -> Term Name DefaultUni DefaultFun ()
var Name
b) Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
`addInteger` Name -> Term Name DefaultUni DefaultFun ()
var Name
c

  (Name
a, Name
b, Name
c, Name
_) = (Name, Name, Name, Name)
makeUniqueNames

testEffectSafeWithoutPreservedLogs :: Assertion
testEffectSafeWithoutPreservedLogs :: Assertion
testEffectSafeWithoutPreservedLogs = do
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"an immediately eval'd var is \"effect safe\"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    InlineM Name DefaultUni DefaultFun () Bool -> Bool
forall r. InlineM Name DefaultUni DefaultFun () r -> r
runInlineWithoutLogging (Term Name DefaultUni DefaultFun ()
-> Name -> Bool -> InlineM Name DefaultUni DefaultFun () Bool
forall name (uni :: * -> *) fun a.
InliningConstraints name uni fun =>
Term name uni fun a -> name -> Bool -> InlineM name uni fun a Bool
effectSafe Term Name DefaultUni DefaultFun ()
term Name
c Bool
False)
  HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"a var before effects is \"effect safe\"" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
    InlineM Name DefaultUni DefaultFun () Bool -> Bool
forall r. InlineM Name DefaultUni DefaultFun () r -> r
runInlineWithoutLogging (Term Name DefaultUni DefaultFun ()
-> Name -> Bool -> InlineM Name DefaultUni DefaultFun () Bool
forall name (uni :: * -> *) fun a.
InliningConstraints name uni fun =>
Term name uni fun a -> name -> Bool -> InlineM name uni fun a Bool
effectSafe Term Name DefaultUni DefaultFun ()
term Name
a Bool
False)
 where
  term :: Term Name DefaultUni DefaultFun ()
  term :: Term Name DefaultUni DefaultFun ()
term = (Name -> Term Name DefaultUni DefaultFun ()
var Name
a Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
`addInteger` Name -> Term Name DefaultUni DefaultFun ()
var Name
b) Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
`addInteger` Name -> Term Name DefaultUni DefaultFun ()
var Name
c

  (Name
a, Name
b, Name
c, Name
_) = (Name, Name, Name, Name)
makeUniqueNames

--------------------------------------------------------------------------------
-- InlineM runner --------------------------------------------------------------

runInlineWithoutLogging :: InlineM Name DefaultUni DefaultFun () r -> r
runInlineWithoutLogging :: forall r. InlineM Name DefaultUni DefaultFun () r -> r
runInlineWithoutLogging = Bool -> InlineM Name DefaultUni DefaultFun () r -> r
forall r. Bool -> InlineM Name DefaultUni DefaultFun () r -> r
runInlineM Bool
False

runInlineWithLogging :: InlineM Name DefaultUni DefaultFun () r -> r
runInlineWithLogging :: forall r. InlineM Name DefaultUni DefaultFun () r -> r
runInlineWithLogging = Bool -> InlineM Name DefaultUni DefaultFun () r -> r
forall r. Bool -> InlineM Name DefaultUni DefaultFun () r -> r
runInlineM Bool
True

runInlineM :: Bool -> InlineM Name DefaultUni DefaultFun () r -> r
runInlineM :: forall r. Bool -> InlineM Name DefaultUni DefaultFun () r -> r
runInlineM Bool
preserveLogging InlineM Name DefaultUni DefaultFun () r
m = r
result
 where
  (r
result, S Name DefaultUni DefaultFun ()
_finalState) =
    Quote (r, S Name DefaultUni DefaultFun ())
-> (r, S Name DefaultUni DefaultFun ())
forall a. Quote a -> a
runQuote (StateT (S Name DefaultUni DefaultFun ()) Quote r
-> S Name DefaultUni DefaultFun ()
-> Quote (r, S Name DefaultUni DefaultFun ())
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (InlineM Name DefaultUni DefaultFun () r
-> InlineInfo Name DefaultFun ()
-> StateT (S Name DefaultUni DefaultFun ()) Quote r
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT InlineM Name DefaultUni DefaultFun () r
m InlineInfo Name DefaultFun ()
inlineInfo) S Name DefaultUni DefaultFun ()
initialState)
  inlineInfo :: InlineInfo Name DefaultFun ()
  inlineInfo :: InlineInfo Name DefaultFun ()
inlineInfo =
    InlineInfo
      { _iiUsages :: Usages
_iiUsages = Usages
forall a. Monoid a => a
mempty
      , _iiHints :: InlineHints Name ()
_iiHints = (() -> Name -> Inline) -> InlineHints Name ()
forall name a. (a -> name -> Inline) -> InlineHints name a
InlineHints \()
_ann Name
_name -> Inline
MayInline
      , _iiBuiltinSemanticsVariant :: BuiltinSemanticsVariant DefaultFun
_iiBuiltinSemanticsVariant = BuiltinSemanticsVariant DefaultFun
forall a. Default a => a
def
      , _iiInlineConstants :: Bool
_iiInlineConstants = Bool
True
      , _iiInlineCallsiteGrowth :: Size
_iiInlineCallsiteGrowth = Integer -> Size
Size Integer
1_000_000
      , _iiPreserveLogging :: Bool
_iiPreserveLogging = Bool
preserveLogging
      }
  initialState :: S Name DefaultUni DefaultFun ()
  initialState :: S Name DefaultUni DefaultFun ()
initialState = S{_subst :: Subst Name DefaultUni DefaultFun ()
_subst = TermEnv Name DefaultUni DefaultFun ()
-> Subst Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun a.
TermEnv name uni fun a -> Subst name uni fun a
Subst (UniqueMap TermUnique (InlineTerm Name DefaultUni DefaultFun ())
-> TermEnv Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun a.
UniqueMap TermUnique (InlineTerm name uni fun a)
-> TermEnv name uni fun a
TermEnv UniqueMap TermUnique (InlineTerm Name DefaultUni DefaultFun ())
forall a. Monoid a => a
mempty), _vars :: UniqueMap TermUnique (VarInfo Name DefaultUni DefaultFun ())
_vars = UniqueMap TermUnique (VarInfo Name DefaultUni DefaultFun ())
forall a. Monoid a => a
mempty}

--------------------------------------------------------------------------------
-- UPLC Term constructors ------------------------------------------------------

type T = Term Name DefaultUni DefaultFun ()

var :: Name -> T
var :: Name -> Term Name DefaultUni DefaultFun ()
var = () -> Name -> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann
Var ()

lam :: Name -> T -> T
lam :: Name
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
lam = ()
-> Name
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann -> Term name uni fun ann
LamAbs ()

app :: T -> T -> T
app :: Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
app = ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Term name uni fun ann
-> Term name uni fun ann
-> Term name uni fun ann
Apply ()

delay :: T -> T
delay :: Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
delay = ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> Term name uni fun ann -> Term name uni fun ann
Delay ()

case_ :: T -> [T] -> T
case_ :: Term Name DefaultUni DefaultFun ()
-> [Term Name DefaultUni DefaultFun ()]
-> Term Name DefaultUni DefaultFun ()
case_ Term Name DefaultUni DefaultFun ()
scrut [Term Name DefaultUni DefaultFun ()]
branches = ()
-> Term Name DefaultUni DefaultFun ()
-> Vector (Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann
-> Term name uni fun ann
-> Vector (Term name uni fun ann)
-> Term name uni fun ann
Case () Term Name DefaultUni DefaultFun ()
scrut ([Item (Vector (Term Name DefaultUni DefaultFun ()))]
-> Vector (Term Name DefaultUni DefaultFun ())
forall l. IsList l => [Item l] -> l
fromList [Item (Vector (Term Name DefaultUni DefaultFun ()))]
[Term Name DefaultUni DefaultFun ()]
branches)

addInteger :: T -> T -> T
addInteger :: Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
addInteger Term Name DefaultUni DefaultFun ()
i Term Name DefaultUni DefaultFun ()
j = DefaultFun -> Term Name DefaultUni DefaultFun ()
builtin DefaultFun
AddInteger Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
`app` Term Name DefaultUni DefaultFun ()
i Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
`app` Term Name DefaultUni DefaultFun ()
j

builtin :: DefaultFun -> T
builtin :: DefaultFun -> Term Name DefaultUni DefaultFun ()
builtin = () -> DefaultFun -> Term Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
ann -> fun -> Term name uni fun ann
Builtin ()

--------------------------------------------------------------------------------
-- Unique names ----------------------------------------------------------------

makeUniqueNames :: (Name, Name, Name, Name)
makeUniqueNames :: (Name, Name, Name, Name)
makeUniqueNames = (TestName -> Int -> Name
name TestName
"a" Int
0, TestName -> Int -> Name
name TestName
"b" Int
1, TestName -> Int -> Name
name TestName
"c" Int
2, TestName -> Int -> Name
name TestName
"d" Int
3)

name :: String -> Int -> Name
name :: TestName -> Int -> Name
name TestName
n Int
u = Text -> Unique -> Name
Name (TestName -> Text
Text.pack TestName
n) (Int -> Unique
Unique Int
u)