module Language.PureScript.Environment where
import Prelude
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import Control.Monad (unless)
import Codec.Serialise (Serialise)
import Data.Aeson ((.=), (.:))
import qualified Data.Aeson as A
import Data.Foldable (find, fold)
import Data.Functor ((<&>))
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe (fromMaybe)
import Data.Semigroup (First(..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.List.NonEmpty as NEL
import Language.PureScript.AST.SourcePos
import Language.PureScript.Crash
import Language.PureScript.Names
import Language.PureScript.Roles
import Language.PureScript.TypeClassDictionaries
import Language.PureScript.Types
import qualified Language.PureScript.Constants.Prim as C
data Environment = Environment
{ Environment
-> Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
names :: M.Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
, Environment
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
types :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
, Environment
-> Map
(Qualified (ProperName 'ConstructorName))
(DataDeclType, ProperName 'TypeName, SourceType, [Ident])
dataConstructors :: M.Map (Qualified (ProperName 'ConstructorName)) (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
, Environment
-> Map
(Qualified (ProperName 'TypeName))
([(Text, Maybe SourceType)], SourceType)
typeSynonyms :: M.Map (Qualified (ProperName 'TypeName)) ([(Text, Maybe SourceType)], SourceType)
, Environment
-> Map
QualifiedBy
(Map
(Qualified (ProperName 'ClassName))
(Map (Qualified Ident) (NonEmpty NamedDict)))
typeClassDictionaries :: M.Map QualifiedBy (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) (NEL.NonEmpty NamedDict)))
, Environment
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
typeClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
} deriving (Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Environment] -> ShowS
$cshowList :: [Environment] -> ShowS
show :: Environment -> String
$cshow :: Environment -> String
showsPrec :: Int -> Environment -> ShowS
$cshowsPrec :: Int -> Environment -> ShowS
Show, forall x. Rep Environment x -> Environment
forall x. Environment -> Rep Environment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Environment x -> Environment
$cfrom :: forall x. Environment -> Rep Environment x
Generic)
instance NFData Environment
data TypeClassData = TypeClassData
{ TypeClassData -> [(Text, Maybe SourceType)]
typeClassArguments :: [(Text, Maybe SourceType)]
, TypeClassData -> [(Ident, SourceType)]
typeClassMembers :: [(Ident, SourceType)]
, TypeClassData -> [SourceConstraint]
typeClassSuperclasses :: [SourceConstraint]
, TypeClassData -> [FunctionalDependency]
typeClassDependencies :: [FunctionalDependency]
, TypeClassData -> Set Int
typeClassDeterminedArguments :: S.Set Int
, TypeClassData -> Set (Set Int)
typeClassCoveringSets :: S.Set (S.Set Int)
, TypeClassData -> Bool
typeClassIsEmpty :: Bool
} deriving (Int -> TypeClassData -> ShowS
[TypeClassData] -> ShowS
TypeClassData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeClassData] -> ShowS
$cshowList :: [TypeClassData] -> ShowS
show :: TypeClassData -> String
$cshow :: TypeClassData -> String
showsPrec :: Int -> TypeClassData -> ShowS
$cshowsPrec :: Int -> TypeClassData -> ShowS
Show, forall x. Rep TypeClassData x -> TypeClassData
forall x. TypeClassData -> Rep TypeClassData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeClassData x -> TypeClassData
$cfrom :: forall x. TypeClassData -> Rep TypeClassData x
Generic)
instance NFData TypeClassData
data FunctionalDependency = FunctionalDependency
{ FunctionalDependency -> [Int]
fdDeterminers :: [Int]
, FunctionalDependency -> [Int]
fdDetermined :: [Int]
} deriving (Int -> FunctionalDependency -> ShowS
[FunctionalDependency] -> ShowS
FunctionalDependency -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionalDependency] -> ShowS
$cshowList :: [FunctionalDependency] -> ShowS
show :: FunctionalDependency -> String
$cshow :: FunctionalDependency -> String
showsPrec :: Int -> FunctionalDependency -> ShowS
$cshowsPrec :: Int -> FunctionalDependency -> ShowS
Show, forall x. Rep FunctionalDependency x -> FunctionalDependency
forall x. FunctionalDependency -> Rep FunctionalDependency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunctionalDependency x -> FunctionalDependency
$cfrom :: forall x. FunctionalDependency -> Rep FunctionalDependency x
Generic)
instance NFData FunctionalDependency
instance Serialise FunctionalDependency
instance A.FromJSON FunctionalDependency where
parseJSON :: Value -> Parser FunctionalDependency
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"FunctionalDependency" forall a b. (a -> b) -> a -> b
$ \Object
o ->
[Int] -> [Int] -> FunctionalDependency
FunctionalDependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"determiners"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"determined"
instance A.ToJSON FunctionalDependency where
toJSON :: FunctionalDependency -> Value
toJSON FunctionalDependency{[Int]
fdDetermined :: [Int]
fdDeterminers :: [Int]
fdDetermined :: FunctionalDependency -> [Int]
fdDeterminers :: FunctionalDependency -> [Int]
..} =
[Pair] -> Value
A.object [ Key
"determiners" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Int]
fdDeterminers
, Key
"determined" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Int]
fdDetermined
]
initEnvironment :: Environment
initEnvironment :: Environment
initEnvironment = Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
-> Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
-> Map
(Qualified (ProperName 'ConstructorName))
(DataDeclType, ProperName 'TypeName, SourceType, [Ident])
-> Map
(Qualified (ProperName 'TypeName))
([(Text, Maybe SourceType)], SourceType)
-> Map
QualifiedBy
(Map
(Qualified (ProperName 'ClassName))
(Map (Qualified Ident) (NonEmpty NamedDict)))
-> Map (Qualified (ProperName 'ClassName)) TypeClassData
-> Environment
Environment forall k a. Map k a
M.empty Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
allPrimTypes forall k a. Map k a
M.empty forall k a. Map k a
M.empty forall k a. Map k a
M.empty Map (Qualified (ProperName 'ClassName)) TypeClassData
allPrimClasses
makeTypeClassData
:: [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData :: [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData [(Text, Maybe SourceType)]
args [(Ident, SourceType)]
m [SourceConstraint]
s [FunctionalDependency]
deps = [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Set Int
-> Set (Set Int)
-> Bool
-> TypeClassData
TypeClassData [(Text, Maybe SourceType)]
args [(Ident, SourceType)]
m [SourceConstraint]
s [FunctionalDependency]
deps Set Int
determinedArgs Set (Set Int)
coveringSets
where
( Set Int
determinedArgs, Set (Set Int)
coveringSets ) = Int -> [FunctionalDependency] -> (Set Int, Set (Set Int))
computeCoveringSets (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Maybe SourceType)]
args) [FunctionalDependency]
deps
type Frontier = M.Map IS.IntSet (First (IM.IntMap (NEL.NonEmpty IS.IntSet)))
computeCoveringSets :: Int -> [FunctionalDependency] -> (S.Set Int, S.Set (S.Set Int))
computeCoveringSets :: Int -> [FunctionalDependency] -> (Set Int, Set (Set Int))
computeCoveringSets Int
nargs [FunctionalDependency]
deps = ( Set Int
determinedArgs, Set (Set Int)
coveringSets )
where
argumentIndices :: Set Int
argumentIndices = forall a. Ord a => [a] -> Set a
S.fromList [Int
0 .. Int
nargs forall a. Num a => a -> a -> a
- Int
1]
allCoveringSets :: S.Set (S.Set Int)
allCoveringSets :: Set (Set Int)
allCoveringSets = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall a. [a] -> Set a
S.fromDistinctAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IS.toAscList) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Frontier -> (Set IntSet, ())
search forall a b. (a -> b) -> a -> b
$
forall k a. k -> a -> Map k a
M.singleton
([Int] -> IntSet
IS.fromList [Int
0 .. Int
nargs forall a. Num a => a -> a -> a
- Int
1]) forall a b. (a -> b) -> a -> b
$
forall a. a -> First a
First forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ do
FunctionalDependency
fd <- [FunctionalDependency]
deps
let srcs :: NonEmpty IntSet
srcs = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int] -> IntSet
IS.fromList (FunctionalDependency -> [Int]
fdDeterminers FunctionalDependency
fd))
Int
tgt <- FunctionalDependency -> [Int]
fdDetermined FunctionalDependency
fd
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
tgt, NonEmpty IntSet
srcs)
where
search :: Frontier -> (S.Set IS.IntSet, ())
search :: Frontier -> (Set IntSet, ())
search Frontier
frontier = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Frontier
frontier) forall a b. (a -> b) -> a -> b
$ forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
M.foldMapWithKey IntSet
-> First (IntMap (NonEmpty IntSet)) -> (Set IntSet, Frontier)
step Frontier
frontier forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Frontier -> (Set IntSet, ())
search
step :: IS.IntSet -> First (IM.IntMap (NEL.NonEmpty IS.IntSet)) -> (S.Set IS.IntSet, Frontier)
step :: IntSet
-> First (IntMap (NonEmpty IntSet)) -> (Set IntSet, Frontier)
step IntSet
needed (First IntMap (NonEmpty IntSet)
inEdges)
| forall a. IntMap a -> Bool
IM.null IntMap (NonEmpty IntSet)
inEdges = (forall a. a -> Set a
S.singleton IntSet
needed, forall k a. Map k a
M.empty)
| Bool
otherwise = (forall a. Set a
S.empty, forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Int -> Frontier
removeParameter [Int]
paramsToTry)
where
determined :: [Int]
determined = forall a. IntMap a -> [Int]
IM.keys IntMap (NonEmpty IntSet)
inEdges
acycDetermined :: Maybe Int
acycDetermined = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Int -> IntSet -> Bool
`IS.notMember` (forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IS.unions forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. NonEmpty a -> [a]
NEL.toList forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [a]
IM.elems IntMap (NonEmpty IntSet)
inEdges)) [Int]
determined
paramsToTry :: [Int]
paramsToTry = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Int]
determined forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
acycDetermined
removeParameter :: Int -> Frontier
removeParameter :: Int -> Frontier
removeParameter Int
y =
forall k a. k -> a -> Map k a
M.singleton
(Int -> IntSet -> IntSet
IS.delete Int
y IntSet
needed) forall a b. (a -> b) -> a -> b
$
case Maybe Int
acycDetermined of
Just Int
_ -> forall a. a -> First a
First forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> IntMap a
IM.delete Int
y IntMap (NonEmpty IntSet)
inEdges
Maybe Int
Nothing ->
forall a. a -> First a
First forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IM.mapMaybe (forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> NonEmpty a -> [a]
NEL.filter (Int
y Int -> IntSet -> Bool
`IS.notMember`)) forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> IntMap a
IM.delete Int
y IntMap (NonEmpty IntSet)
inEdges
coveringSets :: Set (Set Int)
coveringSets = forall a. (a -> Bool) -> Set a -> Set a
S.filter (\Set Int
v -> Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Set Int
c -> Set Int
c forall a. Ord a => Set a -> Set a -> Bool
`S.isProperSubsetOf` Set Int
v) Set (Set Int)
allCoveringSets)) Set (Set Int)
allCoveringSets
determinedArgs :: Set Int
determinedArgs = Set Int
argumentIndices forall a. Ord a => Set a -> Set a -> Set a
`S.difference` forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Set (Set Int)
coveringSets
data NameVisibility
= Undefined
| Defined
deriving (Int -> NameVisibility -> ShowS
[NameVisibility] -> ShowS
NameVisibility -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameVisibility] -> ShowS
$cshowList :: [NameVisibility] -> ShowS
show :: NameVisibility -> String
$cshow :: NameVisibility -> String
showsPrec :: Int -> NameVisibility -> ShowS
$cshowsPrec :: Int -> NameVisibility -> ShowS
Show, NameVisibility -> NameVisibility -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameVisibility -> NameVisibility -> Bool
$c/= :: NameVisibility -> NameVisibility -> Bool
== :: NameVisibility -> NameVisibility -> Bool
$c== :: NameVisibility -> NameVisibility -> Bool
Eq, forall x. Rep NameVisibility x -> NameVisibility
forall x. NameVisibility -> Rep NameVisibility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NameVisibility x -> NameVisibility
$cfrom :: forall x. NameVisibility -> Rep NameVisibility x
Generic)
instance NFData NameVisibility
instance Serialise NameVisibility
data NameKind
= Private
| Public
| External
deriving (Int -> NameKind -> ShowS
[NameKind] -> ShowS
NameKind -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameKind] -> ShowS
$cshowList :: [NameKind] -> ShowS
show :: NameKind -> String
$cshow :: NameKind -> String
showsPrec :: Int -> NameKind -> ShowS
$cshowsPrec :: Int -> NameKind -> ShowS
Show, NameKind -> NameKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameKind -> NameKind -> Bool
$c/= :: NameKind -> NameKind -> Bool
== :: NameKind -> NameKind -> Bool
$c== :: NameKind -> NameKind -> Bool
Eq, forall x. Rep NameKind x -> NameKind
forall x. NameKind -> Rep NameKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NameKind x -> NameKind
$cfrom :: forall x. NameKind -> Rep NameKind x
Generic)
instance NFData NameKind
instance Serialise NameKind
data TypeKind
= DataType DataDeclType [(Text, Maybe SourceType, Role)] [(ProperName 'ConstructorName, [SourceType])]
| TypeSynonym
| ExternData [Role]
| LocalTypeVariable
| ScopedTypeVar
deriving (Int -> TypeKind -> ShowS
[TypeKind] -> ShowS
TypeKind -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeKind] -> ShowS
$cshowList :: [TypeKind] -> ShowS
show :: TypeKind -> String
$cshow :: TypeKind -> String
showsPrec :: Int -> TypeKind -> ShowS
$cshowsPrec :: Int -> TypeKind -> ShowS
Show, TypeKind -> TypeKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeKind -> TypeKind -> Bool
$c/= :: TypeKind -> TypeKind -> Bool
== :: TypeKind -> TypeKind -> Bool
$c== :: TypeKind -> TypeKind -> Bool
Eq, forall x. Rep TypeKind x -> TypeKind
forall x. TypeKind -> Rep TypeKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeKind x -> TypeKind
$cfrom :: forall x. TypeKind -> Rep TypeKind x
Generic)
instance NFData TypeKind
instance Serialise TypeKind
data DataDeclType
= Data
| Newtype
deriving (Int -> DataDeclType -> ShowS
[DataDeclType] -> ShowS
DataDeclType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataDeclType] -> ShowS
$cshowList :: [DataDeclType] -> ShowS
show :: DataDeclType -> String
$cshow :: DataDeclType -> String
showsPrec :: Int -> DataDeclType -> ShowS
$cshowsPrec :: Int -> DataDeclType -> ShowS
Show, DataDeclType -> DataDeclType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataDeclType -> DataDeclType -> Bool
$c/= :: DataDeclType -> DataDeclType -> Bool
== :: DataDeclType -> DataDeclType -> Bool
$c== :: DataDeclType -> DataDeclType -> Bool
Eq, Eq DataDeclType
DataDeclType -> DataDeclType -> Bool
DataDeclType -> DataDeclType -> Ordering
DataDeclType -> DataDeclType -> DataDeclType
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
min :: DataDeclType -> DataDeclType -> DataDeclType
$cmin :: DataDeclType -> DataDeclType -> DataDeclType
max :: DataDeclType -> DataDeclType -> DataDeclType
$cmax :: DataDeclType -> DataDeclType -> DataDeclType
>= :: DataDeclType -> DataDeclType -> Bool
$c>= :: DataDeclType -> DataDeclType -> Bool
> :: DataDeclType -> DataDeclType -> Bool
$c> :: DataDeclType -> DataDeclType -> Bool
<= :: DataDeclType -> DataDeclType -> Bool
$c<= :: DataDeclType -> DataDeclType -> Bool
< :: DataDeclType -> DataDeclType -> Bool
$c< :: DataDeclType -> DataDeclType -> Bool
compare :: DataDeclType -> DataDeclType -> Ordering
$ccompare :: DataDeclType -> DataDeclType -> Ordering
Ord, forall x. Rep DataDeclType x -> DataDeclType
forall x. DataDeclType -> Rep DataDeclType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataDeclType x -> DataDeclType
$cfrom :: forall x. DataDeclType -> Rep DataDeclType x
Generic)
instance NFData DataDeclType
instance Serialise DataDeclType
showDataDeclType :: DataDeclType -> Text
showDataDeclType :: DataDeclType -> Text
showDataDeclType DataDeclType
Data = Text
"data"
showDataDeclType DataDeclType
Newtype = Text
"newtype"
instance A.ToJSON DataDeclType where
toJSON :: DataDeclType -> Value
toJSON = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDeclType -> Text
showDataDeclType
instance A.FromJSON DataDeclType where
parseJSON :: Value -> Parser DataDeclType
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"DataDeclType" forall a b. (a -> b) -> a -> b
$ \case
Text
"data" -> forall (m :: * -> *) a. Monad m => a -> m a
return DataDeclType
Data
Text
"newtype" -> forall (m :: * -> *) a. Monad m => a -> m a
return DataDeclType
Newtype
Text
other -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid type: '" forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
other forall a. [a] -> [a] -> [a]
++ String
"'"
kindType :: SourceType
kindType :: SourceType
kindType = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Type
kindConstraint :: SourceType
kindConstraint :: SourceType
kindConstraint = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Constraint
kindSymbol :: SourceType
kindSymbol :: SourceType
kindSymbol = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Symbol
kindDoc :: SourceType
kindDoc :: SourceType
kindDoc = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Doc
kindOrdering :: SourceType
kindOrdering :: SourceType
kindOrdering = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.TypeOrdering
kindRowList :: SourceType -> SourceType
kindRowList :: SourceType -> SourceType
kindRowList = forall a. a -> Type a -> Type a -> Type a
TypeApp (SourceSpan, [Comment])
nullSourceAnn (Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.RowList)
kindRow :: SourceType -> SourceType
kindRow :: SourceType -> SourceType
kindRow = forall a. a -> Type a -> Type a -> Type a
TypeApp (SourceSpan, [Comment])
nullSourceAnn (Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Row)
kindOfREmpty :: SourceType
kindOfREmpty :: SourceType
kindOfREmpty = Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k"))
tyFunction :: SourceType
tyFunction :: SourceType
tyFunction = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Function
tyString :: SourceType
tyString :: SourceType
tyString = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.String
tyChar :: SourceType
tyChar :: SourceType
tyChar = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Char
tyNumber :: SourceType
tyNumber :: SourceType
tyNumber = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Number
tyInt :: SourceType
tyInt :: SourceType
tyInt = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Int
tyBoolean :: SourceType
tyBoolean :: SourceType
tyBoolean = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Boolean
tyArray :: SourceType
tyArray :: SourceType
tyArray = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Array
tyRecord :: SourceType
tyRecord :: SourceType
tyRecord = Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor Qualified (ProperName 'TypeName)
C.Record
tyVar :: Text -> SourceType
tyVar :: Text -> SourceType
tyVar = forall a. a -> Text -> Type a
TypeVar (SourceSpan, [Comment])
nullSourceAnn
tyForall :: Text -> SourceType -> SourceType -> SourceType
tyForall :: Text -> SourceType -> SourceType -> SourceType
tyForall Text
var SourceType
k SourceType
ty = forall a.
a
-> Text -> Maybe (Type a) -> Type a -> Maybe SkolemScope -> Type a
ForAll (SourceSpan, [Comment])
nullSourceAnn Text
var (forall a. a -> Maybe a
Just SourceType
k) SourceType
ty forall a. Maybe a
Nothing
function :: SourceType -> SourceType -> SourceType
function :: SourceType -> SourceType -> SourceType
function = forall a. a -> Type a -> Type a -> Type a
TypeApp (SourceSpan, [Comment])
nullSourceAnn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Type a -> Type a -> Type a
TypeApp (SourceSpan, [Comment])
nullSourceAnn SourceType
tyFunction
(-:>) :: SourceType -> SourceType -> SourceType
-:> :: SourceType -> SourceType -> SourceType
(-:>) = SourceType -> SourceType -> SourceType
function
infixr 4 -:>
primClass :: Qualified (ProperName 'ClassName) -> (SourceType -> SourceType) -> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass :: Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
name SourceType -> SourceType
mkKind =
[ let k :: SourceType
k = SourceType -> SourceType
mkKind SourceType
kindConstraint
in (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (ProperName 'ClassName)
name, (SourceType
k, [Role] -> TypeKind
ExternData (forall a. Type a -> [Role]
nominalRolesForKind SourceType
k)))
, let k :: SourceType
k = SourceType -> SourceType
mkKind SourceType
kindType
in (forall (a :: ProperNameType). ProperName a -> ProperName a
dictTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (ProperName 'ClassName)
name, (SourceType
k, TypeKind
TypeSynonym))
]
primTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypes =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Qualified (ProperName 'TypeName)
C.Type, (SourceType
kindType, [Role] -> TypeKind
ExternData []))
, (Qualified (ProperName 'TypeName)
C.Constraint, (SourceType
kindType, [Role] -> TypeKind
ExternData []))
, (Qualified (ProperName 'TypeName)
C.Symbol, (SourceType
kindType, [Role] -> TypeKind
ExternData []))
, (Qualified (ProperName 'TypeName)
C.Row, (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Phantom]))
, (Qualified (ProperName 'TypeName)
C.Function, (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Representational, Role
Representational]))
, (Qualified (ProperName 'TypeName)
C.Array, (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Representational]))
, (Qualified (ProperName 'TypeName)
C.Record, (SourceType -> SourceType
kindRow SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Representational]))
, (Qualified (ProperName 'TypeName)
C.String, (SourceType
kindType, [Role] -> TypeKind
ExternData []))
, (Qualified (ProperName 'TypeName)
C.Char, (SourceType
kindType, [Role] -> TypeKind
ExternData []))
, (Qualified (ProperName 'TypeName)
C.Number, (SourceType
kindType, [Role] -> TypeKind
ExternData []))
, (Qualified (ProperName 'TypeName)
C.Int, (SourceType
kindType, [Role] -> TypeKind
ExternData []))
, (Qualified (ProperName 'TypeName)
C.Boolean, (SourceType
kindType, [Role] -> TypeKind
ExternData []))
, (Qualified (ProperName 'ClassName)
C.Partial forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName, (SourceType
kindConstraint, [Role] -> TypeKind
ExternData []))
]
allPrimTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
allPrimTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
allPrimTypes = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
[ Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypes
, Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primBooleanTypes
, Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primCoerceTypes
, Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primOrderingTypes
, Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowTypes
, Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowListTypes
, Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primSymbolTypes
, Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primIntTypes
, Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypeErrorTypes
]
primBooleanTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primBooleanTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primBooleanTypes =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Qualified (ProperName 'TypeName)
C.True, (SourceType
tyBoolean, [Role] -> TypeKind
ExternData []))
, (Qualified (ProperName 'TypeName)
C.False, (SourceType
tyBoolean, [Role] -> TypeKind
ExternData []))
]
primCoerceTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primCoerceTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primCoerceTypes =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.Coercible (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType forall a b. (a -> b) -> a -> b
$ Text -> SourceType
tyVar Text
"k" SourceType -> SourceType -> SourceType
-:> Text -> SourceType
tyVar Text
"k" SourceType -> SourceType -> SourceType
-:> SourceType
kind)
]
primOrderingTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primOrderingTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primOrderingTypes =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Qualified (ProperName 'TypeName)
C.TypeOrdering, (SourceType
kindType, [Role] -> TypeKind
ExternData []))
, (Qualified (ProperName 'TypeName)
C.LT, (SourceType
kindOrdering, [Role] -> TypeKind
ExternData []))
, (Qualified (ProperName 'TypeName)
C.EQ, (SourceType
kindOrdering, [Role] -> TypeKind
ExternData []))
, (Qualified (ProperName 'TypeName)
C.GT, (SourceType
kindOrdering, [Role] -> TypeKind
ExternData []))
]
primRowTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowTypes =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.RowUnion (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType forall a b. (a -> b) -> a -> b
$ SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType
kind)
, Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.RowNub (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType forall a b. (a -> b) -> a -> b
$ SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType
kind)
, Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.RowLacks (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType forall a b. (a -> b) -> a -> b
$ SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType
kind)
, Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.RowCons (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType forall a b. (a -> b) -> a -> b
$ SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> Text -> SourceType
tyVar Text
"k" SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType
kind)
]
primRowListTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowListTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primRowListTypes =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
[ (Qualified (ProperName 'TypeName)
C.RowList, (SourceType
kindType SourceType -> SourceType -> SourceType
-:> SourceType
kindType, [Role] -> TypeKind
ExternData [Role
Phantom]))
, (Qualified (ProperName 'TypeName)
C.RowListCons, (Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType forall a b. (a -> b) -> a -> b
$ SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> Text -> SourceType
tyVar Text
"k" SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRowList (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRowList (Text -> SourceType
tyVar Text
"k"), [Role] -> TypeKind
ExternData [Role
Phantom, Role
Phantom, Role
Phantom]))
, (Qualified (ProperName 'TypeName)
C.RowListNil, (Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType forall a b. (a -> b) -> a -> b
$ SourceType -> SourceType
kindRowList (Text -> SourceType
tyVar Text
"k"), [Role] -> TypeKind
ExternData []))
] forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat
[ Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.RowToList (\SourceType
kind -> Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType forall a b. (a -> b) -> a -> b
$ SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType -> SourceType
kindRowList (Text -> SourceType
tyVar Text
"k") SourceType -> SourceType -> SourceType
-:> SourceType
kind)
]
primSymbolTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primSymbolTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primSymbolTypes =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.SymbolAppend (\SourceType
kind -> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kind)
, Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.SymbolCompare (\SourceType
kind -> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindOrdering SourceType -> SourceType -> SourceType
-:> SourceType
kind)
, Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.SymbolCons (\SourceType
kind -> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kind)
]
primIntTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primIntTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primIntTypes =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.IntAdd (\SourceType
kind -> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
kind)
, Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.IntCompare (\SourceType
kind -> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
kindOrdering SourceType -> SourceType -> SourceType
-:> SourceType
kind)
, Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.IntMul (\SourceType
kind -> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
kind)
, Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.IntToString (\SourceType
kind -> SourceType
tyInt SourceType -> SourceType -> SourceType
-:> SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kind)
]
primTypeErrorTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypeErrorTypes :: Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
primTypeErrorTypes =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
[ (Qualified (ProperName 'TypeName)
C.Doc, (SourceType
kindType, [Role] -> TypeKind
ExternData []))
, (Qualified (ProperName 'ClassName)
C.Fail forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName, (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindConstraint, [Role] -> TypeKind
ExternData [Role
Nominal]))
, (Qualified (ProperName 'ClassName)
C.Warn forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName, (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindConstraint, [Role] -> TypeKind
ExternData [Role
Nominal]))
, (Qualified (ProperName 'TypeName)
C.Text, (SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom]))
, (Qualified (ProperName 'TypeName)
C.Quote, (Text -> SourceType -> SourceType -> SourceType
tyForall Text
"k" SourceType
kindType forall a b. (a -> b) -> a -> b
$ Text -> SourceType
tyVar Text
"k" SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom]))
, (Qualified (ProperName 'TypeName)
C.QuoteLabel, (SourceType
kindSymbol SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom]))
, (Qualified (ProperName 'TypeName)
C.Beside, (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom, Role
Phantom]))
, (Qualified (ProperName 'TypeName)
C.Above, (SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kindDoc, [Role] -> TypeKind
ExternData [Role
Phantom, Role
Phantom]))
] forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat
[ Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.Fail (\SourceType
kind -> SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kind)
, Qualified (ProperName 'ClassName)
-> (SourceType -> SourceType)
-> [(Qualified (ProperName 'TypeName), (SourceType, TypeKind))]
primClass Qualified (ProperName 'ClassName)
C.Warn (\SourceType
kind -> SourceType
kindDoc SourceType -> SourceType -> SourceType
-:> SourceType
kind)
]
primClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primClasses =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Qualified (ProperName 'ClassName)
C.Partial, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData [] [] [] [] Bool
True)
]
allPrimClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
allPrimClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
allPrimClasses = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
[ Map (Qualified (ProperName 'ClassName)) TypeClassData
primClasses
, Map (Qualified (ProperName 'ClassName)) TypeClassData
primCoerceClasses
, Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowClasses
, Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowListClasses
, Map (Qualified (ProperName 'ClassName)) TypeClassData
primSymbolClasses
, Map (Qualified (ProperName 'ClassName)) TypeClassData
primIntClasses
, Map (Qualified (ProperName 'ClassName)) TypeClassData
primTypeErrorClasses
]
primCoerceClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primCoerceClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primCoerceClasses =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Qualified (ProperName 'ClassName)
C.Coercible, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[ (Text
"a", forall a. a -> Maybe a
Just (Text -> SourceType
tyVar Text
"k"))
, (Text
"b", forall a. a -> Maybe a
Just (Text -> SourceType
tyVar Text
"k"))
] [] [] [] Bool
True)
]
primRowClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowClasses =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Qualified (ProperName 'ClassName)
C.RowUnion, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[ (Text
"left", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
, (Text
"right", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
, (Text
"union", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
] [] []
[ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1] [Int
2]
, [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
1, Int
2] [Int
0]
, [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
2, Int
0] [Int
1]
] Bool
True)
, (Qualified (ProperName 'ClassName)
C.RowNub, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[ (Text
"original", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
, (Text
"nubbed", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
] [] []
[ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0] [Int
1]
] Bool
True)
, (Qualified (ProperName 'ClassName)
C.RowLacks, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[ (Text
"label", forall a. a -> Maybe a
Just SourceType
kindSymbol)
, (Text
"row", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
] [] [] [] Bool
True)
, (Qualified (ProperName 'ClassName)
C.RowCons, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[ (Text
"label", forall a. a -> Maybe a
Just SourceType
kindSymbol)
, (Text
"a", forall a. a -> Maybe a
Just (Text -> SourceType
tyVar Text
"k"))
, (Text
"tail", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
, (Text
"row", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
] [] []
[ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1, Int
2] [Int
3]
, [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
3] [Int
1, Int
2]
] Bool
True)
]
primRowListClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowListClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowListClasses =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Qualified (ProperName 'ClassName)
C.RowToList, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[ (Text
"row", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRow (Text -> SourceType
tyVar Text
"k")))
, (Text
"list", forall a. a -> Maybe a
Just (SourceType -> SourceType
kindRowList (Text -> SourceType
tyVar Text
"k")))
] [] []
[ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0] [Int
1]
] Bool
True)
]
primSymbolClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primSymbolClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primSymbolClasses =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Qualified (ProperName 'ClassName)
C.SymbolAppend, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[ (Text
"left", forall a. a -> Maybe a
Just SourceType
kindSymbol)
, (Text
"right", forall a. a -> Maybe a
Just SourceType
kindSymbol)
, (Text
"appended", forall a. a -> Maybe a
Just SourceType
kindSymbol)
] [] []
[ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1] [Int
2]
, [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
1, Int
2] [Int
0]
, [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
2, Int
0] [Int
1]
] Bool
True)
, (Qualified (ProperName 'ClassName)
C.SymbolCompare, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[ (Text
"left", forall a. a -> Maybe a
Just SourceType
kindSymbol)
, (Text
"right", forall a. a -> Maybe a
Just SourceType
kindSymbol)
, (Text
"ordering", forall a. a -> Maybe a
Just SourceType
kindOrdering)
] [] []
[ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1] [Int
2]
] Bool
True)
, (Qualified (ProperName 'ClassName)
C.SymbolCons, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[ (Text
"head", forall a. a -> Maybe a
Just SourceType
kindSymbol)
, (Text
"tail", forall a. a -> Maybe a
Just SourceType
kindSymbol)
, (Text
"symbol", forall a. a -> Maybe a
Just SourceType
kindSymbol)
] [] []
[ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1] [Int
2]
, [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
2] [Int
0, Int
1]
] Bool
True)
]
primIntClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primIntClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primIntClasses =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Qualified (ProperName 'ClassName)
C.IntAdd, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[ (Text
"left", forall a. a -> Maybe a
Just SourceType
tyInt)
, (Text
"right", forall a. a -> Maybe a
Just SourceType
tyInt)
, (Text
"sum", forall a. a -> Maybe a
Just SourceType
tyInt)
] [] []
[ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1] [Int
2]
, [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
2] [Int
1]
, [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
1, Int
2] [Int
0]
] Bool
True)
, (Qualified (ProperName 'ClassName)
C.IntCompare, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[ (Text
"left", forall a. a -> Maybe a
Just SourceType
tyInt)
, (Text
"right", forall a. a -> Maybe a
Just SourceType
tyInt)
, (Text
"ordering", forall a. a -> Maybe a
Just SourceType
kindOrdering)
] [] []
[ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1] [Int
2]
] Bool
True)
, (Qualified (ProperName 'ClassName)
C.IntMul, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[ (Text
"left", forall a. a -> Maybe a
Just SourceType
tyInt)
, (Text
"right", forall a. a -> Maybe a
Just SourceType
tyInt)
, (Text
"product", forall a. a -> Maybe a
Just SourceType
tyInt)
] [] []
[ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0, Int
1] [Int
2]
] Bool
True)
, (Qualified (ProperName 'ClassName)
C.IntToString, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[ (Text
"int", forall a. a -> Maybe a
Just SourceType
tyInt)
, (Text
"string", forall a. a -> Maybe a
Just SourceType
kindSymbol)
] [] []
[ [Int] -> [Int] -> FunctionalDependency
FunctionalDependency [Int
0] [Int
1]
] Bool
True)
]
primTypeErrorClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
primTypeErrorClasses :: Map (Qualified (ProperName 'ClassName)) TypeClassData
primTypeErrorClasses =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (Qualified (ProperName 'ClassName)
C.Fail, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[(Text
"message", forall a. a -> Maybe a
Just SourceType
kindDoc)] [] [] [] Bool
True)
, (Qualified (ProperName 'ClassName)
C.Warn, [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData
[(Text
"message", forall a. a -> Maybe a
Just SourceType
kindDoc)] [] [] [] Bool
True)
]
lookupConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
lookupConstructor :: Environment
-> Qualified (ProperName 'ConstructorName)
-> (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
lookupConstructor Environment
env Qualified (ProperName 'ConstructorName)
ctor =
forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
internalError String
"Data constructor not found") forall a b. (a -> b) -> a -> b
$ Qualified (ProperName 'ConstructorName)
ctor forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Environment
-> Map
(Qualified (ProperName 'ConstructorName))
(DataDeclType, ProperName 'TypeName, SourceType, [Ident])
dataConstructors Environment
env
lookupValue :: Environment -> Qualified Ident -> Maybe (SourceType, NameKind, NameVisibility)
lookupValue :: Environment
-> Qualified Ident -> Maybe (SourceType, NameKind, NameVisibility)
lookupValue Environment
env Qualified Ident
ident = Qualified Ident
ident forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Environment
-> Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
names Environment
env
dictTypeName' :: Text -> Text
dictTypeName' :: Text -> Text
dictTypeName' = (forall a. Semigroup a => a -> a -> a
<> Text
"$Dict")
dictTypeName :: ProperName a -> ProperName a
dictTypeName :: forall (a :: ProperNameType). ProperName a -> ProperName a
dictTypeName = forall (a :: ProperNameType). Text -> ProperName a
ProperName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dictTypeName' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). ProperName a -> Text
runProperName
isDictTypeName :: ProperName a -> Bool
isDictTypeName :: forall (a :: ProperNameType). ProperName a -> Bool
isDictTypeName = Text -> Text -> Bool
T.isSuffixOf Text
"$Dict" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). ProperName a -> Text
runProperName
nominalRolesForKind :: Type a -> [Role]
nominalRolesForKind :: forall a. Type a -> [Role]
nominalRolesForKind Type a
k = forall a. Int -> a -> [a]
replicate (forall a. Type a -> Int
kindArity Type a
k) Role
Nominal
kindArity :: Type a -> Int
kindArity :: forall a. Type a -> Int
kindArity = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Type a -> ([Type a], Type a)
unapplyKinds
unapplyKinds :: Type a -> ([Type a], Type a)
unapplyKinds :: forall a. Type a -> ([Type a], Type a)
unapplyKinds = forall {a}. [Type a] -> Type a -> ([Type a], Type a)
go [] where
go :: [Type a] -> Type a -> ([Type a], Type a)
go [Type a]
kinds (TypeApp a
_ (TypeApp a
_ Type a
fn Type a
k1) Type a
k2)
| forall a b. Type a -> Type b -> Bool
eqType Type a
fn SourceType
tyFunction = [Type a] -> Type a -> ([Type a], Type a)
go (Type a
k1 forall a. a -> [a] -> [a]
: [Type a]
kinds) Type a
k2
go [Type a]
kinds (ForAll a
_ Text
_ Maybe (Type a)
_ Type a
k Maybe SkolemScope
_) = [Type a] -> Type a -> ([Type a], Type a)
go [Type a]
kinds Type a
k
go [Type a]
kinds Type a
k = (forall a. [a] -> [a]
reverse [Type a]
kinds, Type a
k)