ghc/compiler/main/ErrsRn.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1995
   3 %
   4 \section[ErrsRn]{Reporting errors from the renamer}
   5
   6 This is an internal module---access to these functions is through
   7 @Errors@.
   8
   9 \begin{code}
  10 #include "HsVersions.h"
  11
  12 module ErrsRn where
  13
  14 import AbsSyn           -- we print a bunch of stuff in here
  15 import AbsUniType       ( TyVarTemplate )
  16 import UniType          ( UniType(..) )
  17                         -- UniType is concrete, to make some errors
  18                         -- more informative.
  19 import ErrUtils
  20 import Name             ( cmpName )
  21 import Outputable
  22 import Pretty           -- to pretty-print error messages
  23 import SrcLoc           ( mkUnknownSrcLoc, SrcLoc )
  24 import Util
  25 \end{code}
  26
  27 \begin{code}
  28 badClassOpErr :: Name{-class-} -> ProtoName{-op-} -> SrcLoc -> Error
  29         -- Class op expected but something else found
  30 badClassOpErr clas op locn
  31   = addErrLoc locn "" ( \ sty ->
  32     ppBesides [ppChar '`', ppr sty op, ppStr "' is not an operation of class `",
  33               ppr sty clas, ppStr "'."] )
  34
  35 ----------------------------------------------------------------
  36 badExportNameErr :: String -> String -> Error
  37
  38 badExportNameErr name whats_wrong
  39   = dontAddErrLoc
  40         "Error in the export list" ( \ sty ->
  41     ppBesides [ppChar '`', ppStr name, ppStr "' ", ppStr whats_wrong] )
  42
  43 ----------------------------------------------------------------
  44 badImportNameErr :: String -> String -> String -> SrcLoc -> Error
  45
  46 badImportNameErr mod name whats_wrong locn
  47   = addErrLoc locn
  48         ("Error in an import list for the module `"++mod++"'") ( \ sty ->
  49     ppBesides [ppChar '`', ppStr name, ppStr "' ", ppStr whats_wrong] )
  50
  51 ----------------------------------------------------------------
  52 derivingInIfaceErr :: ProtoName -> [ProtoName] -> SrcLoc -> Error
  53         -- GHC doesn't support "deriving" in interfaces
  54
  55 derivingInIfaceErr ty deriveds locn
  56   = addErrLoc locn "Glasgow Haskell doesn't support `deriving' in interfaces" ( \ sty ->
  57     ppBesides [ ppStr "type: ", ppr sty ty,
  58                 ppStr "; derived: ", interpp'SP sty deriveds ] )
  59
  60 ----------------------------------------------------------------
  61 derivingNonStdClassErr :: Name -> ProtoName -> SrcLoc -> Error
  62         -- if "deriving" specified for a non-standard class
  63
  64 derivingNonStdClassErr tycon clas locn
  65   = addErrLoc locn "Can't have a derived instance of this class" ( \ sty ->
  66     ppBesides [ppStr "type constructor: ", ppr sty tycon,
  67                                  ppStr "; class: ", ppr sty clas] )
  68
  69 ----------------------------------------------------------------
  70 dupNamesErr :: String -> [(ProtoName,SrcLoc)] -> Error
  71
  72 dupNamesErr descriptor ((first_pname,locn1) : dup_things) sty
  73   = ppAboves (first_item : map dup_item dup_things)
  74   where
  75     first_item
  76       = ppBesides [ ppr PprForUser locn1,
  77             ppStr ": multiple declarations of a ", ppStr descriptor, ppStr ": ",
  78             ppr sty first_pname ]
  79
  80     dup_item (pname, locn)
  81       = ppBesides [ ppr PprForUser locn,
  82             ppStr ": here was another declaration of `", ppr sty pname, ppStr "'" ]
  83
  84 ----------------------------------------------------------------
  85 dupPreludeNameErr :: String -> (ProtoName, SrcLoc) -> Error
  86
  87 dupPreludeNameErr descriptor (nm, locn)
  88   = addShortErrLocLine locn ( \ sty ->
  89     ppBesides [ ppStr "A conflict with a Prelude ", ppStr descriptor,
  90                 ppStr ": ", ppr sty nm ])
  91
  92 ----------------------------------------------------------------
  93 dupSigDeclErr :: [RenamedSig] -> Error
  94         -- Duplicate signatures in a group; the sigs have locns on them
  95 dupSigDeclErr sigs
  96   = let
  97         undup_sigs = fst (removeDups cmp_sig sigs)
  98     in
  99     addErrLoc locn1
 100         ("more than one "++what_it_is++"\n\thas been given for these variables") ( \ sty ->
 101     ppAboves (map (ppr sty) undup_sigs) )
 102   where
 103     (what_it_is, locn1)
 104       = case (head sigs) of
 105           Sig        _ _ _ loc -> ("type signature",loc)
 106           ClassOpSig _ _ _ loc -> ("class-method type signature", loc)
 107           SpecSig    _ _ _ loc -> ("SPECIALIZE pragma",loc)
 108           InlineSig  _ _   loc -> ("INLINE pragma",loc)
 109           MagicUnfoldingSig _ _ loc -> ("MAGIC_UNFOLDING pragma",loc)
 110
 111     cmp_sig a b = get_name a `cmpName` get_name b
 112
 113     get_name (Sig        n _ _ _) = n
 114     get_name (ClassOpSig n _ _ _) = n
 115     get_name (SpecSig    n _ _ _) = n
 116     get_name (InlineSig  n _   _) = n
 117     get_name (MagicUnfoldingSig n _ _) = n
 118
 119 ----------------------------------------------------------------
 120 duplicateImportsInInterfaceErr :: String -> [ProtoName] -> Error
 121 duplicateImportsInInterfaceErr iface dups
 122   = panic "duplicateImportsInInterfaceErr: NOT DONE YET?"
 123
 124 ----------------------------------------------------------------
 125 inlineInRecursiveBindsErr  :: [(Name, SrcLoc)] -> Error
 126
 127 inlineInRecursiveBindsErr [(name, locn)]
 128   = addShortErrLocLine locn ( \ sty ->
 129     ppBesides [ppStr "INLINE pragma for a recursive definition: ",
 130         ppr sty name] )
 131 inlineInRecursiveBindsErr names_n_locns
 132   = \ sty ->
 133     ppHang (ppStr "INLINE pragmas for some recursive definitions:")
 134          4 (ppAboves [ ppBesides [ppr PprForUser locn, ppStr ": ", ppr sty n]
 135                      | (n, locn) <- names_n_locns ])
 136
 137 ----------------------------------------------------------------
 138 --mismatchedPragmasErr :: (Annotations, SrcLoc)
 139 --                   -> (Annotations, SrcLoc)
 140 --                   -> Error
 141 {- UNUSED:
 142 mismatchedPragmasErr (anns1, _) (anns2, _)
 143   = dontAddErrLoc "Mismatched pragmas from interfaces" ( \ sty ->
 144     ppSep [ppr sty anns1, ppr sty anns2] )
 145 -}
 146
 147 ----------------------------------------------------------------
 148 shadowedNameErr :: Name -> SrcLoc -> Error
 149 shadowedNameErr shadow locn
 150   = addShortErrLocLine locn ( \ sty ->
 151     ppBesides [ppStr "more than one value with the same name (shadowing): ",
 152         ppr sty shadow] )
 153
 154 ----------------------------------------------------------------
 155 unknownNameErr :: String -> ProtoName -> SrcLoc -> Error
 156 unknownNameErr descriptor undef_thing locn
 157   = addShortErrLocLine locn ( \ sty ->
 158     ppBesides [ppStr "undefined ", ppStr descriptor, ppStr ": ",
 159         ppr sty undef_thing] )
 160
 161 ----------------------------------------------------------------
 162 missingSigErr :: SrcLoc -> ProtoName -> Error
 163         -- Top-level definition without a type signature
 164         -- (when SigsRequired flag is in use)
 165 missingSigErr locn var
 166   = addShortErrLocLine locn ( \ sty ->
 167     ppBesides [ppStr "a definition but no type signature for `",
 168                ppr sty var,
 169                ppStr "'."])
 170
 171 ----------------------------------------------------------------
 172 unknownSigDeclErr :: String -> ProtoName -> SrcLoc -> Error
 173         -- Signature/Pragma given for unknown variable
 174 unknownSigDeclErr flavor var locn
 175   = addShortErrLocLine locn ( \ sty ->
 176     ppBesides [ppStr flavor, ppStr " but no definition for `",
 177                ppr sty var,
 178                ppStr "'."])
 179
 180 ----------------------------------------------------------------
 181 weirdImportExportConstraintErr :: ProtoName -> IE -> SrcLoc -> Error
 182
 183 weirdImportExportConstraintErr thing constraint locn
 184   = addShortErrLocLine locn ( \ sty ->
 185     ppBesides [ppStr "Illegal import/export constraint on `",
 186                ppr sty thing,
 187                ppStr "': ", ppr PprForUser constraint])
 188
 189 ----------------------------------------------------------------
 190 methodBindErr :: ProtoNameMonoBinds -> SrcLoc -> Error
 191 methodBindErr mbind locn
 192  = addErrLoc locn "Can't handle multiple methods defined by one pattern binding"
 193         (\ sty -> ppr sty mbind)
 194 \end{code}