Commit bcb59950 authored by Iavor S. Diatchki's avatar Iavor S. Diatchki
Browse files

Merge remote-tracking branch 'origin/master' into type-nats

parents 81b2b118 4f6a56ea
Simon Marlow <marlowsd@gmail.com>, simonmar, simonmar@microsoft.com, simonm
Ross Paterson <ross@soi.city.ac.uk>, ross
Sven Panne <sven.panne@aedion.de>, panne
Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>, malcolm
Simon Peyton Jones <simonpj@microsoft.com>, simonpj
Don Stewart <dons@galois.com>, dons
Tim Harris <tharris@microsoft.com>, tharris
Lennart Augustsson <lennart@augustsson.net>, lennart.augustsson@credit-suisse.com
Duncan Coutts <duncan@haskell.org>, duncan.coutts@worc.ox.ac.uk, duncan@well-typed.com
Ben Lippmeier <benl@ouroborus.net>, benl@cse.unsw.edu.au, Ben.Lippmeier@anu.edu.au, Ben.Lippmeier.anu.edu.au
Manuel M T Chakravarty <chak@cse.unsw.edu.au>, chak
Jose Pedro Magalhaes <jpm@cs.uu.nl>, jpm@cs.uu.nl
Sigbjorn Finne <sof@galois.com>, sof
Wolfgang Thaller <wolfgang.thaller@gmx.net>, wolfgang
Julian Seward <jseward@acm.org>, sewardj
Ian Lynagh <igloo@earth.li>, igloo
Roman Leshchinskiy <rl@cse.unsw.edu.au>, rl@cse.unsw.edu.au
John Dias <dias@cs.tufts.edu>, dias@eecs.tufts.edu, dias@eecs.harvard.edu
Norman Ramsey <nr@eecs.harvard.edu>, nr@eecs.harvard.edu
Andy Gill <andygill@ku.edu>, andy
Will Partain <partain@dcs.gla.ac.uk>, partain
Don Syme <dsyme@microsoft.com>, dsyme
Pepe Iborra <mnislaih@gmail.com>, pepe
Neil Mitchell <ndmitchell@gmail.com>, Neil Mitchell
Gabriele Keller <keller@cse.unsw.edu.au>, keller
Daan Leijen <daan@microsoft.com>, daan
Audrey Tang <audreyt@audreyt.org>, audreyt@audreyt.org
Hans-Wolfgang Loidl <hwloidl@macs.hw.ac.uk>, hwloidl
Bernie Pope <bjpop@csse.unimelb.edu.au>, bjpop@csse.unimelb.edu.au
#Top-level dirs:
^alex/
^common-rts/
^CONTRIB/
^dll/
^greencard/
^green-card/
^haddock/
^haggis/
^happy/
^hdirect/
^hood/
^hslibs/
^hws/
^hx/
^literate/
^mhms/
^mkworld/
^nofib(/|$)
^lib/
^misc/
^mkworld/
^runtime/
^testsuite(/|$)
# bindists
^ghc-
^bin-manifest-
#Packages:
^libraries/Cabal(/|$)
^libraries/ALUT(/|$)
^libraries/GLUT(/|$)
^libraries/HGL(/|$)
^libraries/HUnit(/|$)
^libraries/HaXml(/|$)
^libraries/Japi(/|$)
^libraries/OpenAL(/|$)
^libraries/OpenGL(/|$)
^libraries/QuickCheck(/|$)
^libraries/Win32(/|$)
^libraries/X11(/|$)
^libraries/array(/|$)
^libraries/arrows(/|$)
^libraries/base(/|$)
^libraries/base3-compat(/|$)
^libraries/binary(/|$)
^libraries/bytestring(/|$)
^libraries/cgi(/|$)
^libraries/concurrent(/|$)
^libraries/containers(/|$)
^libraries/directory(/|$)
^libraries/editline(/|$)
^libraries/fgl(/|$)
^libraries/filepath(/|$)
^libraries/getopt(/|$)
^libraries/ghc-prim(/|$)
^libraries/haskell-src(/|$)
^libraries/haskell98(/|$)
^libraries/hpc(/|$)
^libraries/html(/|$)
^libraries/integer-.*(/|$)
^libraries/old-locale(/|$)
^libraries/old-time(/|$)
^libraries/monads(/|$)
^libraries/mtl(/|$)
^libraries/ndp(/|$)
^libraries/network(/|$)
^libraries/packedstring(/|$)
^libraries/parsec(/|$)
^libraries/parallel(/|$)
^libraries/pretty(/|$)
^libraries/process(/|$)
^libraries/random(/|$)
^libraries/readline(/|$)
^libraries/regex-base(/|$)
^libraries/regex-compat(/|$)
^libraries/regex-posix(/|$)
^libraries/st(/|$)
^libraries/stm(/|$)
^libraries/syb(/|$)
^libraries/template-haskell(/|$)
^libraries/time(/|$)
^libraries/timeout(/|$)
^libraries/unique(/|$)
^libraries/unix(/|$)
^libraries/xhtml(/|$)
^libraries/dph(/|$)
^libraries/utf8-string(/|$)
^libraries/terminfo(/|$)
^libraries/haskeline(/|$)
^libraries/extensible-exceptions(/|$)
# Other library bits that get generated:
^libraries/bootstrapping/
^libraries/stamp/
^libraries/ifBuildable(/|$)
^libraries/installPackage(/|$)
^libraries/index.html
^libraries/doc-index.*\.html
^libraries/haddock-util.js
^libraries/haddock.css
^libraries/haskell_icon.gif
^libraries/minus.gif
^libraries/plus.gif
^libraries/libraries.txt
# It's often useful to have somewhere in the build tree to install to
^inst(/|$)
# Boring file regexps:
\.hi$
\.hi-boot$
\.o-boot$
\.p_o$
\.t_o$
\.debug_o$
\.thr_o$
\.thr_p_o$
\.thr_debug_o$
\.o$
\.a$
\.o\.cmd$
# *.ko files aren't boring by default because they might
# be Korean translations rather than kernel modules.
# \.ko$
\.ko\.cmd$
\.mod\.c$
(^|/)\.tmp_versions($|/)
(^|/)CVS($|/)
(^|/)RCS($|/)
~$
#(^|/)\.[^/]
(^|/)_darcs($|/)
\.bak$
\.BAK$
\.orig$
(^|/)vssver\.scc$
\.swp$
(^|/)MT($|/)
(^|/)\{arch\}($|/)
(^|/).arch-ids($|/)
(^|/),
\.class$
\.prof$
(^|/)\.DS_Store$
(^|/)BitKeeper($|/)
(^|/)ChangeSet($|/)
(^|/)\.svn($|/)
(^|/)\.git($|/)
\.git-ignore$
\.py[co]$
\#
\.cvsignore$
(^|/)Thumbs\.db$
\.depend$
\.depend-.*$
^compiler/primop-
^compiler/cmm/CmmLex.hs$
^compiler/cmm/CmmParse.hs$
^compiler/ghci/LibFFI.hs$
^compiler/ghci/LibFFI_hsc.c$
^compiler/main/Config.hs$
^compiler/main/ParsePkgConf.hs$
^compiler/parser/Parser.y$
^compiler/parser/Parser.hs$
^compiler/parser/Lexer.hs$
^compiler/parser/ParserCore.hs$
^compiler/parser/HaddockLex.hs
^compiler/parser/HaddockParse.hs
^compiler/prelude/primops.txt$
^compiler/stage1($|/)
^compiler/stage2($|/)
^compiler/stage3($|/)
^compiler/utils/Fingerprint.hs$
^compiler/utils/Fingerprint_hsc.c$
^mk/build.mk$
^mk/validate.mk$
^mk/are-validating.mk$
^mk/config.h.in$
^mk/config.h$
^mk/config.mk$
^mk/stamp-h$
^stage3.package.conf$
^inplace-datadir(/|$)
(^|/)autom4te.cache($|/)
^rts/AutoApply.*cmm$
^rts/sm/Evac_thr.c$
^rts/sm/Scav_thr.c$
package.conf.inplace$
package.conf.installed$
(^|/)config.log$
(^|/)config.status$
(^|/)configure$
^ghc.spec$
^docs/users_guide/ug-book.xml$
^docs/man/flags.xml$
^docs/man/flags.xsl$
^docs/man/ghc.1$
^extra-gcc-opts$
# ignore scripts like push-monk
^push-
^pull-
# Common log file names; testlog is made by validate
^testlog
^log
^utils/[a-zA-Z0-9-]+/dist-install(/|$)
^utils/[a-zA-Z0-9-]+/dist-inplace(/|$)
^utils/[a-zA-Z0-9-]+/install-inplace(/|$)
^compiler/Makefile-stage[1-3](/|$)
^compiler/dist-stage[1-3](/|$)
^ghc/dist-stage[1-3](/|$)
^ghc/stage[1-3]-inplace(/|$)
^utils/ext-core/Driver$
^utils/ext-core/PrimEnv.hs$
^utils/genapply/genapply$
^utils/genprimopcode/Lexer.hs$
^utils/genprimopcode/Parser.hs$
^utils/genprimopcode/genprimopcode$
^utils/ghc-pkg/Version.hs$
^utils/ghc-pkg/ghc-pkg-inplace$
^utils/ghc-pkg/ghc-pkg-inplace.bin$
^utils/ghc-pkg/ghc-pkg-inplace.hs$
^utils/ghc-pkg/ghc-pkg.bin$
^utils/hasktags/hasktags$
^utils/hasktags/hasktags-inplace$
^utils/hp2ps/hp2ps$
^utils/hpc/HpcParser.hs$
^utils/hsc2hs(/|$)
^utils/haddock(/|$)
^utils/lndir/lndir$
^utils/mkdependC/mkdependC$
^utils/mkdirhier/mkdirhier$
^utils/prof/cgprof/cgprof$
^utils/prof/ghcprof-inplace$
^utils/pwd/pwd$
^utils/pwd/pwd-inplace$
^utils/runghc/runghc$
^utils/runghc/runghc-inplace$
^utils/runghc/runhaskell$
^utils/runstdtest/runstdtest$
^utils/unlit/unlit$
^driver/ghci/ghc-pkg-inplace$
^driver/ghci/ghci-inplace$
^driver/mangler/ghc-asm$
^driver/mangler/ghc-asm.prl$
^driver/package.conf$
^driver/package.conf.inplace.old$
^driver/split/ghc-split$
^driver/split/ghc-split.prl$
^driver/stamp-pkg-conf-rts$
^includes/DerivedConstants.h$
^includes/GHCConstants.h$
^includes/ghcautoconf.h$
^includes/ghcplatform.h$
^includes/mkDerivedConstantsHdr$
^includes/mkGHCConstants$
^libffi/build($|/)
^libffi/ffi.h$
^libffi/stamp.ffi.static$
......@@ -190,6 +190,12 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
; checkL (not (isStrictId binder)
|| (isNonRec rec_flag && not (isTopLevel top_lvl_flag)))
(mkStrictMsg binder)
-- Check that if the binder is local, it is not marked as exported
; checkL (not (isExportedId binder) || isTopLevel top_lvl_flag)
(mkNonTopExportedMsg binder)
-- Check that if the binder is local, it does not have an external name
; checkL (not (isExternalName (Var.varName binder)) || isTopLevel top_lvl_flag)
(mkNonTopExternalNameMsg binder)
-- Check whether binder's specialisations contain any out-of-scope variables
; mapM_ (checkBndrIdInScope binder) bndr_vars
......@@ -1030,7 +1036,7 @@ lookupIdInScope id
Nothing -> do { addErrL out_of_scope
; return id } }
where
out_of_scope = ppr id <+> ptext (sLit "is out of scope")
out_of_scope = pprBndr LetBind id <+> ptext (sLit "is out of scope")
oneTupleDataConId :: Id -- Should not happen
......@@ -1050,7 +1056,7 @@ checkInScope :: SDoc -> Var -> LintM ()
checkInScope loc_msg var =
do { subst <- getTvSubst
; checkL (not (mustHaveLocalBinding var) || (var `isInScope` subst))
(hsep [ppr var, loc_msg]) }
(hsep [pprBndr LetBind var, loc_msg]) }
checkTys :: OutType -> OutType -> MsgDoc -> LintM ()
-- check ty2 is subtype of ty1 (ie, has same structure but usage
......@@ -1230,6 +1236,13 @@ mkStrictMsg binder
hsep [ptext (sLit "Binder's demand info:"), ppr (idDemandInfo binder)]
]
mkNonTopExportedMsg :: Id -> MsgDoc
mkNonTopExportedMsg binder
= hsep [ptext (sLit "Non-top-level binder is marked as exported:"), ppr binder]
mkNonTopExternalNameMsg :: Id -> MsgDoc
mkNonTopExternalNameMsg binder
= hsep [ptext (sLit "Non-top-level binder has an external name:"), ppr binder]
mkKindErrMsg :: TyVar -> Type -> MsgDoc
mkKindErrMsg tyvar arg_ty
......
......@@ -917,10 +917,10 @@ instance Outputable AltCon where
instance Show AltCon where
showsPrec p con = showsPrecSDoc p (ppr con)
cmpAlt :: Alt b -> Alt b -> Ordering
cmpAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Ordering
cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
ltAlt :: Alt b -> Alt b -> Bool
ltAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Bool
ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
cmpAltCon :: AltCon -> AltCon -> Ordering
......
......@@ -15,7 +15,8 @@ module CoreUtils (
mkAltExpr,
-- * Taking expressions apart
findDefault, findAlt, isDefaultAlt, mergeAlts, trimConArgs,
findDefault, findAlt, isDefaultAlt,
mergeAlts, trimConArgs, filterAlts,
-- * Properties of expressions
exprType, coreAltType, coreAltsType,
......@@ -69,7 +70,7 @@ import Util
import Pair
import Data.Word
import Data.Bits
import Data.List ( mapAccumL )
import Data.List
\end{code}
......@@ -342,18 +343,18 @@ This makes it easy to find, though it makes matching marginally harder.
\begin{code}
-- | Extract the default case alternative
findDefault :: [CoreAlt] -> ([CoreAlt], Maybe CoreExpr)
findDefault :: [(AltCon, [a], b)] -> ([(AltCon, [a], b)], Maybe b)
findDefault ((DEFAULT,args,rhs) : alts) = ASSERT( null args ) (alts, Just rhs)
findDefault alts = (alts, Nothing)
isDefaultAlt :: CoreAlt -> Bool
isDefaultAlt :: (AltCon, a, b) -> Bool
isDefaultAlt (DEFAULT, _, _) = True
isDefaultAlt _ = False
-- | Find the case alternative corresponding to a particular
-- constructor: panics if no such constructor exists
findAlt :: AltCon -> [CoreAlt] -> Maybe CoreAlt
findAlt :: AltCon -> [(AltCon, a, b)] -> Maybe (AltCon, a, b)
-- A "Nothing" result *is* legitmiate
-- See Note [Unreachable code]
findAlt con alts
......@@ -369,7 +370,7 @@ findAlt con alts
GT -> ASSERT( not (con1 == DEFAULT) ) go alts deflt
---------------------------------
mergeAlts :: [CoreAlt] -> [CoreAlt] -> [CoreAlt]
mergeAlts :: [(AltCon, a, b)] -> [(AltCon, a, b)] -> [(AltCon, a, b)]
-- ^ Merge alternatives preserving order; alternatives in
-- the first argument shadow ones in the second
mergeAlts [] as2 = as2
......@@ -396,6 +397,83 @@ trimConArgs (LitAlt _) args = ASSERT( null args ) []
trimConArgs (DataAlt dc) args = dropList (dataConUnivTyVars dc) args
\end{code}
\begin{code}
filterAlts :: [Unique] -- ^ Supply of uniques used in case we have to manufacture a new AltCon
-> Type -- ^ Type of scrutinee (used to prune possibilities)
-> [AltCon] -- ^ Constructors known to be impossible due to the form of the scrutinee
-> [(AltCon, [Var], a)] -- ^ Alternatives
-> ([AltCon], Bool, [(AltCon, [Var], a)])
-- Returns:
-- 1. Constructors that will never be encountered by the *default* case (if any)
-- 2. Whether we managed to refine the default alternative into a specific constructor (for statistcs only)
-- 3. The new alternatives
--
-- NB: the final list of alternatives may be empty:
-- This is a tricky corner case. If the data type has no constructors,
-- which GHC allows, then the case expression will have at most a default
-- alternative.
--
-- If callers need to preserve the invariant that there is always at least one branch
-- in a "case" statement then they will need to manually add a dummy case branch that just
-- calls "error" or similar.
filterAlts us ty imposs_cons alts = (imposs_deflt_cons, refined_deflt, merged_alts)
where
(alts_wo_default, maybe_deflt) = findDefault alts
alt_cons = [con | (con,_,_) <- alts_wo_default]
imposs_deflt_cons = nub (imposs_cons ++ alt_cons)
-- "imposs_deflt_cons" are handled
-- EITHER by the context,
-- OR by a non-DEFAULT branch in this case expression.
trimmed_alts = filterOut impossible_alt alts_wo_default
merged_alts = mergeAlts trimmed_alts (maybeToList maybe_deflt')
-- We need the mergeAlts in case the new default_alt
-- has turned into a constructor alternative.
-- The merge keeps the inner DEFAULT at the front, if there is one
-- and interleaves the alternatives in the right order
(refined_deflt, maybe_deflt') = case maybe_deflt of
Just deflt_rhs -> case mb_tc_app of
Just (tycon, inst_tys)
| -- This branch handles the case where we are
-- scrutinisng an algebraic data type
isAlgTyCon tycon -- It's a data type, tuple, or unboxed tuples.
, not (isNewTyCon tycon) -- We can have a newtype, if we are just doing an eval:
-- case x of { DEFAULT -> e }
-- and we don't want to fill in a default for them!
, Just all_cons <- tyConDataCons_maybe tycon
, let imposs_data_cons = [con | DataAlt con <- imposs_deflt_cons] -- We now know it's a data type
impossible con = con `elem` imposs_data_cons || dataConCannotMatch inst_tys con
-> case filterOut impossible all_cons of
-- Eliminate the default alternative
-- altogether if it can't match:
[] -> (False, Nothing)
-- It matches exactly one constructor, so fill it in:
[con] -> (True, Just (DataAlt con, ex_tvs ++ arg_ids, deflt_rhs))
where (ex_tvs, arg_ids) = dataConRepInstPat us con inst_tys
_ -> (False, Just (DEFAULT, [], deflt_rhs))
| debugIsOn, isAlgTyCon tycon
, null (tyConDataCons tycon)
, not (isFamilyTyCon tycon || isAbstractTyCon tycon)
-- Check for no data constructors
-- This can legitimately happen for abstract types and type families,
-- so don't report that
-> pprTrace "prepareDefault" (ppr tycon)
(False, Just (DEFAULT, [], deflt_rhs))
_ -> (False, Just (DEFAULT, [], deflt_rhs))
Nothing -> (False, Nothing)
mb_tc_app = splitTyConApp_maybe ty
Just (_, inst_tys) = mb_tc_app
impossible_alt :: (AltCon, a, b) -> Bool
impossible_alt (con, _, _) | con `elem` imposs_cons = True
impossible_alt (DataAlt con, _, _) = dataConCannotMatch inst_tys con
impossible_alt _ = False
\end{code}
Note [Unreachable code]
~~~~~~~~~~~~~~~~~~~~~~~
It is possible (although unusual) for GHC to find a case expression
......
This diff is collapsed.
......@@ -3,38 +3,31 @@
%
-- ---------------------------------------------------------------------------
-- The dynamic linker for object code (.o .so .dll files)
-- The dynamic linker for object code (.o .so .dll files)
-- ---------------------------------------------------------------------------
Primarily, this module consists of an interface to the C-land dynamic linker.
\begin{code}
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module ObjLink (
initObjLinker, -- :: IO ()
loadDLL, -- :: String -> IO (Maybe String)
loadArchive, -- :: String -> IO ()
loadObj, -- :: String -> IO ()
unloadObj, -- :: String -> IO ()
module ObjLink (
initObjLinker, -- :: IO ()
loadDLL, -- :: String -> IO (Maybe String)
loadArchive, -- :: String -> IO ()
loadObj, -- :: String -> IO ()
unloadObj, -- :: String -> IO ()
insertSymbol, -- :: String -> String -> Ptr a -> IO ()
lookupSymbol, -- :: String -> IO (Maybe (Ptr a))
resolveObjs -- :: IO SuccessFlag
lookupSymbol, -- :: String -> IO (Maybe (Ptr a))
resolveObjs -- :: IO SuccessFlag
) where
import Panic
import BasicTypes ( SuccessFlag, successIf )
import Config ( cLeadingUnderscore )
import BasicTypes ( SuccessFlag, successIf )
import Config ( cLeadingUnderscore )
import Util
import Control.Monad ( when )
import Foreign.C
import Foreign ( nullPtr )
import Foreign ( nullPtr )
import GHC.Exts ( Ptr(..) )
import System.Posix.Internals ( CFilePath, withFilePath )
import System.FilePath ( dropExtension )
......@@ -57,8 +50,8 @@ lookupSymbol str_in = do
withCAString str $ \c_str -> do
addr <- c_lookupSymbol c_str
if addr == nullPtr
then return Nothing
else return (Just addr)
then return Nothing
else return (Just addr)
prefixUnderscore :: String -> String
prefixUnderscore
......@@ -85,9 +78,9 @@ loadDLL str0 = do
--
maybe_errmsg <- withFilePath str $ \dll -> c_addDLL dll
if maybe_errmsg == nullPtr
then return Nothing
else do str <- peekCString maybe_errmsg
return (Just str)
then return Nothing
else do str <- peekCString maybe_errmsg
return (Just str)
loadArchive :: String -> IO ()
loadArchive str = do
......
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\begin{code}
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
-- |
-- Support for source code annotation feature of GHC. That is the ANN pragma.
--
-- (c) The University of Glasgow 2006
-- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
--
module Annotations (
-- * Main Annotation data types
Annotation(..),
AnnTarget(..), CoreAnnTarget,
getAnnTargetName_maybe,
-- * AnnEnv for collecting and querying Annotations
AnnEnv,
mkAnnEnv, extendAnnEnvList, plusAnnEnv, emptyAnnEnv, findAnns,
deserializeAnns
) where
-- * Main Annotation data types
Annotation(..),
AnnTarget(..), CoreAnnTarget,
getAnnTargetName_maybe,
-- * AnnEnv for collecting and querying Annotations
AnnEnv,
mkAnnEnv, extendAnnEnvList, plusAnnEnv, emptyAnnEnv, findAnns,
deserializeAnns
) where
import Name
import Module ( Module )
import Name
import Outputable
import UniqFM
import Serialized
import UniqFM
import Unique
import Data.Typeable
import Data.Maybe
import Data.Typeable
import Data.Word ( Word8 )
......@@ -40,14 +33,14 @@ import Data.Word ( Word8 )
data Annotation = Annotation {
ann_target :: CoreAnnTarget, -- ^ The target of the annotation
ann_value :: Serialized -- ^ 'Serialized' version of the annotation that
-- allows recovery of its value or can
-- allows recovery of its value or can
-- be persisted to an interface file
}
-- | An annotation target
data AnnTarget name
= NamedTarget name -- ^ We are annotating something with a name:
-- a type or identifier
-- a type or identifier
| ModuleTarget Module -- ^ We are annotating a particular module
-- | The kind of annotation target found in the middle end of the compiler
......@@ -57,6 +50,7 @@ instance Functor AnnTarget where
fmap f (NamedTarget nm) = NamedTarget (f nm)
fmap _ (ModuleTarget mod) = ModuleTarget mod
-- | Get the 'name' of an annotation target if it exists.
getAnnTargetName_maybe :: AnnTarget name -> Maybe name
getAnnTargetName_maybe (NamedTarget nm) = Just nm
getAnnTargetName_maybe _ = Nothing
......@@ -74,20 +68,25 @@ instance Outputable Annotation where
ppr ann = ppr (ann_target ann)
-- | A collection of annotations
newtype AnnEnv = MkAnnEnv (UniqFM [Serialized])
-- Can't use a type synonym or we hit bug #2412 due to source import
newtype AnnEnv = MkAnnEnv (UniqFM [Serialized])
-- | An empty annotation environment.
emptyAnnEnv :: AnnEnv
emptyAnnEnv = MkAnnEnv emptyUFM
-- | Construct a new annotation environment that contains the list of
-- annotations provided.