[commit: ghc] master,ghc-lwc2: Fix a TODO in the compiler (9010ab9)

[Ian Lynagh]

Repository : http://darcs.haskell.org/ghc.git/

On branches: master,ghc-lwc2

http://hackage.haskell.org/trac/ghc/changeset/9010ab9035529adc992cb67a0040320ba1c60e21

>---------------------------------------------------------------

commit 9010ab9035529adc992cb67a0040320ba1c60e21
Author: Ian Lynagh <ian at well-typed.com>
Date:   Tue Feb 26 18:57:39 2013 +0000

    Fix a TODO in the compiler
    
    AnnProvenance now has Functor, Foldable, Traversable instances.

>---------------------------------------------------------------

 compiler/hsSyn/HsDecls.lhs   | 18 ++++++------------
 compiler/rename/RnSource.lhs |  3 ++-
 2 files changed, 8 insertions(+), 13 deletions(-)

diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 13638a0..ce391c7 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -4,7 +4,8 @@
 %
 
 \begin{code}
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable,
+             DeriveTraversable #-}
 
 -- | Abstract syntax of global declarations.
 --
@@ -54,7 +55,7 @@ module HsDecls (
   WarnDecl(..),  LWarnDecl,
   -- ** Annotations
   AnnDecl(..), LAnnDecl, 
-  AnnProvenance(..), annProvenanceName_maybe, modifyAnnProvenanceNameM,
+  AnnProvenance(..), annProvenanceName_maybe,
 
   -- * Grouping
   HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups
@@ -84,8 +85,9 @@ import SrcLoc
 import FastString
 
 import Bag
-import Control.Monad    ( liftM )
 import Data.Data        hiding (TyCon)
+import Data.Foldable (Foldable)
+import Data.Traversable
 \end{code}
 
 %************************************************************************
@@ -1359,21 +1361,13 @@ instance (OutputableBndr name) => Outputable (AnnDecl name) where
 data AnnProvenance name = ValueAnnProvenance name
                         | TypeAnnProvenance name
                         | ModuleAnnProvenance
-  deriving (Data, Typeable)
+  deriving (Data, Typeable, Functor, Foldable, Traversable)
 
 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
 annProvenanceName_maybe (TypeAnnProvenance name)  = Just name
 annProvenanceName_maybe ModuleAnnProvenance       = Nothing
 
--- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
-modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
-modifyAnnProvenanceNameM fm prov =
-    case prov of
-            ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
-            TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
-            ModuleAnnProvenance -> return ModuleAnnProvenance
-
 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
 pprAnnProvenance ModuleAnnProvenance       = ptext (sLit "ANN module")
 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 7ff473f..cc41038 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -44,6 +44,7 @@ import Digraph          ( SCC, flattenSCC, stronglyConnCompFromEdgedVertices )
 
 import Control.Monad
 import Data.List( partition )
+import Data.Traversable (traverse)
 import Maybes( orElse )
 \end{code}
 
@@ -339,7 +340,7 @@ rnAnnDecl (HsAnnotation provenance expr) = do
 
 rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
 rnAnnProvenance provenance = do
-    provenance' <- modifyAnnProvenanceNameM lookupTopBndrRn provenance
+    provenance' <- traverse lookupTopBndrRn provenance
     return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
 \end{code}