Types.lhs 3.48 KB
Newer Older
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
\paragraph{Types}
The functions \texttt{toType}, \texttt{toTypes}, and \texttt{fromType}
convert Curry type expressions into types and vice versa. The
functions \texttt{qualifyType} and \texttt{unqualifyType} add and
remove module qualifiers in a type, respectively.

When Curry type expression are converted with \texttt{toType} or
\texttt{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.
\begin{verbatim}

> module Base.Types
>  ( toQualType, toQualTypes, toType, toTypes, toType', fromQualType, fromType
>  ) where

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

> import Curry.Base.Ident
> import qualified Curry.Syntax as CS

25
> import Base.Expr
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
26
27
28
29
30
31
32
33
34
35
> import Messages (internalError)
> import Types

> toQualType :: ModuleIdent -> [Ident] -> CS.TypeExpr -> Type
> toQualType m tvs = qualifyType m . toType tvs

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

> toType :: [Ident] -> CS.TypeExpr -> Type
36
> toType tvs ty = toType' (Map.fromList (zip (tvs ++ tvs') [0 ..])) ty
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
37
38
39
>   where tvs' = [tv | tv <- nub (fv ty), tv `notElem` tvs]

> toTypes :: [Ident] -> [CS.TypeExpr] -> [Type]
40
> toTypes tvs tys = map (toType' (Map.fromList (zip (tvs ++ tvs') [0 ..]))) tys
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
>   where tvs' = [tv | tv <- nub (concatMap fv tys), tv `notElem` tvs]

> toType' :: Map.Map Ident Int -> CS.TypeExpr -> Type
> toType' tvs (CS.ConstructorType tc tys) =
>   TypeConstructor tc (map (toType' tvs) tys)
> toType' tvs (CS.VariableType tv) =
>   maybe (internalError ("toType " ++ show tv)) TypeVariable (Map.lookup tv tvs)
> toType' tvs (CS.TupleType tys)
>   | null tys = TypeConstructor (qualify unitId) []
>   | otherwise = TypeConstructor (qualify (tupleId (length tys'))) tys'
>   where tys' = map (toType' tvs) tys
> toType' tvs (CS.ListType ty) = TypeConstructor (qualify listId) [toType' tvs ty]
> toType' tvs (CS.ArrowType ty1 ty2) =
>   TypeArrow (toType' tvs ty1) (toType' tvs ty2)
> toType' tvs (CS.RecordType fs rty) =
56
>   TypeRecord (concatMap (\ (ls, ty) -> map (\ l -> (l, toType' tvs ty)) ls) fs)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
57
>              (maybe Nothing
58
>                 (\ ty -> case toType' tvs ty of
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
>                           TypeVariable tv -> Just tv
>                           _ -> internalError ("toType " ++ show ty))
>                 rty)

> fromQualType :: ModuleIdent -> Type -> CS.TypeExpr
> fromQualType m = fromType . unqualifyType m

> fromType :: Type -> CS.TypeExpr
> fromType (TypeConstructor tc tys)
>   | isTupleId c = CS.TupleType tys'
>   | c == listId && length tys == 1 = CS.ListType (head tys')
>   | c == unitId && null tys = CS.TupleType []
>   | otherwise = CS.ConstructorType tc tys'
>   where c = unqualify tc
>         tys' = map fromType tys
> fromType (TypeVariable tv) =
>   CS.VariableType (if tv >= 0 then identSupply !! tv
>                            else mkIdent ('_' : show (-tv)))
> fromType (TypeConstrained tys _) = fromType (head tys)
> fromType (TypeArrow ty1 ty2) = CS.ArrowType (fromType ty1) (fromType ty2)
> fromType (TypeSkolem k) = CS.VariableType (mkIdent ("_?" ++ show k))
> fromType (TypeRecord fs rty) =
81
82
>   CS.RecordType (map (\ (l, ty) -> ([l], fromType ty)) fs)
>              (maybe Nothing (Just . fromType . TypeVariable) rty)