2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
8 -- * Main Annotation data types
10 AnnTarget(..), CoreAnnTarget,
11 getAnnTargetName_maybe,
13 -- * AnnEnv for collecting and querying Annotations
15 mkAnnEnv, extendAnnEnvList, plusAnnEnv, emptyAnnEnv, findAnns
19 import Module ( Module )
27 import Data.Word ( Word8 )
30 -- | Represents an annotation after it has been sufficiently desugared from
31 -- it's initial form of 'HsDecls.AnnDecl'
32 data Annotation = Annotation {
33 ann_target :: CoreAnnTarget, -- ^ The target of the annotation
34 ann_value :: Serialized -- ^ 'Serialized' version of the annotation that
35 -- allows recovery of its value or can
36 -- be persisted to an interface file
39 -- | An annotation target
41 = NamedTarget name -- ^ We are annotating something with a name:
42 -- a type or identifier
43 | ModuleTarget Module -- ^ We are annotating a particular module
45 -- | The kind of annotation target found in the middle end of the compiler
46 type CoreAnnTarget = AnnTarget Name
48 instance Functor AnnTarget where
49 fmap f (NamedTarget nm) = NamedTarget (f nm)
50 fmap _ (ModuleTarget mod) = ModuleTarget mod
52 getAnnTargetName_maybe :: AnnTarget name -> Maybe name
53 getAnnTargetName_maybe (NamedTarget nm) = Just nm
54 getAnnTargetName_maybe _ = Nothing
56 instance Uniquable name => Uniquable (AnnTarget name) where
57 getUnique (NamedTarget nm) = getUnique nm
58 getUnique (ModuleTarget mod) = deriveUnique (getUnique mod) 0
59 -- deriveUnique prevents OccName uniques clashing with NamedTarget
61 instance Outputable name => Outputable (AnnTarget name) where
62 ppr (NamedTarget nm) = text "Named target" <+> ppr nm
63 ppr (ModuleTarget mod) = text "Module target" <+> ppr mod
66 -- | A collection of annotations
67 newtype AnnEnv = MkAnnEnv (UniqFM [Serialized])
68 -- Can't use a type synonym or we hit bug #2412 due to source import
71 emptyAnnEnv = MkAnnEnv emptyUFM
73 mkAnnEnv :: [Annotation] -> AnnEnv
74 mkAnnEnv = extendAnnEnvList emptyAnnEnv
76 extendAnnEnvList :: AnnEnv -> [Annotation] -> AnnEnv
77 extendAnnEnvList (MkAnnEnv env) anns
78 = MkAnnEnv $ addListToUFM_C (++) env $
79 map (\ann -> (getUnique (ann_target ann), [ann_value ann])) anns
81 plusAnnEnv :: AnnEnv -> AnnEnv -> AnnEnv
82 plusAnnEnv (MkAnnEnv env1) (MkAnnEnv env2) = MkAnnEnv $ plusUFM_C (++) env1 env2
84 -- | Find the annotations attached to the given target as 'Typeable'
85 -- values of your choice. If no deserializer is specified,
86 -- only transient annotations will be returned.
87 findAnns :: Typeable a => ([Word8] -> a) -> AnnEnv -> CoreAnnTarget -> [a]
88 findAnns deserialize (MkAnnEnv ann_env)
89 = (mapMaybe (fromSerialized deserialize))
90 . (lookupWithDefaultUFM ann_env [])