-- editorconfig-checker-disable-file
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

module PlutusCore.Generators.Hedgehog.AST
    ( simpleRecursive
    , discardIfAnyConstant
    , AstGen
    , runAstGen
    , genVersion
    , genNames
    , genName
    , genTyName
    , genKind
    , genBuiltin
    , genConstant
    , genType
    , genTerm
    , genProgram
    , mangleNames
    ) where

import PlutusPrelude

import PlutusCore
import PlutusCore.Core.Plated (termConstantsDeep)
import PlutusCore.Generators.QuickCheck.Builtin ()
import PlutusCore.Name.Unique (isQuotedIdentifierChar)
import PlutusCore.Subst

import Control.Lens (andOf, coerced, to)
import Control.Monad.Morph (hoist)
import Control.Monad.Reader
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Set.Lens (setOf)
import Data.Text (Text)
import Data.Text qualified as Text
import Hedgehog hiding (Size, Var)
import Hedgehog.Gen qualified as Gen
import Hedgehog.Gen.QuickCheck (arbitrary)
import Hedgehog.Internal.Gen qualified as Gen
import Hedgehog.Range qualified as Range

simpleRecursive :: MonadGen m => [m a] -> [m a] -> m a
simpleRecursive :: forall (m :: * -> *) a. MonadGen m => [m a] -> [m a] -> m a
simpleRecursive = ([m a] -> m a) -> [m a] -> [m a] -> m a
forall (m :: * -> *) a.
MonadGen m =>
([m a] -> m a) -> [m a] -> [m a] -> m a
Gen.recursive [m a] -> m a
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice

{- Note [ScopeHandling]
We intentionally do not distinguish between the type-level and term-level scopes to ensure that
all the machineries handle variables with same uniques from distinct scopes correctly.
-}

-- See Note [ScopeHandling].
-- | The monad that generators run in. The environment is a list of names to choose from for
-- generation of variables and binders.
type AstGen = GenT (Reader [Name])

runAstGen :: MonadGen m => AstGen a -> m a
runAstGen :: forall (m :: * -> *) a. MonadGen m => AstGen a -> m a
runAstGen AstGen a
a = do
    [Name]
names <- m [Name]
forall (m :: * -> *). MonadGen m => m [Name]
genNames
    GenT (GenBase m) a -> m a
forall a. GenT (GenBase m) a -> m a
forall (m :: * -> *) a. MonadGen m => GenT (GenBase m) a -> m a
Gen.fromGenT (GenT (GenBase m) a -> m a) -> GenT (GenBase m) a -> m a
forall a b. (a -> b) -> a -> b
$ (forall a. Reader [Name] a -> GenBase m a)
-> AstGen a -> GenT (GenBase m) a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> GenT m b -> GenT n b
hoist (a -> GenBase m a
forall a. a -> GenBase m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> GenBase m a)
-> (Reader [Name] a -> a) -> Reader [Name] a -> GenBase m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reader [Name] a -> [Name] -> a) -> [Name] -> Reader [Name] a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reader [Name] a -> [Name] -> a
forall r a. Reader r a -> r -> a
runReader [Name]
names) AstGen a
a

discardIfAnyConstant
  :: MonadGen m
  => (Some (ValueOf uni) -> Bool)
  -> m (Program tyname name uni fun ann)
  -> m (Program tyname name uni fun ann)
discardIfAnyConstant :: forall (m :: * -> *) (uni :: * -> *) tyname name fun ann.
MonadGen m =>
(Some (ValueOf uni) -> Bool)
-> m (Program tyname name uni fun ann)
-> m (Program tyname name uni fun ann)
discardIfAnyConstant Some (ValueOf uni) -> Bool
p = (Program tyname name uni fun ann -> Bool)
-> m (Program tyname name uni fun ann)
-> m (Program tyname name uni fun ann)
forall (m :: * -> *) a. MonadGen m => (a -> Bool) -> m a -> m a
Gen.filterT ((Program tyname name uni fun ann -> Bool)
 -> m (Program tyname name uni fun ann)
 -> m (Program tyname name uni fun ann))
-> (Getting All (Program tyname name uni fun ann) Bool
    -> Program tyname name uni fun ann -> Bool)
-> Getting All (Program tyname name uni fun ann) Bool
-> m (Program tyname name uni fun ann)
-> m (Program tyname name uni fun ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting All (Program tyname name uni fun ann) Bool
-> Program tyname name uni fun ann -> Bool
forall s. Getting All s Bool -> s -> Bool
andOf (Getting All (Program tyname name uni fun ann) Bool
 -> m (Program tyname name uni fun ann)
 -> m (Program tyname name uni fun ann))
-> Getting All (Program tyname name uni fun ann) Bool
-> m (Program tyname name uni fun ann)
-> m (Program tyname name uni fun ann)
forall a b. (a -> b) -> a -> b
$ (Term tyname name uni fun ann
 -> Const All (Term tyname name uni fun ann))
-> Program tyname name uni fun ann
-> Const All (Program tyname name uni fun ann)
forall tyname1 name1 (uni1 :: * -> *) fun1 ann tyname2 name2
       (uni2 :: * -> *) fun2 (f :: * -> *).
Functor f =>
(Term tyname1 name1 uni1 fun1 ann
 -> f (Term tyname2 name2 uni2 fun2 ann))
-> Program tyname1 name1 uni1 fun1 ann
-> f (Program tyname2 name2 uni2 fun2 ann)
progTerm ((Term tyname name uni fun ann
  -> Const All (Term tyname name uni fun ann))
 -> Program tyname name uni fun ann
 -> Const All (Program tyname name uni fun ann))
-> ((Bool -> Const All Bool)
    -> Term tyname name uni fun ann
    -> Const All (Term tyname name uni fun ann))
-> Getting All (Program tyname name uni fun ann) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Some (ValueOf uni) -> Const All (Some (ValueOf uni)))
-> Term tyname name uni fun ann
-> Const All (Term tyname name uni fun ann)
forall tyname name (uni :: * -> *) fun ann (f :: * -> *).
(Contravariant f, Applicative f) =>
(Some (ValueOf uni) -> f (Some (ValueOf uni)))
-> Term tyname name uni fun ann -> f (Term tyname name uni fun ann)
termConstantsDeep ((Some (ValueOf uni) -> Const All (Some (ValueOf uni)))
 -> Term tyname name uni fun ann
 -> Const All (Term tyname name uni fun ann))
-> ((Bool -> Const All Bool)
    -> Some (ValueOf uni) -> Const All (Some (ValueOf uni)))
-> (Bool -> Const All Bool)
-> Term tyname name uni fun ann
-> Const All (Term tyname name uni fun ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Some (ValueOf uni) -> Bool)
-> (Bool -> Const All Bool)
-> Some (ValueOf uni)
-> Const All (Some (ValueOf uni))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Bool -> Bool
not (Bool -> Bool)
-> (Some (ValueOf uni) -> Bool) -> Some (ValueOf uni) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Some (ValueOf uni) -> Bool
p)

-- The parser will reject uses of new constructs if the version is not high enough
-- In order to keep our lives simple, we just generate a version that is always high
-- enough to support everything. That gives us less coverage of parsing versions, but
-- that's not likely to be the place where things go wrong
genVersion :: MonadGen m => m Version
genVersion :: forall (m :: * -> *). MonadGen m => m Version
genVersion = Natural -> Natural -> Natural -> Version
Version (Natural -> Natural -> Natural -> Version)
-> m Natural -> m (Natural -> Natural -> Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> m Natural
forall {m :: * -> *} {a}. (MonadGen m, Integral a) => a -> m a
intFrom Natural
1 m (Natural -> Natural -> Version)
-> m Natural -> m (Natural -> Version)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> m Natural
forall {m :: * -> *} {a}. (MonadGen m, Integral a) => a -> m a
intFrom Natural
1 m (Natural -> Version) -> m Natural -> m Version
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> m Natural
forall {m :: * -> *} {a}. (MonadGen m, Integral a) => a -> m a
intFrom Natural
0 where
    intFrom :: a -> m a
intFrom a
x = Range a -> m a
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral_ (Range a -> m a) -> Range a -> m a
forall a b. (a -> b) -> a -> b
$ a -> a -> Range a
forall a. Integral a => a -> a -> Range a
Range.linear a
x a
20

genNameText :: MonadGen m => m Text
genNameText :: forall (m :: * -> *). MonadGen m => m Text
genNameText = [m Text] -> m Text
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice [m Text
genUnquoted, m Text
genQuoted]
  where
    genUnquoted :: m Text
genUnquoted =
        Char -> Text -> Text
Text.cons
            (Char -> Text -> Text) -> m Char -> m (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alpha
            m (Text -> Text) -> m Text -> m Text
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int -> m Char -> m Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
4) ([m Char] -> m Char
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice [m Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum, [Char] -> m Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element [Char
'_', Char
'\'']])
    genQuoted :: m Text
genQuoted =
        Range Int -> m Char -> m Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
5) ((Char -> Bool) -> m Char -> m Char
forall (m :: * -> *) a. MonadGen m => (a -> Bool) -> m a -> m a
Gen.filterT Char -> Bool
isQuotedIdentifierChar m Char
forall (m :: * -> *). MonadGen m => m Char
Gen.ascii)

-- | Generate a fixed set of names which we will use, of only up to a short size to make it
-- likely that we get reuse.
-- We do not attempt not to generate reserved words such as @all@ or @abs@ as the classic syntax
-- parsers (both PLC and PIR ones) can handle names of variables clashing with reserved words.
-- In the readable syntax that would be troubling, though, but we don't have a parser for that anyway.
genNames :: MonadGen m => m [Name]
genNames :: forall (m :: * -> *). MonadGen m => m [Name]
genNames = do
    let genUniq :: m Unique
genUniq = Int -> Unique
Unique (Int -> Unique) -> m Int -> m Unique
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
100)
    [Unique]
uniqs <- Set Unique -> [Unique]
forall a. Set a -> [a]
Set.toList (Set Unique -> [Unique]) -> m (Set Unique) -> m [Unique]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m Unique -> m (Set Unique)
forall (m :: * -> *) a.
(MonadGen m, Ord a) =>
Range Int -> m a -> m (Set a)
Gen.set (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
20) m Unique
genUniq
    [Unique] -> (Unique -> m Name) -> m [Name]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Unique]
uniqs ((Unique -> m Name) -> m [Name]) -> (Unique -> m Name) -> m [Name]
forall a b. (a -> b) -> a -> b
$ \Unique
uniq -> do
        Text
text <- m Text
forall (m :: * -> *). MonadGen m => m Text
genNameText
        Name -> m Name
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> m Name) -> Name -> m Name
forall a b. (a -> b) -> a -> b
$ Text -> Unique -> Name
Name Text
text Unique
uniq

genName :: AstGen Name
genName :: AstGen Name
genName = GenT (Reader [Name]) [Name]
forall r (m :: * -> *). MonadReader r m => m r
ask GenT (Reader [Name]) [Name]
-> ([Name] -> AstGen Name) -> AstGen Name
forall a b.
GenT (Reader [Name]) a
-> (a -> GenT (Reader [Name]) b) -> GenT (Reader [Name]) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Name] -> AstGen Name
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element

genTyName :: AstGen TyName
genTyName :: AstGen TyName
genTyName = Name -> TyName
TyName (Name -> TyName) -> AstGen Name -> AstGen TyName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen Name
genName

genKind :: AstGen (Kind ())
genKind :: AstGen (Kind ())
genKind = [AstGen (Kind ())] -> [AstGen (Kind ())] -> AstGen (Kind ())
forall (m :: * -> *) a. MonadGen m => [m a] -> [m a] -> m a
simpleRecursive [AstGen (Kind ())]
nonRecursive [AstGen (Kind ())]
recursive where
    nonRecursive :: [AstGen (Kind ())]
nonRecursive = Kind () -> AstGen (Kind ())
forall a. a -> GenT (Reader [Name]) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Kind () -> AstGen (Kind ())) -> [Kind ()] -> [AstGen (Kind ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [() -> Kind ()] -> () -> [Kind ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [() -> Kind ()
forall ann. ann -> Kind ann
Type] ()
    recursive :: [AstGen (Kind ())]
recursive = [() -> Kind () -> Kind () -> Kind ()
forall ann. ann -> Kind ann -> Kind ann -> Kind ann
KindArrow () (Kind () -> Kind () -> Kind ())
-> AstGen (Kind ()) -> GenT (Reader [Name]) (Kind () -> Kind ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen (Kind ())
genKind GenT (Reader [Name]) (Kind () -> Kind ())
-> AstGen (Kind ()) -> AstGen (Kind ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AstGen (Kind ())
genKind]

genBuiltin :: (Bounded fun, Enum fun) => AstGen fun
genBuiltin :: forall fun. (Bounded fun, Enum fun) => AstGen fun
genBuiltin = [fun] -> GenT (Reader [Name]) fun
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element [fun
forall a. Bounded a => a
minBound .. fun
forall a. Bounded a => a
maxBound]

genConstant :: AstGen (Some (ValueOf DefaultUni))
-- The @QuickCheck@ generator is a good one, so we reuse it in @hedgehog@ via @hedgehog-quickcheck@.
genConstant :: AstGen (Some (ValueOf DefaultUni))
genConstant = AstGen (Some (ValueOf DefaultUni))
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary

genSomeTypeIn :: AstGen (SomeTypeIn DefaultUni)
-- The @QuickCheck@ generator is a good one, so we reuse it in @hedgehog@ via @hedgehog-quickcheck@.
genSomeTypeIn :: AstGen (SomeTypeIn DefaultUni)
genSomeTypeIn = AstGen (SomeTypeIn DefaultUni)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary

genType :: AstGen (Type TyName DefaultUni ())
genType :: AstGen (Type TyName DefaultUni ())
genType = [AstGen (Type TyName DefaultUni ())]
-> [AstGen (Type TyName DefaultUni ())]
-> AstGen (Type TyName DefaultUni ())
forall (m :: * -> *) a. MonadGen m => [m a] -> [m a] -> m a
simpleRecursive [AstGen (Type TyName DefaultUni ())]
nonRecursive [AstGen (Type TyName DefaultUni ())]
recursive where
    varGen :: GenT (Reader [Name]) (Type TyName uni ())
varGen = () -> TyName -> Type TyName uni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
TyVar () (TyName -> Type TyName uni ())
-> AstGen TyName -> GenT (Reader [Name]) (Type TyName uni ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen TyName
genTyName
    funGen :: AstGen (Type TyName DefaultUni ())
funGen = ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyFun () (Type TyName DefaultUni ()
 -> Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> AstGen (Type TyName DefaultUni ())
-> GenT
     (Reader [Name])
     (Type TyName DefaultUni () -> Type TyName DefaultUni ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen (Type TyName DefaultUni ())
genType GenT
  (Reader [Name])
  (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> AstGen (Type TyName DefaultUni ())
-> AstGen (Type TyName DefaultUni ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AstGen (Type TyName DefaultUni ())
genType
    lamGen :: AstGen (Type TyName DefaultUni ())
lamGen = ()
-> TyName
-> Kind ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> tyname -> Kind ann -> Type tyname uni ann -> Type tyname uni ann
TyLam () (TyName
 -> Kind ()
 -> Type TyName DefaultUni ()
 -> Type TyName DefaultUni ())
-> AstGen TyName
-> GenT
     (Reader [Name])
     (Kind () -> Type TyName DefaultUni () -> Type TyName DefaultUni ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen TyName
genTyName GenT
  (Reader [Name])
  (Kind () -> Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> AstGen (Kind ())
-> GenT
     (Reader [Name])
     (Type TyName DefaultUni () -> Type TyName DefaultUni ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AstGen (Kind ())
genKind GenT
  (Reader [Name])
  (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> AstGen (Type TyName DefaultUni ())
-> AstGen (Type TyName DefaultUni ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AstGen (Type TyName DefaultUni ())
genType
    forallGen :: AstGen (Type TyName DefaultUni ())
forallGen = ()
-> TyName
-> Kind ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> tyname -> Kind ann -> Type tyname uni ann -> Type tyname uni ann
TyForall () (TyName
 -> Kind ()
 -> Type TyName DefaultUni ()
 -> Type TyName DefaultUni ())
-> AstGen TyName
-> GenT
     (Reader [Name])
     (Kind () -> Type TyName DefaultUni () -> Type TyName DefaultUni ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen TyName
genTyName GenT
  (Reader [Name])
  (Kind () -> Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> AstGen (Kind ())
-> GenT
     (Reader [Name])
     (Type TyName DefaultUni () -> Type TyName DefaultUni ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AstGen (Kind ())
genKind GenT
  (Reader [Name])
  (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> AstGen (Type TyName DefaultUni ())
-> AstGen (Type TyName DefaultUni ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AstGen (Type TyName DefaultUni ())
genType
    applyGen :: AstGen (Type TyName DefaultUni ())
applyGen = ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Type tyname uni ann
TyApp () (Type TyName DefaultUni ()
 -> Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> AstGen (Type TyName DefaultUni ())
-> GenT
     (Reader [Name])
     (Type TyName DefaultUni () -> Type TyName DefaultUni ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen (Type TyName DefaultUni ())
genType GenT
  (Reader [Name])
  (Type TyName DefaultUni () -> Type TyName DefaultUni ())
-> AstGen (Type TyName DefaultUni ())
-> AstGen (Type TyName DefaultUni ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AstGen (Type TyName DefaultUni ())
genType
    sopGen :: AstGen (Type TyName DefaultUni ())
sopGen = () -> [[Type TyName DefaultUni ()]] -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> [[Type tyname uni ann]] -> Type tyname uni ann
TySOP () ([[Type TyName DefaultUni ()]] -> Type TyName DefaultUni ())
-> GenT (Reader [Name]) [[Type TyName DefaultUni ()]]
-> AstGen (Type TyName DefaultUni ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Range Int
-> GenT (Reader [Name]) [Type TyName DefaultUni ()]
-> GenT (Reader [Name]) [[Type TyName DefaultUni ()]]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10) (Range Int
-> AstGen (Type TyName DefaultUni ())
-> GenT (Reader [Name]) [Type TyName DefaultUni ()]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10) AstGen (Type TyName DefaultUni ())
genType))
    tyBuiltinGen :: GenT (Reader [Name]) (Type tyname DefaultUni ())
tyBuiltinGen = () -> SomeTypeIn DefaultUni -> Type tyname DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> SomeTypeIn uni -> Type tyname uni ann
TyBuiltin () (SomeTypeIn DefaultUni -> Type tyname DefaultUni ())
-> AstGen (SomeTypeIn DefaultUni)
-> GenT (Reader [Name]) (Type tyname DefaultUni ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen (SomeTypeIn DefaultUni)
genSomeTypeIn
    recursive :: [AstGen (Type TyName DefaultUni ())]
recursive = [AstGen (Type TyName DefaultUni ())
funGen, AstGen (Type TyName DefaultUni ())
applyGen, AstGen (Type TyName DefaultUni ())
sopGen]
    nonRecursive :: [AstGen (Type TyName DefaultUni ())]
nonRecursive = [AstGen (Type TyName DefaultUni ())
forall {uni :: * -> *}. GenT (Reader [Name]) (Type TyName uni ())
varGen, AstGen (Type TyName DefaultUni ())
lamGen, AstGen (Type TyName DefaultUni ())
forallGen, AstGen (Type TyName DefaultUni ())
forall {tyname}. GenT (Reader [Name]) (Type tyname DefaultUni ())
tyBuiltinGen]

genTerm :: forall fun. (Bounded fun, Enum fun) => AstGen (Term TyName Name DefaultUni fun ())
genTerm :: forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term TyName Name DefaultUni fun ())
genTerm = [GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())]
-> [GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())]
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall (m :: * -> *) a. MonadGen m => [m a] -> [m a] -> m a
simpleRecursive [GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())]
nonRecursive [GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())]
recursive where
    varGen :: GenT (Reader [Name]) (Term tyname Name uni fun ())
varGen = () -> Name -> Term tyname Name uni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann -> name -> Term tyname name uni fun ann
Var () (Name -> Term tyname Name uni fun ())
-> AstGen Name
-> GenT (Reader [Name]) (Term tyname Name uni fun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen Name
genName
    absGen :: GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
absGen = ()
-> TyName
-> Kind ()
-> Term TyName Name DefaultUni fun ()
-> Term TyName Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann
-> tyname
-> Kind ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
TyAbs () (TyName
 -> Kind ()
 -> Term TyName Name DefaultUni fun ()
 -> Term TyName Name DefaultUni fun ())
-> AstGen TyName
-> GenT
     (Reader [Name])
     (Kind ()
      -> Term TyName Name DefaultUni fun ()
      -> Term TyName Name DefaultUni fun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen TyName
genTyName GenT
  (Reader [Name])
  (Kind ()
   -> Term TyName Name DefaultUni fun ()
   -> Term TyName Name DefaultUni fun ())
-> AstGen (Kind ())
-> GenT
     (Reader [Name])
     (Term TyName Name DefaultUni fun ()
      -> Term TyName Name DefaultUni fun ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AstGen (Kind ())
genKind GenT
  (Reader [Name])
  (Term TyName Name DefaultUni fun ()
   -> Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term TyName Name DefaultUni fun ())
genTerm
    instGen :: GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
instGen = ()
-> Term TyName Name DefaultUni fun ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann
-> Term tyname name uni fun ann
-> Type tyname uni ann
-> Term tyname name uni fun ann
TyInst () (Term TyName Name DefaultUni fun ()
 -> Type TyName DefaultUni () -> Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
-> GenT
     (Reader [Name])
     (Type TyName DefaultUni () -> Term TyName Name DefaultUni fun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term TyName Name DefaultUni fun ())
genTerm GenT
  (Reader [Name])
  (Type TyName DefaultUni () -> Term TyName Name DefaultUni fun ())
-> AstGen (Type TyName DefaultUni ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AstGen (Type TyName DefaultUni ())
genType
    lamGen :: GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
lamGen = ()
-> Name
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni fun ()
-> Term TyName Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann
-> name
-> Type tyname uni ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
LamAbs () (Name
 -> Type TyName DefaultUni ()
 -> Term TyName Name DefaultUni fun ()
 -> Term TyName Name DefaultUni fun ())
-> AstGen Name
-> GenT
     (Reader [Name])
     (Type TyName DefaultUni ()
      -> Term TyName Name DefaultUni fun ()
      -> Term TyName Name DefaultUni fun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen Name
genName GenT
  (Reader [Name])
  (Type TyName DefaultUni ()
   -> Term TyName Name DefaultUni fun ()
   -> Term TyName Name DefaultUni fun ())
-> AstGen (Type TyName DefaultUni ())
-> GenT
     (Reader [Name])
     (Term TyName Name DefaultUni fun ()
      -> Term TyName Name DefaultUni fun ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AstGen (Type TyName DefaultUni ())
genType GenT
  (Reader [Name])
  (Term TyName Name DefaultUni fun ()
   -> Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term TyName Name DefaultUni fun ())
genTerm
    applyGen :: GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
applyGen = ()
-> Term TyName Name DefaultUni fun ()
-> Term TyName Name DefaultUni fun ()
-> Term TyName Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
Apply () (Term TyName Name DefaultUni fun ()
 -> Term TyName Name DefaultUni fun ()
 -> Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
-> GenT
     (Reader [Name])
     (Term TyName Name DefaultUni fun ()
      -> Term TyName Name DefaultUni fun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term TyName Name DefaultUni fun ())
genTerm GenT
  (Reader [Name])
  (Term TyName Name DefaultUni fun ()
   -> Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term TyName Name DefaultUni fun ())
genTerm
    unwrapGen :: GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
unwrapGen = ()
-> Term TyName Name DefaultUni fun ()
-> Term TyName Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann -> Term tyname name uni fun ann -> Term tyname name uni fun ann
Unwrap () (Term TyName Name DefaultUni fun ()
 -> Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term TyName Name DefaultUni fun ())
genTerm
    wrapGen :: GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
wrapGen = ()
-> Type TyName DefaultUni ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni fun ()
-> Term TyName Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
IWrap () (Type TyName DefaultUni ()
 -> Type TyName DefaultUni ()
 -> Term TyName Name DefaultUni fun ()
 -> Term TyName Name DefaultUni fun ())
-> AstGen (Type TyName DefaultUni ())
-> GenT
     (Reader [Name])
     (Type TyName DefaultUni ()
      -> Term TyName Name DefaultUni fun ()
      -> Term TyName Name DefaultUni fun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen (Type TyName DefaultUni ())
genType GenT
  (Reader [Name])
  (Type TyName DefaultUni ()
   -> Term TyName Name DefaultUni fun ()
   -> Term TyName Name DefaultUni fun ())
-> AstGen (Type TyName DefaultUni ())
-> GenT
     (Reader [Name])
     (Term TyName Name DefaultUni fun ()
      -> Term TyName Name DefaultUni fun ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AstGen (Type TyName DefaultUni ())
genType GenT
  (Reader [Name])
  (Term TyName Name DefaultUni fun ()
   -> Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term TyName Name DefaultUni fun ())
genTerm
    errorGen :: GenT (Reader [Name]) (Term TyName name DefaultUni fun ())
errorGen = ()
-> Type TyName DefaultUni () -> Term TyName name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann -> Type tyname uni ann -> Term tyname name uni fun ann
Error () (Type TyName DefaultUni () -> Term TyName name DefaultUni fun ())
-> AstGen (Type TyName DefaultUni ())
-> GenT (Reader [Name]) (Term TyName name DefaultUni fun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen (Type TyName DefaultUni ())
genType
    constrGen :: GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
constrGen = ()
-> Type TyName DefaultUni ()
-> Word64
-> [Term TyName Name DefaultUni fun ()]
-> Term TyName Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann
-> Type tyname uni ann
-> Word64
-> [Term tyname name uni fun ann]
-> Term tyname name uni fun ann
Constr () (Type TyName DefaultUni ()
 -> Word64
 -> [Term TyName Name DefaultUni fun ()]
 -> Term TyName Name DefaultUni fun ())
-> AstGen (Type TyName DefaultUni ())
-> GenT
     (Reader [Name])
     (Word64
      -> [Term TyName Name DefaultUni fun ()]
      -> Term TyName Name DefaultUni fun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen (Type TyName DefaultUni ())
genType GenT
  (Reader [Name])
  (Word64
   -> [Term TyName Name DefaultUni fun ()]
   -> Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) Word64
-> GenT
     (Reader [Name])
     ([Term TyName Name DefaultUni fun ()]
      -> Term TyName Name DefaultUni fun ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Word64 -> GenT (Reader [Name]) Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 (Word64 -> Word64 -> Range Word64
forall a. Integral a => a -> a -> Range a
Range.linear Word64
0 Word64
10) GenT
  (Reader [Name])
  ([Term TyName Name DefaultUni fun ()]
   -> Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) [Term TyName Name DefaultUni fun ()]
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) [Term TyName Name DefaultUni fun ()]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10) GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term TyName Name DefaultUni fun ())
genTerm
    caseGen :: GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
caseGen = ()
-> Type TyName DefaultUni ()
-> Term TyName Name DefaultUni fun ()
-> [Term TyName Name DefaultUni fun ()]
-> Term TyName Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann
-> Type tyname uni ann
-> Term tyname name uni fun ann
-> [Term tyname name uni fun ann]
-> Term tyname name uni fun ann
Case () (Type TyName DefaultUni ()
 -> Term TyName Name DefaultUni fun ()
 -> [Term TyName Name DefaultUni fun ()]
 -> Term TyName Name DefaultUni fun ())
-> AstGen (Type TyName DefaultUni ())
-> GenT
     (Reader [Name])
     (Term TyName Name DefaultUni fun ()
      -> [Term TyName Name DefaultUni fun ()]
      -> Term TyName Name DefaultUni fun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen (Type TyName DefaultUni ())
genType GenT
  (Reader [Name])
  (Term TyName Name DefaultUni fun ()
   -> [Term TyName Name DefaultUni fun ()]
   -> Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
-> GenT
     (Reader [Name])
     ([Term TyName Name DefaultUni fun ()]
      -> Term TyName Name DefaultUni fun ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term TyName Name DefaultUni fun ())
genTerm GenT
  (Reader [Name])
  ([Term TyName Name DefaultUni fun ()]
   -> Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) [Term TyName Name DefaultUni fun ()]
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) [Term TyName Name DefaultUni fun ()]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10) GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term TyName Name DefaultUni fun ())
genTerm
    recursive :: [GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())]
recursive = [GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
absGen, GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
instGen, GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
lamGen, GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
applyGen, GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
unwrapGen, GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
wrapGen, GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
constrGen, GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
caseGen]
    nonRecursive :: [GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())]
nonRecursive = [GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall {tyname} {uni :: * -> *} {fun}.
GenT (Reader [Name]) (Term tyname Name uni fun ())
varGen, ()
-> Some (ValueOf DefaultUni) -> Term TyName Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann -> Some (ValueOf uni) -> Term tyname name uni fun ann
Constant () (Some (ValueOf DefaultUni) -> Term TyName Name DefaultUni fun ())
-> AstGen (Some (ValueOf DefaultUni))
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstGen (Some (ValueOf DefaultUni))
genConstant, () -> fun -> Term TyName Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann -> fun -> Term tyname name uni fun ann
Builtin () (fun -> Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) fun
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT (Reader [Name]) fun
forall fun. (Bounded fun, Enum fun) => AstGen fun
genBuiltin, GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall {name} {fun}.
GenT (Reader [Name]) (Term TyName name DefaultUni fun ())
errorGen]

genProgram :: forall fun. (Bounded fun, Enum fun) => AstGen (Program TyName Name DefaultUni fun ())
genProgram :: forall fun.
(Bounded fun, Enum fun) =>
AstGen (Program TyName Name DefaultUni fun ())
genProgram = ()
-> Version
-> Term TyName Name DefaultUni fun ()
-> Program TyName Name DefaultUni fun ()
forall tyname name (uni :: * -> *) fun ann.
ann
-> Version
-> Term tyname name uni fun ann
-> Program tyname name uni fun ann
Program () (Version
 -> Term TyName Name DefaultUni fun ()
 -> Program TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) Version
-> GenT
     (Reader [Name])
     (Term TyName Name DefaultUni fun ()
      -> Program TyName Name DefaultUni fun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT (Reader [Name]) Version
forall (m :: * -> *). MonadGen m => m Version
genVersion GenT
  (Reader [Name])
  (Term TyName Name DefaultUni fun ()
   -> Program TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
-> GenT (Reader [Name]) (Program TyName Name DefaultUni fun ())
forall a b.
GenT (Reader [Name]) (a -> b)
-> GenT (Reader [Name]) a -> GenT (Reader [Name]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT (Reader [Name]) (Term TyName Name DefaultUni fun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Term TyName Name DefaultUni fun ())
genTerm

{- Note [Name mangling]
We want to test that turning a term into a distinct one results in a failed equality check.
For this we keep the spine of the term the same, but change some of its variables at their
usage sites. Variables that are going to be changed are selected before the mangling happens,
so that this subset of term's variables can be easily controlled and is dependent on the size
parameter of the generator. Once variables are selected, the next step is to generate some new
variables none of which is a member of the set of variables prepared for mangling (but the new
variables are allowed to overlap with those that the term already contains and that are not
going to be mangled). The last step is to actually mangle the term by replacing /each usage
of a variable/ from the prepared set of variables with a /random/ variable from the set of new
variables. This way we get diverse and interesting mangled terms.
-}

subset1 :: (MonadGen m, Ord a) => Set a -> m (Maybe (Set a))
subset1 :: forall (m :: * -> *) a.
(MonadGen m, Ord a) =>
Set a -> m (Maybe (Set a))
subset1 Set a
s
    | [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs   = Maybe (Set a) -> m (Maybe (Set a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Set a)
forall a. Maybe a
Nothing
    | Bool
otherwise = ([a] -> Maybe (Set a)) -> m [a] -> m (Maybe (Set a))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set a -> Maybe (Set a)
forall a. a -> Maybe a
Just (Set a -> Maybe (Set a)) -> ([a] -> Set a) -> [a] -> Maybe (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList) (m [a] -> m (Maybe (Set a))) -> m [a] -> m (Maybe (Set a))
forall a b. (a -> b) -> a -> b
$ (:) (a -> [a] -> [a]) -> m a -> m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> m a
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element [a]
xs m ([a] -> [a]) -> m [a] -> m [a]
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> m [a]
forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
Gen.subsequence [a]
xs
    where xs :: [a]
xs = Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
s

substAllNames
    :: Monad m
    => (Name -> m (Maybe Name))
    -> Term TyName Name DefaultUni DefaultFun ()
    -> m (Term TyName Name DefaultUni DefaultFun ())
substAllNames :: forall (m :: * -> *).
Monad m =>
(Name -> m (Maybe Name))
-> Term TyName Name DefaultUni DefaultFun ()
-> m (Term TyName Name DefaultUni DefaultFun ())
substAllNames Name -> m (Maybe Name)
ren =
    (Name -> m (Maybe (Term TyName Name DefaultUni DefaultFun ())))
-> Term TyName Name DefaultUni DefaultFun ()
-> m (Term TyName Name DefaultUni DefaultFun ())
forall (m :: * -> *) name tyname (uni :: * -> *) fun ann.
Monad m =>
(name -> m (Maybe (Term tyname name uni fun ann)))
-> Term tyname name uni fun ann -> m (Term tyname name uni fun ann)
termSubstNamesM ((Maybe Name -> Maybe (Term TyName Name DefaultUni DefaultFun ()))
-> m (Maybe Name)
-> m (Maybe (Term TyName Name DefaultUni DefaultFun ()))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Name -> Term TyName Name DefaultUni DefaultFun ())
-> Maybe Name -> Maybe (Term TyName Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Name -> Term TyName Name DefaultUni DefaultFun ())
 -> Maybe Name -> Maybe (Term TyName Name DefaultUni DefaultFun ()))
-> (Name -> Term TyName Name DefaultUni DefaultFun ())
-> Maybe Name
-> Maybe (Term TyName Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ () -> Name -> Term TyName Name DefaultUni DefaultFun ()
forall tyname name (uni :: * -> *) fun ann.
ann -> name -> Term tyname name uni fun ann
Var ()) (m (Maybe Name)
 -> m (Maybe (Term TyName Name DefaultUni DefaultFun ())))
-> (Name -> m (Maybe Name))
-> Name
-> m (Maybe (Term TyName Name DefaultUni DefaultFun ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> m (Maybe Name)
ren) (Term TyName Name DefaultUni DefaultFun ()
 -> m (Term TyName Name DefaultUni DefaultFun ()))
-> (Term TyName Name DefaultUni DefaultFun ()
    -> m (Term TyName Name DefaultUni DefaultFun ()))
-> Term TyName Name DefaultUni DefaultFun ()
-> m (Term TyName Name DefaultUni DefaultFun ())
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
    (TyName -> m (Maybe (Type TyName DefaultUni ())))
-> Term TyName Name DefaultUni DefaultFun ()
-> m (Term TyName Name DefaultUni DefaultFun ())
forall (m :: * -> *) tyname (uni :: * -> *) ann name fun.
Monad m =>
(tyname -> m (Maybe (Type tyname uni ann)))
-> Term tyname name uni fun ann -> m (Term tyname name uni fun ann)
termSubstTyNamesM ((Maybe Name -> Maybe (Type TyName DefaultUni ()))
-> m (Maybe Name) -> m (Maybe (Type TyName DefaultUni ()))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Name -> Type TyName DefaultUni ())
-> Maybe Name -> Maybe (Type TyName DefaultUni ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Name -> Type TyName DefaultUni ())
 -> Maybe Name -> Maybe (Type TyName DefaultUni ()))
-> (Name -> Type TyName DefaultUni ())
-> Maybe Name
-> Maybe (Type TyName DefaultUni ())
forall a b. (a -> b) -> a -> b
$ () -> TyName -> Type TyName DefaultUni ()
forall tyname (uni :: * -> *) ann.
ann -> tyname -> Type tyname uni ann
TyVar () (TyName -> Type TyName DefaultUni ())
-> (Name -> TyName) -> Name -> Type TyName DefaultUni ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TyName
TyName) (m (Maybe Name) -> m (Maybe (Type TyName DefaultUni ())))
-> (TyName -> m (Maybe Name))
-> TyName
-> m (Maybe (Type TyName DefaultUni ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> m (Maybe Name)
ren (Name -> m (Maybe Name))
-> (TyName -> Name) -> TyName -> m (Maybe Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyName -> Name
unTyName)

-- See Note [ScopeHandling].
allTermNames :: Term TyName Name DefaultUni DefaultFun () -> Set Name
allTermNames :: Term TyName Name DefaultUni DefaultFun () -> Set Name
allTermNames = Getting (Set Name) (Term TyName Name DefaultUni DefaultFun ()) Name
-> Term TyName Name DefaultUni DefaultFun () -> Set Name
forall a s. Getting (Set a) s a -> s -> Set a
setOf ((Name -> f Name)
-> Term TyName Name DefaultUni DefaultFun ()
-> f (Term TyName Name DefaultUni DefaultFun ())
forall tyname name (uni :: * -> *) fun ann (f :: * -> *).
(Contravariant f, Applicative f) =>
(name -> f name)
-> Term tyname name uni fun ann -> f (Term tyname name uni fun ann)
forall {f :: * -> *}.
(Contravariant f, Applicative f) =>
(Name -> f Name)
-> Term TyName Name DefaultUni DefaultFun ()
-> f (Term TyName Name DefaultUni DefaultFun ())
vTerm (forall {f :: * -> *}.
 (Contravariant f, Applicative f) =>
 (Name -> f Name)
 -> Term TyName Name DefaultUni DefaultFun ()
 -> f (Term TyName Name DefaultUni DefaultFun ()))
-> (forall {f :: * -> *}.
    (Contravariant f, Applicative f) =>
    (Name -> f Name)
    -> Term TyName Name DefaultUni DefaultFun ()
    -> f (Term TyName Name DefaultUni DefaultFun ()))
-> forall {f :: * -> *}.
   (Contravariant f, Applicative f) =>
   (Name -> f Name)
   -> Term TyName Name DefaultUni DefaultFun ()
   -> f (Term TyName Name DefaultUni DefaultFun ())
forall s a. Fold s a -> Fold s a -> Fold s a
<^> (TyName -> f TyName)
-> Term TyName Name DefaultUni DefaultFun ()
-> f (Term TyName Name DefaultUni DefaultFun ())
forall tyname name (uni :: * -> *) fun ann (f :: * -> *).
(Contravariant f, Applicative f) =>
(tyname -> f tyname)
-> Term tyname name uni fun ann -> f (Term tyname name uni fun ann)
tvTerm ((TyName -> f TyName)
 -> Term TyName Name DefaultUni DefaultFun ()
 -> f (Term TyName Name DefaultUni DefaultFun ()))
-> ((Name -> f Name) -> TyName -> f TyName)
-> (Name -> f Name)
-> Term TyName Name DefaultUni DefaultFun ()
-> f (Term TyName Name DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> f Name) -> TyName -> f TyName
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso TyName TyName Name Name
coerced)

-- See Note [Name mangling]
mangleNames :: Term TyName Name DefaultUni DefaultFun () -> AstGen (Maybe (Term TyName Name DefaultUni DefaultFun ()))
mangleNames :: Term TyName Name DefaultUni DefaultFun ()
-> AstGen (Maybe (Term TyName Name DefaultUni DefaultFun ()))
mangleNames Term TyName Name DefaultUni DefaultFun ()
term = do
    let names :: Set Name
names = Term TyName Name DefaultUni DefaultFun () -> Set Name
allTermNames Term TyName Name DefaultUni DefaultFun ()
term
    Maybe (Set Name)
mayNamesMangle <- Set Name -> GenT (Reader [Name]) (Maybe (Set Name))
forall (m :: * -> *) a.
(MonadGen m, Ord a) =>
Set a -> m (Maybe (Set a))
subset1 Set Name
names
    Maybe (Set Name)
-> (Set Name
    -> GenT
         (Reader [Name]) (Term TyName Name DefaultUni DefaultFun ()))
-> AstGen (Maybe (Term TyName Name DefaultUni DefaultFun ()))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (Set Name)
mayNamesMangle ((Set Name
  -> GenT
       (Reader [Name]) (Term TyName Name DefaultUni DefaultFun ()))
 -> AstGen (Maybe (Term TyName Name DefaultUni DefaultFun ())))
-> (Set Name
    -> GenT
         (Reader [Name]) (Term TyName Name DefaultUni DefaultFun ()))
-> AstGen (Maybe (Term TyName Name DefaultUni DefaultFun ()))
forall a b. (a -> b) -> a -> b
$ \Set Name
namesMangle -> do
        let isNew :: Name -> Bool
isNew Name
name = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Name
name Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Name
namesMangle
        [Name]
newNames <- GenT (Reader [Name]) (Maybe [Name]) -> GenT (Reader [Name]) [Name]
forall (m :: * -> *) a. MonadGen m => m (Maybe a) -> m a
Gen.justT (GenT (Reader [Name]) (Maybe [Name])
 -> GenT (Reader [Name]) [Name])
-> GenT (Reader [Name]) (Maybe [Name])
-> GenT (Reader [Name]) [Name]
forall a b. (a -> b) -> a -> b
$ ([Name] -> Bool) -> [Name] -> Maybe [Name]
forall (f :: * -> *) a. Alternative f => (a -> Bool) -> a -> f a
ensure (Bool -> Bool
not (Bool -> Bool) -> ([Name] -> Bool) -> [Name] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([Name] -> Maybe [Name])
-> ([Name] -> [Name]) -> [Name] -> Maybe [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
isNew ([Name] -> Maybe [Name])
-> GenT (Reader [Name]) [Name]
-> GenT (Reader [Name]) (Maybe [Name])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT (Reader [Name]) [Name]
forall (m :: * -> *). MonadGen m => m [Name]
genNames
        let mang :: Name -> f (Maybe Name)
mang Name
name
                | Name
name Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Name
namesMangle = Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> f Name -> f (Maybe Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name] -> f Name
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element [Name]
newNames
                | Bool
otherwise                     = Maybe Name -> f (Maybe Name)
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing
        (Name -> GenT (Reader [Name]) (Maybe Name))
-> Term TyName Name DefaultUni DefaultFun ()
-> GenT (Reader [Name]) (Term TyName Name DefaultUni DefaultFun ())
forall (m :: * -> *).
Monad m =>
(Name -> m (Maybe Name))
-> Term TyName Name DefaultUni DefaultFun ()
-> m (Term TyName Name DefaultUni DefaultFun ())
substAllNames Name -> GenT (Reader [Name]) (Maybe Name)
forall {f :: * -> *}. MonadGen f => Name -> f (Maybe Name)
mang Term TyName Name DefaultUni DefaultFun ()
term