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
183
184
185
186
187
188
189
190
191
192
193
194
|
%
% (c) The AQUA Project, Glasgow University, 1994-1995
%
\section[ErrsRn]{Reporting errors from the renamer}
This is an internal module---access to these functions is through
@Errors@.
\begin{code}
#include "HsVersions.h"
module ErrsRn where
import AbsSyn -- we print a bunch of stuff in here
import AbsUniType ( TyVarTemplate )
import UniType ( UniType(..) )
-- UniType is concrete, to make some errors
-- more informative.
import ErrUtils
import Name ( cmpName )
import Outputable
import Pretty -- to pretty-print error messages
import SrcLoc ( mkUnknownSrcLoc, SrcLoc )
import Util
\end{code}
\begin{code}
badClassOpErr :: Name{-class-} -> ProtoName{-op-} -> SrcLoc -> Error
-- Class op expected but something else found
badClassOpErr clas op locn
= addErrLoc locn "" ( \ sty ->
ppBesides [ppChar '`', ppr sty op, ppStr "' is not an operation of class `",
ppr sty clas, ppStr "'."] )
----------------------------------------------------------------
badExportNameErr :: String -> String -> Error
badExportNameErr name whats_wrong
= dontAddErrLoc
"Error in the export list" ( \ sty ->
ppBesides [ppChar '`', ppStr name, ppStr "' ", ppStr whats_wrong] )
----------------------------------------------------------------
badImportNameErr :: String -> String -> String -> SrcLoc -> Error
badImportNameErr mod name whats_wrong locn
= addErrLoc locn
("Error in an import list for the module `"++mod++"'") ( \ sty ->
ppBesides [ppChar '`', ppStr name, ppStr "' ", ppStr whats_wrong] )
----------------------------------------------------------------
derivingInIfaceErr :: ProtoName -> [ProtoName] -> SrcLoc -> Error
-- GHC doesn't support "deriving" in interfaces
derivingInIfaceErr ty deriveds locn
= addErrLoc locn "Glasgow Haskell doesn't support `deriving' in interfaces" ( \ sty ->
ppBesides [ ppStr "type: ", ppr sty ty,
ppStr "; derived: ", interpp'SP sty deriveds ] )
----------------------------------------------------------------
derivingNonStdClassErr :: Name -> ProtoName -> SrcLoc -> Error
-- if "deriving" specified for a non-standard class
derivingNonStdClassErr tycon clas locn
= addErrLoc locn "Can't have a derived instance of this class" ( \ sty ->
ppBesides [ppStr "type constructor: ", ppr sty tycon,
ppStr "; class: ", ppr sty clas] )
----------------------------------------------------------------
dupNamesErr :: String -> [(ProtoName,SrcLoc)] -> Error
dupNamesErr descriptor ((first_pname,locn1) : dup_things) sty
= ppAboves (first_item : map dup_item dup_things)
where
first_item
= ppBesides [ ppr PprForUser locn1,
ppStr ": multiple declarations of a ", ppStr descriptor, ppStr ": ",
ppr sty first_pname ]
dup_item (pname, locn)
= ppBesides [ ppr PprForUser locn,
ppStr ": here was another declaration of `", ppr sty pname, ppStr "'" ]
----------------------------------------------------------------
dupPreludeNameErr :: String -> (ProtoName, SrcLoc) -> Error
dupPreludeNameErr descriptor (nm, locn)
= addShortErrLocLine locn ( \ sty ->
ppBesides [ ppStr "A conflict with a Prelude ", ppStr descriptor,
ppStr ": ", ppr sty nm ])
----------------------------------------------------------------
dupSigDeclErr :: [RenamedSig] -> Error
-- Duplicate signatures in a group; the sigs have locns on them
dupSigDeclErr sigs
= let
undup_sigs = fst (removeDups cmp_sig sigs)
in
addErrLoc locn1
("more than one "++what_it_is++"\n\thas been given for these variables") ( \ sty ->
ppAboves (map (ppr sty) undup_sigs) )
where
(what_it_is, locn1)
= case (head sigs) of
Sig _ _ _ loc -> ("type signature",loc)
ClassOpSig _ _ _ loc -> ("class-method type signature", loc)
SpecSig _ _ _ loc -> ("SPECIALIZE pragma",loc)
InlineSig _ _ loc -> ("INLINE pragma",loc)
MagicUnfoldingSig _ _ loc -> ("MAGIC_UNFOLDING pragma",loc)
cmp_sig a b = get_name a `cmpName` get_name b
get_name (Sig n _ _ _) = n
get_name (ClassOpSig n _ _ _) = n
get_name (SpecSig n _ _ _) = n
get_name (InlineSig n _ _) = n
get_name (MagicUnfoldingSig n _ _) = n
----------------------------------------------------------------
duplicateImportsInInterfaceErr :: String -> [ProtoName] -> Error
duplicateImportsInInterfaceErr iface dups
= panic "duplicateImportsInInterfaceErr: NOT DONE YET?"
----------------------------------------------------------------
inlineInRecursiveBindsErr :: [(Name, SrcLoc)] -> Error
inlineInRecursiveBindsErr [(name, locn)]
= addShortErrLocLine locn ( \ sty ->
ppBesides [ppStr "INLINE pragma for a recursive definition: ",
ppr sty name] )
inlineInRecursiveBindsErr names_n_locns
= \ sty ->
ppHang (ppStr "INLINE pragmas for some recursive definitions:")
4 (ppAboves [ ppBesides [ppr PprForUser locn, ppStr ": ", ppr sty n]
| (n, locn) <- names_n_locns ])
----------------------------------------------------------------
--mismatchedPragmasErr :: (Annotations, SrcLoc)
-- -> (Annotations, SrcLoc)
-- -> Error
{- UNUSED:
mismatchedPragmasErr (anns1, _) (anns2, _)
= dontAddErrLoc "Mismatched pragmas from interfaces" ( \ sty ->
ppSep [ppr sty anns1, ppr sty anns2] )
-}
----------------------------------------------------------------
shadowedNameErr :: Name -> SrcLoc -> Error
shadowedNameErr shadow locn
= addShortErrLocLine locn ( \ sty ->
ppBesides [ppStr "more than one value with the same name (shadowing): ",
ppr sty shadow] )
----------------------------------------------------------------
unknownNameErr :: String -> ProtoName -> SrcLoc -> Error
unknownNameErr descriptor undef_thing locn
= addShortErrLocLine locn ( \ sty ->
ppBesides [ppStr "undefined ", ppStr descriptor, ppStr ": ",
ppr sty undef_thing] )
----------------------------------------------------------------
missingSigErr :: SrcLoc -> ProtoName -> Error
-- Top-level definition without a type signature
-- (when SigsRequired flag is in use)
missingSigErr locn var
= addShortErrLocLine locn ( \ sty ->
ppBesides [ppStr "a definition but no type signature for `",
ppr sty var,
ppStr "'."])
----------------------------------------------------------------
unknownSigDeclErr :: String -> ProtoName -> SrcLoc -> Error
-- Signature/Pragma given for unknown variable
unknownSigDeclErr flavor var locn
= addShortErrLocLine locn ( \ sty ->
ppBesides [ppStr flavor, ppStr " but no definition for `",
ppr sty var,
ppStr "'."])
----------------------------------------------------------------
weirdImportExportConstraintErr :: ProtoName -> IE -> SrcLoc -> Error
weirdImportExportConstraintErr thing constraint locn
= addShortErrLocLine locn ( \ sty ->
ppBesides [ppStr "Illegal import/export constraint on `",
ppr sty thing,
ppStr "': ", ppr PprForUser constraint])
----------------------------------------------------------------
methodBindErr :: ProtoNameMonoBinds -> SrcLoc -> Error
methodBindErr mbind locn
= addErrLoc locn "Can't handle multiple methods defined by one pattern binding"
(\ sty -> ppr sty mbind)
\end{code}
|
