-- |-- 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--moduleAnnotations(-- * Main Annotation data typesAnnotation (..),AnnPayload ,AnnTarget (..),CoreAnnTarget ,getAnnTargetName_maybe ,-- * AnnEnv for collecting and querying AnnotationsAnnEnv ,mkAnnEnv ,extendAnnEnvList ,plusAnnEnv ,emptyAnnEnv ,findAnns ,findAnnsByTypeRep ,deserializeAnns )whereimportGhcPrelude importBinary importModule (Module )importName importOutputable importGHC.Serialized importUniqFM importUnique importControl.MonadimportData.MaybeimportData.TypeableimportData.Word(Word8)-- | Represents an annotation after it has been sufficiently desugared from-- it's initial form of 'HsDecls.AnnDecl'dataAnnotation =Annotation {ann_target ::CoreAnnTarget ,-- ^ The target of the annotationann_value ::AnnPayload }typeAnnPayload =Serialized -- ^ The "payload" of an annotation-- allows recovery of its value at a given type,-- and can be persisted to an interface file-- | An annotation targetdataAnnTarget name =NamedTarget name -- ^ We are annotating something with a name:-- a type or identifier|ModuleTarget Module -- ^ We are annotating a particular module-- | The kind of annotation target found in the middle end of the compilertypeCoreAnnTarget =AnnTarget Name instanceFunctorAnnTarget wherefmap 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 ->Maybename getAnnTargetName_maybe (NamedTarget nm )=Justnm getAnnTargetName_maybe_=NothinginstanceUniquable name =>Uniquable (AnnTarget name )wheregetUnique (NamedTarget nm )=getUnique nm getUnique(ModuleTarget mod )=deriveUnique (getUnique mod )0-- deriveUnique prevents OccName uniques clashing with NamedTargetinstanceOutputable name =>Outputable (AnnTarget name )whereppr (NamedTarget nm )=text "Named target"<+> ppr nm ppr(ModuleTarget mod )=text "Module target"<+> ppr mod instanceBinary name =>Binary (AnnTarget name )whereput_ bh (NamedTarget a )=doputByte bh 0put_ bh a put_bh (ModuleTarget a )=doputByte bh 1put_ bh a get bh =doh <-getByte bh caseh of0->liftMNamedTarget $get bh _->liftMModuleTarget $get bh instanceOutputable Annotation whereppr ann =ppr (ann_targetann )-- | A collection of annotations-- Can't use a type synonym or we hit bug #2412 due to source importnewtypeAnnEnv =MkAnnEnv (UniqFM [AnnPayload ])-- | An empty annotation environment.emptyAnnEnv::AnnEnv emptyAnnEnv =MkAnnEnv emptyUFM -- | Construct a new annotation environment that contains the list of-- annotations provided.mkAnnEnv::[Annotation ]->AnnEnv mkAnnEnv =extendAnnEnvList emptyAnnEnv -- | Add the given annotation to the environment.extendAnnEnvList::AnnEnv ->[Annotation ]->AnnEnv extendAnnEnvList (MkAnnEnv env )anns =MkAnnEnv $addListToUFM_C (++)env $map(\ann ->(getUnique (ann_targetann ),[ann_valueann ]))anns -- | Union two annotation environments.plusAnnEnv::AnnEnv ->AnnEnv ->AnnEnv plusAnnEnv (MkAnnEnv env1 )(MkAnnEnv env2 )=MkAnnEnv $plusUFM_C (++)env1 env2 -- | Find the annotations attached to the given target as 'Typeable'-- values of your choice. If no deserializer is specified,-- only transient annotations will be returned.findAnns::Typeablea =>([Word8]->a )->AnnEnv ->CoreAnnTarget ->[a ]findAnns deserialize (MkAnnEnv ann_env )=(mapMaybe(fromSerialized deserialize )).(lookupWithDefaultUFM ann_env [])-- | Find the annotations attached to the given target as 'Typeable'-- values of your choice. If no deserializer is specified,-- only transient annotations will be returned.findAnnsByTypeRep::AnnEnv ->CoreAnnTarget ->TypeRep->[[Word8]]findAnnsByTypeRep (MkAnnEnv ann_env )target tyrep =[ws |Serialized tyrep' ws <-lookupWithDefaultUFM ann_env []target ,tyrep' ==tyrep ]-- | Deserialize all annotations of a given type. This happens lazily, that is-- no deserialization will take place until the [a] is actually demanded and-- the [a] can also be empty (the UniqFM is not filtered).deserializeAnns::Typeablea =>([Word8]->a )->AnnEnv ->UniqFM [a ]deserializeAnns deserialize (MkAnnEnv ann_env )=mapUFM (mapMaybe(fromSerialized deserialize ))ann_env