Commit e8788ca1 authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Compiler messages now use Doc for message body

parent bb39c58d
......@@ -2,17 +2,16 @@ module Base.Messages
( -- * Output of user information
info, status, putErrLn, putErrsLn
-- * program abortion
, abortWith, internalError, errorMessage, errorMessages
, abortWith, abortWithMessages, internalError, errorMessage, errorMessages
-- * creating messages
, Message, toMessage, posMsg, qposMsg, mposMsg
, Message, posMessage
) where
import Control.Monad (unless)
import System.IO (hPutStrLn, stderr)
import System.Exit (ExitCode (..), exitWith)
import System.IO (hPutStrLn, stderr)
import System.Exit (exitFailure)
import Curry.Base.Ident (ModuleIdent (..), Ident (..), QualIdent, qidPosition)
import Curry.Base.MessageMonad (Message, toMessage)
import Curry.Base.MessageMonad (Message, posMessage, ppMessage, ppMessages)
import CompilerOpts (Options (optVerbosity), Verbosity (..))
......@@ -34,23 +33,18 @@ putErrsLn = mapM_ putErrLn
-- |Print a list of error messages on 'stderr' and abort the program
abortWith :: [String] -> IO a
abortWith errs = putErrsLn errs >> exitWith (ExitFailure 1)
abortWith errs = putErrsLn errs >> exitFailure
-- |Print a list of error messages on 'stderr' and abort the program
abortWithMessages :: [Message] -> IO a
abortWithMessages msgs = putErrLn (show $ ppMessages msgs) >> exitFailure
-- |Raise an internal error
internalError :: String -> a
internalError msg = error $ "Internal error: " ++ msg
errorMessage :: Message -> a
errorMessage = error . show
errorMessage = error . show . ppMessage
errorMessages :: [Message] -> a
errorMessages = error . unlines . map show
posMsg :: Ident -> String -> Message
posMsg i errMsg = toMessage (idPosition i) errMsg
qposMsg :: QualIdent -> String -> Message
qposMsg i errMsg = toMessage (qidPosition i) errMsg
mposMsg :: ModuleIdent -> String -> Message
mposMsg m errMsg = toMessage (midPosition m) errMsg
errorMessages = error . show . ppMessages
......@@ -6,12 +6,13 @@ import Data.List (nub, union)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import qualified Data.Set as Set
import Text.PrettyPrint
import Curry.Base.Ident
import Curry.Base.Position
import Curry.Syntax
import Base.Messages (Message, internalError, mposMsg, posMsg, qposMsg)
import Base.Messages (Message, internalError, posMessage)
import Base.TopEnv
import Base.Types
import Base.Utils (findMultiples)
......@@ -239,50 +240,53 @@ isRecordType _ = False
-- ---------------------------------------------------------------------------
errUndefinedEntity :: QualIdent -> Message
errUndefinedEntity x = qposMsg x $
"Entity " ++ qualName x ++ " in export list is not defined"
errUndefinedEntity x = posMessage x $ hsep $ map text
["Entity", qualName x, "in export list is not defined"]
errUndefinedType :: QualIdent -> Message
errUndefinedType tc = qposMsg tc $
"Type " ++ qualName tc ++ " in export list is not defined"
errUndefinedType tc = posMessage tc $ hsep $ map text
["Type", qualName tc, "in export list is not defined"]
errModuleNotImported :: ModuleIdent -> Message
errModuleNotImported m = mposMsg m $
"Module " ++ moduleName m ++ " not imported"
errModuleNotImported m = posMessage m $ hsep $ map text
["Module", moduleName m, "not imported"]
errMultipleExportType :: [Ident] -> Message
errMultipleExportType [] = internalError
"Checks.ExportCheck.errMultipleExportType: empty list"
errMultipleExportType (i:is) = posMsg i $
"Multiple exports of type " ++ idName i ++ " at:\n"
++ unlines (map showPos (i:is))
where showPos = (" " ++) . showLine . idPosition
errMultipleExportType (i:is) = posMessage i $
text "Multiple exports of type" <+> text (idName i) <+> text "at:" $+$
nest 2 (vcat (map showPos (i:is)))
where showPos = text . showLine . idPosition
errMultipleExportValue :: [Ident] -> Message
errMultipleExportValue [] = internalError
"Checks.ExportCheck.errMultipleExportValue: empty list"
errMultipleExportValue (i:is) = posMsg i $
"Multiple exports of " ++ idName i ++ " at:\n"
++ unlines (map showPos (i:is))
where showPos = (" " ++) . showLine . idPosition
errMultipleExportValue (i:is) = posMessage i $
text "Multiple exports of" <+> text (idName i) <+> text "at:" $+$
nest 2 (vcat (map showPos (i:is)))
where showPos = text . showLine . idPosition
errAmbiguousType :: QualIdent -> Message
errAmbiguousType tc = qposMsg tc $ "Ambiguous type " ++ qualName tc
errAmbiguousType tc = posMessage tc $ hsep $ map text
["Ambiguous type", qualName tc]
errAmbiguousName :: QualIdent -> Message
errAmbiguousName x = qposMsg x $ "Ambiguous name " ++ qualName x
errAmbiguousName x = posMessage x $ hsep $ map text
["Ambiguous name", qualName x]
errExportDataConstr :: QualIdent -> Message
errExportDataConstr c = qposMsg c $
"Data constructor " ++ qualName c ++ " in export list"
errExportDataConstr c = posMessage c $ hsep $ map text
["Data constructor", qualName c, "in export list"]
errNonDataType :: QualIdent -> Message
errNonDataType tc = qposMsg tc $ qualName tc ++ " is not a data type"
errNonDataType tc = posMessage tc $ hsep $ map text
[qualName tc, "is not a data type"]
errUndefinedDataConstr :: QualIdent -> Ident -> Message
errUndefinedDataConstr tc c = posMsg c $
idName c ++ " is not a data constructor of type " ++ qualName tc
errUndefinedDataConstr tc c = posMessage c $ hsep $ map text
[idName c, "is not a data constructor of type", qualName tc]
errUndefinedLabel :: QualIdent -> Ident -> Message
errUndefinedLabel r l = posMsg l $
idName l ++ " is not a label of the record " ++ qualName r
errUndefinedLabel r l = posMessage l $ hsep $ map text
[idName l, "is not a label of the record", qualName r]
......@@ -27,12 +27,13 @@ is defined more than once.
> import Control.Monad (forM, liftM, liftM2, liftM3, unless, when)
> import qualified Control.Monad.State as S (State, runState, gets, modify)
> import Text.PrettyPrint
> import Curry.Base.Ident
> import Curry.Base.Position
> import Curry.Syntax
> import Base.Messages (Message, posMsg, qposMsg, internalError)
> import Base.Messages (Message, posMessage, internalError)
> import Base.TopEnv
> import Base.Utils (findMultiples)
......@@ -314,36 +315,43 @@ Error messages:
\begin{verbatim}
> errUndefinedType :: QualIdent -> Message
> errUndefinedType tc = qposMsg tc $ "Undefined type " ++ qualName tc
> errUndefinedType tc = posMessage tc $ hsep $ map text
> ["Undefined type", qualName tc]
> errAmbiguousType :: QualIdent -> Message
> errAmbiguousType tc = qposMsg tc $ "Ambiguous type " ++ qualName tc
> errAmbiguousType tc = posMessage tc $ hsep $ map text
> ["Ambiguous type", qualName tc]
> errMultipleDeclaration :: [Ident] -> Message
> errMultipleDeclaration [] = internalError
> "KindCheck.errMultipleDeclaration: empty list"
> errMultipleDeclaration (i:is) = posMsg i $
> "Multiple declarations for type `" ++ idName i ++ "` at:\n"
> ++ unlines (map showPos (i:is))
> where showPos = (" " ++) . showLine . idPosition
> errMultipleDeclaration (i:is) = posMessage i $
> text "Multiple declarations for type" <+> text (escName i)
> <+> text "at:" $+$
> nest 2 (vcat (map showPos (i:is)))
> where showPos = text . showLine . idPosition
> errNonLinear :: Ident -> Message
> errNonLinear tv = posMsg tv $ "Type variable " ++ idName tv ++
> " occurs more than once on left hand side of type declaration"
> errNonLinear tv = posMessage tv $ hsep $ map text
> [ "Type variable", idName tv
> , "occurs more than once on left hand side of type declaration"]
> errNoVariable :: Ident -> Message
> errNoVariable tv = posMsg tv $ "Type constructor " ++ idName tv ++
> " used in left hand side of type declaration"
> errNoVariable tv = posMessage tv $ hsep $ map text
> [ "Type constructor", idName tv
> , "used in left hand side of type declaration"]
> errWrongArity :: QualIdent -> Int -> Int -> Message
> errWrongArity tc arity argc = qposMsg tc $
> "Type constructor " ++ qualName tc ++ " expects " ++ arguments arity ++
> " but is applied to " ++ show argc
> errWrongArity tc arity argc = posMessage tc $
> text "Type constructor" <+> text (qualName tc)
> <+> text "expects" <+> text (arguments arity)
> <> comma <+> text "but is applied to" <+> text (show argc)
> where arguments 0 = "no arguments"
> arguments 1 = "1 argument"
> arguments n = show n ++ " arguments"
> errUnboundVariable :: Ident -> Message
> errUnboundVariable tv = posMsg tv $ "Unbound type variable " ++ idName tv
> errUnboundVariable tv = posMessage tv $ hsep $ map text
> ["Unbound type variable", idName tv]
\end{verbatim}
......@@ -21,13 +21,14 @@ of the operators involved.
> import Control.Monad (liftM, liftM2, liftM3, unless, when)
> import qualified Control.Monad.State as S (State, runState, gets, modify)
> import Data.List (partition)
> import Text.PrettyPrint
> import Curry.Base.Ident
> import Curry.Base.Position
> import Curry.Syntax
> import Base.Expr
> import Base.Messages (Message, posMsg, qposMsg)
> import Base.Messages (Message, posMessage)
> import Base.Utils (findDouble)
> import Env.OpPrec (PEnv, OpPrec (..), PrecInfo (..), defaultP, bindP
......@@ -490,21 +491,21 @@ Error messages.
\begin{verbatim}
> errUndefinedOperator :: Ident -> Message
> errUndefinedOperator op = posMsg op $
> "no definition for " ++ idName op ++ " in this scope"
> errUndefinedOperator op = posMessage op $ hsep $ map text
> ["No definition for", idName op, "in this scope"]
> errDuplicatePrecedence :: Ident -> Message
> errDuplicatePrecedence op = posMsg op $
> "More than one fixity declaration for " ++ idName op
> errDuplicatePrecedence op = posMessage op $ hsep $ map text
> ["More than one fixity declaration for", idName op]
> errInvalidParse :: String -> Ident -> QualIdent -> Message
> errInvalidParse what op1 op2 = posMsg op1 $
> "Invalid use of " ++ what ++ " " ++ idName op1
> ++ " with " ++ qualName op2 ++ (showLine $ qidPosition op2)
> errInvalidParse what op1 op2 = posMessage op1 $ hsep $ map text
> [ "Invalid use of", what, idName op1, "with", qualName op2
> , showLine $ qidPosition op2]
> errAmbiguousParse :: String -> QualIdent -> QualIdent -> Message
> errAmbiguousParse what op1 op2 = qposMsg op1 $
> "Ambiguous use of " ++ what ++ " " ++ qualName op1
> ++ " with " ++ qualName op2 ++ (showLine $ qidPosition op2)
> errAmbiguousParse what op1 op2 = posMessage op1 $ hsep $ map text
> ["Ambiguous use of", what, qualName op1, "with", qualName op2
> , showLine $ qidPosition op2]
\end{verbatim}
......@@ -27,13 +27,14 @@ definition.
> import Data.List ((\\), insertBy, partition)
> import Data.Maybe (fromJust, isJust, isNothing, maybeToList)
> import qualified Data.Set as Set (empty, insert, member)
> import Text.PrettyPrint
> import Curry.Base.Ident
> import Curry.Base.Position
> import Curry.Syntax
> import Base.Expr
> import Base.Messages (Message, toMessage, internalError, posMsg, qposMsg)
> import Base.Messages (Message, posMessage, internalError)
> import Base.NestEnv
> import Base.Types
> import Base.Utils ((++!), findDouble, findMultiples)
......@@ -982,113 +983,122 @@ Error messages.
\begin{verbatim}
> errUndefinedVariable :: QualIdent -> Message
> errUndefinedVariable v = qposMsg v $ qualName v ++ " is undefined"
> errUndefinedVariable v = posMessage v $ hsep $ map text
> [qualName v, "is undefined"]
> errUndefinedData :: QualIdent -> Message
> errUndefinedData c = qposMsg c $ "Undefined data constructor " ++ qualName c
> errUndefinedData c = posMessage c $ hsep $ map text
> ["Undefined data constructor", qualName c]
> errUndefinedLabel :: Ident -> Message
> errUndefinedLabel l = posMsg l $ "Undefined record label `" ++ idName l ++ "`"
> errUndefinedLabel l = posMessage l $ hsep $ map text
> ["Undefined record label", escName l]
> errAmbiguousIdent :: [RenameInfo] -> QualIdent -> Message
> errAmbiguousIdent rs | any isConstr rs = errAmbiguousData
> | otherwise = errAmbiguousVariable
> errAmbiguousVariable :: QualIdent -> Message
> errAmbiguousVariable v = qposMsg v $ "Ambiguous variable " ++ qualName v
> errAmbiguousVariable v = posMessage v $ hsep $ map text
> ["Ambiguous variable", qualName v]
> errAmbiguousData :: QualIdent -> Message
> errAmbiguousData c = qposMsg c $ "Ambiguous data constructor " ++ qualName c
> errAmbiguousData c = posMessage c $ hsep $ map text
> ["Ambiguous data constructor", qualName c]
> errDuplicateDefinition :: Ident -> Message
> errDuplicateDefinition v = posMsg v $
> "More than one definition for `" ++ idName v ++ "`"
> errDuplicateDefinition v = posMessage v $ hsep $ map text
> ["More than one definition for", escName v]
> errDuplicateVariable :: Ident -> Message
> errDuplicateVariable v = posMsg v $
> idName v ++ " occurs more than once in pattern"
> errDuplicateVariable v = posMessage v $ hsep $ map text
> [idName v, "occurs more than once in pattern"]
> errMultipleDataConstructor :: [Ident] -> Message
> errMultipleDataConstructor [] = internalError
> "SyntaxCheck.errMultipleDataDeclaration: empty list"
> errMultipleDataConstructor (i:is) = posMsg i $
> "Multiple definitions for data constructor `" ++ idName i ++ "` at:\n"
> ++ unlines (map showPos (i:is))
> where showPos = (" " ++) . showLine . idPosition
> errMultipleDataConstructor (i:is) = posMessage i $
> text "Multiple definitions for data constructor" <+> text (escName i)
> <+> text "at:" $+$
> nest 2 (vcat (map showPos (i:is)))
> where showPos = text . showLine . idPosition
> errDuplicateTypeSig :: Ident -> Message
> errDuplicateTypeSig v = posMsg v $
> "More than one type signature for `" ++ idName v ++ "`"
> errDuplicateTypeSig v = posMessage v $ hsep $ map text
> ["More than one type signature for", escName v]
> errDuplicateEvalAnnot :: Ident -> Message
> errDuplicateEvalAnnot v = posMsg v $
> "More than one eval annotation for `" ++ idName v ++ "`"
> errDuplicateEvalAnnot v = posMessage v $ hsep $ map text
> ["More than one eval annotation for", escName v]
> errDuplicateLabel :: Ident -> Message
> errDuplicateLabel l = posMsg l $
> "Multiple occurrence of record label `" ++ idName l ++ "`"
> errDuplicateLabel l = posMessage l $ hsep $ map text
> ["Multiple occurrence of record label", escName l]
> errMissingLabel :: Position -> Ident -> QualIdent -> String -> Message
> errMissingLabel p l r what = toMessage p $
> "Missing label `" ++ idName l
> ++ "` in the " ++ what ++ " of `" ++ idName (unqualify r) ++ "`"
> errMissingLabel p l r what = posMessage p $ hsep $ map text
> ["Missing label", escName l, "in the", what, "of", escName (unqualify r)]
> errIllegalLabel :: Ident -> QualIdent -> Message
> errIllegalLabel l r = posMsg l $
> "Label `" ++ idName l ++ "` is not defined in record `"
> ++ idName (unqualify r) ++ "`"
> errIllegalLabel l r = posMessage l $ hsep $ map text
> ["Label", escName l, "is not defined in record", escName (unqualify r)]
> errIllegalRecordId :: Ident -> Message
> errIllegalRecordId r = posMsg r $ "Record identifier `" ++ idName r
> ++ "` already assigned to a data constructor"
> errIllegalRecordId r = posMessage r $ hsep $ map text
> ["Record identifier", escName r, "already assigned to a data constructor"]
> errNonVariable :: String -> Ident -> Message
> errNonVariable what c = posMsg c $
> "Data constructor `" ++ idName c ++ "` in left hand side of " ++ what
> errNonVariable what c = posMessage c $ hsep $ map text
> ["Data constructor", escName c, "in left hand side of", what]
> errNoBody :: Ident -> Message
> errNoBody v = posMsg v $ "No body for `" ++ idName v ++ "`"
> errNoBody v = posMessage v $ hsep $ map text ["No body for", escName v]
> errNoTypeSig :: Ident -> Message
> errNoTypeSig f = posMsg f $
> "No type signature for external function `" ++ idName f ++ "`"
> errNoTypeSig f = posMessage f $ hsep $ map text
> ["No type signature for external function", escName f]
> errToplevelPattern :: Position -> Message
> errToplevelPattern p = toMessage p
> errToplevelPattern p = posMessage p $ text
> "Pattern declaration not allowed at top-level"
> errNotALabel :: Ident -> Message
> errNotALabel l = posMsg l $ "`" ++ idName l ++ "` is not a record label"
> errNotALabel l = posMessage l $
> text (escName l) <+> text "is not a record label"
> errDifferentArity :: Ident -> Message
> errDifferentArity f = posMsg f $
> "Equations for `" ++ idName f ++ "` have different arities"
> errDifferentArity f = posMessage f $ hsep $ map text
> ["Equations for", escName f, "have different arities"]
> errWrongArity :: QualIdent -> Int -> Int -> Message
> errWrongArity c arity' argc = qposMsg c $
> "Data constructor " ++ qualName c ++ " expects " ++ arguments arity' ++
> " but is applied to " ++ show argc
> errWrongArity c arity' argc = posMessage c $ hsep (map text
> ["Data constructor", qualName c, "expects", arguments arity'])
> <> comma <+> text "but is applied to" <+> text (show argc)
> where arguments 0 = "no arguments"
> arguments 1 = "1 argument"
> arguments n = show n ++ " arguments"
> errIllegalRecordPattern :: Position -> Message
> errIllegalRecordPattern p = toMessage p
> "Expexting `_` after `|` in the record pattern"
> errIllegalRecordPattern p = posMessage p $ hsep $ map text
> [ "Expexting", escName anonId, "after", escName (mkIdent "|")
> , "in the record pattern" ]
> errMissingLanguageExtension :: Position -> String -> Extension -> Message
> errMissingLanguageExtension p what ext = toMessage p $
> what ++ " are not supported in standard Curry."
> ++ "\n Use flag -e or -X" ++ show ext ++ " to enable this extension."
> errMissingLanguageExtension p what ext = posMessage p $
> text what <+> text "are not supported in standard Curry." $+$
> nest 2 (text "Use flag -e or -X" <> text (show ext)
> <+> text "to enable this extension.")
> errEmptyRecord :: Position -> Message
> errEmptyRecord p = toMessage p "empty records are not allowed"
> errEmptyRecord p = posMessage p $ text "Empty records are not allowed"
> errInfixWithoutParens :: Position -> [(QualIdent, QualIdent)] -> Message
> errInfixWithoutParens p calls = toMessage p $
> "Missing parens in infix patterns: \n" ++ unlines (map showCall calls)
> where showCall (q1, q2) =
> show q1 ++ " " ++ showLine (qidPosition q1)
> ++ "calls " ++ show q2 ++ " " ++ showLine (qidPosition q2)
> errInfixWithoutParens p calls = posMessage p $
> text "Missing parens in infix patterns:" $+$
> vcat (map showCall calls)
> where
> showCall (q1, q2) = showWithPos q1 <+> text "calls" <+> showWithPos q2
> showWithPos q = text (qualName q)
> <+> parens (text $ showLine $ qidPosition q)
\end{verbatim}
......@@ -38,7 +38,7 @@ type annotation is present.
> import Base.CurryTypes (fromQualType, toType, toTypes)
> import Base.Expr
> import Base.Messages (Message, toMessage, posMsg, internalError)
> import Base.Messages (Message, posMessage, internalError)
> import Base.SCC
> import Base.TopEnv
> import Base.Types
......@@ -1320,39 +1320,39 @@ Error functions.
> errRecursiveTypes :: [Ident] -> Message
> errRecursiveTypes [] = internalError
> "TypeCheck.recursiveTypes: empty list"
> errRecursiveTypes [tc] = posMsg tc $
> "Recursive synonym type " ++ idName tc
> errRecursiveTypes (tc : tcs) = posMsg tc $
> "Recursive synonym types " ++ idName tc ++ types "" tcs
> errRecursiveTypes [tc] = posMessage tc $ hsep $ map text
> ["Recursive synonym type", idName tc]
> errRecursiveTypes (tc : tcs) = posMessage tc $
> text "Recursive synonym types" <+> text (idName tc) <+> types empty tcs
> where
> types _ [] = ""
> types comm [tc1] = comm ++ " and " ++ idName tc1
> ++ showLine (idPosition tc1)
> types _ (tc1:tcs1) = ", " ++ idName tc1
> ++ showLine (idPosition tc1)
> ++ types "," tcs1
> types _ [] = empty
> types comm [tc1] = comm <+> text "and" <+> text (idName tc1)
> <+> parens (text $ showLine $ idPosition tc1)
> types _ (tc1:tcs1) = comma <+> text (idName tc1) <+>
> parens (text $ showLine $ idPosition tc1)
> <> types comma tcs1
> errPolymorphicFreeVar :: Ident -> Message
> errPolymorphicFreeVar v = posMsg v $
> "Free variable " ++ idName v ++ " has a polymorphic type"
> errPolymorphicFreeVar v = posMessage v $ hsep $ map text
> ["Free variable", idName v, "has a polymorphic type"]
> errTypeSigTooGeneral :: Position -> ModuleIdent -> Doc -> TypeExpr -> TypeScheme
> -> Message
> errTypeSigTooGeneral p m what ty sigma = toMessage p $ show $ vcat
> errTypeSigTooGeneral p m what ty sigma = posMessage p $ vcat
> [ text "Type signature too general", what
> , text "Inferred type:" <+> ppTypeScheme m sigma
> , text "Type signature:" <+> ppTypeExpr 0 ty
> ]
> errNonFunctionType :: Position -> String -> Doc -> ModuleIdent -> Type -> Message
> errNonFunctionType p what doc m ty = toMessage p $ show $ vcat
> errNonFunctionType p what doc m ty = posMessage p $ vcat
> [ text "Type error in" <+> text what, doc
> , text "Type:" <+> ppType m ty
> , text "Cannot be applied"
> ]
> errNonBinaryOp :: Position -> String -> Doc -> ModuleIdent -> Type -> Message
> errNonBinaryOp p what doc m ty = toMessage p $ show $ vcat
> errNonBinaryOp p what doc m ty = posMessage p $ vcat
> [ text "Type error in" <+> text what, doc
> , text "Type:" <+> ppType m ty
> , text "Cannot be used as binary operator"
......@@ -1360,7 +1360,7 @@ Error functions.
> errTypeMismatch :: Position -> String -> Doc -> ModuleIdent -> Type -> Type -> Doc
> -> Message
> errTypeMismatch p what doc m ty1 ty2 reason = toMessage p $ show $ vcat
> errTypeMismatch p what doc m ty1 ty2 reason = posMessage p $ vcat
> [ text "Type error in" <+> text what, doc
> , text "Inferred type:" <+> ppType m ty2
> , text "Expected type:" <+> ppType m ty1
......@@ -1368,7 +1368,7 @@ Error functions.
> ]
> errSkolemEscapingScope :: Position -> ModuleIdent -> Doc -> Type -> Message
> errSkolemEscapingScope p m what ty = toMessage p $ show $ vcat
> errSkolemEscapingScope p m what ty = posMessage p $ vcat
> [ text "Existential type escapes out of its scope"
> , what, text "Type:" <+> ppType m ty
> ]
......
......@@ -18,12 +18,13 @@ import Control.Monad.State
(State, execState, filterM, gets, modify, unless, when, foldM_)
import qualified Data.Map as Map (empty, insert, lookup)
import Data.List (intersect, intersectBy, unionBy)
import Text.PrettyPrint
import Curry.Base.Ident
import Curry.Base.Position
import Curry.Syntax
import Base.Messages (Message, toMessage)
import Base.Messages (Message, posMessage)
import qualified Base.ScopeEnv as ScopeEnv
import Env.Value (ValueEnv, ValueInfo (..), qualLookupValue)
......@@ -738,43 +739,39 @@ typeId ident = qualify (renameIdent ident 1)
-- ---------------------------------------------------------------------------
warnMultiplyImportedModule :: ModuleIdent -> Message
warnMultiplyImportedModule mid = toMessage (midPosition mid) $
"Module \"" ++ show mid ++ "\" is imported more than once"
warnMultiplyImportedModule mid = posMessage mid $ hsep $ map text
["Module", moduleName mid, "is imported more than once"]
warnMultiplyImportedSymbol :: ModuleIdent -> Ident -> Message
warnMultiplyImportedSymbol mid ident = posWarn ident $
"Symbol \"" ++ show ident ++ "\" is imported from module \""
++ show mid ++ "\" more than once"
warnMultiplyImportedSymbol mid ident = posMessage ident $ hsep $ map text
[ "Symbol", escName ident, "from module", moduleName mid
, "is imported more than once" ]