From f0183230483e777e8f3d8f325798f3dd8f912a6a Mon Sep 17 00:00:00 2001
From: Roman Leshchinskiy <rl@cse.unsw.edu.au>
Date: Thu, 29 Oct 2009 14:32:19 +0000
Subject: [PATCH] Utility functions for annotations

---
 compiler/main/Annotations.lhs    |   12 ++++++++++--
 compiler/simplCore/CoreMonad.lhs |   11 ++++++++++-
 2 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/compiler/main/Annotations.lhs b/compiler/main/Annotations.lhs
index d1b566b..e1a4963 100644
--- a/compiler/main/Annotations.lhs
+++ b/compiler/main/Annotations.lhs
@@ -12,7 +12,8 @@ module Annotations (
     
     -- * AnnEnv for collecting and querying Annotations
     AnnEnv,
-    mkAnnEnv, extendAnnEnvList, plusAnnEnv, emptyAnnEnv, findAnns
+    mkAnnEnv, extendAnnEnvList, plusAnnEnv, emptyAnnEnv, findAnns,
+    deserializeAnns
   ) where
 
 import Name
@@ -90,4 +91,11 @@ findAnns :: Typeable a => ([Word8] -> a) -> AnnEnv -> CoreAnnTarget -> [a]
 findAnns deserialize (MkAnnEnv ann_env) 
   = (mapMaybe (fromSerialized deserialize))
     . (lookupWithDefaultUFM ann_env [])
-\end{code}
\ No newline at end of file
+
+-- | 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 :: Typeable a => ([Word8] -> a) -> AnnEnv -> UniqFM [a]
+deserializeAnns deserialize (MkAnnEnv ann_env)
+  = mapUFM (mapMaybe (fromSerialized deserialize)) ann_env
+\end{code}
diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index a231103..c49ac17 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -22,7 +22,7 @@ module CoreMonad (
     liftIO1, liftIO2, liftIO3, liftIO4,
     
     -- ** Dealing with annotations
-    findAnnotations, addAnnotation,
+    findAnnotations, deserializeAnnotations, addAnnotation,
     
     -- ** Screen output
     putMsg, putMsgS, errorMsg, errorMsgS, 
@@ -57,6 +57,7 @@ import Outputable
 import qualified ErrUtils as Err
 import Maybes
 import UniqSupply
+import LazyUniqFM       ( UniqFM )
 
 import Data.Dynamic
 import Data.IORef
@@ -251,6 +252,14 @@ findAnnotations deserialize target = do
      ann_env <- getAnnEnv
      return (findAnns deserialize ann_env target)
 
+-- | 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).
+deserializeAnnotations :: Typeable a => ([Word8] -> a) -> CoreM (UniqFM [a])
+deserializeAnnotations deserialize = do
+     ann_env <- getAnnEnv
+     return (deserializeAnns deserialize ann_env)
+
 addAnnotation :: Typeable a => (a -> [Word8]) -> CoreAnnTarget -> a -> CoreM ()
 addAnnotation serialize target what = addAnnotationToEnv $ Annotation { ann_target = target, ann_value = toSerialized serialize what }
 
-- 
1.7.10.4