[commit: ghc] master: Fix annotation reification for home package modules (48e475e)

git at git.haskell.org git at git.haskell.org
Mon Apr 28 12:46:55 UTC 2014


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/48e475e45f517896c6618d38a09b8d223f3d7585/ghc

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

commit 48e475e45f517896c6618d38a09b8d223f3d7585
Author: Gergely Risko <errge at nilcons.com>
Date:   Fri Apr 25 15:35:58 2014 +0200

    Fix annotation reification for home package modules
    
    The reifyAnnotation method of the Q monad correctly gathered annotations
    from TCG and EPS.  Unfortunately it didn't look into the Home Package
    Table.  This resulted in annotations not being found if they are in the
    same package as the splice that is reifying and ghc --make is used for
    compilation management.  Fix this by using the already existing
    prepareAnnotations method from HscTypes.lhs that correctly searches
    in HPT and EPS both.
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


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

48e475e45f517896c6618d38a09b8d223f3d7585
 compiler/typecheck/TcSplice.lhs |   13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 7fce241..7ec8a9e 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -1507,13 +1507,14 @@ lookupThAnnLookup (TH.AnnLookupModule (TH.Module pn mn))
     mkModule (stringToPackageId $ TH.pkgString pn) (mkModuleName $ TH.modString mn)
 
 reifyAnnotations :: Data a => TH.AnnLookup -> TcM [a]
-reifyAnnotations th_nm
-  = do { name <- lookupThAnnLookup th_nm
-       ; eps <- getEps
+reifyAnnotations th_name
+  = do { name <- lookupThAnnLookup th_name
+       ; topEnv <- getTopEnv
+       ; epsHptAnns <- liftIO $ prepareAnnotations topEnv Nothing
        ; tcg <- getGblEnv
-       ; let epsAnns = findAnns deserializeWithData (eps_ann_env eps) name
-       ; let envAnns = findAnns deserializeWithData (tcg_ann_env tcg) name
-       ; return (envAnns ++ epsAnns) }
+       ; let selectedEpsHptAnns = findAnns deserializeWithData epsHptAnns name
+       ; let selectedTcgAnns = findAnns deserializeWithData (tcg_ann_env tcg) name
+       ; return (selectedEpsHptAnns ++ selectedTcgAnns) }
 
 ------------------------------
 modToTHMod :: Module -> TH.Module



More information about the ghc-commits mailing list