{- |
    Module      :  $Header$
    Description :  Conversion of type representation
    Copyright   :  (c)         Wolfgang Lux
                   2011 - 2012 Björn Peemöller
                   2015        Jan Tikovsky
                   2016        Finn Teegen
    License     :  BSD-3-clause

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

   The functions 'toType', 'toTypes', and 'fromType' convert Curry type
   expressions into types and vice versa. The functions 'qualifyType' and
   'unqualifyType' add and remove module qualifiers in a type, respectively.

   When Curry type expression are converted with 'toType' or 'toTypes',
   type variables are assigned ascending indices in the order of their
   occurrence. It is possible to pass a list of additional type variables
   to both functions which are assigned indices before those variables
   occurring in the type. This allows preserving the order of type variables
   in the left hand side of a type declaration.
-}

module Base.CurryTypes
  ( toType, toTypes, toQualType, toQualTypes
  , toPred, toQualPred, toPredSet, toQualPredSet, toPredType, toQualPredType
  , toConstrType, toMethodType
  , fromType, fromQualType
  , fromPred, fromQualPred, fromPredSet, fromQualPredSet, fromPredType
  , fromQualPredType
  , ppType, ppPred, ppPredType, ppTypeScheme
  ) where

import Data.List (nub)
import qualified Data.Map as Map (Map, fromList, lookup)
import qualified Data.Set as Set

import Curry.Base.Ident
import Curry.Base.Pretty (Doc)
import Curry.Base.SpanInfo
import qualified Curry.Syntax as CS
import Curry.Syntax.Pretty (ppConstraint, ppTypeExpr, ppQualTypeExpr)

import Base.Expr
import Base.Messages (internalError)
import Base.Types

enumTypeVars :: (Expr a, QuantExpr a) => [Ident] -> a -> Map.Map Ident Int
enumTypeVars :: [Ident] -> a -> Map Ident Int
enumTypeVars tvs :: [Ident]
tvs ty :: a
ty = [(Ident, Int)] -> Map Ident Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Ident, Int)] -> Map Ident Int)
-> [(Ident, Int)] -> Map Ident Int
forall a b. (a -> b) -> a -> b
$ [Ident] -> [Int] -> [(Ident, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Ident]
tvs [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ [Ident]
tvs') [0..]
  where
    tvs' :: [Ident]
tvs' = [Ident
tv | Ident
tv <- [Ident] -> [Ident]
forall a. Eq a => [a] -> [a]
nub (a -> [Ident]
forall e. Expr e => e -> [Ident]
fv a
ty), Ident
tv Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Ident]
tvs] [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++
             [Ident
tv | Ident
tv <- [Ident] -> [Ident]
forall a. Eq a => [a] -> [a]
nub (a -> [Ident]
forall e. QuantExpr e => e -> [Ident]
bv a
ty), Ident
tv Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Ident]
tvs]

toType :: [Ident] -> CS.TypeExpr -> Type
toType :: [Ident] -> TypeExpr -> Type
toType tvs :: [Ident]
tvs ty :: TypeExpr
ty = Map Ident Int -> TypeExpr -> [Type] -> Type
toType' ([Ident] -> TypeExpr -> Map Ident Int
forall a. (Expr a, QuantExpr a) => [Ident] -> a -> Map Ident Int
enumTypeVars [Ident]
tvs TypeExpr
ty) TypeExpr
ty []

toTypes :: [Ident] -> [CS.TypeExpr] -> [Type]
toTypes :: [Ident] -> [TypeExpr] -> [Type]
toTypes tvs :: [Ident]
tvs tys :: [TypeExpr]
tys = (TypeExpr -> Type) -> [TypeExpr] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (((TypeExpr -> [Type] -> Type) -> [Type] -> TypeExpr -> Type
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Map Ident Int -> TypeExpr -> [Type] -> Type
toType' ([Ident] -> [TypeExpr] -> Map Ident Int
forall a. (Expr a, QuantExpr a) => [Ident] -> a -> Map Ident Int
enumTypeVars [Ident]
tvs [TypeExpr]
tys))) []) [TypeExpr]
tys

toType' :: Map.Map Ident Int -> CS.TypeExpr -> [Type] -> Type
toType' :: Map Ident Int -> TypeExpr -> [Type] -> Type
toType' _   (CS.ConstructorType _ tc :: QualIdent
tc) tys :: [Type]
tys = Type -> [Type] -> Type
applyType (QualIdent -> Type
TypeConstructor QualIdent
tc) [Type]
tys
toType' tvs :: Map Ident Int
tvs (CS.ApplyType  _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) tys :: [Type]
tys =
  Map Ident Int -> TypeExpr -> [Type] -> Type
toType' Map Ident Int
tvs TypeExpr
ty1 (Map Ident Int -> TypeExpr -> [Type] -> Type
toType' Map Ident Int
tvs TypeExpr
ty2 [] Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: [Type]
tys)
toType' tvs :: Map Ident Int
tvs (CS.VariableType    _ tv :: Ident
tv) tys :: [Type]
tys =
  Type -> [Type] -> Type
applyType (Int -> Type
TypeVariable (Map Ident Int -> Ident -> Int
toVar Map Ident Int
tvs Ident
tv)) [Type]
tys
toType' tvs :: Map Ident Int
tvs (CS.TupleType      _ tys :: [TypeExpr]
tys) tys' :: [Type]
tys'
  | [TypeExpr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeExpr]
tys  = String -> Type
forall a. String -> a
internalError "Base.CurryTypes.toType': zero-element tuple"
  | [Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
tys' = [Type] -> Type
tupleType ([Type] -> Type) -> [Type] -> Type
forall a b. (a -> b) -> a -> b
$ (TypeExpr -> Type) -> [TypeExpr] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (((TypeExpr -> [Type] -> Type) -> [Type] -> TypeExpr -> Type
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((TypeExpr -> [Type] -> Type) -> [Type] -> TypeExpr -> Type)
-> (TypeExpr -> [Type] -> Type) -> [Type] -> TypeExpr -> Type
forall a b. (a -> b) -> a -> b
$ Map Ident Int -> TypeExpr -> [Type] -> Type
toType' Map Ident Int
tvs) []) [TypeExpr]
tys
  | Bool
otherwise = String -> Type
forall a. String -> a
internalError "Base.CurryTypes.toType': tuple type application"
toType' tvs :: Map Ident Int
tvs (CS.ListType        _ ty :: TypeExpr
ty) tys :: [Type]
tys
  | [Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
tys  = Type -> Type
listType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Map Ident Int -> TypeExpr -> [Type] -> Type
toType' Map Ident Int
tvs TypeExpr
ty []
  | Bool
otherwise = String -> Type
forall a. String -> a
internalError "Base.CurryTypes.toType': list type application"
toType' tvs :: Map Ident Int
tvs (CS.ArrowType  _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) tys :: [Type]
tys
  | [Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
tys = Type -> Type -> Type
TypeArrow (Map Ident Int -> TypeExpr -> [Type] -> Type
toType' Map Ident Int
tvs TypeExpr
ty1 []) (Map Ident Int -> TypeExpr -> [Type] -> Type
toType' Map Ident Int
tvs TypeExpr
ty2 [])
  | Bool
otherwise = String -> Type
forall a. String -> a
internalError "Base.CurryTypes.toType': arrow type application"
toType' tvs :: Map Ident Int
tvs (CS.ParenType       _ ty :: TypeExpr
ty) tys :: [Type]
tys = Map Ident Int -> TypeExpr -> [Type] -> Type
toType' Map Ident Int
tvs TypeExpr
ty [Type]
tys
toType' tvs :: Map Ident Int
tvs (CS.ForallType _ tvs' :: [Ident]
tvs' ty :: TypeExpr
ty) tys :: [Type]
tys
  | [Ident] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ident]
tvs' = Map Ident Int -> TypeExpr -> [Type] -> Type
toType' Map Ident Int
tvs TypeExpr
ty [Type]
tys
  | Bool
otherwise = Type -> [Type] -> Type
applyType ([Int] -> Type -> Type
TypeForall ((Ident -> Int) -> [Ident] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Map Ident Int -> Ident -> Int
toVar Map Ident Int
tvs) [Ident]
tvs')
                                      (Map Ident Int -> TypeExpr -> [Type] -> Type
toType' Map Ident Int
tvs TypeExpr
ty []))
                          [Type]
tys

toVar :: Map.Map Ident Int -> Ident -> Int
toVar :: Map Ident Int -> Ident -> Int
toVar tvs :: Map Ident Int
tvs tv :: Ident
tv = case Ident -> Map Ident Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
tv Map Ident Int
tvs of
  Just tv' :: Int
tv' -> Int
tv'
  Nothing  -> String -> Int
forall a. String -> a
internalError "Base.CurryTypes.toVar: unknown type variable"

toQualType :: ModuleIdent -> [Ident] -> CS.TypeExpr -> Type
toQualType :: ModuleIdent -> [Ident] -> TypeExpr -> Type
toQualType m :: ModuleIdent
m tvs :: [Ident]
tvs = ModuleIdent -> Type -> Type
qualifyType ModuleIdent
m (Type -> Type) -> (TypeExpr -> Type) -> TypeExpr -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> TypeExpr -> Type
toType [Ident]
tvs

toQualTypes :: ModuleIdent -> [Ident] -> [CS.TypeExpr] -> [Type]
toQualTypes :: ModuleIdent -> [Ident] -> [TypeExpr] -> [Type]
toQualTypes m :: ModuleIdent
m tvs :: [Ident]
tvs = (Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleIdent -> Type -> Type
qualifyType ModuleIdent
m) ([Type] -> [Type])
-> ([TypeExpr] -> [Type]) -> [TypeExpr] -> [Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> [TypeExpr] -> [Type]
toTypes [Ident]
tvs

toPred :: [Ident] -> CS.Constraint -> Pred
toPred :: [Ident] -> Constraint -> Pred
toPred tvs :: [Ident]
tvs c :: Constraint
c = Map Ident Int -> Constraint -> Pred
toPred' ([Ident] -> Constraint -> Map Ident Int
forall a. (Expr a, QuantExpr a) => [Ident] -> a -> Map Ident Int
enumTypeVars [Ident]
tvs Constraint
c) Constraint
c

toPred' :: Map.Map Ident Int -> CS.Constraint -> Pred
toPred' :: Map Ident Int -> Constraint -> Pred
toPred' tvs :: Map Ident Int
tvs (CS.Constraint _ qcls :: QualIdent
qcls ty :: TypeExpr
ty) = QualIdent -> Type -> Pred
Pred QualIdent
qcls (Map Ident Int -> TypeExpr -> [Type] -> Type
toType' Map Ident Int
tvs TypeExpr
ty [])

toQualPred :: ModuleIdent -> [Ident] -> CS.Constraint -> Pred
toQualPred :: ModuleIdent -> [Ident] -> Constraint -> Pred
toQualPred m :: ModuleIdent
m tvs :: [Ident]
tvs = ModuleIdent -> Pred -> Pred
qualifyPred ModuleIdent
m (Pred -> Pred) -> (Constraint -> Pred) -> Constraint -> Pred
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> Constraint -> Pred
toPred [Ident]
tvs

toPredSet :: [Ident] -> CS.Context -> PredSet
toPredSet :: [Ident] -> Context -> PredSet
toPredSet tvs :: [Ident]
tvs cx :: Context
cx = Map Ident Int -> Context -> PredSet
toPredSet' ([Ident] -> Context -> Map Ident Int
forall a. (Expr a, QuantExpr a) => [Ident] -> a -> Map Ident Int
enumTypeVars [Ident]
tvs Context
cx) Context
cx

toPredSet' :: Map.Map Ident Int -> CS.Context -> PredSet
toPredSet' :: Map Ident Int -> Context -> PredSet
toPredSet' tvs :: Map Ident Int
tvs = [Pred] -> PredSet
forall a. Ord a => [a] -> Set a
Set.fromList ([Pred] -> PredSet) -> (Context -> [Pred]) -> Context -> PredSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Constraint -> Pred) -> Context -> [Pred]
forall a b. (a -> b) -> [a] -> [b]
map (Map Ident Int -> Constraint -> Pred
toPred' Map Ident Int
tvs)

toQualPredSet :: ModuleIdent -> [Ident] -> CS.Context -> PredSet
toQualPredSet :: ModuleIdent -> [Ident] -> Context -> PredSet
toQualPredSet m :: ModuleIdent
m tvs :: [Ident]
tvs = ModuleIdent -> PredSet -> PredSet
qualifyPredSet ModuleIdent
m (PredSet -> PredSet) -> (Context -> PredSet) -> Context -> PredSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> Context -> PredSet
toPredSet [Ident]
tvs

toPredType :: [Ident] -> CS.QualTypeExpr -> PredType
toPredType :: [Ident] -> QualTypeExpr -> PredType
toPredType tvs :: [Ident]
tvs qty :: QualTypeExpr
qty = Map Ident Int -> QualTypeExpr -> PredType
toPredType' ([Ident] -> QualTypeExpr -> Map Ident Int
forall a. (Expr a, QuantExpr a) => [Ident] -> a -> Map Ident Int
enumTypeVars [Ident]
tvs QualTypeExpr
qty) QualTypeExpr
qty

toPredType' :: Map.Map Ident Int -> CS.QualTypeExpr -> PredType
toPredType' :: Map Ident Int -> QualTypeExpr -> PredType
toPredType' tvs :: Map Ident Int
tvs (CS.QualTypeExpr _ cx :: Context
cx ty :: TypeExpr
ty) =
  PredSet -> Type -> PredType
PredType (Map Ident Int -> Context -> PredSet
toPredSet' Map Ident Int
tvs Context
cx) (Map Ident Int -> TypeExpr -> [Type] -> Type
toType' Map Ident Int
tvs TypeExpr
ty [])

toQualPredType :: ModuleIdent -> [Ident] -> CS.QualTypeExpr -> PredType
toQualPredType :: ModuleIdent -> [Ident] -> QualTypeExpr -> PredType
toQualPredType m :: ModuleIdent
m tvs :: [Ident]
tvs = ModuleIdent -> PredType -> PredType
qualifyPredType ModuleIdent
m (PredType -> PredType)
-> (QualTypeExpr -> PredType) -> QualTypeExpr -> PredType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> QualTypeExpr -> PredType
toPredType [Ident]
tvs

-- The function 'toConstrType' returns the type of a data or newtype
-- constructor. Hereby, it restricts the context to those type variables
-- which are free in the argument types.

toConstrType :: QualIdent -> [Ident] -> [CS.TypeExpr] -> PredType
toConstrType :: QualIdent -> [Ident] -> [TypeExpr] -> PredType
toConstrType tc :: QualIdent
tc tvs :: [Ident]
tvs tys :: [TypeExpr]
tys = [Ident] -> QualTypeExpr -> PredType
toPredType [Ident]
tvs (QualTypeExpr -> PredType) -> QualTypeExpr -> PredType
forall a b. (a -> b) -> a -> b
$
  SpanInfo -> Context -> TypeExpr -> QualTypeExpr
CS.QualTypeExpr SpanInfo
NoSpanInfo [] TypeExpr
ty'
  where ty' :: TypeExpr
ty'  = (TypeExpr -> TypeExpr -> TypeExpr)
-> TypeExpr -> [TypeExpr] -> TypeExpr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
CS.ArrowType SpanInfo
NoSpanInfo) TypeExpr
ty0 [TypeExpr]
tys
        ty0 :: TypeExpr
ty0  = (TypeExpr -> TypeExpr -> TypeExpr)
-> TypeExpr -> [TypeExpr] -> TypeExpr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
CS.ApplyType SpanInfo
NoSpanInfo)
                     (SpanInfo -> QualIdent -> TypeExpr
CS.ConstructorType SpanInfo
NoSpanInfo QualIdent
tc)
                     ((Ident -> TypeExpr) -> [Ident] -> [TypeExpr]
forall a b. (a -> b) -> [a] -> [b]
map (SpanInfo -> Ident -> TypeExpr
CS.VariableType SpanInfo
NoSpanInfo) [Ident]
tvs)

-- The function 'toMethodType' returns the type of a type class method.
-- It adds the implicit type class constraint to the method's type signature
-- and ensures that the class' type variable is always assigned index 0.

toMethodType :: QualIdent -> Ident -> CS.QualTypeExpr -> PredType
toMethodType :: QualIdent -> Ident -> QualTypeExpr -> PredType
toMethodType qcls :: QualIdent
qcls clsvar :: Ident
clsvar (CS.QualTypeExpr spi :: SpanInfo
spi cx :: Context
cx ty :: TypeExpr
ty) =
  [Ident] -> QualTypeExpr -> PredType
toPredType [Ident
clsvar] (SpanInfo -> Context -> TypeExpr -> QualTypeExpr
CS.QualTypeExpr SpanInfo
spi Context
cx' TypeExpr
ty)
  where cx' :: Context
cx' = SpanInfo -> QualIdent -> TypeExpr -> Constraint
CS.Constraint SpanInfo
NoSpanInfo QualIdent
qcls
                (SpanInfo -> Ident -> TypeExpr
CS.VariableType SpanInfo
NoSpanInfo Ident
clsvar) Constraint -> Context -> Context
forall a. a -> [a] -> [a]
: Context
cx

fromType :: [Ident] -> Type -> CS.TypeExpr
fromType :: [Ident] -> Type -> TypeExpr
fromType tvs :: [Ident]
tvs ty :: Type
ty = [Ident] -> Type -> [TypeExpr] -> TypeExpr
fromType' [Ident]
tvs Type
ty []

fromType' :: [Ident] -> Type -> [CS.TypeExpr] -> CS.TypeExpr
fromType' :: [Ident] -> Type -> [TypeExpr] -> TypeExpr
fromType' _   (TypeConstructor    tc :: QualIdent
tc) tys :: [TypeExpr]
tys
  | QualIdent -> Bool
isQTupleId QualIdent
tc Bool -> Bool -> Bool
&& QualIdent -> Int
qTupleArity QualIdent
tc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [TypeExpr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeExpr]
tys
    = SpanInfo -> [TypeExpr] -> TypeExpr
CS.TupleType SpanInfo
NoSpanInfo [TypeExpr]
tys
  | QualIdent
tc QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
qListId Bool -> Bool -> Bool
&& [TypeExpr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeExpr]
tys Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
    = SpanInfo -> TypeExpr -> TypeExpr
CS.ListType SpanInfo
NoSpanInfo ([TypeExpr] -> TypeExpr
forall a. [a] -> a
head [TypeExpr]
tys)
  | Bool
otherwise
  = (TypeExpr -> TypeExpr -> TypeExpr)
-> TypeExpr -> [TypeExpr] -> TypeExpr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
CS.ApplyType SpanInfo
NoSpanInfo) (SpanInfo -> QualIdent -> TypeExpr
CS.ConstructorType SpanInfo
NoSpanInfo QualIdent
tc) [TypeExpr]
tys
fromType' tvs :: [Ident]
tvs (TypeApply     ty1 :: Type
ty1 ty2 :: Type
ty2) tys :: [TypeExpr]
tys =
  [Ident] -> Type -> [TypeExpr] -> TypeExpr
fromType' [Ident]
tvs Type
ty1 ([Ident] -> Type -> TypeExpr
fromType [Ident]
tvs Type
ty2 TypeExpr -> [TypeExpr] -> [TypeExpr]
forall a. a -> [a] -> [a]
: [TypeExpr]
tys)
fromType' tvs :: [Ident]
tvs (TypeVariable       tv :: Int
tv) tys :: [TypeExpr]
tys =
  (TypeExpr -> TypeExpr -> TypeExpr)
-> TypeExpr -> [TypeExpr] -> TypeExpr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
CS.ApplyType SpanInfo
NoSpanInfo) (SpanInfo -> Ident -> TypeExpr
CS.VariableType SpanInfo
NoSpanInfo ([Ident] -> Int -> Ident
fromVar [Ident]
tvs Int
tv))
    [TypeExpr]
tys
fromType' tvs :: [Ident]
tvs (TypeArrow     ty1 :: Type
ty1 ty2 :: Type
ty2) tys :: [TypeExpr]
tys =
  (TypeExpr -> TypeExpr -> TypeExpr)
-> TypeExpr -> [TypeExpr] -> TypeExpr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
CS.ApplyType SpanInfo
NoSpanInfo)
    (SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
CS.ArrowType SpanInfo
NoSpanInfo ([Ident] -> Type -> TypeExpr
fromType [Ident]
tvs Type
ty1) ([Ident] -> Type -> TypeExpr
fromType [Ident]
tvs Type
ty2)) [TypeExpr]
tys
fromType' tvs :: [Ident]
tvs (TypeConstrained tys :: [Type]
tys _) tys' :: [TypeExpr]
tys' = [Ident] -> Type -> [TypeExpr] -> TypeExpr
fromType' [Ident]
tvs ([Type] -> Type
forall a. [a] -> a
head [Type]
tys) [TypeExpr]
tys'
fromType' tvs :: [Ident]
tvs (TypeForall    tvs' :: [Int]
tvs' ty :: Type
ty) tys :: [TypeExpr]
tys
  | [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
tvs' = [Ident] -> Type -> [TypeExpr] -> TypeExpr
fromType' [Ident]
tvs Type
ty [TypeExpr]
tys
  | Bool
otherwise = (TypeExpr -> TypeExpr -> TypeExpr)
-> TypeExpr -> [TypeExpr] -> TypeExpr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (SpanInfo -> TypeExpr -> TypeExpr -> TypeExpr
CS.ApplyType SpanInfo
NoSpanInfo)
                      (SpanInfo -> [Ident] -> TypeExpr -> TypeExpr
CS.ForallType SpanInfo
NoSpanInfo ((Int -> Ident) -> [Int] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map ([Ident] -> Int -> Ident
fromVar [Ident]
tvs) [Int]
tvs')
                                                ([Ident] -> Type -> TypeExpr
fromType [Ident]
tvs Type
ty))
                      [TypeExpr]
tys

fromVar :: [Ident] -> Int -> Ident
fromVar :: [Ident] -> Int -> Ident
fromVar tvs :: [Ident]
tvs tv :: Int
tv = if Int
tv Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 then [Ident]
tvs [Ident] -> Int -> Ident
forall a. [a] -> Int -> a
!! Int
tv else String -> Ident
mkIdent ('_' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show (-Int
tv))

fromQualType :: ModuleIdent -> [Ident] -> Type -> CS.TypeExpr
fromQualType :: ModuleIdent -> [Ident] -> Type -> TypeExpr
fromQualType m :: ModuleIdent
m tvs :: [Ident]
tvs = [Ident] -> Type -> TypeExpr
fromType [Ident]
tvs (Type -> TypeExpr) -> (Type -> Type) -> Type -> TypeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> Type -> Type
unqualifyType ModuleIdent
m

fromPred :: [Ident] -> Pred -> CS.Constraint
fromPred :: [Ident] -> Pred -> Constraint
fromPred tvs :: [Ident]
tvs (Pred qcls :: QualIdent
qcls ty :: Type
ty) = SpanInfo -> QualIdent -> TypeExpr -> Constraint
CS.Constraint SpanInfo
NoSpanInfo QualIdent
qcls ([Ident] -> Type -> TypeExpr
fromType [Ident]
tvs Type
ty)

fromQualPred :: ModuleIdent -> [Ident] -> Pred -> CS.Constraint
fromQualPred :: ModuleIdent -> [Ident] -> Pred -> Constraint
fromQualPred m :: ModuleIdent
m tvs :: [Ident]
tvs = [Ident] -> Pred -> Constraint
fromPred [Ident]
tvs (Pred -> Constraint) -> (Pred -> Pred) -> Pred -> Constraint
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ModuleIdent -> Pred -> Pred
unqualifyPred ModuleIdent
m

-- Due to the sorting of the predicate set, the list of constraints is sorted
-- as well.

fromPredSet :: [Ident] -> PredSet -> CS.Context
fromPredSet :: [Ident] -> PredSet -> Context
fromPredSet tvs :: [Ident]
tvs = (Pred -> Constraint) -> [Pred] -> Context
forall a b. (a -> b) -> [a] -> [b]
map ([Ident] -> Pred -> Constraint
fromPred [Ident]
tvs) ([Pred] -> Context) -> (PredSet -> [Pred]) -> PredSet -> Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredSet -> [Pred]
forall a. Set a -> [a]
Set.toAscList

fromQualPredSet :: ModuleIdent -> [Ident] -> PredSet -> CS.Context
fromQualPredSet :: ModuleIdent -> [Ident] -> PredSet -> Context
fromQualPredSet m :: ModuleIdent
m tvs :: [Ident]
tvs = [Ident] -> PredSet -> Context
fromPredSet [Ident]
tvs (PredSet -> Context) -> (PredSet -> PredSet) -> PredSet -> Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> PredSet -> PredSet
unqualifyPredSet ModuleIdent
m

fromPredType :: [Ident] -> PredType -> CS.QualTypeExpr
fromPredType :: [Ident] -> PredType -> QualTypeExpr
fromPredType tvs :: [Ident]
tvs (PredType ps :: PredSet
ps ty :: Type
ty) =
  SpanInfo -> Context -> TypeExpr -> QualTypeExpr
CS.QualTypeExpr SpanInfo
NoSpanInfo ([Ident] -> PredSet -> Context
fromPredSet [Ident]
tvs PredSet
ps) ([Ident] -> Type -> TypeExpr
fromType [Ident]
tvs Type
ty)

fromQualPredType :: ModuleIdent -> [Ident] -> PredType -> CS.QualTypeExpr
fromQualPredType :: ModuleIdent -> [Ident] -> PredType -> QualTypeExpr
fromQualPredType m :: ModuleIdent
m tvs :: [Ident]
tvs = [Ident] -> PredType -> QualTypeExpr
fromPredType [Ident]
tvs (PredType -> QualTypeExpr)
-> (PredType -> PredType) -> PredType -> QualTypeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> PredType -> PredType
unqualifyPredType ModuleIdent
m

-- The following functions implement pretty-printing for types.

ppType :: ModuleIdent -> Type -> Doc
ppType :: ModuleIdent -> Type -> Doc
ppType m :: ModuleIdent
m = Int -> TypeExpr -> Doc
ppTypeExpr 0 (TypeExpr -> Doc) -> (Type -> TypeExpr) -> Type -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> [Ident] -> Type -> TypeExpr
fromQualType ModuleIdent
m [Ident]
identSupply

ppPred :: ModuleIdent -> Pred -> Doc
ppPred :: ModuleIdent -> Pred -> Doc
ppPred m :: ModuleIdent
m = Constraint -> Doc
ppConstraint (Constraint -> Doc) -> (Pred -> Constraint) -> Pred -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> [Ident] -> Pred -> Constraint
fromQualPred ModuleIdent
m [Ident]
identSupply

ppPredType :: ModuleIdent -> PredType -> Doc
ppPredType :: ModuleIdent -> PredType -> Doc
ppPredType m :: ModuleIdent
m = QualTypeExpr -> Doc
ppQualTypeExpr (QualTypeExpr -> Doc)
-> (PredType -> QualTypeExpr) -> PredType -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> [Ident] -> PredType -> QualTypeExpr
fromQualPredType ModuleIdent
m [Ident]
identSupply

ppTypeScheme :: ModuleIdent -> TypeScheme -> Doc
ppTypeScheme :: ModuleIdent -> TypeScheme -> Doc
ppTypeScheme m :: ModuleIdent
m (ForAll _ pty :: PredType
pty) = ModuleIdent -> PredType -> Doc
ppPredType ModuleIdent
m PredType
pty