Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.6
http://hackage.haskell.org/trac/ghc/changeset/1aa031e7013caf59f3297d29e81ed573eb306356 >--------------------------------------------------------------- commit 1aa031e7013caf59f3297d29e81ed573eb306356 Author: Simon Marlow <[email protected]> Date: Wed Sep 5 16:38:50 2012 +0100 Fix #7215: we weren't calculating the hashes correctly for sub-binders MERGED from commit 583c87d00d2058b1a073ea1f5d7f4e0d92b7a9a4 >--------------------------------------------------------------- compiler/iface/IfaceSyn.lhs | 22 ++++++++++++++++++++++ compiler/iface/MkIface.lhs | 17 ++--------------- compiler/main/HscTypes.lhs | 34 ++++++++++++++++------------------ 3 files changed, 40 insertions(+), 33 deletions(-) diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index bc5fc95..a41a9da 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -24,6 +24,7 @@ module IfaceSyn ( -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, + ifaceDeclFingerprints, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -51,6 +52,10 @@ import Outputable import FastString import Module import TysWiredIn ( eqTyConName ) +import Fingerprint +import Binary + +import System.IO.Unsafe infixl 3 &&& \end{code} @@ -448,6 +453,23 @@ ifaceDeclImplicitBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_tc_occ, ifaceDeclImplicitBndrs _ = [] +-- ----------------------------------------------------------------------------- +-- The fingerprints of an IfaceDecl + + -- We better give each name bound by the declaration a + -- different fingerprint! So we calculate the fingerprint of + -- each binder by combining the fingerprint of the whole + -- declaration with the name of the binder. (#5614, #7215) +ifaceDeclFingerprints :: Fingerprint -> IfaceDecl -> [(OccName,Fingerprint)] +ifaceDeclFingerprints hash decl + = (ifName decl, hash) : + [ (occ, computeFingerprint' (hash,occ)) + | occ <- ifaceDeclImplicitBndrs decl ] + where + computeFingerprint' = + unsafeDupablePerformIO + . computeFingerprint (panic "ifaceDeclFingerprints") + ----------------------------- Printing IfaceDecl ------------------------------ instance Outputable IfaceDecl where diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index c94b19a..443a7ea 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -530,25 +530,12 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls -- to assign fingerprints to all the OccNames that it binds, to -- use when referencing those OccNames in later declarations. -- - -- We better give each name bound by the declaration a - -- different fingerprint! So we calculate the fingerprint of - -- each binder by combining the fingerprint of the whole - -- declaration with the name of the binder. (#5614) extend_hash_env :: OccEnv (OccName,Fingerprint) -> (Fingerprint,IfaceDecl) -> IO (OccEnv (OccName,Fingerprint)) extend_hash_env env0 (hash,d) = do - let - sub_bndrs = ifaceDeclImplicitBndrs d - fp_sub_bndr occ = computeFingerprint putNameLiterally (hash,occ) - -- - sub_fps <- mapM fp_sub_bndr sub_bndrs - return (foldr (\(b,fp) env -> extendOccEnv env b (b,fp)) env1 - (zip sub_bndrs sub_fps)) - where - decl_name = ifName d - item = (decl_name, hash) - env1 = extendOccEnv env0 decl_name item + return (foldr (\(b,fp) env -> extendOccEnv env b (b,fp)) env0 + (ifaceDeclFingerprints hash d)) -- (local_env, decls_w_hashes) <- diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 793740e..7c1f169 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -744,6 +744,22 @@ emptyModIface mod mi_trust = noIfaceTrustInfo, mi_trust_pkg = False } + +-- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface' +mkIfaceHashCache :: [(Fingerprint,IfaceDecl)] + -> (OccName -> Maybe (OccName, Fingerprint)) +mkIfaceHashCache pairs + = \occ -> lookupOccEnv env occ + where + env = foldr add_decl emptyOccEnv pairs + add_decl (v,d) env0 = foldr add env0 (ifaceDeclFingerprints v d) + where + add (occ,hash) env0 = extendOccEnv env0 occ (occ,hash) + +emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint) +emptyIfaceHashCache _occ = Nothing + + -- | The 'ModDetails' is essentially a cache for information in the 'ModIface' -- for home modules only. Information relating to packages will be loaded into -- global environments in 'ExternalPackageState'. @@ -1460,24 +1476,6 @@ class Monad m => MonadThings m where lookupTyCon = liftM tyThingTyCon . lookupThing \end{code} -\begin{code} --- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface' -mkIfaceHashCache :: [(Fingerprint,IfaceDecl)] - -> (OccName -> Maybe (OccName, Fingerprint)) -mkIfaceHashCache pairs - = \occ -> lookupOccEnv env occ - where - env = foldr add_decl emptyOccEnv pairs - add_decl (v,d) env0 = foldr add_imp env1 (ifaceDeclImplicitBndrs d) - where - decl_name = ifName d - env1 = extendOccEnv env0 decl_name (decl_name, v) - add_imp bndr env = extendOccEnv env bndr (decl_name, v) - -emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint) -emptyIfaceHashCache _occ = Nothing -\end{code} - %************************************************************************ %* * \subsection{Auxiliary types} _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
