{- |
    Module      :  $Header$
    Description :  Type expansion
    Copyright   :  (c) 2016 Finn Teegen
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

   This module implements expansion of alias types in types and predicates.
-}

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

-- The function 'expandType' expands all type synonyms in a type
-- and also qualifies all type constructors with the name of the module
-- in which the type was defined. Similarly, 'expandPred' expands all
-- type synonyms in a predicate and also qualifies all class identifiers
-- with the name of the module in which the class was defined. The
-- function 'expandPredSet' minimizes the predicate set after expansion.

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)

-- The functions 'expandMonoType' and 'expandPolyType' convert (qualified)
-- type expressions into (predicated) types and also expand all type synonyms
-- and qualify all type constructors during the conversion.

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 []

-- The function 'expandConstrType' computes the predicated type for a data
-- or newtype constructor. Similar to 'toConstrType' from 'CurryTypes', the
-- type's context is restricted to those type variables which are free in
-- the argument types. However, type synonyms are expanded and type constructors
-- and type classes are qualified with the name of the module containing their
-- definition.

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

-- The function 'expandMethodType' converts the type of a type class method
-- Similar to function 'toMethodType' from 'CurryTypes', the implicit class
-- constraint is added to the method's type and the class' type variable is
-- assigned index 0. However, type synonyms are expanded and type constructors
-- and type classes are qualified with the name of the module containing their
-- definition.

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