module Base.TypeExpansion
( module Base.TypeExpansion
) where
import qualified Data.Set.Extra as Set (map)
import Curry.Base.Ident
import Curry.Syntax
import Base.CurryTypes
import Base.Messages
import Base.Types
import Base.TypeSubst
import Env.Class
import Env.TypeConstructor
expandType :: ModuleIdent -> TCEnv -> Type -> Type
expandType :: ModuleIdent -> TCEnv -> Type -> Type
expandType m :: ModuleIdent
m tcEnv :: TCEnv
tcEnv ty :: Type
ty = ModuleIdent -> TCEnv -> Type -> [Type] -> Type
expandType' ModuleIdent
m TCEnv
tcEnv Type
ty []
expandType' :: ModuleIdent -> TCEnv -> Type -> [Type] -> Type
expandType' :: ModuleIdent -> TCEnv -> Type -> [Type] -> Type
expandType' m :: ModuleIdent
m tcEnv :: TCEnv
tcEnv (TypeConstructor tc :: QualIdent
tc) tys :: [Type]
tys =
case QualIdent -> TCEnv -> [TypeInfo]
qualLookupTypeInfo QualIdent
tc TCEnv
tcEnv of
[DataType tc' :: QualIdent
tc' _ _ ] -> Type -> [Type] -> Type
applyType (QualIdent -> Type
TypeConstructor QualIdent
tc') [Type]
tys
[RenamingType tc' :: QualIdent
tc' _ _ ] -> Type -> [Type] -> Type
applyType (QualIdent -> Type
TypeConstructor QualIdent
tc') [Type]
tys
[AliasType _ _ n :: Int
n ty :: Type
ty] -> let (tys' :: [Type]
tys', tys'' :: [Type]
tys'') = Int -> [Type] -> ([Type], [Type])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [Type]
tys
in Type -> [Type] -> Type
applyType ([Type] -> Type -> Type
forall a. ExpandAliasType a => [Type] -> a -> a
expandAliasType [Type]
tys' Type
ty) [Type]
tys''
_ -> case QualIdent -> TCEnv -> [TypeInfo]
qualLookupTypeInfo (ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
tc) TCEnv
tcEnv of
[DataType tc' :: QualIdent
tc' _ _ ] -> Type -> [Type] -> Type
applyType (QualIdent -> Type
TypeConstructor QualIdent
tc') [Type]
tys
[RenamingType tc' :: QualIdent
tc' _ _ ] -> Type -> [Type] -> Type
applyType (QualIdent -> Type
TypeConstructor QualIdent
tc') [Type]
tys
[AliasType _ _ n :: Int
n ty :: Type
ty] -> let (tys' :: [Type]
tys', tys'' :: [Type]
tys'') = Int -> [Type] -> ([Type], [Type])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [Type]
tys
in Type -> [Type] -> Type
applyType ([Type] -> Type -> Type
forall a. ExpandAliasType a => [Type] -> a -> a
expandAliasType [Type]
tys' Type
ty) [Type]
tys''
_ -> String -> Type
forall a. String -> a
internalError (String -> Type) -> String -> Type
forall a b. (a -> b) -> a -> b
$ "Base.TypeExpansion.expandType: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualIdent -> String
forall a. Show a => a -> String
show QualIdent
tc
expandType' m :: ModuleIdent
m tcEnv :: TCEnv
tcEnv (TypeApply ty1 :: Type
ty1 ty2 :: Type
ty2) tys :: [Type]
tys =
ModuleIdent -> TCEnv -> Type -> [Type] -> Type
expandType' ModuleIdent
m TCEnv
tcEnv Type
ty1 (ModuleIdent -> TCEnv -> Type -> Type
expandType ModuleIdent
m TCEnv
tcEnv Type
ty2 Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: [Type]
tys)
expandType' _ _ tv :: Type
tv@(TypeVariable _) tys :: [Type]
tys = Type -> [Type] -> Type
applyType Type
tv [Type]
tys
expandType' _ _ tc :: Type
tc@(TypeConstrained _ _) tys :: [Type]
tys = Type -> [Type] -> Type
applyType Type
tc [Type]
tys
expandType' m :: ModuleIdent
m tcEnv :: TCEnv
tcEnv (TypeArrow ty1 :: Type
ty1 ty2 :: Type
ty2) tys :: [Type]
tys =
Type -> [Type] -> Type
applyType (Type -> Type -> Type
TypeArrow (ModuleIdent -> TCEnv -> Type -> Type
expandType ModuleIdent
m TCEnv
tcEnv Type
ty1) (ModuleIdent -> TCEnv -> Type -> Type
expandType ModuleIdent
m TCEnv
tcEnv Type
ty2)) [Type]
tys
expandType' m :: ModuleIdent
m tcEnv :: TCEnv
tcEnv (TypeForall tvs :: [Int]
tvs ty :: Type
ty) tys :: [Type]
tys =
Type -> [Type] -> Type
applyType ([Int] -> Type -> Type
TypeForall [Int]
tvs (ModuleIdent -> TCEnv -> Type -> Type
expandType ModuleIdent
m TCEnv
tcEnv Type
ty)) [Type]
tys
expandPred :: ModuleIdent -> TCEnv -> Pred -> Pred
expandPred :: ModuleIdent -> TCEnv -> Pred -> Pred
expandPred m :: ModuleIdent
m tcEnv :: TCEnv
tcEnv (Pred qcls :: QualIdent
qcls ty :: Type
ty) = case QualIdent -> TCEnv -> [TypeInfo]
qualLookupTypeInfo QualIdent
qcls TCEnv
tcEnv of
[TypeClass ocls :: QualIdent
ocls _ _] -> QualIdent -> Type -> Pred
Pred QualIdent
ocls (ModuleIdent -> TCEnv -> Type -> Type
expandType ModuleIdent
m TCEnv
tcEnv Type
ty)
_ -> case QualIdent -> TCEnv -> [TypeInfo]
qualLookupTypeInfo (ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
qcls) TCEnv
tcEnv of
[TypeClass ocls :: QualIdent
ocls _ _] -> QualIdent -> Type -> Pred
Pred QualIdent
ocls (ModuleIdent -> TCEnv -> Type -> Type
expandType ModuleIdent
m TCEnv
tcEnv Type
ty)
_ -> String -> Pred
forall a. String -> a
internalError (String -> Pred) -> String -> Pred
forall a b. (a -> b) -> a -> b
$ "Base.TypeExpansion.expandPred: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualIdent -> String
forall a. Show a => a -> String
show QualIdent
qcls
expandPredSet :: ModuleIdent -> TCEnv -> ClassEnv -> PredSet -> PredSet
expandPredSet :: ModuleIdent -> TCEnv -> ClassEnv -> PredSet -> PredSet
expandPredSet m :: ModuleIdent
m tcEnv :: TCEnv
tcEnv clsEnv :: ClassEnv
clsEnv = ClassEnv -> PredSet -> PredSet
minPredSet ClassEnv
clsEnv (PredSet -> PredSet) -> (PredSet -> PredSet) -> PredSet -> PredSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pred -> Pred) -> PredSet -> PredSet
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (ModuleIdent -> TCEnv -> Pred -> Pred
expandPred ModuleIdent
m TCEnv
tcEnv)
expandPredType :: ModuleIdent -> TCEnv -> ClassEnv -> PredType -> PredType
expandPredType :: ModuleIdent -> TCEnv -> ClassEnv -> PredType -> PredType
expandPredType m :: ModuleIdent
m tcEnv :: TCEnv
tcEnv clsEnv :: ClassEnv
clsEnv (PredType ps :: PredSet
ps ty :: Type
ty) =
PredSet -> Type -> PredType
PredType (ModuleIdent -> TCEnv -> ClassEnv -> PredSet -> PredSet
expandPredSet ModuleIdent
m TCEnv
tcEnv ClassEnv
clsEnv PredSet
ps) (ModuleIdent -> TCEnv -> Type -> Type
expandType ModuleIdent
m TCEnv
tcEnv Type
ty)
expandMonoType :: ModuleIdent -> TCEnv -> [Ident] -> TypeExpr -> Type
expandMonoType :: ModuleIdent -> TCEnv -> [Ident] -> TypeExpr -> Type
expandMonoType m :: ModuleIdent
m tcEnv :: TCEnv
tcEnv tvs :: [Ident]
tvs = ModuleIdent -> TCEnv -> Type -> Type
expandType ModuleIdent
m TCEnv
tcEnv (Type -> Type) -> (TypeExpr -> Type) -> TypeExpr -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> TypeExpr -> Type
toType [Ident]
tvs
expandPolyType :: ModuleIdent -> TCEnv -> ClassEnv -> QualTypeExpr -> PredType
expandPolyType :: ModuleIdent -> TCEnv -> ClassEnv -> QualTypeExpr -> PredType
expandPolyType m :: ModuleIdent
m tcEnv :: TCEnv
tcEnv clsEnv :: ClassEnv
clsEnv =
Int -> PredType -> PredType
normalize 0 (PredType -> PredType)
-> (QualTypeExpr -> PredType) -> QualTypeExpr -> PredType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> TCEnv -> ClassEnv -> PredType -> PredType
expandPredType ModuleIdent
m TCEnv
tcEnv ClassEnv
clsEnv (PredType -> PredType)
-> (QualTypeExpr -> PredType) -> QualTypeExpr -> PredType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> QualTypeExpr -> PredType
toPredType []
expandConstrType :: ModuleIdent -> TCEnv -> ClassEnv -> QualIdent -> [Ident]
-> [TypeExpr] -> PredType
expandConstrType :: ModuleIdent
-> TCEnv
-> ClassEnv
-> QualIdent
-> [Ident]
-> [TypeExpr]
-> PredType
expandConstrType m :: ModuleIdent
m tcEnv :: TCEnv
tcEnv clsEnv :: ClassEnv
clsEnv tc :: QualIdent
tc tvs :: [Ident]
tvs tys :: [TypeExpr]
tys =
Int -> PredType -> PredType
normalize Int
n (PredType -> PredType) -> PredType -> PredType
forall a b. (a -> b) -> a -> b
$ ModuleIdent -> TCEnv -> ClassEnv -> PredType -> PredType
expandPredType ModuleIdent
m TCEnv
tcEnv ClassEnv
clsEnv PredType
pty
where n :: Int
n = [Ident] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ident]
tvs
pty :: PredType
pty = QualIdent -> [Ident] -> [TypeExpr] -> PredType
toConstrType QualIdent
tc [Ident]
tvs [TypeExpr]
tys
expandMethodType :: ModuleIdent -> TCEnv -> ClassEnv -> QualIdent -> Ident
-> QualTypeExpr -> PredType
expandMethodType :: ModuleIdent
-> TCEnv
-> ClassEnv
-> QualIdent
-> Ident
-> QualTypeExpr
-> PredType
expandMethodType m :: ModuleIdent
m tcEnv :: TCEnv
tcEnv clsEnv :: ClassEnv
clsEnv qcls :: QualIdent
qcls tv :: Ident
tv =
Int -> PredType -> PredType
normalize 1 (PredType -> PredType)
-> (QualTypeExpr -> PredType) -> QualTypeExpr -> PredType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> TCEnv -> ClassEnv -> PredType -> PredType
expandPredType ModuleIdent
m TCEnv
tcEnv ClassEnv
clsEnv (PredType -> PredType)
-> (QualTypeExpr -> PredType) -> QualTypeExpr -> PredType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualIdent -> Ident -> QualTypeExpr -> PredType
toMethodType QualIdent
qcls Ident
tv