module Env.Type
( TypeKind (..), toTypeKind,
TypeEnv, bindTypeKind, lookupTypeKind, qualLookupTypeKind
) where
import Curry.Base.Ident
import Base.Messages (internalError)
import Base.TopEnv
import Base.Types (constrIdent, methodName)
import Env.TypeConstructor (TypeInfo (..))
import Data.List (union)
data TypeKind
= Data QualIdent [Ident]
| Alias QualIdent
| Class QualIdent [Ident]
deriving (TypeKind -> TypeKind -> Bool
(TypeKind -> TypeKind -> Bool)
-> (TypeKind -> TypeKind -> Bool) -> Eq TypeKind
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, Int -> TypeKind -> ShowS
[TypeKind] -> ShowS
TypeKind -> String
(Int -> TypeKind -> ShowS)
-> (TypeKind -> String) -> ([TypeKind] -> ShowS) -> Show TypeKind
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)
instance Entity TypeKind where
origName :: TypeKind -> QualIdent
origName (Data tc :: QualIdent
tc _) = QualIdent
tc
origName (Alias tc :: QualIdent
tc ) = QualIdent
tc
origName (Class cls :: QualIdent
cls _) = QualIdent
cls
merge :: TypeKind -> TypeKind -> Maybe TypeKind
merge (Data tc :: QualIdent
tc cs :: [Ident]
cs) (Data tc' :: QualIdent
tc' cs' :: [Ident]
cs')
| QualIdent
tc QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
tc' = TypeKind -> Maybe TypeKind
forall a. a -> Maybe a
Just (TypeKind -> Maybe TypeKind) -> TypeKind -> Maybe TypeKind
forall a b. (a -> b) -> a -> b
$ QualIdent -> [Ident] -> TypeKind
Data QualIdent
tc ([Ident] -> TypeKind) -> [Ident] -> TypeKind
forall a b. (a -> b) -> a -> b
$ [Ident]
cs [Ident] -> [Ident] -> [Ident]
forall a. Eq a => [a] -> [a] -> [a]
`union` [Ident]
cs'
merge (Alias tc :: QualIdent
tc) (Alias tc' :: QualIdent
tc')
| QualIdent
tc QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
tc' = TypeKind -> Maybe TypeKind
forall a. a -> Maybe a
Just (TypeKind -> Maybe TypeKind) -> TypeKind -> Maybe TypeKind
forall a b. (a -> b) -> a -> b
$ QualIdent -> TypeKind
Alias QualIdent
tc
merge (Class cls :: QualIdent
cls ms :: [Ident]
ms) (Class cls' :: QualIdent
cls' ms' :: [Ident]
ms')
| QualIdent
cls QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
cls' = TypeKind -> Maybe TypeKind
forall a. a -> Maybe a
Just (TypeKind -> Maybe TypeKind) -> TypeKind -> Maybe TypeKind
forall a b. (a -> b) -> a -> b
$QualIdent -> [Ident] -> TypeKind
Class QualIdent
cls ([Ident] -> TypeKind) -> [Ident] -> TypeKind
forall a b. (a -> b) -> a -> b
$ [Ident]
ms [Ident] -> [Ident] -> [Ident]
forall a. Eq a => [a] -> [a] -> [a]
`union` [Ident]
ms'
merge _ _ = Maybe TypeKind
forall a. Maybe a
Nothing
toTypeKind :: TypeInfo -> TypeKind
toTypeKind :: TypeInfo -> TypeKind
toTypeKind (DataType tc :: QualIdent
tc _ cs :: [DataConstr]
cs) = QualIdent -> [Ident] -> TypeKind
Data QualIdent
tc ((DataConstr -> Ident) -> [DataConstr] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map DataConstr -> Ident
constrIdent [DataConstr]
cs)
toTypeKind (RenamingType tc :: QualIdent
tc _ nc :: DataConstr
nc) = QualIdent -> [Ident] -> TypeKind
Data QualIdent
tc [DataConstr -> Ident
constrIdent DataConstr
nc]
toTypeKind (AliasType tc :: QualIdent
tc _ _ _) = QualIdent -> TypeKind
Alias QualIdent
tc
toTypeKind (TypeClass cls :: QualIdent
cls _ ms :: [ClassMethod]
ms) = QualIdent -> [Ident] -> TypeKind
Class QualIdent
cls ((ClassMethod -> Ident) -> [ClassMethod] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map ClassMethod -> Ident
methodName [ClassMethod]
ms)
toTypeKind (TypeVar _) =
String -> TypeKind
forall a. String -> a
internalError "Env.Type.toTypeKind: type variable"
type TypeEnv = TopEnv TypeKind
bindTypeKind :: ModuleIdent -> Ident -> TypeKind -> TypeEnv -> TypeEnv
bindTypeKind :: ModuleIdent -> Ident -> TypeKind -> TypeEnv -> TypeEnv
bindTypeKind m :: ModuleIdent
m ident :: Ident
ident tk :: TypeKind
tk = Ident -> TypeKind -> TypeEnv -> TypeEnv
forall a. Ident -> a -> TopEnv a -> TopEnv a
bindTopEnv Ident
ident TypeKind
tk (TypeEnv -> TypeEnv) -> (TypeEnv -> TypeEnv) -> TypeEnv -> TypeEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualIdent -> TypeKind -> TypeEnv -> TypeEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv QualIdent
qident TypeKind
tk
where
qident :: QualIdent
qident = ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
ident
lookupTypeKind :: Ident -> TypeEnv -> [TypeKind]
lookupTypeKind :: Ident -> TypeEnv -> [TypeKind]
lookupTypeKind = Ident -> TypeEnv -> [TypeKind]
forall a. Ident -> TopEnv a -> [a]
lookupTopEnv
qualLookupTypeKind :: QualIdent -> TypeEnv -> [TypeKind]
qualLookupTypeKind :: QualIdent -> TypeEnv -> [TypeKind]
qualLookupTypeKind = QualIdent -> TypeEnv -> [TypeKind]
forall a. QualIdent -> TopEnv a -> [a]
qualLookupTopEnv