Commit 2449d5f2 authored by Katharina Rahf's avatar Katharina Rahf
Browse files

Merge branch 'master' into krah/ParenType

parents 7f1441c1 a68ce6c3
Change log for curry-frontend
=============================
Under development
Under development (0.4.1)
=================
* Added a simple cabal test suite
* Split import of interfaces/modules and expansion and checking of
import specifications into two modules.
* Improved error messages generated by export check (fixes #1253)
* Split checking and expansion of export specification into two
subsequent steps (by Yannik Potdevin, fixes #1335)
* Consider parenthesized type expressions in the Curry AST (by Katharina Rahf)
Version 0.4.0
......
Name: curry-frontend
Version: 0.4.1
Cabal-Version: >= 1.6
Cabal-Version: >= 1.10
Synopsis: Compile the functional logic language Curry to several
intermediate formats
Description: The Curry Frontend consists of the executable program "cymake".
......@@ -33,19 +33,25 @@ Flag network-uri
description: Get Network.URI from the network-uri package
default: True
Executable cymake
hs-source-dirs: src
Main-is: cymake.hs
Build-Depends: base == 4.*, curry-base == 0.4.1
, containers, directory, mtl, process, transformers, syb
Library
hs-source-dirs: src
default-language: Haskell2010
Build-Depends:
base == 4.*
, containers
, curry-base == 0.4.1
, directory
, filepath
, mtl
, process
, syb
, transformers
if flag(network-uri)
build-depends: network-uri >= 2.6
else
build-depends: network < 2.6
ghc-options: -Wall
Other-Modules:
Paths_curry_frontend
, Base.CurryTypes
Exposed-Modules:
Base.CurryTypes
, Base.Expr
, Base.Messages
, Base.NestEnv
......@@ -61,6 +67,7 @@ Executable cymake
, Checks.ExportCheck
, Checks.InterfaceCheck
, Checks.InterfaceSyntaxCheck
, Checks.ImportSyntaxCheck
, Checks.KindCheck
, Checks.PrecCheck
, Checks.SyntaxCheck
......@@ -76,6 +83,7 @@ Executable cymake
, Env.TypeConstructor
, Env.Value
, Exports
, Files.CymakePath
, Generators
, Generators.GenAbstractCurry
, Generators.GenFlatCurry
......@@ -97,10 +105,35 @@ Executable cymake
, Transformations.Lift
, Transformations.Qual
, Transformations.Simplify
Library
hs-source-dirs: src
Build-Depends: filepath
Exposed-Modules:
Files.CymakePath
Other-Modules:
Paths_curry_frontend
ghc-options: -Wall
Executable cymake
hs-source-dirs: src
Main-is: cymake.hs
default-language: Haskell2010
Build-Depends:
base == 4.*
, containers
, curry-base == 0.4.1
, curry-frontend
, directory
, filepath
, mtl
, process
, syb
, transformers
if flag(network-uri)
build-depends: network-uri >= 2.6
else
build-depends: network < 2.6
ghc-options: -Wall
Test-Suite test-frontend
type: detailed-0.9
hs-source-dirs: test
default-language: Haskell2010
test-module: TestFrontend
build-depends: base == 4.*, Cabal >= 1.20, curry-base == 0.4.1
, curry-frontend == 0.4.1, filepath
module Base.Messages
( -- * Output of user information
status, warn, putErrLn, putErrsLn
status, putErrLn, putErrsLn
-- * program abortion
, abortWith, abortWithMessage, abortWithMessages
, abortWith, abortWithMessage, abortWithMessages, warnOrAbort
, internalError, errorMessage, errorMessages
-- * creating messages
, Message, message, posMessage
......@@ -15,20 +15,14 @@ import Data.List (sort)
import System.IO (hFlush, hPutStrLn, stderr, stdout)
import System.Exit (exitFailure)
import Curry.Base.Message ( Message, message, posMessage, ppMessage
, ppMessages, ppWarning, ppError)
import Curry.Base.Message ( Message, message, posMessage, ppWarning
, ppMessages, ppError)
import Curry.Base.Pretty (Doc, text)
import CompilerOpts (Options (..), WarnOpts (..), Verbosity (..))
status :: MonadIO m => Options -> String -> m ()
status opts msg = unless (optVerbosity opts < VerbStatus) (putMsg msg)
warn :: MonadIO m => WarnOpts -> [Message] -> m ()
warn opts msgs = when (wnWarn opts && not (null msgs)) $ do
liftIO $ putErrLn (show $ ppMessages ppWarning $ sort msgs)
when (wnWarnAsError opts) $ liftIO $ do
putErrLn "Failed due to -Werror"
exitFailure
-- |Print a message on 'stdout'
putMsg :: MonadIO m => String -> m ()
putMsg msg = liftIO (putStrLn msg >> hFlush stdout)
......@@ -52,9 +46,20 @@ abortWithMessage msg = abortWithMessages [msg]
-- |Print a list of error messages on 'stderr' and abort the program
abortWithMessages :: [Message] -> IO a
abortWithMessages msgs = do
unless (null msgs) $ putErrLn (show $ ppMessages ppMessage $ sort msgs)
exitFailure
abortWithMessages msgs = printMessages ppError msgs >> exitFailure
-- |Print a list of warning messages on 'stderr' and abort the program
-- |if the -Werror option is set
warnOrAbort :: WarnOpts -> [Message] -> IO ()
warnOrAbort opts msgs = when (wnWarn opts && not (null msgs)) $ do
if wnWarnAsError opts
then abortWithMessages (msgs ++ [message $ text "Failed due to -Werror"])
else printMessages ppWarning msgs
-- |Print a list of messages on 'stderr'
printMessages :: (Message -> Doc) -> [Message] -> IO ()
printMessages msgType msgs
= unless (null msgs) $ putErrLn (show $ ppMessages msgType $ sort msgs)
-- |Raise an internal error
internalError :: String -> a
......
......@@ -27,7 +27,7 @@ module Base.Types
, TypeScheme (..), ExistTypeScheme (..), monoType, polyType
-- * Predefined types
, unitType, boolType, charType, intType, floatType, stringType
, successType, listType, ioType, tupleType, typeVar, predefTypes
, listType, ioType, tupleType, typeVar, predefTypes
) where
import Curry.Base.Ident
......@@ -35,9 +35,8 @@ import Curry.Base.Ident
-- A type is either a type variable, an application of a type constructor
-- to a list of arguments, or an arrow type. The 'TypeConstrained'
-- case is used for representing type variables that are restricted to a
-- particular set of types. At present, this is used for typing guard
-- expressions, which are restricted to be either of type 'Bool' or of type
-- 'Success', and integer literals, which are restricted to types 'Int' and
-- particular set of types. At present, this is used for typing
-- integer literals, which are restricted to types 'Int' and
-- 'Float'. If the type is not restricted, it defaults to the first type
-- from the constraint list.
-- The case 'TypeSkolem' is used for handling skolem types, which
......@@ -246,9 +245,6 @@ floatType = primType qFloatId []
stringType :: Type
stringType = listType charType
successType :: Type
successType = primType qSuccessId []
listType :: Type -> Type
listType ty = primType qListId [ty]
......
......@@ -13,16 +13,17 @@
-}
module Checks where
import qualified Checks.InterfaceCheck as IC (interfaceCheck)
import qualified Checks.ExportCheck as EC (exportCheck, expandExports)
import qualified Checks.KindCheck as KC (kindCheck)
import qualified Checks.PrecCheck as PC (precCheck)
import qualified Checks.SyntaxCheck as SC (syntaxCheck)
import qualified Checks.TypeCheck as TC (typeCheck)
import qualified Checks.WarnCheck as WC (warnCheck)
import qualified Checks.InterfaceCheck as IC (interfaceCheck)
import qualified Checks.ImportSyntaxCheck as ISC (importCheck)
import qualified Checks.ExportCheck as EC (exportCheck, expandExports)
import qualified Checks.KindCheck as KC (kindCheck)
import qualified Checks.PrecCheck as PC (precCheck)
import qualified Checks.SyntaxCheck as SC (syntaxCheck)
import qualified Checks.TypeCheck as TC (typeCheck)
import qualified Checks.WarnCheck as WC (warnCheck)
import Curry.Base.Monad
import Curry.Syntax (Module (..), Interface (..))
import Curry.Syntax (Module (..), Interface (..), ImportSpec)
import Base.Messages
import CompilerEnv
......@@ -37,6 +38,12 @@ interfaceCheck _ (env, intf)
where msgs = IC.interfaceCheck (opPrecEnv env) (tyConsEnv env)
(valueEnv env) intf
importCheck :: Monad m => Interface -> Maybe ImportSpec -> CYT m (Maybe ImportSpec)
importCheck intf is
| null msgs = ok is'
| otherwise = failMessages msgs
where (is', msgs) = ISC.importCheck intf is
-- |Check the kinds of type definitions and signatures.
--
-- * Declarations: Nullary type constructors and type variables are
......
......@@ -2,7 +2,8 @@
Module : $Header$
Description : Check the export specification of a module
Copyright : (c) 1999 - 2004 Wolfgang Lux
2011 - 2015 Björn Peemöller
2011 - 2016 Björn Peemöller
2015 - 2016 Yannik Potdevin
License : OtherLicense
Maintainer : bjp@informatik.uni-kiel.de
......@@ -51,6 +52,9 @@ import Env.ModuleAlias (AliasEnv)
import Env.TypeConstructor (TCEnv, TypeInfo (..), qualLookupTCUnique)
import Env.Value (ValueEnv, ValueInfo (..), qualLookupValueUnique)
currentModuleName :: String
currentModuleName = "Checks.ExportCheck"
-- ---------------------------------------------------------------------------
-- Check and expansion of the export statement
-- ---------------------------------------------------------------------------
......@@ -62,24 +66,138 @@ expandExports m aEnv tcEnv tyEnv spec = Exporting (exportPos spec) es
exportPos (Just (Exporting p _)) = p
exportPos Nothing = NoPos
es = fst (checkAndExpand m aEnv tcEnv tyEnv spec)
es = expand m aEnv tcEnv tyEnv spec
exportCheck :: ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv
-> Maybe ExportSpec -> [Message]
exportCheck m aEnv tcEnv tyEnv spec = case errs of
[] -> checkNonUniqueness es
exportCheck m aEnv tcEnv tyEnv spec = case check m aEnv tcEnv tyEnv spec of
[] -> checkNonUniqueness $ expand m aEnv tcEnv tyEnv spec
ms -> ms
where
(es, errs) = checkAndExpand m aEnv tcEnv tyEnv spec
checkAndExpand :: ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv
-> Maybe ExportSpec -> ([Export], [Message])
checkAndExpand m aEnv tcEnv tyEnv spec
= runECM ((joinExports . canonExports tcEnv) <$> expandSpec spec) initState
-- -----------------------------------------------------------------------------
-- Export Check Monad
-- -----------------------------------------------------------------------------
data ECState = ECState
{ moduleIdent :: ModuleIdent
, importedMods :: Set.Set ModuleIdent
, tyConsEnv :: TCEnv
, valueEnv :: ValueEnv
, errors :: [Message]
}
type ECM a = S.State ECState a
runECM :: ECM a -> ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv -> (a, [Message])
runECM ecm m aEnv tcEnv tyEnv
= let (a, s') = S.runState ecm initState in (a, reverse $ errors s')
where
initState = ECState m imported tcEnv tyEnv []
imported = Set.fromList (Map.elems aEnv)
getModuleIdent :: ECM ModuleIdent
getModuleIdent = S.gets moduleIdent
getImportedModules :: ECM (Set.Set ModuleIdent)
getImportedModules = S.gets importedMods
getTyConsEnv :: ECM TCEnv
getTyConsEnv = S.gets tyConsEnv
getValueEnv :: ECM ValueEnv
getValueEnv = S.gets valueEnv
report :: Message -> ECM ()
report err = S.modify (\ s -> s { errors = err : errors s })
ok :: ECM ()
ok = return ()
-- -----------------------------------------------------------------------------
-- Check
-- -----------------------------------------------------------------------------
check :: ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec
-> [Message]
check m aEnv tcEnv tyEnv spec = snd $ runECM (checkSpec spec) m aEnv tcEnv tyEnv
-- |Check export specification.
checkSpec :: Maybe ExportSpec -> ECM ()
checkSpec (Just (Exporting _ es)) = mapM_ checkExport es
checkSpec Nothing = ok
-- |Check single export.
checkExport :: Export -> ECM ()
checkExport (Export x ) = checkThing x
checkExport (ExportTypeWith tc cs) = checkTypeWith tc cs
checkExport (ExportTypeAll tc ) = checkTypeAll tc
checkExport (ExportModule em ) = checkModule em
-- |Check export of type constructor / function
checkThing :: QualIdent -> ECM ()
checkThing tc = do
m <- getModuleIdent
tcEnv <- getTyConsEnv
case qualLookupTCUnique m tc tcEnv of
[] -> checkThing' tc Nothing
[t] -> checkThing' tc (Just [ExportTypeWith (origName t) []])
ts -> report (errAmbiguousType tc ts)
-- |Expand export of data cons / function
checkThing' :: QualIdent -> Maybe [Export] -> ECM ()
checkThing' f tcExport = do
m <- getModuleIdent
tyEnv <- getValueEnv
case qualLookupValueUnique m f tyEnv of
[] -> justTcOr errUndefinedName
[v] -> case v of
Value _ _ _ -> ok
Label _ _ _ -> report $ errOutsideTypeLabel f (getTc v)
_ -> justTcOr $ flip errOutsideTypeConstructor (getTc v)
fs -> report (errAmbiguousName f fs)
where
justTcOr errFun = maybe (report $ errFun f) (const ok) tcExport
getTc (DataConstructor _ _ _ (ForAllExist _ _ ty)) = getTc' ty
getTc (NewtypeConstructor _ _ (ForAllExist _ _ ty)) = getTc' ty
getTc (Label _ _ (ForAll _ (TypeArrow (TypeConstructor tc _) _))) = tc
getTc err = internalError $ currentModuleName ++ ".checkThing'.getTc: " ++ show err
getTc' ty = let (TypeConstructor tc _) = arrowBase ty in tc
checkTypeWith :: QualIdent -> [Ident] -> ECM ()
checkTypeWith tc xs = do
m <- getModuleIdent
tcEnv <- getTyConsEnv
case qualLookupTCUnique m tc tcEnv of
[] -> report (errUndefinedType tc)
[DataType _ _ cs] -> mapM_ (checkElement (visibleElems cs )) xs'
[RenamingType _ _ c] -> mapM_ (checkElement (visibleElems [c])) xs'
[_] -> report (errNonDataType tc)
ts -> report (errAmbiguousType tc ts)
where
xs' = nub xs
-- check if given identifier is constructor or label of type tc
checkElement cs' c = unless (c `elem` cs') $ report $ errUndefinedElement tc c
-- |Check type constructor with all data constructors and record labels.
checkTypeAll :: QualIdent -> ECM ()
checkTypeAll tc = do
m <- getModuleIdent
tcEnv <- getTyConsEnv
case qualLookupTCUnique m tc tcEnv of
[] -> report (errUndefinedType tc)
[DataType _ _ _] -> ok
[RenamingType _ _ _] -> ok
[_] -> report (errNonDataType tc)
ts -> report (errAmbiguousType tc ts)
checkModule :: ModuleIdent -> ECM ()
checkModule em = do
isLocal <- (em ==) <$> getModuleIdent
isForeign <- (Set.member em) <$> getImportedModules
unless (isLocal || isForeign) $ report $ errModuleNotImported em
-- Check whether two entities of the same kind (type or constructor/function)
-- share the same unqualified name, which is not allowed since they could
-- not be uniquely resolved at their usage.
......@@ -104,36 +222,14 @@ checkNonUniqueness es = map errMultipleType (findMultiples types )
++ [ unqualify f | Export f <- es ]
-- -----------------------------------------------------------------------------
-- Expansion + Check
-- Expansion
-- -----------------------------------------------------------------------------
data ECState = ECState
{ moduleIdent :: ModuleIdent
, importedMods :: Set.Set ModuleIdent
, tyConsEnv :: TCEnv
, valueEnv :: ValueEnv
, errors :: [Message]
}
type ECM a = S.State ECState a
runECM :: ECM a -> ECState -> (a, [Message])
runECM ecm s = let (a, s') = S.runState ecm s in (a, reverse $ errors s')
getModuleIdent :: ECM ModuleIdent
getModuleIdent = S.gets moduleIdent
getImportedModules :: ECM (Set.Set ModuleIdent)
getImportedModules = S.gets importedMods
getTyConsEnv :: ECM TCEnv
getTyConsEnv = S.gets tyConsEnv
getValueEnv :: ECM ValueEnv
getValueEnv = S.gets valueEnv
report :: Message -> ECM ()
report err = S.modify (\ s -> s { errors = err : errors s })
expand :: ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec
-> [Export]
expand m aEnv tcEnv tyEnv spec
= fst $ runECM ((joinExports . canonExports tcEnv) <$> expandSpec spec)
m aEnv tcEnv tyEnv
-- While checking all export specifications, the compiler expands
-- specifications of the form @T(..)@ into @T(C_1,...,C_m,l_1,...,l_n)@,
......@@ -152,8 +248,8 @@ report err = S.modify (\ s -> s { errors = err : errors s })
-- |Expand export specification
expandSpec :: Maybe ExportSpec -> ECM [Export]
expandSpec Nothing = expandLocalModule
expandSpec (Just (Exporting _ es)) = concat <$> mapM expandExport es
expandSpec Nothing = expandLocalModule
-- |Expand single export
expandExport :: Export -> ECM [Export]
......@@ -169,8 +265,8 @@ expandThing tc = do
tcEnv <- getTyConsEnv
case qualLookupTCUnique m tc tcEnv of
[] -> expandThing' tc Nothing
[t] -> expandThing' tc (Just [ExportTypeWith (origName t) []])
ts -> report (errAmbiguousType tc ts) >> return []
[t] -> expandThing' tc (Just [ExportTypeWith (origName t @> tc) []])
err -> internalError $ currentModuleName ++ ".expandThing: " ++ show err
-- |Expand export of data cons / function
expandThing' :: QualIdent -> Maybe [Export] -> ECM [Export]
......@@ -178,24 +274,8 @@ expandThing' f tcExport = do
m <- getModuleIdent
tyEnv <- getValueEnv
case qualLookupValueUnique m f tyEnv of
[] -> justTcOr errUndefinedName
[Value f' _ _] -> return $ Export f' : fromMaybe [] tcExport
[Label l _ (ForAll _ (TypeArrow (TypeConstructor tc _) _))] -> do
report $ errExportLabel f tc
return $ Export l : fromMaybe [] tcExport
[c] -> justTcOr $ flip errExportDataConstr $ getTc c
fs -> report (errAmbiguousName f fs) >> return []
where
justTcOr errFun = case tcExport of
Nothing -> report (errFun f) >> return []
Just tc -> return tc
getTc (DataConstructor _ _ _ (ForAllExist _ _ ty)) = getTc' ty
getTc (NewtypeConstructor _ _ (ForAllExist _ _ ty)) = getTc' ty
getTc (Label _ _ (ForAll _ (TypeArrow (TypeConstructor tc _) _))) = tc
getTc _ = internalError "ExportCheck.getTc"
getTc' ty = let (TypeConstructor tc _) = arrowBase ty in tc
[Value f' _ _] -> return $ Export (f' @> f) : fromMaybe [] tcExport
_ -> return $ fromMaybe [] tcExport
-- |Expand type constructor with explicit data constructors and record labels
expandTypeWith :: QualIdent -> [Ident] -> ECM [Export]
......@@ -203,21 +283,8 @@ expandTypeWith tc xs = do
m <- getModuleIdent
tcEnv <- getTyConsEnv
case qualLookupTCUnique m tc tcEnv of
[] -> report (errUndefinedType tc) >> return []
[t@(DataType _ _ cs)] -> do
mapM_ (checkElement (visibleElems cs)) xs'
return [ExportTypeWith (origName t) xs']
[t@(RenamingType _ _ c)] -> do
mapM_ (checkElement (visibleElems [c])) xs'
return [ExportTypeWith (origName t) xs']
[_] -> report (errNonDataType tc) >> return []
ts -> report (errAmbiguousType tc ts) >> return []
where
xs' = nub xs
-- check if given identifier is constructor or label of type tc
checkElement cs' c = do
unless (c `elem` cs') $ report $ errUndefinedElement tc c
return c
[t] -> return [ExportTypeWith (origName t @> tc) $ nub xs]
err -> internalError $ currentModuleName ++ ".expandTypeWith: " ++ show err
-- |Expand type constructor with all data constructors and record labels
expandTypeAll :: QualIdent -> ECM [Export]
......@@ -225,11 +292,8 @@ expandTypeAll tc = do
m <- getModuleIdent
tcEnv <- getTyConsEnv
case qualLookupTCUnique m tc tcEnv of
[] -> report (errUndefinedType tc) >> return []
[t@(DataType _ _ _)] -> return $ [exportType t]
[t@(RenamingType _ _ _)] -> return $ [exportType t]
[_] -> report (errNonDataType tc) >> return []
ts -> report (errAmbiguousType tc ts) >> return []
[t] -> return [exportType t]
err -> internalError $ currentModuleName ++ ".expandTypeAll: " ++ show err
expandModule :: ModuleIdent -> ECM [Export]
expandModule em = do
......@@ -237,7 +301,6 @@ expandModule em = do
isForeign <- (Set.member em) <$> getImportedModules
locals <- if isLocal then expandLocalModule else return []
foreigns <- if isForeign then expandImportedModule em else return []
unless (isLocal || isForeign) $ report $ errModuleNotImported em
return $ locals ++ foreigns
expandLocalModule :: ECM [Export]
......@@ -284,18 +347,18 @@ canonExport :: Map.Map QualIdent Export -> Export -> Export
canonExport ls (Export x) = fromMaybe (Export x) (Map.lookup x ls)
canonExport _ (ExportTypeWith tc xs) = ExportTypeWith tc xs
canonExport _ e = internalError $
"Checks.ExportCheck.canonExport: " ++ show e
currentModuleName ++ ".canonExport: " ++ show e
canonLabels :: TCEnv -> [Export] -> Map.Map QualIdent Export
canonLabels tcEnv es = foldr bindLabels Map.empty (allEntities tcEnv)
where
tcs = [tc | ExportTypeWith tc _ <- es]
bindLabels t ls
| tc' `elem` tcs = foldr (bindLabel tc') ls (elements t)
| otherwise = ls
where
tc' = origName t
bindLabel tc x = Map.insert (qualifyLike tc x) (ExportTypeWith tc [x])
tcs = [tc | ExportTypeWith tc _ <- es]
bindLabels t ls
| tc' `elem` tcs = foldr (bindLabel tc') ls (elements t)
| otherwise = ls
where
tc' = origName t
bindLabel tc x = Map.insert (qualifyLike tc x) (ExportTypeWith tc [x])
-- The expanded list of exported entities may contain duplicates. These
-- are removed by the function joinExports. In particular, this
......@@ -312,13 +375,13 @@ joinType :: Export -> Map.Map QualIdent [Ident] -> Map.Map QualIdent [Ident]
joinType (Export _) tcs = tcs
joinType (ExportTypeWith tc cs) tcs = Map.insertWith union tc cs tcs
joinType export _ = internalError $
"Checks.ExportCheck.joinType: " ++ show export
currentModuleName ++ ".joinType: " ++ show export
joinFun :: Export -> Set.Set QualIdent -> Set.Set QualIdent
joinFun (Export f) fs = f `Set.insert` fs
joinFun (ExportTypeWith _ _) fs = fs
joinFun export _ = internalError $
"Checks.ExportCheck.joinFun: " ++ show export
currentModuleName ++ ".joinFun: " ++ show export
-- ---------------------------------------------------------------------------
-- Auxiliary definitions
......@@ -337,59 +400,45 @@ visibleElems cs = map constrIdent cs ++ (nub (concatMap recLabels cs))
-- Error messages
-- ---------------------------------------------------------------------------
errModuleNotImported :: ModuleIdent -> Message
errModuleNotImported m = posMessage m $ hsep $ map text
["Module", escModuleName m, "not imported"]
errAmbiguousName :: QualIdent -> [ValueInfo] -> Message
errAmbiguousName x vs = errAmbiguous "name" x (map origName vs)
errUndefinedType :: QualIdent -> Message
errUndefinedType = errUndefined "Type"
errAmbiguousType :: QualIdent -> [TypeInfo] -> Message
errAmbiguousType tc tcs = errAmbiguous "type" tc (map origName tcs)
errUndefinedElement :: QualIdent -> Ident -> Message
errUndefinedElement tc c = posMessage c $ hsep $ map text
[ idName c, "is not a constructor or label of type ", qualName tc ]
errAmbiguous :: String -> QualIdent -> [QualIdent] -> Message
errAmbiguous what qn qns = posMessage qn
$ text "Ambiguous" <+> text what <+> text (escQualName qn)
$+$ text "It could refer to:"
$+$ nest 2 (vcat (map (text . escQualName) qns))
errUndefinedName :: QualIdent -> Message
errUndefinedName = errUndefined "Name"
errModuleNotImported :: ModuleIdent -> Message