{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, DeriveLift, RankNTypes,
ScopedTypeVariables, TupleSections, AllowAmbiguousTypes,
TemplateHaskellQuotes, TypeApplications, MagicHash #-}
module Language.Haskell.TH.Desugar.Util (
newUniqueName,
impossible,
nameOccursIn, allNamesIn, mkTypeName, mkDataName, mkNameWith, isDataName,
stripVarP_maybe, extractBoundNamesStmt,
concatMapM, mapAccumLM, mapMaybeM, expectJustM,
stripPlainTV_maybe, extractTvbKind_maybe,
thirdOf3, splitAtList, extractBoundNamesDec,
extractBoundNamesPat,
tvbToType, tvbToTypeWithSig,
nameMatches, thdOf3, liftFst, liftSnd, firstMatch, firstMatchM,
tupleNameDegree_maybe,
unboxedSumNameDegree_maybe, unboxedTupleNameDegree_maybe, splitTuple_maybe,
topEverywhereM, isInfixDataCon,
isTypeKindName, typeKindName,
unSigType, unfoldType, ForallTelescope(..), FunArgs(..), VisFunArg(..),
filterVisFunArgs, ravelType, unravelType,
TypeArg(..), applyType, filterTANormals, probablyWrongUnTypeArg,
tyVarBndrVisToTypeArg, tyVarBndrVisToTypeArgWithSig,
bindIP,
DataFlavor(..),
freeKindVariablesWellScoped,
ForAllTyFlag(..), tvbForAllTyFlagsToSpecs, tvbForAllTyFlagsToBndrVis,
matchUpSAKWithDecl
) where
import Prelude hiding (mapM, foldl, concatMap, any)
import Language.Haskell.TH hiding ( cxt )
import Language.Haskell.TH.Datatype
import Language.Haskell.TH.Datatype.TyVarBndr
import qualified Language.Haskell.TH.Desugar.OSet as OS
import Language.Haskell.TH.Desugar.OSet (OSet)
import Language.Haskell.TH.Instances ()
import Language.Haskell.TH.Syntax
import qualified Control.Monad.Fail as Fail
import Data.Foldable
import Data.Function ( on )
import Data.Generics ( Data, Typeable, everything, extM, gmapM, mkQ )
import qualified Data.Kind as Kind
import qualified Data.List as List
import qualified Data.Map as Map
import Data.Map ( Map )
import Data.Maybe
import qualified Data.Set as Set
import Data.Traversable
import GHC.Classes ( IP )
import GHC.Generics ( Generic )
import Unsafe.Coerce ( unsafeCoerce )
#if __GLASGOW_HASKELL__ >= 900
import Language.Haskell.TH.Ppr ( PprFlag(..) )
import qualified Language.Haskell.TH.PprLib as Ppr
#endif
#if __GLASGOW_HASKELL__ >= 906
import GHC.Tuple ( Solo(MkSolo) )
#elif __GLASGOW_HASKELL__ >= 900
import GHC.Tuple ( Solo(Solo) )
#endif
#if __GLASGOW_HASKELL__ >= 908
import GHC.Tuple ( Tuple0, Unit )
import Text.Read ( readMaybe )
#endif
#if __GLASGOW_HASKELL__ >= 910
import GHC.Types ( Solo#, Sum2#, Tuple0#, Unit# )
#endif
newUniqueName :: Quasi q => String -> q Name
newUniqueName :: forall (q :: * -> *). Quasi q => String -> q Name
newUniqueName String
str = do
Name
n <- String -> q Name
forall (q :: * -> *). Quasi q => String -> q Name
qNewName String
str
String -> q Name
forall (q :: * -> *). Quasi q => String -> q Name
qNewName (String -> q Name) -> String -> q Name
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Show a => a -> String
show Name
n
mkNameWith :: Quasi q => (String -> q (Maybe Name))
-> (String -> String -> String -> Name)
-> String -> q Name
mkNameWith :: forall (q :: * -> *).
Quasi q =>
(String -> q (Maybe Name))
-> (String -> String -> String -> Name) -> String -> q Name
mkNameWith String -> q (Maybe Name)
lookup_fun String -> String -> String -> Name
mkName_fun String
str = do
Maybe Name
m_name <- String -> q (Maybe Name)
lookup_fun String
str
case Maybe Name
m_name of
Just Name
name -> Name -> q Name
forall a. a -> q a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
Maybe Name
Nothing -> do
Loc { loc_package :: Loc -> String
loc_package = String
pkg, loc_module :: Loc -> String
loc_module = String
modu } <- q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
Name -> q Name
forall a. a -> q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> q Name) -> Name -> q Name
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> Name
mkName_fun String
pkg String
modu String
str
mkTypeName :: Quasi q => String -> q Name
mkTypeName :: forall (q :: * -> *). Quasi q => String -> q Name
mkTypeName = (String -> q (Maybe Name))
-> (String -> String -> String -> Name) -> String -> q Name
forall (q :: * -> *).
Quasi q =>
(String -> q (Maybe Name))
-> (String -> String -> String -> Name) -> String -> q Name
mkNameWith (Bool -> String -> q (Maybe Name)
forall (m :: * -> *). Quasi m => Bool -> String -> m (Maybe Name)
qLookupName Bool
True) String -> String -> String -> Name
mkNameG_tc
mkDataName :: Quasi q => String -> q Name
mkDataName :: forall (q :: * -> *). Quasi q => String -> q Name
mkDataName = (String -> q (Maybe Name))
-> (String -> String -> String -> Name) -> String -> q Name
forall (q :: * -> *).
Quasi q =>
(String -> q (Maybe Name))
-> (String -> String -> String -> Name) -> String -> q Name
mkNameWith (Bool -> String -> q (Maybe Name)
forall (m :: * -> *). Quasi m => Bool -> String -> m (Maybe Name)
qLookupName Bool
False) String -> String -> String -> Name
mkNameG_d
isDataName :: Name -> Bool
isDataName :: Name -> Bool
isDataName (Name OccName
_ (NameG NameSpace
DataName PkgName
_ ModName
_)) = Bool
True
isDataName Name
_ = Bool
False
stripVarP_maybe :: Pat -> Maybe Name
stripVarP_maybe :: Pat -> Maybe Name
stripVarP_maybe (VarP Name
name) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
name
stripVarP_maybe Pat
_ = Maybe Name
forall a. Maybe a
Nothing
stripPlainTV_maybe :: TyVarBndr_ flag -> Maybe Name
stripPlainTV_maybe :: forall flag. TyVarBndr_ flag -> Maybe Name
stripPlainTV_maybe = (Name -> Maybe Name)
-> (Name -> Kind -> Maybe Name) -> TyVarBndr_ flag -> Maybe Name
forall r flag.
(Name -> r) -> (Name -> Kind -> r) -> TyVarBndr_ flag -> r
elimTV Name -> Maybe Name
forall a. a -> Maybe a
Just (\Name
_ Kind
_ -> Maybe Name
forall a. Maybe a
Nothing)
extractTvbKind_maybe :: TyVarBndr_ flag -> Maybe Kind
= (Name -> Maybe Kind)
-> (Name -> Kind -> Maybe Kind) -> TyVarBndr_ flag -> Maybe Kind
forall r flag.
(Name -> r) -> (Name -> Kind -> r) -> TyVarBndr_ flag -> r
elimTV (\Name
_ -> Maybe Kind
forall a. Maybe a
Nothing) (\Name
_ Kind
k -> Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
k)
impossible :: Fail.MonadFail q => String -> q a
impossible :: forall (q :: * -> *) a. MonadFail q => String -> q a
impossible String
err = String -> q a
forall a. String -> q a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n This should not happen in Haskell.\n Please email rae@cs.brynmawr.edu with your code if you see this.")
tvbToType :: TyVarBndr_ flag -> Type
tvbToType :: forall flag. TyVarBndr_ flag -> Kind
tvbToType = Name -> Kind
VarT (Name -> Kind)
-> (TyVarBndr_ flag -> Name) -> TyVarBndr_ flag -> Kind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVarBndr_ flag -> Name
forall flag. TyVarBndr_ flag -> Name
tvName
tvbToTypeWithSig :: TyVarBndr_ flag -> Type
tvbToTypeWithSig :: forall flag. TyVarBndr_ flag -> Kind
tvbToTypeWithSig = (Name -> Kind) -> (Name -> Kind -> Kind) -> TyVarBndr_ flag -> Kind
forall r flag.
(Name -> r) -> (Name -> Kind -> r) -> TyVarBndr_ flag -> r
elimTV Name -> Kind
VarT (\Name
n Kind
k -> Kind -> Kind -> Kind
SigT (Name -> Kind
VarT Name
n) Kind
k)
nameMatches :: Name -> Name -> Bool
nameMatches :: Name -> Name -> Bool
nameMatches n1 :: Name
n1@(Name OccName
occ1 NameFlavour
flav1) n2 :: Name
n2@(Name OccName
occ2 NameFlavour
flav2)
| NameFlavour
NameS <- NameFlavour
flav1 = OccName
occ1 OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== OccName
occ2
| NameFlavour
NameS <- NameFlavour
flav2 = OccName
occ1 OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== OccName
occ2
| NameQ ModName
mod1 <- NameFlavour
flav1
, NameQ ModName
mod2 <- NameFlavour
flav2
= ModName
mod1 ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
== ModName
mod2 Bool -> Bool -> Bool
&& OccName
occ1 OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== OccName
occ2
| NameQ ModName
mod1 <- NameFlavour
flav1
, NameG NameSpace
_ PkgName
_ ModName
mod2 <- NameFlavour
flav2
= ModName
mod1 ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
== ModName
mod2 Bool -> Bool -> Bool
&& OccName
occ1 OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== OccName
occ2
| NameG NameSpace
_ PkgName
_ ModName
mod1 <- NameFlavour
flav1
, NameQ ModName
mod2 <- NameFlavour
flav2
= ModName
mod1 ModName -> ModName -> Bool
forall a. Eq a => a -> a -> Bool
== ModName
mod2 Bool -> Bool -> Bool
&& OccName
occ1 OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== OccName
occ2
| Bool
otherwise
= Name
n1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n2
tupleNameDegree_maybe :: Name -> Maybe Int
tupleNameDegree_maybe :: Name -> Maybe Int
tupleNameDegree_maybe Name
name
#if __GLASGOW_HASKELL__ >= 900
| Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''Solo = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
#if __GLASGOW_HASKELL__ >= 906
| Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== 'MkSolo = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
#else
| name == 'Solo = Just 1
#endif
#endif
#if __GLASGOW_HASKELL__ >= 908
| name == ''Unit = Just 0
|
namePackage name == namePackage ''Tuple0
, nameModule name == nameModule ''Tuple0
, 'T':'u':'p':'l':'e':n <- nameBase name
= readMaybe n
#endif
| Bool
otherwise
= String -> Maybe Int
tuple_syntax_degree_maybe (Name -> String
nameBase Name
name)
where
tuple_syntax_degree_maybe :: String -> Maybe Int
tuple_syntax_degree_maybe :: String -> Maybe Int
tuple_syntax_degree_maybe String
s = do
Char
'(' : String
s1 <- String -> Maybe String
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
(String
commas, String
")") <- (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, String) -> Maybe (String, String))
-> (String, String) -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') String
s1
let degree :: Int
degree
| String
"" <- String
commas = Int
0
| Bool
otherwise = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
commas Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
degree
unboxedSumDegree_maybe :: String -> Maybe Int
unboxedSumDegree_maybe :: String -> Maybe Int
unboxedSumDegree_maybe = Char -> String -> Maybe Int
unboxedSumTupleDegree_maybe Char
'|'
unboxedSumNameDegree_maybe :: Name -> Maybe Int
unboxedSumNameDegree_maybe :: Name -> Maybe Int
unboxedSumNameDegree_maybe Name
name
#if __GLASGOW_HASKELL__ >= 910
|
namePackage name == namePackage ''Sum2#
, nameModule name == nameModule ''Sum2#
, 'S':'u':'m':n:"#" <- nameBase name
= readMaybe [n]
#endif
| Bool
otherwise
= String -> Maybe Int
unboxedSumDegree_maybe (Name -> String
nameBase Name
name)
unboxedTupleDegree_maybe :: String -> Maybe Int
unboxedTupleDegree_maybe :: String -> Maybe Int
unboxedTupleDegree_maybe = Char -> String -> Maybe Int
unboxedSumTupleDegree_maybe Char
','
unboxedSumTupleDegree_maybe :: Char -> String -> Maybe Int
unboxedSumTupleDegree_maybe :: Char -> String -> Maybe Int
unboxedSumTupleDegree_maybe Char
sep String
s = do
Char
'(' : Char
'#' : String
s1 <- String -> Maybe String
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
(String
seps, String
"#)") <- (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, String) -> Maybe (String, String))
-> (String, String) -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
sep) String
s1
let degree :: Int
degree
| String
"" <- String
seps = Int
0
| Bool
otherwise = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
seps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Int -> Maybe Int
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
degree
unboxedTupleNameDegree_maybe :: Name -> Maybe Int
unboxedTupleNameDegree_maybe :: Name -> Maybe Int
unboxedTupleNameDegree_maybe Name
name
#if __GLASGOW_HASKELL__ >= 910
| name == ''Solo# = Just 1
| name == ''Unit# = Just 0
|
namePackage name == namePackage ''Tuple0#
, nameModule name == nameModule ''Tuple0#
, 'T':'u':'p':'l':'e':n:"#" <- nameBase name
= readMaybe [n]
#endif
| Bool
otherwise
= String -> Maybe Int
unboxedTupleDegree_maybe (Name -> String
nameBase Name
name)
splitTuple_maybe :: Type -> Maybe [Type]
splitTuple_maybe :: Kind -> Maybe [Kind]
splitTuple_maybe Kind
t = [Kind] -> Kind -> Maybe [Kind]
go [] Kind
t
where go :: [Kind] -> Kind -> Maybe [Kind]
go [Kind]
args (Kind
t1 `AppT` Kind
t2) = [Kind] -> Kind -> Maybe [Kind]
go (Kind
t2Kind -> [Kind] -> [Kind]
forall a. a -> [a] -> [a]
:[Kind]
args) Kind
t1
go [Kind]
args (Kind
t1 `SigT` Kind
_k) = [Kind] -> Kind -> Maybe [Kind]
go [Kind]
args Kind
t1
go [Kind]
args (ConT Name
con_name)
| Just Int
degree <- Name -> Maybe Int
tupleNameDegree_maybe Name
con_name
, [Kind] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
degree
= [Kind] -> Maybe [Kind]
forall a. a -> Maybe a
Just [Kind]
args
go [Kind]
args (TupleT Int
degree)
| [Kind] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
degree
= [Kind] -> Maybe [Kind]
forall a. a -> Maybe a
Just [Kind]
args
go [Kind]
_ Kind
_ = Maybe [Kind]
forall a. Maybe a
Nothing
data ForallTelescope
= ForallVis [TyVarBndrUnit]
| ForallInvis [TyVarBndrSpec]
deriving (ForallTelescope -> ForallTelescope -> Bool
(ForallTelescope -> ForallTelescope -> Bool)
-> (ForallTelescope -> ForallTelescope -> Bool)
-> Eq ForallTelescope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForallTelescope -> ForallTelescope -> Bool
== :: ForallTelescope -> ForallTelescope -> Bool
$c/= :: ForallTelescope -> ForallTelescope -> Bool
/= :: ForallTelescope -> ForallTelescope -> Bool
Eq, Int -> ForallTelescope -> String -> String
[ForallTelescope] -> String -> String
ForallTelescope -> String
(Int -> ForallTelescope -> String -> String)
-> (ForallTelescope -> String)
-> ([ForallTelescope] -> String -> String)
-> Show ForallTelescope
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ForallTelescope -> String -> String
showsPrec :: Int -> ForallTelescope -> String -> String
$cshow :: ForallTelescope -> String
show :: ForallTelescope -> String
$cshowList :: [ForallTelescope] -> String -> String
showList :: [ForallTelescope] -> String -> String
Show, Typeable ForallTelescope
Typeable ForallTelescope =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForallTelescope -> c ForallTelescope)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForallTelescope)
-> (ForallTelescope -> Constr)
-> (ForallTelescope -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForallTelescope))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForallTelescope))
-> ((forall b. Data b => b -> b)
-> ForallTelescope -> ForallTelescope)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r)
-> (forall u.
(forall d. Data d => d -> u) -> ForallTelescope -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> ForallTelescope -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope)
-> Data ForallTelescope
ForallTelescope -> Constr
ForallTelescope -> DataType
(forall b. Data b => b -> b) -> ForallTelescope -> ForallTelescope
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ForallTelescope -> u
forall u. (forall d. Data d => d -> u) -> ForallTelescope -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForallTelescope
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForallTelescope -> c ForallTelescope
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForallTelescope)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForallTelescope)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForallTelescope -> c ForallTelescope
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForallTelescope -> c ForallTelescope
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForallTelescope
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForallTelescope
$ctoConstr :: ForallTelescope -> Constr
toConstr :: ForallTelescope -> Constr
$cdataTypeOf :: ForallTelescope -> DataType
dataTypeOf :: ForallTelescope -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForallTelescope)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForallTelescope)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForallTelescope)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForallTelescope)
$cgmapT :: (forall b. Data b => b -> b) -> ForallTelescope -> ForallTelescope
gmapT :: (forall b. Data b => b -> b) -> ForallTelescope -> ForallTelescope
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForallTelescope -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ForallTelescope -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ForallTelescope -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ForallTelescope -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ForallTelescope -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ForallTelescope -> m ForallTelescope
Data)
data FunArgs
= FANil
| FAForalls ForallTelescope FunArgs
| FACxt Cxt FunArgs
| FAAnon Type FunArgs
deriving (FunArgs -> FunArgs -> Bool
(FunArgs -> FunArgs -> Bool)
-> (FunArgs -> FunArgs -> Bool) -> Eq FunArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FunArgs -> FunArgs -> Bool
== :: FunArgs -> FunArgs -> Bool
$c/= :: FunArgs -> FunArgs -> Bool
/= :: FunArgs -> FunArgs -> Bool
Eq, Int -> FunArgs -> String -> String
[FunArgs] -> String -> String
FunArgs -> String
(Int -> FunArgs -> String -> String)
-> (FunArgs -> String)
-> ([FunArgs] -> String -> String)
-> Show FunArgs
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> FunArgs -> String -> String
showsPrec :: Int -> FunArgs -> String -> String
$cshow :: FunArgs -> String
show :: FunArgs -> String
$cshowList :: [FunArgs] -> String -> String
showList :: [FunArgs] -> String -> String
Show, Typeable FunArgs
Typeable FunArgs =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunArgs -> c FunArgs)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunArgs)
-> (FunArgs -> Constr)
-> (FunArgs -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunArgs))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FunArgs))
-> ((forall b. Data b => b -> b) -> FunArgs -> FunArgs)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r)
-> (forall u. (forall d. Data d => d -> u) -> FunArgs -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> FunArgs -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs)
-> Data FunArgs
FunArgs -> Constr
FunArgs -> DataType
(forall b. Data b => b -> b) -> FunArgs -> FunArgs
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FunArgs -> u
forall u. (forall d. Data d => d -> u) -> FunArgs -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunArgs
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunArgs -> c FunArgs
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunArgs)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FunArgs)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunArgs -> c FunArgs
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunArgs -> c FunArgs
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunArgs
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunArgs
$ctoConstr :: FunArgs -> Constr
toConstr :: FunArgs -> Constr
$cdataTypeOf :: FunArgs -> DataType
dataTypeOf :: FunArgs -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunArgs)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunArgs)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FunArgs)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FunArgs)
$cgmapT :: (forall b. Data b => b -> b) -> FunArgs -> FunArgs
gmapT :: (forall b. Data b => b -> b) -> FunArgs -> FunArgs
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunArgs -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FunArgs -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FunArgs -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FunArgs -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FunArgs -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunArgs -> m FunArgs
Data)
data VisFunArg
= VisFADep TyVarBndrUnit
| VisFAAnon Type
deriving (VisFunArg -> VisFunArg -> Bool
(VisFunArg -> VisFunArg -> Bool)
-> (VisFunArg -> VisFunArg -> Bool) -> Eq VisFunArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VisFunArg -> VisFunArg -> Bool
== :: VisFunArg -> VisFunArg -> Bool
$c/= :: VisFunArg -> VisFunArg -> Bool
/= :: VisFunArg -> VisFunArg -> Bool
Eq, Int -> VisFunArg -> String -> String
[VisFunArg] -> String -> String
VisFunArg -> String
(Int -> VisFunArg -> String -> String)
-> (VisFunArg -> String)
-> ([VisFunArg] -> String -> String)
-> Show VisFunArg
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> VisFunArg -> String -> String
showsPrec :: Int -> VisFunArg -> String -> String
$cshow :: VisFunArg -> String
show :: VisFunArg -> String
$cshowList :: [VisFunArg] -> String -> String
showList :: [VisFunArg] -> String -> String
Show, Typeable VisFunArg
Typeable VisFunArg =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VisFunArg -> c VisFunArg)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VisFunArg)
-> (VisFunArg -> Constr)
-> (VisFunArg -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VisFunArg))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VisFunArg))
-> ((forall b. Data b => b -> b) -> VisFunArg -> VisFunArg)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r)
-> (forall u. (forall d. Data d => d -> u) -> VisFunArg -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> VisFunArg -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg)
-> Data VisFunArg
VisFunArg -> Constr
VisFunArg -> DataType
(forall b. Data b => b -> b) -> VisFunArg -> VisFunArg
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> VisFunArg -> u
forall u. (forall d. Data d => d -> u) -> VisFunArg -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VisFunArg
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VisFunArg -> c VisFunArg
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VisFunArg)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VisFunArg)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VisFunArg -> c VisFunArg
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> VisFunArg -> c VisFunArg
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VisFunArg
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c VisFunArg
$ctoConstr :: VisFunArg -> Constr
toConstr :: VisFunArg -> Constr
$cdataTypeOf :: VisFunArg -> DataType
dataTypeOf :: VisFunArg -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VisFunArg)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c VisFunArg)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VisFunArg)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c VisFunArg)
$cgmapT :: (forall b. Data b => b -> b) -> VisFunArg -> VisFunArg
gmapT :: (forall b. Data b => b -> b) -> VisFunArg -> VisFunArg
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> VisFunArg -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> VisFunArg -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> VisFunArg -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> VisFunArg -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> VisFunArg -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> VisFunArg -> m VisFunArg
Data)
filterVisFunArgs :: FunArgs -> [VisFunArg]
filterVisFunArgs :: FunArgs -> [VisFunArg]
filterVisFunArgs FunArgs
FANil = []
filterVisFunArgs (FAForalls ForallTelescope
tele FunArgs
args) =
case ForallTelescope
tele of
ForallVis [TyVarBndrUnit]
tvbs -> (TyVarBndrUnit -> VisFunArg) -> [TyVarBndrUnit] -> [VisFunArg]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndrUnit -> VisFunArg
VisFADep [TyVarBndrUnit]
tvbs [VisFunArg] -> [VisFunArg] -> [VisFunArg]
forall a. [a] -> [a] -> [a]
++ [VisFunArg]
args'
ForallInvis [TyVarBndrSpec]
_ -> [VisFunArg]
args'
where
args' :: [VisFunArg]
args' = FunArgs -> [VisFunArg]
filterVisFunArgs FunArgs
args
filterVisFunArgs (FACxt [Kind]
_ FunArgs
args) =
FunArgs -> [VisFunArg]
filterVisFunArgs FunArgs
args
filterVisFunArgs (FAAnon Kind
t FunArgs
args) =
Kind -> VisFunArg
VisFAAnon Kind
tVisFunArg -> [VisFunArg] -> [VisFunArg]
forall a. a -> [a] -> [a]
:FunArgs -> [VisFunArg]
filterVisFunArgs FunArgs
args
ravelType :: FunArgs -> Type -> Type
ravelType :: FunArgs -> Kind -> Kind
ravelType FunArgs
FANil Kind
res = Kind
res
ravelType (FAForalls (ForallInvis [TyVarBndrSpec]
tvbs) (FACxt [Kind]
p FunArgs
args)) Kind
res =
[TyVarBndrSpec] -> [Kind] -> Kind -> Kind
ForallT [TyVarBndrSpec]
tvbs [Kind]
p (FunArgs -> Kind -> Kind
ravelType FunArgs
args Kind
res)
ravelType (FAForalls (ForallInvis [TyVarBndrSpec]
tvbs) FunArgs
args) Kind
res = [TyVarBndrSpec] -> [Kind] -> Kind -> Kind
ForallT [TyVarBndrSpec]
tvbs [] (FunArgs -> Kind -> Kind
ravelType FunArgs
args Kind
res)
ravelType (FAForalls (ForallVis [TyVarBndrUnit]
_tvbs) FunArgs
_args) Kind
_res =
#if __GLASGOW_HASKELL__ >= 809
[TyVarBndrUnit] -> Kind -> Kind
ForallVisT [TyVarBndrUnit]
_tvbs (FunArgs -> Kind -> Kind
ravelType FunArgs
_args Kind
_res)
#else
error "Visible dependent quantification supported only on GHC 8.10+"
#endif
ravelType (FACxt [Kind]
cxt FunArgs
args) Kind
res = [TyVarBndrSpec] -> [Kind] -> Kind -> Kind
ForallT [] [Kind]
cxt (FunArgs -> Kind -> Kind
ravelType FunArgs
args Kind
res)
ravelType (FAAnon Kind
t FunArgs
args) Kind
res = Kind -> Kind -> Kind
AppT (Kind -> Kind -> Kind
AppT Kind
ArrowT Kind
t) (FunArgs -> Kind -> Kind
ravelType FunArgs
args Kind
res)
unravelType :: Type -> (FunArgs, Type)
unravelType :: Kind -> (FunArgs, Kind)
unravelType (ForallT [TyVarBndrSpec]
tvbs [Kind]
cxt Kind
ty) =
let (FunArgs
args, Kind
res) = Kind -> (FunArgs, Kind)
unravelType Kind
ty in
(ForallTelescope -> FunArgs -> FunArgs
FAForalls ([TyVarBndrSpec] -> ForallTelescope
ForallInvis [TyVarBndrSpec]
tvbs) ([Kind] -> FunArgs -> FunArgs
FACxt [Kind]
cxt FunArgs
args), Kind
res)
unravelType (AppT (AppT Kind
ArrowT Kind
t1) Kind
t2) =
let (FunArgs
args, Kind
res) = Kind -> (FunArgs, Kind)
unravelType Kind
t2 in
(Kind -> FunArgs -> FunArgs
FAAnon Kind
t1 FunArgs
args, Kind
res)
#if __GLASGOW_HASKELL__ >= 809
unravelType (ForallVisT [TyVarBndrUnit]
tvbs Kind
ty) =
let (FunArgs
args, Kind
res) = Kind -> (FunArgs, Kind)
unravelType Kind
ty in
(ForallTelescope -> FunArgs -> FunArgs
FAForalls ([TyVarBndrUnit] -> ForallTelescope
ForallVis [TyVarBndrUnit]
tvbs) FunArgs
args, Kind
res)
#endif
unravelType Kind
t = (FunArgs
FANil, Kind
t)
unSigType :: Type -> Type
unSigType :: Kind -> Kind
unSigType (SigT Kind
t Kind
_) = Kind
t
unSigType (AppT Kind
f Kind
x) = Kind -> Kind -> Kind
AppT (Kind -> Kind
unSigType Kind
f) (Kind -> Kind
unSigType Kind
x)
unSigType (ForallT [TyVarBndrSpec]
tvbs [Kind]
ctxt Kind
t) =
[TyVarBndrSpec] -> [Kind] -> Kind -> Kind
ForallT [TyVarBndrSpec]
tvbs ((Kind -> Kind) -> [Kind] -> [Kind]
forall a b. (a -> b) -> [a] -> [b]
map Kind -> Kind
unSigPred [Kind]
ctxt) (Kind -> Kind
unSigType Kind
t)
unSigType (InfixT Kind
t1 Name
n Kind
t2) = Kind -> Name -> Kind -> Kind
InfixT (Kind -> Kind
unSigType Kind
t1) Name
n (Kind -> Kind
unSigType Kind
t2)
unSigType (UInfixT Kind
t1 Name
n Kind
t2) = Kind -> Name -> Kind -> Kind
UInfixT (Kind -> Kind
unSigType Kind
t1) Name
n (Kind -> Kind
unSigType Kind
t2)
unSigType (ParensT Kind
t) = Kind -> Kind
ParensT (Kind -> Kind
unSigType Kind
t)
#if __GLASGOW_HASKELL__ >= 807
unSigType (AppKindT Kind
t Kind
k) = Kind -> Kind -> Kind
AppKindT (Kind -> Kind
unSigType Kind
t) (Kind -> Kind
unSigType Kind
k)
unSigType (ImplicitParamT String
n Kind
t) = String -> Kind -> Kind
ImplicitParamT String
n (Kind -> Kind
unSigType Kind
t)
#endif
unSigType Kind
t = Kind
t
unSigPred :: Pred -> Pred
unSigPred :: Kind -> Kind
unSigPred = Kind -> Kind
unSigType
unfoldType :: Type -> (Type, [TypeArg])
unfoldType :: Kind -> (Kind, [TypeArg])
unfoldType = [TypeArg] -> Kind -> (Kind, [TypeArg])
go []
where
go :: [TypeArg] -> Type -> (Type, [TypeArg])
go :: [TypeArg] -> Kind -> (Kind, [TypeArg])
go [TypeArg]
acc (ForallT [TyVarBndrSpec]
_ [Kind]
_ Kind
ty) = [TypeArg] -> Kind -> (Kind, [TypeArg])
go [TypeArg]
acc Kind
ty
go [TypeArg]
acc (AppT Kind
ty1 Kind
ty2) = [TypeArg] -> Kind -> (Kind, [TypeArg])
go (Kind -> TypeArg
TANormal Kind
ty2TypeArg -> [TypeArg] -> [TypeArg]
forall a. a -> [a] -> [a]
:[TypeArg]
acc) Kind
ty1
go [TypeArg]
acc (SigT Kind
ty Kind
_) = [TypeArg] -> Kind -> (Kind, [TypeArg])
go [TypeArg]
acc Kind
ty
go [TypeArg]
acc (ParensT Kind
ty) = [TypeArg] -> Kind -> (Kind, [TypeArg])
go [TypeArg]
acc Kind
ty
go [TypeArg]
acc (InfixT Kind
ty1 Name
n Kind
ty2) = [TypeArg] -> Kind -> (Kind, [TypeArg])
go (Kind -> TypeArg
TANormal Kind
ty1TypeArg -> [TypeArg] -> [TypeArg]
forall a. a -> [a] -> [a]
:Kind -> TypeArg
TANormal Kind
ty2TypeArg -> [TypeArg] -> [TypeArg]
forall a. a -> [a] -> [a]
:[TypeArg]
acc) (Name -> Kind
ConT Name
n)
#if __GLASGOW_HASKELL__ >= 807
go [TypeArg]
acc (AppKindT Kind
ty Kind
ki) = [TypeArg] -> Kind -> (Kind, [TypeArg])
go (Kind -> TypeArg
TyArg Kind
kiTypeArg -> [TypeArg] -> [TypeArg]
forall a. a -> [a] -> [a]
:[TypeArg]
acc) Kind
ty
#endif
#if __GLASGOW_HASKELL__ >= 904
go [TypeArg]
acc (PromotedInfixT Kind
ty1 Name
n Kind
ty2) = [TypeArg] -> Kind -> (Kind, [TypeArg])
go (Kind -> TypeArg
TANormal Kind
ty1TypeArg -> [TypeArg] -> [TypeArg]
forall a. a -> [a] -> [a]
:Kind -> TypeArg
TANormal Kind
ty2TypeArg -> [TypeArg] -> [TypeArg]
forall a. a -> [a] -> [a]
:[TypeArg]
acc) (Name -> Kind
PromotedT Name
n)
#endif
go [TypeArg]
acc Kind
ty = (Kind
ty, [TypeArg]
acc)
data TypeArg
= TANormal Type
| TyArg Kind
deriving (TypeArg -> TypeArg -> Bool
(TypeArg -> TypeArg -> Bool)
-> (TypeArg -> TypeArg -> Bool) -> Eq TypeArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeArg -> TypeArg -> Bool
== :: TypeArg -> TypeArg -> Bool
$c/= :: TypeArg -> TypeArg -> Bool
/= :: TypeArg -> TypeArg -> Bool
Eq, Int -> TypeArg -> String -> String
[TypeArg] -> String -> String
TypeArg -> String
(Int -> TypeArg -> String -> String)
-> (TypeArg -> String)
-> ([TypeArg] -> String -> String)
-> Show TypeArg
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TypeArg -> String -> String
showsPrec :: Int -> TypeArg -> String -> String
$cshow :: TypeArg -> String
show :: TypeArg -> String
$cshowList :: [TypeArg] -> String -> String
showList :: [TypeArg] -> String -> String
Show, Typeable TypeArg
Typeable TypeArg =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeArg -> c TypeArg)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeArg)
-> (TypeArg -> Constr)
-> (TypeArg -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeArg))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeArg))
-> ((forall b. Data b => b -> b) -> TypeArg -> TypeArg)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r)
-> (forall u. (forall d. Data d => d -> u) -> TypeArg -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> TypeArg -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg)
-> Data TypeArg
TypeArg -> Constr
TypeArg -> DataType
(forall b. Data b => b -> b) -> TypeArg -> TypeArg
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TypeArg -> u
forall u. (forall d. Data d => d -> u) -> TypeArg -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeArg
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeArg -> c TypeArg
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeArg)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeArg)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeArg -> c TypeArg
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeArg -> c TypeArg
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeArg
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeArg
$ctoConstr :: TypeArg -> Constr
toConstr :: TypeArg -> Constr
$cdataTypeOf :: TypeArg -> DataType
dataTypeOf :: TypeArg -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeArg)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeArg)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeArg)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeArg)
$cgmapT :: (forall b. Data b => b -> b) -> TypeArg -> TypeArg
gmapT :: (forall b. Data b => b -> b) -> TypeArg -> TypeArg
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeArg -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypeArg -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypeArg -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeArg -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TypeArg -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TypeArg -> m TypeArg
Data)
applyType :: Type -> [TypeArg] -> Type
applyType :: Kind -> [TypeArg] -> Kind
applyType = (Kind -> TypeArg -> Kind) -> Kind -> [TypeArg] -> Kind
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Kind -> TypeArg -> Kind
apply
where
apply :: Type -> TypeArg -> Type
apply :: Kind -> TypeArg -> Kind
apply Kind
f (TANormal Kind
x) = Kind
f Kind -> Kind -> Kind
`AppT` Kind
x
apply Kind
f (TyArg Kind
_x) =
#if __GLASGOW_HASKELL__ >= 807
Kind
f Kind -> Kind -> Kind
`AppKindT` Kind
_x
#else
f
#endif
filterTANormals :: [TypeArg] -> [Type]
filterTANormals :: [TypeArg] -> [Kind]
filterTANormals = (TypeArg -> Maybe Kind) -> [TypeArg] -> [Kind]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TypeArg -> Maybe Kind
getTANormal
where
getTANormal :: TypeArg -> Maybe Type
getTANormal :: TypeArg -> Maybe Kind
getTANormal (TANormal Kind
t) = Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
t
getTANormal (TyArg {}) = Maybe Kind
forall a. Maybe a
Nothing
tyVarBndrVisToTypeArg :: TyVarBndrVis -> TypeArg
tyVarBndrVisToTypeArg :: TyVarBndrUnit -> TypeArg
tyVarBndrVisToTypeArg TyVarBndrUnit
bndr =
case TyVarBndrUnit -> ()
forall flag. TyVarBndr_ flag -> flag
tvFlag TyVarBndrUnit
bndr of
()
BndrReq -> Kind -> TypeArg
TANormal Kind
bndr_ty
()
BndrInvis -> Kind -> TypeArg
TyArg Kind
bndr_ty
where
bndr_ty :: Kind
bndr_ty = TyVarBndrUnit -> Kind
forall flag. TyVarBndr_ flag -> Kind
tvbToType TyVarBndrUnit
bndr
tyVarBndrVisToTypeArgWithSig :: TyVarBndrVis -> TypeArg
tyVarBndrVisToTypeArgWithSig :: TyVarBndrUnit -> TypeArg
tyVarBndrVisToTypeArgWithSig TyVarBndrUnit
bndr =
case TyVarBndrUnit -> ()
forall flag. TyVarBndr_ flag -> flag
tvFlag TyVarBndrUnit
bndr of
()
BndrReq -> Kind -> TypeArg
TANormal Kind
bndr_ty
()
BndrInvis -> Kind -> TypeArg
TyArg Kind
bndr_ty
where
bndr_ty :: Kind
bndr_ty = TyVarBndrUnit -> Kind
forall flag. TyVarBndr_ flag -> Kind
tvbToTypeWithSig TyVarBndrUnit
bndr
probablyWrongUnTypeArg :: TypeArg -> Type
probablyWrongUnTypeArg :: TypeArg -> Kind
probablyWrongUnTypeArg (TANormal Kind
t) = Kind
t
probablyWrongUnTypeArg (TyArg Kind
k) = Kind
k
matchUpSAKWithDecl ::
forall q.
Fail.MonadFail q
=> Kind
-> [TyVarBndrVis]
-> q [TyVarBndr_ ForAllTyFlag]
matchUpSAKWithDecl :: forall (q :: * -> *).
MonadFail q =>
Kind -> [TyVarBndrUnit] -> q [TyVarBndr_ ForAllTyFlag]
matchUpSAKWithDecl Kind
decl_sak [TyVarBndrUnit]
decl_bndrs = do
let decl_sak_free_tvbs :: [TyVarBndrSpec]
decl_sak_free_tvbs =
Specificity -> [TyVarBndrUnit] -> [TyVarBndrSpec]
forall newFlag oldFlag.
newFlag -> [TyVarBndr_ oldFlag] -> [TyVarBndr_ newFlag]
changeTVFlags Specificity
SpecifiedSpec ([TyVarBndrUnit] -> [TyVarBndrSpec])
-> [TyVarBndrUnit] -> [TyVarBndrSpec]
forall a b. (a -> b) -> a -> b
$ [Kind] -> [TyVarBndrUnit]
freeVariablesWellScoped [Kind
decl_sak]
decl_sak' :: Kind
decl_sak' = [TyVarBndrSpec] -> [Kind] -> Kind -> Kind
ForallT [TyVarBndrSpec]
decl_sak_free_tvbs [] Kind
decl_sak
let (FunArgs
decl_sak_args, Kind
_) = Kind -> (FunArgs, Kind)
unravelType Kind
decl_sak'
[TyVarBndr_ ForAllTyFlag]
sing_sak_tvbs <- FunArgs -> [TyVarBndrUnit] -> q [TyVarBndr_ ForAllTyFlag]
forall (q :: * -> *).
MonadFail q =>
FunArgs -> [TyVarBndrUnit] -> q [TyVarBndr_ ForAllTyFlag]
matchUpSigWithDecl FunArgs
decl_sak_args [TyVarBndrUnit]
decl_bndrs
let invis_decl_sak_args :: [TyVarBndrSpec]
invis_decl_sak_args = FunArgs -> [TyVarBndrSpec]
filterInvisTvbArgs FunArgs
decl_sak_args
invis_decl_sak_arg_nms :: [Name]
invis_decl_sak_arg_nms = (TyVarBndrSpec -> Name) -> [TyVarBndrSpec] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndrSpec -> Name
forall flag. TyVarBndr_ flag -> Name
tvName [TyVarBndrSpec]
invis_decl_sak_args
invis_decl_bndrs :: [TyVarBndrUnit]
invis_decl_bndrs = [TyVarBndrUnit] -> [TyVarBndrUnit]
forall flag. [TyVarBndr_ flag] -> [TyVarBndrUnit]
freeKindVariablesWellScoped [TyVarBndrUnit]
decl_bndrs
invis_decl_bndr_nms :: [Name]
invis_decl_bndr_nms = (TyVarBndrUnit -> Name) -> [TyVarBndrUnit] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndrUnit -> Name
forall flag. TyVarBndr_ flag -> Name
tvName [TyVarBndrUnit]
invis_decl_bndrs
swizzle_env :: Map Name Name
swizzle_env =
[(Name, Name)] -> Map Name Name
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, Name)] -> Map Name Name)
-> [(Name, Name)] -> Map Name Name
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name] -> [(Name, Name)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
invis_decl_sak_arg_nms [Name]
invis_decl_bndr_nms
(Map Name Kind
_, [TyVarBndr_ ForAllTyFlag]
swizzled_sing_sak_tvbs) =
(Map Name Kind
-> TyVarBndr_ ForAllTyFlag
-> (Map Name Kind, TyVarBndr_ ForAllTyFlag))
-> Map Name Kind
-> [TyVarBndr_ ForAllTyFlag]
-> (Map Name Kind, [TyVarBndr_ ForAllTyFlag])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL (Map Name Name
-> Map Name Kind
-> TyVarBndr_ ForAllTyFlag
-> (Map Name Kind, TyVarBndr_ ForAllTyFlag)
forall flag.
Map Name Name
-> Map Name Kind
-> TyVarBndr_ flag
-> (Map Name Kind, TyVarBndr_ flag)
swizzleTvb Map Name Name
swizzle_env) Map Name Kind
forall k a. Map k a
Map.empty [TyVarBndr_ ForAllTyFlag]
sing_sak_tvbs
[TyVarBndr_ ForAllTyFlag] -> q [TyVarBndr_ ForAllTyFlag]
forall a. a -> q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TyVarBndr_ ForAllTyFlag]
swizzled_sing_sak_tvbs
matchUpSigWithDecl ::
forall q.
Fail.MonadFail q
=> FunArgs
-> [TyVarBndrVis]
-> q [TyVarBndr_ ForAllTyFlag]
matchUpSigWithDecl :: forall (q :: * -> *).
MonadFail q =>
FunArgs -> [TyVarBndrUnit] -> q [TyVarBndr_ ForAllTyFlag]
matchUpSigWithDecl = Map Name Kind
-> FunArgs -> [TyVarBndrUnit] -> q [TyVarBndr_ ForAllTyFlag]
go_fun_args Map Name Kind
forall k a. Map k a
Map.empty
where
go_fun_args ::
Map Name Type
-> FunArgs -> [TyVarBndrVis] -> q [TyVarBndr_ ForAllTyFlag]
go_fun_args :: Map Name Kind
-> FunArgs -> [TyVarBndrUnit] -> q [TyVarBndr_ ForAllTyFlag]
go_fun_args Map Name Kind
_ FunArgs
FANil [] =
[TyVarBndr_ ForAllTyFlag] -> q [TyVarBndr_ ForAllTyFlag]
forall a. a -> q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
go_fun_args Map Name Kind
_ FunArgs
FANil [TyVarBndrUnit]
decl_bndrs =
String -> q [TyVarBndr_ ForAllTyFlag]
forall a. String -> q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> q [TyVarBndr_ ForAllTyFlag])
-> String -> q [TyVarBndr_ ForAllTyFlag]
forall a b. (a -> b) -> a -> b
$ String
"matchUpSigWithDecl.go_fun_args: Too many binders: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [TyVarBndrUnit] -> String
forall a. Show a => a -> String
show [TyVarBndrUnit]
decl_bndrs
go_fun_args Map Name Kind
subst (FACxt [] FunArgs
args) [TyVarBndrUnit]
decl_bndrs =
Map Name Kind
-> FunArgs -> [TyVarBndrUnit] -> q [TyVarBndr_ ForAllTyFlag]
go_fun_args Map Name Kind
subst FunArgs
args [TyVarBndrUnit]
decl_bndrs
go_fun_args Map Name Kind
_ (FACxt (Kind
_:[Kind]
_) FunArgs
_) [TyVarBndrUnit]
_ =
String -> q [TyVarBndr_ ForAllTyFlag]
forall a. String -> q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"matchUpSigWithDecl.go_fun_args: Unexpected kind-level constraint"
go_fun_args Map Name Kind
subst (FAForalls (ForallInvis [TyVarBndrSpec]
tvbs) FunArgs
sig_args) [TyVarBndrUnit]
decl_bndrs =
Map Name Kind
-> [TyVarBndrSpec]
-> FunArgs
-> [TyVarBndrUnit]
-> q [TyVarBndr_ ForAllTyFlag]
go_invis_tvbs Map Name Kind
subst [TyVarBndrSpec]
tvbs FunArgs
sig_args [TyVarBndrUnit]
decl_bndrs
go_fun_args Map Name Kind
subst (FAForalls (ForallVis [TyVarBndrUnit]
tvbs) FunArgs
sig_args) [TyVarBndrUnit]
decl_bndrs =
Map Name Kind
-> [TyVarBndrUnit]
-> FunArgs
-> [TyVarBndrUnit]
-> q [TyVarBndr_ ForAllTyFlag]
go_vis_tvbs Map Name Kind
subst [TyVarBndrUnit]
tvbs FunArgs
sig_args [TyVarBndrUnit]
decl_bndrs
go_fun_args Map Name Kind
subst (FAAnon Kind
anon FunArgs
sig_args) (TyVarBndrUnit
decl_bndr:[TyVarBndrUnit]
decl_bndrs) =
case TyVarBndrUnit -> ()
forall flag. TyVarBndr_ flag -> flag
tvFlag TyVarBndrUnit
decl_bndr of
()
BndrReq -> do
let decl_bndr_name :: Name
decl_bndr_name = TyVarBndrUnit -> Name
forall flag. TyVarBndr_ flag -> Name
tvName TyVarBndrUnit
decl_bndr
mb_decl_bndr_kind :: Maybe Kind
mb_decl_bndr_kind = TyVarBndrUnit -> Maybe Kind
forall flag. TyVarBndr_ flag -> Maybe Kind
extractTvbKind_maybe TyVarBndrUnit
decl_bndr
anon' :: Kind
anon' = Map Name Kind -> Kind -> Kind
forall a. TypeSubstitution a => Map Name Kind -> a -> a
applySubstitution Map Name Kind
subst Kind
anon
anon'' :: Kind
anon'' =
case Maybe Kind
mb_decl_bndr_kind of
Maybe Kind
Nothing -> Kind
anon'
Just Kind
decl_bndr_kind -> do
let mb_match_subst :: Maybe (Map Name Kind)
mb_match_subst = Kind -> Kind -> Maybe (Map Name Kind)
matchTy Kind
decl_bndr_kind Kind
anon'
Kind -> (Map Name Kind -> Kind) -> Maybe (Map Name Kind) -> Kind
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Kind
decl_bndr_kind (Map Name Kind -> Kind -> Kind
forall a. TypeSubstitution a => Map Name Kind -> a -> a
`applySubstitution` Kind
decl_bndr_kind) Maybe (Map Name Kind)
mb_match_subst
[TyVarBndr_ ForAllTyFlag]
sig_args' <- Map Name Kind
-> FunArgs -> [TyVarBndrUnit] -> q [TyVarBndr_ ForAllTyFlag]
go_fun_args Map Name Kind
subst FunArgs
sig_args [TyVarBndrUnit]
decl_bndrs
[TyVarBndr_ ForAllTyFlag] -> q [TyVarBndr_ ForAllTyFlag]
forall a. a -> q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TyVarBndr_ ForAllTyFlag] -> q [TyVarBndr_ ForAllTyFlag])
-> [TyVarBndr_ ForAllTyFlag] -> q [TyVarBndr_ ForAllTyFlag]
forall a b. (a -> b) -> a -> b
$ Name -> ForAllTyFlag -> Kind -> TyVarBndr_ ForAllTyFlag
forall flag. Name -> flag -> Kind -> TyVarBndr_ flag
kindedTVFlag Name
decl_bndr_name ForAllTyFlag
Required Kind
anon'' TyVarBndr_ ForAllTyFlag
-> [TyVarBndr_ ForAllTyFlag] -> [TyVarBndr_ ForAllTyFlag]
forall a. a -> [a] -> [a]
: [TyVarBndr_ ForAllTyFlag]
sig_args'
()
BndrInvis ->
String -> q [TyVarBndr_ ForAllTyFlag]
forall a. String -> q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> q [TyVarBndr_ ForAllTyFlag])
-> String -> q [TyVarBndr_ ForAllTyFlag]
forall a b. (a -> b) -> a -> b
$ String
"dMatchUpSigWithDecl.go_fun_args: Expected visible binder, encountered invisible binder: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TyVarBndrUnit -> String
forall a. Show a => a -> String
show TyVarBndrUnit
decl_bndr
go_fun_args Map Name Kind
_ FunArgs
_ [] =
String -> q [TyVarBndr_ ForAllTyFlag]
forall a. String -> q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"matchUpSigWithDecl.go_fun_args: Too few binders"
go_invis_tvbs ::
Map Name Type
-> [TyVarBndrSpec]
-> FunArgs
-> [TyVarBndrVis]
-> q [TyVarBndr_ ForAllTyFlag]
go_invis_tvbs :: Map Name Kind
-> [TyVarBndrSpec]
-> FunArgs
-> [TyVarBndrUnit]
-> q [TyVarBndr_ ForAllTyFlag]
go_invis_tvbs Map Name Kind
subst [] FunArgs
sig_args [TyVarBndrUnit]
decl_bndrs =
Map Name Kind
-> FunArgs -> [TyVarBndrUnit] -> q [TyVarBndr_ ForAllTyFlag]
go_fun_args Map Name Kind
subst FunArgs
sig_args [TyVarBndrUnit]
decl_bndrs
go_invis_tvbs Map Name Kind
subst (TyVarBndrSpec
invis_tvb:[TyVarBndrSpec]
invis_tvbs) FunArgs
sig_args [TyVarBndrUnit]
decl_bndrss =
case [TyVarBndrUnit]
decl_bndrss of
[] -> q [TyVarBndr_ ForAllTyFlag]
skip_invis_bndr
TyVarBndrUnit
decl_bndr:[TyVarBndrUnit]
decl_bndrs ->
case TyVarBndrUnit -> ()
forall flag. TyVarBndr_ flag -> flag
tvFlag TyVarBndrUnit
decl_bndr of
()
BndrReq -> q [TyVarBndr_ ForAllTyFlag]
skip_invis_bndr
()
BndrInvis -> do
let (Map Name Kind
subst', TyVarBndrSpec
sig_tvb) = Map Name Kind
-> TyVarBndrSpec -> TyVarBndrUnit -> (Map Name Kind, TyVarBndrSpec)
forall flag.
Map Name Kind
-> TyVarBndr_ flag
-> TyVarBndrUnit
-> (Map Name Kind, TyVarBndr_ flag)
match_tvbs Map Name Kind
subst TyVarBndrSpec
invis_tvb TyVarBndrUnit
decl_bndr
[TyVarBndr_ ForAllTyFlag]
sig_args' <- Map Name Kind
-> [TyVarBndrSpec]
-> FunArgs
-> [TyVarBndrUnit]
-> q [TyVarBndr_ ForAllTyFlag]
go_invis_tvbs Map Name Kind
subst' [TyVarBndrSpec]
invis_tvbs FunArgs
sig_args [TyVarBndrUnit]
decl_bndrs
[TyVarBndr_ ForAllTyFlag] -> q [TyVarBndr_ ForAllTyFlag]
forall a. a -> q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Specificity -> ForAllTyFlag)
-> TyVarBndrSpec -> TyVarBndr_ ForAllTyFlag
forall flag flag'.
(flag -> flag') -> TyVarBndr_ flag -> TyVarBndr_ flag'
mapTVFlag Specificity -> ForAllTyFlag
Invisible TyVarBndrSpec
sig_tvb TyVarBndr_ ForAllTyFlag
-> [TyVarBndr_ ForAllTyFlag] -> [TyVarBndr_ ForAllTyFlag]
forall a. a -> [a] -> [a]
: [TyVarBndr_ ForAllTyFlag]
sig_args')
where
skip_invis_bndr :: q [TyVarBndr_ ForAllTyFlag]
skip_invis_bndr :: q [TyVarBndr_ ForAllTyFlag]
skip_invis_bndr = do
let (Map Name Kind
subst', TyVarBndrSpec
invis_tvb') = Map Name Kind -> TyVarBndrSpec -> (Map Name Kind, TyVarBndrSpec)
forall flag.
Map Name Kind
-> TyVarBndr_ flag -> (Map Name Kind, TyVarBndr_ flag)
substTvb Map Name Kind
subst TyVarBndrSpec
invis_tvb
[TyVarBndr_ ForAllTyFlag]
sig_args' <- Map Name Kind
-> [TyVarBndrSpec]
-> FunArgs
-> [TyVarBndrUnit]
-> q [TyVarBndr_ ForAllTyFlag]
go_invis_tvbs Map Name Kind
subst' [TyVarBndrSpec]
invis_tvbs FunArgs
sig_args [TyVarBndrUnit]
decl_bndrss
[TyVarBndr_ ForAllTyFlag] -> q [TyVarBndr_ ForAllTyFlag]
forall a. a -> q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TyVarBndr_ ForAllTyFlag] -> q [TyVarBndr_ ForAllTyFlag])
-> [TyVarBndr_ ForAllTyFlag] -> q [TyVarBndr_ ForAllTyFlag]
forall a b. (a -> b) -> a -> b
$ (Specificity -> ForAllTyFlag)
-> TyVarBndrSpec -> TyVarBndr_ ForAllTyFlag
forall flag flag'.
(flag -> flag') -> TyVarBndr_ flag -> TyVarBndr_ flag'
mapTVFlag Specificity -> ForAllTyFlag
Invisible TyVarBndrSpec
invis_tvb' TyVarBndr_ ForAllTyFlag
-> [TyVarBndr_ ForAllTyFlag] -> [TyVarBndr_ ForAllTyFlag]
forall a. a -> [a] -> [a]
: [TyVarBndr_ ForAllTyFlag]
sig_args'
go_vis_tvbs ::
Map Name Type
-> [TyVarBndrUnit]
-> FunArgs
-> [TyVarBndrVis]
-> q [TyVarBndr_ ForAllTyFlag]
go_vis_tvbs :: Map Name Kind
-> [TyVarBndrUnit]
-> FunArgs
-> [TyVarBndrUnit]
-> q [TyVarBndr_ ForAllTyFlag]
go_vis_tvbs Map Name Kind
subst [] FunArgs
sig_args [TyVarBndrUnit]
decl_bndrs =
Map Name Kind
-> FunArgs -> [TyVarBndrUnit] -> q [TyVarBndr_ ForAllTyFlag]
go_fun_args Map Name Kind
subst FunArgs
sig_args [TyVarBndrUnit]
decl_bndrs
go_vis_tvbs Map Name Kind
_ (TyVarBndrUnit
_:[TyVarBndrUnit]
_) FunArgs
_ [] =
String -> q [TyVarBndr_ ForAllTyFlag]
forall a. String -> q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"matchUpSigWithDecl.go_vis_tvbs: Too few binders"
go_vis_tvbs Map Name Kind
subst (TyVarBndrUnit
vis_tvb:[TyVarBndrUnit]
vis_tvbs) FunArgs
sig_args (TyVarBndrUnit
decl_bndr:[TyVarBndrUnit]
decl_bndrs) = do
case TyVarBndrUnit -> ()
forall flag. TyVarBndr_ flag -> flag
tvFlag TyVarBndrUnit
decl_bndr of
()
BndrReq -> do
let (Map Name Kind
subst', TyVarBndrUnit
sig_tvb) = Map Name Kind
-> TyVarBndrUnit -> TyVarBndrUnit -> (Map Name Kind, TyVarBndrUnit)
forall flag.
Map Name Kind
-> TyVarBndr_ flag
-> TyVarBndrUnit
-> (Map Name Kind, TyVarBndr_ flag)
match_tvbs Map Name Kind
subst TyVarBndrUnit
vis_tvb TyVarBndrUnit
decl_bndr
[TyVarBndr_ ForAllTyFlag]
sig_args' <- Map Name Kind
-> [TyVarBndrUnit]
-> FunArgs
-> [TyVarBndrUnit]
-> q [TyVarBndr_ ForAllTyFlag]
go_vis_tvbs Map Name Kind
subst' [TyVarBndrUnit]
vis_tvbs FunArgs
sig_args [TyVarBndrUnit]
decl_bndrs
[TyVarBndr_ ForAllTyFlag] -> q [TyVarBndr_ ForAllTyFlag]
forall a. a -> q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((() -> ForAllTyFlag) -> TyVarBndrUnit -> TyVarBndr_ ForAllTyFlag
forall flag flag'.
(flag -> flag') -> TyVarBndr_ flag -> TyVarBndr_ flag'
mapTVFlag (ForAllTyFlag -> () -> ForAllTyFlag
forall a b. a -> b -> a
const ForAllTyFlag
Required) TyVarBndrUnit
sig_tvb TyVarBndr_ ForAllTyFlag
-> [TyVarBndr_ ForAllTyFlag] -> [TyVarBndr_ ForAllTyFlag]
forall a. a -> [a] -> [a]
: [TyVarBndr_ ForAllTyFlag]
sig_args')
()
BndrInvis ->
String -> q [TyVarBndr_ ForAllTyFlag]
forall a. String -> q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> q [TyVarBndr_ ForAllTyFlag])
-> String -> q [TyVarBndr_ ForAllTyFlag]
forall a b. (a -> b) -> a -> b
$ String
"matchUpSigWithDecl.go_vis_tvbs: Expected visible binder, encountered invisible binder: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TyVarBndrUnit -> String
forall a. Show a => a -> String
show TyVarBndrUnit
decl_bndr
match_tvbs ::
Map Name Type
-> TyVarBndr_ flag
-> TyVarBndrVis
-> (Map Name Type, TyVarBndr_ flag)
match_tvbs :: forall flag.
Map Name Kind
-> TyVarBndr_ flag
-> TyVarBndrUnit
-> (Map Name Kind, TyVarBndr_ flag)
match_tvbs Map Name Kind
subst TyVarBndr_ flag
sig_tvb TyVarBndrUnit
decl_bndr =
let decl_bndr_name :: Name
decl_bndr_name = TyVarBndrUnit -> Name
forall flag. TyVarBndr_ flag -> Name
tvName TyVarBndrUnit
decl_bndr
mb_decl_bndr_kind :: Maybe Kind
mb_decl_bndr_kind = TyVarBndrUnit -> Maybe Kind
forall flag. TyVarBndr_ flag -> Maybe Kind
extractTvbKind_maybe TyVarBndrUnit
decl_bndr
sig_tvb_name :: Name
sig_tvb_name = TyVarBndr_ flag -> Name
forall flag. TyVarBndr_ flag -> Name
tvName TyVarBndr_ flag
sig_tvb
sig_tvb_flag :: flag
sig_tvb_flag = TyVarBndr_ flag -> flag
forall flag. TyVarBndr_ flag -> flag
tvFlag TyVarBndr_ flag
sig_tvb
mb_sig_tvb_kind :: Maybe Kind
mb_sig_tvb_kind = Map Name Kind -> Kind -> Kind
forall a. TypeSubstitution a => Map Name Kind -> a -> a
applySubstitution Map Name Kind
subst (Kind -> Kind) -> Maybe Kind -> Maybe Kind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyVarBndr_ flag -> Maybe Kind
forall flag. TyVarBndr_ flag -> Maybe Kind
extractTvbKind_maybe TyVarBndr_ flag
sig_tvb
mb_kind :: Maybe Kind
mb_kind :: Maybe Kind
mb_kind =
case (Maybe Kind
mb_decl_bndr_kind, Maybe Kind
mb_sig_tvb_kind) of
(Maybe Kind
Nothing, Maybe Kind
Nothing) -> Maybe Kind
forall a. Maybe a
Nothing
(Just Kind
decl_bndr_kind, Maybe Kind
Nothing) -> Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
decl_bndr_kind
(Maybe Kind
Nothing, Just Kind
sig_tvb_kind) -> Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
sig_tvb_kind
(Just Kind
decl_bndr_kind, Just Kind
sig_tvb_kind) -> do
Map Name Kind
match_subst <- Kind -> Kind -> Maybe (Map Name Kind)
matchTy Kind
decl_bndr_kind Kind
sig_tvb_kind
Kind -> Maybe Kind
forall a. a -> Maybe a
Just (Kind -> Maybe Kind) -> Kind -> Maybe Kind
forall a b. (a -> b) -> a -> b
$ Map Name Kind -> Kind -> Kind
forall a. TypeSubstitution a => Map Name Kind -> a -> a
applySubstitution Map Name Kind
match_subst Kind
decl_bndr_kind
subst' :: Map Name Kind
subst' = Name -> Kind -> Map Name Kind -> Map Name Kind
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
sig_tvb_name (Name -> Kind
VarT Name
decl_bndr_name) Map Name Kind
subst
sig_tvb' :: TyVarBndr_ flag
sig_tvb' = case Maybe Kind
mb_kind of
Maybe Kind
Nothing -> Name -> flag -> TyVarBndr_ flag
forall flag. Name -> flag -> TyVarBndr_ flag
plainTVFlag Name
decl_bndr_name flag
sig_tvb_flag
Just Kind
kind -> Name -> flag -> Kind -> TyVarBndr_ flag
forall flag. Name -> flag -> Kind -> TyVarBndr_ flag
kindedTVFlag Name
decl_bndr_name flag
sig_tvb_flag Kind
kind in
(Map Name Kind
subst', TyVarBndr_ flag
sig_tvb')
filterInvisTvbArgs :: FunArgs -> [TyVarBndrSpec]
filterInvisTvbArgs :: FunArgs -> [TyVarBndrSpec]
filterInvisTvbArgs FunArgs
FANil = []
filterInvisTvbArgs (FACxt [Kind]
_ FunArgs
args) = FunArgs -> [TyVarBndrSpec]
filterInvisTvbArgs FunArgs
args
filterInvisTvbArgs (FAAnon Kind
_ FunArgs
args) = FunArgs -> [TyVarBndrSpec]
filterInvisTvbArgs FunArgs
args
filterInvisTvbArgs (FAForalls ForallTelescope
tele FunArgs
args) =
let res :: [TyVarBndrSpec]
res = FunArgs -> [TyVarBndrSpec]
filterInvisTvbArgs FunArgs
args in
case ForallTelescope
tele of
ForallVis [TyVarBndrUnit]
_ -> [TyVarBndrSpec]
res
ForallInvis [TyVarBndrSpec]
tvbs' -> [TyVarBndrSpec]
tvbs' [TyVarBndrSpec] -> [TyVarBndrSpec] -> [TyVarBndrSpec]
forall a. [a] -> [a] -> [a]
++ [TyVarBndrSpec]
res
freeKindVariablesWellScoped :: [TyVarBndr_ flag] -> [TyVarBndrUnit]
freeKindVariablesWellScoped :: forall flag. [TyVarBndr_ flag] -> [TyVarBndrUnit]
freeKindVariablesWellScoped [TyVarBndr_ flag]
tvbs =
(TyVarBndrUnit -> [TyVarBndrUnit] -> [TyVarBndrUnit])
-> [TyVarBndrUnit] -> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\TyVarBndrUnit
tvb [TyVarBndrUnit]
kvs ->
(Kind -> [TyVarBndrUnit]) -> Maybe Kind -> [TyVarBndrUnit]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Kind
t -> [Kind] -> [TyVarBndrUnit]
freeVariablesWellScoped [Kind
t]) (TyVarBndrUnit -> Maybe Kind
forall flag. TyVarBndr_ flag -> Maybe Kind
extractTvbKind_maybe TyVarBndrUnit
tvb) [TyVarBndrUnit] -> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a. Eq a => [a] -> [a] -> [a]
`List.union`
(TyVarBndrUnit -> TyVarBndrUnit -> Bool)
-> TyVarBndrUnit -> [TyVarBndrUnit] -> [TyVarBndrUnit]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
List.deleteBy (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Name -> Name -> Bool)
-> (TyVarBndrUnit -> Name)
-> TyVarBndrUnit
-> TyVarBndrUnit
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TyVarBndrUnit -> Name
forall flag. TyVarBndr_ flag -> Name
tvName) TyVarBndrUnit
tvb [TyVarBndrUnit]
kvs)
[]
(() -> [TyVarBndr_ flag] -> [TyVarBndrUnit]
forall newFlag oldFlag.
newFlag -> [TyVarBndr_ oldFlag] -> [TyVarBndr_ newFlag]
changeTVFlags () [TyVarBndr_ flag]
tvbs)
matchTy :: Type -> Type -> Maybe (Map Name Type)
matchTy :: Kind -> Kind -> Maybe (Map Name Kind)
matchTy (VarT Name
var_name) Kind
arg = Map Name Kind -> Maybe (Map Name Kind)
forall a. a -> Maybe a
Just (Map Name Kind -> Maybe (Map Name Kind))
-> Map Name Kind -> Maybe (Map Name Kind)
forall a b. (a -> b) -> a -> b
$ Name -> Kind -> Map Name Kind
forall k a. k -> a -> Map k a
Map.singleton Name
var_name Kind
arg
matchTy (SigT {}) Kind
_ = Maybe (Map Name Kind)
forall a. Maybe a
Nothing
matchTy Kind
pat (SigT Kind
ty Kind
_ki) = Kind -> Kind -> Maybe (Map Name Kind)
matchTy Kind
pat Kind
ty
#if __GLASGOW_HASKELL__ >= 807
matchTy (AppKindT {}) Kind
_ = Maybe (Map Name Kind)
forall a. Maybe a
Nothing
matchTy Kind
pat (AppKindT Kind
ty Kind
_ki) = Kind -> Kind -> Maybe (Map Name Kind)
matchTy Kind
pat Kind
ty
#endif
matchTy (ForallT {}) Kind
_ =
String -> Maybe (Map Name Kind)
forall a. HasCallStack => String -> a
error String
"Cannot match a forall in a pattern"
matchTy Kind
_ (ForallT {}) =
String -> Maybe (Map Name Kind)
forall a. HasCallStack => String -> a
error String
"Cannot match a forall in a target"
matchTy (AppT Kind
pat1 Kind
pat2) (AppT Kind
arg1 Kind
arg2) =
[Maybe (Map Name Kind)] -> Maybe (Map Name Kind)
unionMaybeSubsts [Kind -> Kind -> Maybe (Map Name Kind)
matchTy Kind
pat1 Kind
arg1, Kind -> Kind -> Maybe (Map Name Kind)
matchTy Kind
pat2 Kind
arg2]
matchTy (ConT Name
pat_con) (ConT Name
arg_con)
| Name
pat_con Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
arg_con
= Map Name Kind -> Maybe (Map Name Kind)
forall a. a -> Maybe a
Just Map Name Kind
forall k a. Map k a
Map.empty
| Bool
otherwise
= Maybe (Map Name Kind)
forall a. Maybe a
Nothing
matchTy Kind
ArrowT Kind
ArrowT = Map Name Kind -> Maybe (Map Name Kind)
forall a. a -> Maybe a
Just Map Name Kind
forall k a. Map k a
Map.empty
matchTy (LitT TyLit
pat_lit) (LitT TyLit
arg_lit)
| TyLit
pat_lit TyLit -> TyLit -> Bool
forall a. Eq a => a -> a -> Bool
== TyLit
arg_lit
= Map Name Kind -> Maybe (Map Name Kind)
forall a. a -> Maybe a
Just Map Name Kind
forall k a. Map k a
Map.empty
| Bool
otherwise
= Maybe (Map Name Kind)
forall a. Maybe a
Nothing
matchTy Kind
_ Kind
_ = Maybe (Map Name Kind)
forall a. Maybe a
Nothing
unionMaybeSubsts :: [Maybe (Map Name Type)] -> Maybe (Map Name Type)
unionMaybeSubsts :: [Maybe (Map Name Kind)] -> Maybe (Map Name Kind)
unionMaybeSubsts = (Maybe (Map Name Kind)
-> Maybe (Map Name Kind) -> Maybe (Map Name Kind))
-> Maybe (Map Name Kind)
-> [Maybe (Map Name Kind)]
-> Maybe (Map Name Kind)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Maybe (Map Name Kind)
-> Maybe (Map Name Kind) -> Maybe (Map Name Kind)
union_subst1 (Map Name Kind -> Maybe (Map Name Kind)
forall a. a -> Maybe a
Just Map Name Kind
forall k a. Map k a
Map.empty)
where
union_subst1 ::
Maybe (Map Name Type) -> Maybe (Map Name Type) -> Maybe (Map Name Type)
union_subst1 :: Maybe (Map Name Kind)
-> Maybe (Map Name Kind) -> Maybe (Map Name Kind)
union_subst1 Maybe (Map Name Kind)
ma Maybe (Map Name Kind)
mb = do
Map Name Kind
a <- Maybe (Map Name Kind)
ma
Map Name Kind
b <- Maybe (Map Name Kind)
mb
Map Name Kind -> Map Name Kind -> Maybe (Map Name Kind)
unionSubsts Map Name Kind
a Map Name Kind
b
unionSubsts :: Map Name Type -> Map Name Type -> Maybe (Map Name Type)
unionSubsts :: Map Name Kind -> Map Name Kind -> Maybe (Map Name Kind)
unionSubsts Map Name Kind
a Map Name Kind
b =
let shared_key_set :: Set Name
shared_key_set = Map Name Kind -> Set Name
forall k a. Map k a -> Set k
Map.keysSet Map Name Kind
a Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Map Name Kind -> Set Name
forall k a. Map k a -> Set k
Map.keysSet Map Name Kind
b
matches_up :: Bool
matches_up = (Name -> Bool -> Bool) -> Bool -> Set Name -> Bool
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr (\Name
name -> ((Map Name Kind
a Map Name Kind -> Name -> Kind
forall k a. Ord k => Map k a -> k -> a
Map.! Name
name) Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== (Map Name Kind
b Map Name Kind -> Name -> Kind
forall k a. Ord k => Map k a -> k -> a
Map.! Name
name) Bool -> Bool -> Bool
&&))
Bool
True Set Name
shared_key_set
in
if Bool
matches_up then Map Name Kind -> Maybe (Map Name Kind)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Name Kind
a Map Name Kind -> Map Name Kind -> Map Name Kind
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map Name Kind
b) else Maybe (Map Name Kind)
forall a. Maybe a
Nothing
substTvb :: Map Name Kind -> TyVarBndr_ flag -> (Map Name Kind, TyVarBndr_ flag)
substTvb :: forall flag.
Map Name Kind
-> TyVarBndr_ flag -> (Map Name Kind, TyVarBndr_ flag)
substTvb Map Name Kind
s TyVarBndr_ flag
tvb = (Name -> Map Name Kind -> Map Name Kind
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (TyVarBndr_ flag -> Name
forall flag. TyVarBndr_ flag -> Name
tvName TyVarBndr_ flag
tvb) Map Name Kind
s, (Kind -> Kind) -> TyVarBndr_ flag -> TyVarBndr_ flag
forall flag. (Kind -> Kind) -> TyVarBndr_ flag -> TyVarBndr_ flag
mapTVKind (Map Name Kind -> Kind -> Kind
forall a. TypeSubstitution a => Map Name Kind -> a -> a
applySubstitution Map Name Kind
s) TyVarBndr_ flag
tvb)
swizzleTvb ::
Map Name Name
-> Map Name Type
-> TyVarBndr_ flag
-> (Map Name Type, TyVarBndr_ flag)
swizzleTvb :: forall flag.
Map Name Name
-> Map Name Kind
-> TyVarBndr_ flag
-> (Map Name Kind, TyVarBndr_ flag)
swizzleTvb Map Name Name
swizzle_env Map Name Kind
subst TyVarBndr_ flag
tvb =
(Map Name Kind
subst', TyVarBndr_ flag
tvb2)
where
subst' :: Map Name Kind
subst' = Name -> Kind -> Map Name Kind -> Map Name Kind
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
tvb_name (Name -> Kind
VarT (TyVarBndr_ flag -> Name
forall flag. TyVarBndr_ flag -> Name
tvName TyVarBndr_ flag
tvb2)) Map Name Kind
subst
tvb_name :: Name
tvb_name = TyVarBndr_ flag -> Name
forall flag. TyVarBndr_ flag -> Name
tvName TyVarBndr_ flag
tvb
tvb1 :: TyVarBndr_ flag
tvb1 = (Kind -> Kind) -> TyVarBndr_ flag -> TyVarBndr_ flag
forall flag. (Kind -> Kind) -> TyVarBndr_ flag -> TyVarBndr_ flag
mapTVKind (Map Name Kind -> Kind -> Kind
forall a. TypeSubstitution a => Map Name Kind -> a -> a
applySubstitution Map Name Kind
subst) TyVarBndr_ flag
tvb
tvb2 :: TyVarBndr_ flag
tvb2 =
case Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
tvb_name Map Name Name
swizzle_env of
Just Name
user_name -> (Name -> Name) -> TyVarBndr_ flag -> TyVarBndr_ flag
forall flag. (Name -> Name) -> TyVarBndr_ flag -> TyVarBndr_ flag
mapTVName (Name -> Name -> Name
forall a b. a -> b -> a
const Name
user_name) TyVarBndr_ flag
tvb1
Maybe Name
Nothing -> TyVarBndr_ flag
tvb1
data ForAllTyFlag
= Invisible !Specificity
| Required
deriving (Int -> ForAllTyFlag -> String -> String
[ForAllTyFlag] -> String -> String
ForAllTyFlag -> String
(Int -> ForAllTyFlag -> String -> String)
-> (ForAllTyFlag -> String)
-> ([ForAllTyFlag] -> String -> String)
-> Show ForAllTyFlag
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ForAllTyFlag -> String -> String
showsPrec :: Int -> ForAllTyFlag -> String -> String
$cshow :: ForAllTyFlag -> String
show :: ForAllTyFlag -> String
$cshowList :: [ForAllTyFlag] -> String -> String
showList :: [ForAllTyFlag] -> String -> String
Show, ForAllTyFlag -> ForAllTyFlag -> Bool
(ForAllTyFlag -> ForAllTyFlag -> Bool)
-> (ForAllTyFlag -> ForAllTyFlag -> Bool) -> Eq ForAllTyFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForAllTyFlag -> ForAllTyFlag -> Bool
== :: ForAllTyFlag -> ForAllTyFlag -> Bool
$c/= :: ForAllTyFlag -> ForAllTyFlag -> Bool
/= :: ForAllTyFlag -> ForAllTyFlag -> Bool
Eq, Eq ForAllTyFlag
Eq ForAllTyFlag =>
(ForAllTyFlag -> ForAllTyFlag -> Ordering)
-> (ForAllTyFlag -> ForAllTyFlag -> Bool)
-> (ForAllTyFlag -> ForAllTyFlag -> Bool)
-> (ForAllTyFlag -> ForAllTyFlag -> Bool)
-> (ForAllTyFlag -> ForAllTyFlag -> Bool)
-> (ForAllTyFlag -> ForAllTyFlag -> ForAllTyFlag)
-> (ForAllTyFlag -> ForAllTyFlag -> ForAllTyFlag)
-> Ord ForAllTyFlag
ForAllTyFlag -> ForAllTyFlag -> Bool
ForAllTyFlag -> ForAllTyFlag -> Ordering
ForAllTyFlag -> ForAllTyFlag -> ForAllTyFlag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ForAllTyFlag -> ForAllTyFlag -> Ordering
compare :: ForAllTyFlag -> ForAllTyFlag -> Ordering
$c< :: ForAllTyFlag -> ForAllTyFlag -> Bool
< :: ForAllTyFlag -> ForAllTyFlag -> Bool
$c<= :: ForAllTyFlag -> ForAllTyFlag -> Bool
<= :: ForAllTyFlag -> ForAllTyFlag -> Bool
$c> :: ForAllTyFlag -> ForAllTyFlag -> Bool
> :: ForAllTyFlag -> ForAllTyFlag -> Bool
$c>= :: ForAllTyFlag -> ForAllTyFlag -> Bool
>= :: ForAllTyFlag -> ForAllTyFlag -> Bool
$cmax :: ForAllTyFlag -> ForAllTyFlag -> ForAllTyFlag
max :: ForAllTyFlag -> ForAllTyFlag -> ForAllTyFlag
$cmin :: ForAllTyFlag -> ForAllTyFlag -> ForAllTyFlag
min :: ForAllTyFlag -> ForAllTyFlag -> ForAllTyFlag
Ord, Typeable ForAllTyFlag
Typeable ForAllTyFlag =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForAllTyFlag -> c ForAllTyFlag)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForAllTyFlag)
-> (ForAllTyFlag -> Constr)
-> (ForAllTyFlag -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForAllTyFlag))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForAllTyFlag))
-> ((forall b. Data b => b -> b) -> ForAllTyFlag -> ForAllTyFlag)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForAllTyFlag -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForAllTyFlag -> r)
-> (forall u. (forall d. Data d => d -> u) -> ForAllTyFlag -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> ForAllTyFlag -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ForAllTyFlag -> m ForAllTyFlag)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ForAllTyFlag -> m ForAllTyFlag)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ForAllTyFlag -> m ForAllTyFlag)
-> Data ForAllTyFlag
ForAllTyFlag -> Constr
ForAllTyFlag -> DataType
(forall b. Data b => b -> b) -> ForAllTyFlag -> ForAllTyFlag
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ForAllTyFlag -> u
forall u. (forall d. Data d => d -> u) -> ForAllTyFlag -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForAllTyFlag -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForAllTyFlag -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ForAllTyFlag -> m ForAllTyFlag
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ForAllTyFlag -> m ForAllTyFlag
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForAllTyFlag
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForAllTyFlag -> c ForAllTyFlag
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForAllTyFlag)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForAllTyFlag)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForAllTyFlag -> c ForAllTyFlag
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForAllTyFlag -> c ForAllTyFlag
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForAllTyFlag
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForAllTyFlag
$ctoConstr :: ForAllTyFlag -> Constr
toConstr :: ForAllTyFlag -> Constr
$cdataTypeOf :: ForAllTyFlag -> DataType
dataTypeOf :: ForAllTyFlag -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForAllTyFlag)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForAllTyFlag)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForAllTyFlag)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ForAllTyFlag)
$cgmapT :: (forall b. Data b => b -> b) -> ForAllTyFlag -> ForAllTyFlag
gmapT :: (forall b. Data b => b -> b) -> ForAllTyFlag -> ForAllTyFlag
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForAllTyFlag -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForAllTyFlag -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForAllTyFlag -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForAllTyFlag -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ForAllTyFlag -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ForAllTyFlag -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ForAllTyFlag -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ForAllTyFlag -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ForAllTyFlag -> m ForAllTyFlag
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ForAllTyFlag -> m ForAllTyFlag
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ForAllTyFlag -> m ForAllTyFlag
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ForAllTyFlag -> m ForAllTyFlag
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ForAllTyFlag -> m ForAllTyFlag
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ForAllTyFlag -> m ForAllTyFlag
Data, (forall x. ForAllTyFlag -> Rep ForAllTyFlag x)
-> (forall x. Rep ForAllTyFlag x -> ForAllTyFlag)
-> Generic ForAllTyFlag
forall x. Rep ForAllTyFlag x -> ForAllTyFlag
forall x. ForAllTyFlag -> Rep ForAllTyFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ForAllTyFlag -> Rep ForAllTyFlag x
from :: forall x. ForAllTyFlag -> Rep ForAllTyFlag x
$cto :: forall x. Rep ForAllTyFlag x -> ForAllTyFlag
to :: forall x. Rep ForAllTyFlag x -> ForAllTyFlag
Generic, (forall (m :: * -> *). Quote m => ForAllTyFlag -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
ForAllTyFlag -> Code m ForAllTyFlag)
-> Lift ForAllTyFlag
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ForAllTyFlag -> m Exp
forall (m :: * -> *).
Quote m =>
ForAllTyFlag -> Code m ForAllTyFlag
$clift :: forall (m :: * -> *). Quote m => ForAllTyFlag -> m Exp
lift :: forall (m :: * -> *). Quote m => ForAllTyFlag -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ForAllTyFlag -> Code m ForAllTyFlag
liftTyped :: forall (m :: * -> *).
Quote m =>
ForAllTyFlag -> Code m ForAllTyFlag
Lift)
instance DefaultBndrFlag ForAllTyFlag where
defaultBndrFlag :: ForAllTyFlag
defaultBndrFlag = ForAllTyFlag
Required
#if __GLASGOW_HASKELL__ >= 900
instance PprFlag ForAllTyFlag where
pprTyVarBndr :: TyVarBndr_ ForAllTyFlag -> Doc
pprTyVarBndr (PlainTV Name
nm ForAllTyFlag
vis) =
ForAllTyFlag -> Doc -> Doc
pprForAllTyFlag ForAllTyFlag
vis (Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
nm)
pprTyVarBndr (KindedTV Name
nm ForAllTyFlag
vis Kind
k) =
ForAllTyFlag -> Doc -> Doc
pprForAllTyFlag ForAllTyFlag
vis (Doc -> Doc
Ppr.parens (Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
nm Doc -> Doc -> Doc
Ppr.<+> Doc
Ppr.dcolon Doc -> Doc -> Doc
Ppr.<+> Kind -> Doc
forall a. Ppr a => a -> Doc
ppr Kind
k))
pprForAllTyFlag :: ForAllTyFlag -> Ppr.Doc -> Ppr.Doc
pprForAllTyFlag :: ForAllTyFlag -> Doc -> Doc
pprForAllTyFlag (Invisible Specificity
SpecifiedSpec) Doc
d = Char -> Doc
Ppr.char Char
'@' Doc -> Doc -> Doc
Ppr.<> Doc
d
pprForAllTyFlag (Invisible Specificity
InferredSpec) Doc
d = Doc -> Doc
Ppr.braces Doc
d
pprForAllTyFlag ForAllTyFlag
Required Doc
d = Doc
d
#endif
tvbForAllTyFlagsToSpecs :: [TyVarBndr_ ForAllTyFlag] -> [TyVarBndrSpec]
tvbForAllTyFlagsToSpecs :: [TyVarBndr_ ForAllTyFlag] -> [TyVarBndrSpec]
tvbForAllTyFlagsToSpecs = (TyVarBndr_ ForAllTyFlag -> TyVarBndrSpec)
-> [TyVarBndr_ ForAllTyFlag] -> [TyVarBndrSpec]
forall a b. (a -> b) -> [a] -> [b]
map ((ForAllTyFlag -> Specificity)
-> TyVarBndr_ ForAllTyFlag -> TyVarBndrSpec
forall flag flag'.
(flag -> flag') -> TyVarBndr_ flag -> TyVarBndr_ flag'
mapTVFlag ForAllTyFlag -> Specificity
to_spec)
where
to_spec :: ForAllTyFlag -> Specificity
to_spec :: ForAllTyFlag -> Specificity
to_spec (Invisible Specificity
spec) = Specificity
spec
to_spec ForAllTyFlag
Required = Specificity
SpecifiedSpec
tvbForAllTyFlagsToBndrVis :: [TyVarBndr_ ForAllTyFlag] -> [TyVarBndrVis]
tvbForAllTyFlagsToBndrVis :: [TyVarBndr_ ForAllTyFlag] -> [TyVarBndrUnit]
tvbForAllTyFlagsToBndrVis = [Maybe TyVarBndrUnit] -> [TyVarBndrUnit]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TyVarBndrUnit] -> [TyVarBndrUnit])
-> ([TyVarBndr_ ForAllTyFlag] -> [Maybe TyVarBndrUnit])
-> [TyVarBndr_ ForAllTyFlag]
-> [TyVarBndrUnit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TyVarBndr_ ForAllTyFlag -> Maybe TyVarBndrUnit)
-> [TyVarBndr_ ForAllTyFlag] -> [Maybe TyVarBndrUnit]
forall a b. (a -> b) -> [a] -> [b]
map ((ForAllTyFlag -> Maybe ())
-> TyVarBndr_ ForAllTyFlag -> Maybe TyVarBndrUnit
forall (f :: * -> *) flag flag'.
Applicative f =>
(flag -> f flag') -> TyVarBndr_ flag -> f (TyVarBndr_ flag')
traverseTVFlag ForAllTyFlag -> Maybe ()
to_spec_maybe)
where
to_spec_maybe :: ForAllTyFlag -> Maybe BndrVis
to_spec_maybe :: ForAllTyFlag -> Maybe ()
to_spec_maybe (Invisible Specificity
InferredSpec) = Maybe ()
forall a. Maybe a
Nothing
to_spec_maybe (Invisible Specificity
SpecifiedSpec) = () -> Maybe ()
forall a. a -> Maybe a
Just ()
bndrInvis
to_spec_maybe ForAllTyFlag
Required = () -> Maybe ()
forall a. a -> Maybe a
Just ()
BndrReq
nameOccursIn :: Data a => Name -> a -> Bool
nameOccursIn :: forall a. Data a => Name -> a -> Bool
nameOccursIn Name
n = (Bool -> Bool -> Bool)
-> (forall {a}. Data a => a -> Bool)
-> forall {a}. Data a => a -> Bool
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Bool -> Bool -> Bool
(||) ((forall {a}. Data a => a -> Bool)
-> forall {a}. Data a => a -> Bool)
-> (forall {a}. Data a => a -> Bool)
-> forall {a}. Data a => a -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> (Name -> Bool) -> a -> Bool
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ Bool
False (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n)
allNamesIn :: Data a => a -> [Name]
allNamesIn :: forall a. Data a => a -> [Name]
allNamesIn = ([Name] -> [Name] -> [Name])
-> (forall a. Data a => a -> [Name])
-> forall a. Data a => a -> [Name]
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
(++) ((forall a. Data a => a -> [Name])
-> forall a. Data a => a -> [Name])
-> (forall a. Data a => a -> [Name])
-> forall a. Data a => a -> [Name]
forall a b. (a -> b) -> a -> b
$ [Name] -> (Name -> [Name]) -> a -> [Name]
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ [] (Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[])
extractBoundNamesStmt :: Stmt -> OSet Name
(BindS Pat
pat Exp
_) = Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesStmt (LetS [Dec]
decs) = (Dec -> OSet Name) -> [Dec] -> OSet Name
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Dec -> OSet Name
extractBoundNamesDec [Dec]
decs
extractBoundNamesStmt (NoBindS Exp
_) = OSet Name
forall a. OSet a
OS.empty
extractBoundNamesStmt (ParS [[Stmt]]
stmtss) = ([Stmt] -> OSet Name) -> [[Stmt]] -> OSet Name
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Stmt -> OSet Name) -> [Stmt] -> OSet Name
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Stmt -> OSet Name
extractBoundNamesStmt) [[Stmt]]
stmtss
#if __GLASGOW_HASKELL__ >= 807
extractBoundNamesStmt (RecS [Stmt]
stmtss) = (Stmt -> OSet Name) -> [Stmt] -> OSet Name
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Stmt -> OSet Name
extractBoundNamesStmt [Stmt]
stmtss
#endif
extractBoundNamesDec :: Dec -> OSet Name
(FunD Name
name [Clause]
_) = Name -> OSet Name
forall a. a -> OSet a
OS.singleton Name
name
extractBoundNamesDec (ValD Pat
pat Body
_ [Dec]
_) = Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesDec Dec
_ = OSet Name
forall a. OSet a
OS.empty
extractBoundNamesPat :: Pat -> OSet Name
(LitP Lit
_) = OSet Name
forall a. OSet a
OS.empty
extractBoundNamesPat (VarP Name
name) = Name -> OSet Name
forall a. a -> OSet a
OS.singleton Name
name
extractBoundNamesPat (TupP [Pat]
pats) = (Pat -> OSet Name) -> [Pat] -> OSet Name
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pat -> OSet Name
extractBoundNamesPat [Pat]
pats
extractBoundNamesPat (UnboxedTupP [Pat]
pats) = (Pat -> OSet Name) -> [Pat] -> OSet Name
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pat -> OSet Name
extractBoundNamesPat [Pat]
pats
extractBoundNamesPat (ConP Name
_
#if __GLASGOW_HASKELL__ >= 901
[Kind]
_
#endif
[Pat]
pats) = (Pat -> OSet Name) -> [Pat] -> OSet Name
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pat -> OSet Name
extractBoundNamesPat [Pat]
pats
extractBoundNamesPat (InfixP Pat
p1 Name
_ Pat
p2) = Pat -> OSet Name
extractBoundNamesPat Pat
p1 OSet Name -> OSet Name -> OSet Name
forall a. Ord a => OSet a -> OSet a -> OSet a
`OS.union`
Pat -> OSet Name
extractBoundNamesPat Pat
p2
extractBoundNamesPat (UInfixP Pat
p1 Name
_ Pat
p2) = Pat -> OSet Name
extractBoundNamesPat Pat
p1 OSet Name -> OSet Name -> OSet Name
forall a. Ord a => OSet a -> OSet a -> OSet a
`OS.union`
Pat -> OSet Name
extractBoundNamesPat Pat
p2
extractBoundNamesPat (ParensP Pat
pat) = Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesPat (TildeP Pat
pat) = Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesPat (BangP Pat
pat) = Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesPat (AsP Name
name Pat
pat) = Name -> OSet Name
forall a. a -> OSet a
OS.singleton Name
name OSet Name -> OSet Name -> OSet Name
forall a. Ord a => OSet a -> OSet a -> OSet a
`OS.union`
Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesPat Pat
WildP = OSet Name
forall a. OSet a
OS.empty
extractBoundNamesPat (RecP Name
_ [FieldPat]
field_pats) = let ([Name]
_, [Pat]
pats) = [FieldPat] -> ([Name], [Pat])
forall a b. [(a, b)] -> ([a], [b])
unzip [FieldPat]
field_pats in
(Pat -> OSet Name) -> [Pat] -> OSet Name
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pat -> OSet Name
extractBoundNamesPat [Pat]
pats
extractBoundNamesPat (ListP [Pat]
pats) = (Pat -> OSet Name) -> [Pat] -> OSet Name
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pat -> OSet Name
extractBoundNamesPat [Pat]
pats
extractBoundNamesPat (SigP Pat
pat Kind
_) = Pat -> OSet Name
extractBoundNamesPat Pat
pat
extractBoundNamesPat (ViewP Exp
_ Pat
pat) = Pat -> OSet Name
extractBoundNamesPat Pat
pat
#if __GLASGOW_HASKELL__ >= 801
extractBoundNamesPat (UnboxedSumP Pat
pat Int
_ Int
_) = Pat -> OSet Name
extractBoundNamesPat Pat
pat
#endif
#if __GLASGOW_HASKELL__ >= 909
extractBoundNamesPat (TypeP _) = OS.empty
extractBoundNamesPat (InvisP _) = OS.empty
#endif
#if __GLASGOW_HASKELL__ >= 911
extractBoundNamesPat (OrP pats) = foldMap extractBoundNamesPat pats
#endif
newtype MagicIP name a r = MagicIP (IP name a => r)
bindIP :: forall name a r. a -> (IP name a => r) -> r
bindIP :: forall (name :: Symbol) a r. a -> (IP name a => r) -> r
bindIP a
val IP name a => r
k = (MagicIP name a r -> a -> r
forall a b. a -> b
unsafeCoerce (forall (name :: Symbol) a r. (IP name a => r) -> MagicIP name a r
MagicIP @name r
IP name a => r
k) :: a -> r) a
val
splitAtList :: [a] -> [b] -> ([b], [b])
splitAtList :: forall a b. [a] -> [b] -> ([b], [b])
splitAtList [] [b]
x = ([], [b]
x)
splitAtList (a
_ : [a]
t) (b
x : [b]
xs) =
let ([b]
as, [b]
bs) = [a] -> [b] -> ([b], [b])
forall a b. [a] -> [b] -> ([b], [b])
splitAtList [a]
t [b]
xs in
(b
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
as, [b]
bs)
splitAtList (a
_ : [a]
_) [] = ([], [])
thdOf3 :: (a,b,c) -> c
thdOf3 :: forall a b c. (a, b, c) -> c
thdOf3 (a
_,b
_,c
c) = c
c
liftFst :: (a -> b) -> (a, c) -> (b, c)
liftFst :: forall a b c. (a -> b) -> (a, c) -> (b, c)
liftFst a -> b
f (a
a,c
c) = (a -> b
f a
a, c
c)
liftSnd :: (a -> b) -> (c, a) -> (c, b)
liftSnd :: forall a b c. (a -> b) -> (c, a) -> (c, b)
liftSnd a -> b
f (c
c,a
a) = (c
c, a -> b
f a
a)
thirdOf3 :: (a -> b) -> (c, d, a) -> (c, d, b)
thirdOf3 :: forall a b c d. (a -> b) -> (c, d, a) -> (c, d, b)
thirdOf3 a -> b
f (c
c, d
d, a
a) = (c
c, d
d, a -> b
f a
a)
concatMapM :: (Monad monad, Monoid monoid, Traversable t)
=> (a -> monad monoid) -> t a -> monad monoid
concatMapM :: forall (monad :: * -> *) monoid (t :: * -> *) a.
(Monad monad, Monoid monoid, Traversable t) =>
(a -> monad monoid) -> t a -> monad monoid
concatMapM a -> monad monoid
fn t a
list = do
t monoid
bss <- (a -> monad monoid) -> t a -> monad (t monoid)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM a -> monad monoid
fn t a
list
monoid -> monad monoid
forall a. a -> monad a
forall (m :: * -> *) a. Monad m => a -> m a
return (monoid -> monad monoid) -> monoid -> monad monoid
forall a b. (a -> b) -> a -> b
$ t monoid -> monoid
forall m. Monoid m => t m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold t monoid
bss
mapAccumLM :: Monad m
=> (acc -> x -> m (acc, y))
-> acc
-> [x]
-> m (acc, [y])
mapAccumLM :: forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM acc -> x -> m (acc, y)
_ acc
s [] = (acc, [y]) -> m (acc, [y])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s, [])
mapAccumLM acc -> x -> m (acc, y)
f acc
s (x
x:[x]
xs) = do
(acc
s1, y
x') <- acc -> x -> m (acc, y)
f acc
s x
x
(acc
s2, [y]
xs') <- (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM acc -> x -> m (acc, y)
f acc
s1 [x]
xs
(acc, [y]) -> m (acc, [y])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s2, y
x' y -> [y] -> [y]
forall a. a -> [a] -> [a]
: [y]
xs')
mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
_ [] = [b] -> m [b]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
mapMaybeM a -> m (Maybe b)
f (a
x:[a]
xs) = do
Maybe b
y <- a -> m (Maybe b)
f a
x
[b]
ys <- (a -> m (Maybe b)) -> [a] -> m [b]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
f [a]
xs
[b] -> m [b]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([b] -> m [b]) -> [b] -> m [b]
forall a b. (a -> b) -> a -> b
$ case Maybe b
y of
Maybe b
Nothing -> [b]
ys
Just b
z -> b
z b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
ys
expectJustM :: Fail.MonadFail m => String -> Maybe a -> m a
expectJustM :: forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
expectJustM String
_ (Just a
x) = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
expectJustM String
err Maybe a
Nothing = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
err
firstMatch :: (a -> Maybe b) -> [a] -> Maybe b
firstMatch :: forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstMatch a -> Maybe b
f [a]
xs = [b] -> Maybe b
forall a. [a] -> Maybe a
listToMaybe ([b] -> Maybe b) -> [b] -> Maybe b
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f [a]
xs
firstMatchM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstMatchM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstMatchM a -> m (Maybe b)
f [a]
xs = [b] -> Maybe b
forall a. [a] -> Maybe a
listToMaybe ([b] -> Maybe b) -> m [b] -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m (Maybe b)) -> [a] -> m [b]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
f [a]
xs
topEverywhereM :: (Typeable a, Data b, Monad m) => (a -> m a) -> b -> m b
topEverywhereM :: forall a b (m :: * -> *).
(Typeable a, Data b, Monad m) =>
(a -> m a) -> b -> m b
topEverywhereM a -> m a
handler =
(forall d. Data d => d -> m d) -> b -> m b
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> b -> m b
gmapM ((a -> m a) -> d -> m d
forall a b (m :: * -> *).
(Typeable a, Data b, Monad m) =>
(a -> m a) -> b -> m b
topEverywhereM a -> m a
handler) (b -> m b) -> (a -> m a) -> b -> m b
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` a -> m a
handler
isInfixDataCon :: String -> Bool
isInfixDataCon :: String -> Bool
isInfixDataCon (Char
':':String
_) = Bool
True
isInfixDataCon String
_ = Bool
False
isTypeKindName :: Name -> Bool
isTypeKindName :: Name -> Bool
isTypeKindName Name
n = Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
typeKindName
#if __GLASGOW_HASKELL__ < 805
|| n == starKindName
|| n == uniStarKindName
#endif
typeKindName :: Name
typeKindName :: Name
typeKindName = ''Kind.Type
#if __GLASGOW_HASKELL__ < 805
starKindName :: Name
starKindName = ''(Kind.*)
uniStarKindName :: Name
uniStarKindName = ''(Kind.★)
#endif
data DataFlavor
= Newtype
| Data
| TypeData
deriving (DataFlavor -> DataFlavor -> Bool
(DataFlavor -> DataFlavor -> Bool)
-> (DataFlavor -> DataFlavor -> Bool) -> Eq DataFlavor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataFlavor -> DataFlavor -> Bool
== :: DataFlavor -> DataFlavor -> Bool
$c/= :: DataFlavor -> DataFlavor -> Bool
/= :: DataFlavor -> DataFlavor -> Bool
Eq, Int -> DataFlavor -> String -> String
[DataFlavor] -> String -> String
DataFlavor -> String
(Int -> DataFlavor -> String -> String)
-> (DataFlavor -> String)
-> ([DataFlavor] -> String -> String)
-> Show DataFlavor
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> DataFlavor -> String -> String
showsPrec :: Int -> DataFlavor -> String -> String
$cshow :: DataFlavor -> String
show :: DataFlavor -> String
$cshowList :: [DataFlavor] -> String -> String
showList :: [DataFlavor] -> String -> String
Show, Typeable DataFlavor
Typeable DataFlavor =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataFlavor -> c DataFlavor)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataFlavor)
-> (DataFlavor -> Constr)
-> (DataFlavor -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataFlavor))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DataFlavor))
-> ((forall b. Data b => b -> b) -> DataFlavor -> DataFlavor)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r)
-> (forall u. (forall d. Data d => d -> u) -> DataFlavor -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> DataFlavor -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor)
-> Data DataFlavor
DataFlavor -> Constr
DataFlavor -> DataType
(forall b. Data b => b -> b) -> DataFlavor -> DataFlavor
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DataFlavor -> u
forall u. (forall d. Data d => d -> u) -> DataFlavor -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataFlavor
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataFlavor -> c DataFlavor
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataFlavor)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataFlavor)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataFlavor -> c DataFlavor
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DataFlavor -> c DataFlavor
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataFlavor
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DataFlavor
$ctoConstr :: DataFlavor -> Constr
toConstr :: DataFlavor -> Constr
$cdataTypeOf :: DataFlavor -> DataType
dataTypeOf :: DataFlavor -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataFlavor)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DataFlavor)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataFlavor)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataFlavor)
$cgmapT :: (forall b. Data b => b -> b) -> DataFlavor -> DataFlavor
gmapT :: (forall b. Data b => b -> b) -> DataFlavor -> DataFlavor
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DataFlavor -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DataFlavor -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> DataFlavor -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataFlavor -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DataFlavor -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DataFlavor -> m DataFlavor
Data, (forall x. DataFlavor -> Rep DataFlavor x)
-> (forall x. Rep DataFlavor x -> DataFlavor) -> Generic DataFlavor
forall x. Rep DataFlavor x -> DataFlavor
forall x. DataFlavor -> Rep DataFlavor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DataFlavor -> Rep DataFlavor x
from :: forall x. DataFlavor -> Rep DataFlavor x
$cto :: forall x. Rep DataFlavor x -> DataFlavor
to :: forall x. Rep DataFlavor x -> DataFlavor
Generic, (forall (m :: * -> *). Quote m => DataFlavor -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
DataFlavor -> Code m DataFlavor)
-> Lift DataFlavor
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => DataFlavor -> m Exp
forall (m :: * -> *). Quote m => DataFlavor -> Code m DataFlavor
$clift :: forall (m :: * -> *). Quote m => DataFlavor -> m Exp
lift :: forall (m :: * -> *). Quote m => DataFlavor -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => DataFlavor -> Code m DataFlavor
liftTyped :: forall (m :: * -> *). Quote m => DataFlavor -> Code m DataFlavor
Lift)