-
Notifications
You must be signed in to change notification settings - Fork 1
/
IntfSyntaxCheck.lhs
182 lines (159 loc) · 6.92 KB
/
IntfSyntaxCheck.lhs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
% -*- LaTeX -*-
% $Id: IntfSyntaxCheck.lhs 3169 2015-08-26 19:34:38Z wlux $
%
% Copyright (c) 2000-2015, Wolfgang Lux
% See LICENSE for the full license.
%
\nwfilename{IntfSyntaxCheck.lhs}
\section{Checking Interface Declarations}
Similar to Curry source files, some post-processing has to be applied
to parsed interface files. In particular, the compiler must
disambiguate nullary type constructors and type variables. In
addition, the compiler also checks that all type constructor
applications are saturated. Since interface files are closed -- i.e.,
they include declarations of all entities which are defined in other
modules\footnote{Strictly speaking this is not true. The unit, list,
and tuple types are available in all modules but are included only
in the interface of the Prelude, which contains the definitions of
these types.} -- the compiler can perform this check without
reference to the global environments.
\begin{verbatim}
> module IntfSyntaxCheck(intfSyntaxCheck) where
> import Applicative
> import Base
> import Curry
> import CurryUtils
> import Error
> import IdentInfo
> import List
> import Monad
> import PredefIdent
> import TopEnv
> import Utils
\end{verbatim}
The compiler requires information about the arity of each defined type
constructor as well as information whether the type constructor
denotes an algebraic data type, a renaming type, or a type synonym.
The latter must not occur in type expressions in interfaces.
\begin{verbatim}
> intfSyntaxCheck :: [IDecl] -> Error [IDecl]
> intfSyntaxCheck ds = mapA (checkIDecl env) ds
> where env = foldr bindType initTEnv (concatMap tidents (map unhide ds))
> bindType t = qualBindTopEnv (origName t) t
\end{verbatim}
The checks applied to the interface are similar to those performed
during syntax checking of type expressions.
\begin{verbatim}
> checkIDecl :: TypeEnv -> IDecl -> Error IDecl
> checkIDecl _ (IInfixDecl p fix pr op) = return (IInfixDecl p fix pr op)
> checkIDecl env (HidingDataDecl p tc tvs) =
> checkTypeLhs p tvs *>
> return (HidingDataDecl p tc tvs)
> checkIDecl env (IDataDecl p tc tvs cs xs) =
> do
> cs' <- checkTypeLhs p tvs *> mapA (checkConstrDecl env tvs) cs
> checkHiding p tc (map constr cs ++ nub (concatMap labels cs)) xs
> return (IDataDecl p tc tvs cs' xs)
> checkIDecl env (INewtypeDecl p tc tvs nc xs) =
> do
> nc' <- checkTypeLhs p tvs *> checkNewConstrDecl env tvs nc
> checkHiding p tc (nconstr nc : nlabel nc) xs
> return (INewtypeDecl p tc tvs nc' xs)
> checkIDecl env (ITypeDecl p tc tvs ty) =
> checkTypeLhs p tvs *>
> liftA (ITypeDecl p tc tvs) (checkClosedType env p tvs ty)
> checkIDecl env (IFunctionDecl p f n ty) =
> maybe (return ()) (checkArity p) n *>
> liftA (IFunctionDecl p f n) (checkType env p [] ty)
> where checkArity p n =
> unless (n < toInteger (maxBound::Int)) (errorAt p (arityTooBig n))
> checkTypeLhs :: Position -> [Ident] -> Error ()
> checkTypeLhs p tvs = mapA_ (errorAt p . nonLinear . fst) (duplicates tvs)
> checkConstrDecl :: TypeEnv -> [Ident] -> ConstrDecl -> Error ConstrDecl
> checkConstrDecl env tvs (ConstrDecl p evs c tys) =
> checkTypeLhs p evs *>
> liftA (ConstrDecl p evs c) (mapA (checkClosedType env p tvs') tys)
> where tvs' = evs ++ tvs
> checkConstrDecl env tvs (ConOpDecl p evs ty1 op ty2) =
> checkTypeLhs p evs *>
> liftA2 (flip (ConOpDecl p evs) op)
> (checkClosedType env p tvs' ty1)
> (checkClosedType env p tvs' ty2)
> where tvs' = evs ++ tvs
> checkConstrDecl env tvs (RecordDecl p evs c fs) =
> checkTypeLhs p evs *>
> liftA (RecordDecl p evs c) (mapA (checkFieldDecl env tvs') fs)
> where tvs' = evs ++ tvs
> checkFieldDecl :: TypeEnv -> [Ident] -> FieldDecl -> Error FieldDecl
> checkFieldDecl env tvs (FieldDecl p ls ty) =
> liftA (FieldDecl p ls) (checkClosedType env p tvs ty)
> checkNewConstrDecl :: TypeEnv -> [Ident] -> NewConstrDecl
> -> Error NewConstrDecl
> checkNewConstrDecl env tvs (NewConstrDecl p c ty) =
> liftA (NewConstrDecl p c) (checkClosedType env p tvs ty)
> checkNewConstrDecl env tvs (NewRecordDecl p c l ty) =
> liftA (NewRecordDecl p c l) (checkClosedType env p tvs ty)
> checkClosedType :: TypeEnv -> Position -> [Ident] -> TypeExpr
> -> Error TypeExpr
> checkClosedType env p tvs ty =
> do
> ty' <- checkType env p tvs ty
> mapA_ (errorAt p . unboundVariable)
> (nub (filter (`notElem` tvs) (fv ty')))
> return ty'
> checkType :: TypeEnv -> Position -> [Ident] -> TypeExpr -> Error TypeExpr
> checkType env p tvs (ConstructorType tc tys) =
> liftA2 ($)
> (checkTypeConstr env p tvs tc (null tys))
> (mapA (checkType env p tvs) tys)
> checkType env p tvs (VariableType tv)
> | tv `elem` tvs = return (VariableType tv)
> | otherwise = checkType env p tvs (ConstructorType (qualify tv) [])
> checkType env p tvs (TupleType tys) =
> liftA TupleType (mapA (checkType env p tvs) tys)
> checkType env p tvs (ListType ty) = liftA ListType (checkType env p tvs ty)
> checkType env p tvs (ArrowType ty1 ty2) =
> liftA2 ArrowType (checkType env p tvs ty1) (checkType env p tvs ty2)
> checkTypeConstr :: TypeEnv -> Position -> [Ident] -> QualIdent -> Bool
> -> Error ([TypeExpr] -> TypeExpr)
> checkTypeConstr env p tvs tc atom
> | tc `elem` map qualify tvs = checkTypeVar p tc atom
> | otherwise =
> case qualLookupTopEnv tc env of
> []
> | isPrimTypeId (unqualify tc) -> return (ConstructorType tc)
> | not (isQualified tc) -> checkTypeVar p tc atom
> | otherwise -> errorAt p (undefinedType tc)
> [Data _ _] -> return (ConstructorType tc)
> [Alias _] -> errorAt p (badTypeSynonym tc)
> _ -> internalError "checkTypeConstr"
> checkTypeVar :: Position -> QualIdent -> Bool
> -> Error ([TypeExpr] -> TypeExpr)
> checkTypeVar p tv atom
> | atom = return (const (VariableType (unqualify tv)))
> | otherwise = errorAt p (undefinedType tv)
> checkHiding :: Position -> QualIdent -> [Ident] -> [Ident] -> Error ()
> checkHiding p tc xs xs' =
> mapA_ (errorAt p . noElement tc) (nub (filter (`notElem` xs) xs'))
\end{verbatim}
\ToDo{Much of the above code could be shared with module
\texttt{TypeSyntaxCheck}.}
Error messages.
\begin{verbatim}
> undefinedType :: QualIdent -> String
> undefinedType tc = "Undefined type " ++ qualName tc
> nonLinear :: Ident -> String
> nonLinear tv =
> "Type variable " ++ name tv ++
> " occurs more than once on left hand side of type declaration"
> noElement :: QualIdent -> Ident -> String
> noElement tc x =
> "Hidden constructor or label " ++ name x ++ " is not defined for type " ++
> qualName tc
> unboundVariable :: Ident -> String
> unboundVariable tv = "Undefined type variable " ++ name tv
> badTypeSynonym :: QualIdent -> String
> badTypeSynonym tc = "Synonym type " ++ qualName tc ++ " in interface"
> arityTooBig :: Integer -> String
> arityTooBig n = "Function arity out of range: " ++ show n
\end{verbatim}