diff options
Diffstat (limited to 'compiler/iface')
| -rw-r--r-- | compiler/iface/BinIface.hs | 4 | ||||
| -rw-r--r-- | compiler/iface/IfaceSyn.lhs | 22 | ||||
| -rw-r--r-- | compiler/iface/MkIface.lhs | 17 |
3 files changed, 26 insertions, 17 deletions
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 965b1a96c3..a319f6ed62 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -117,7 +117,7 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do -- should be). Also, the serialisation of value of type "Bin -- a" used to depend on the word size of the machine, now they -- are always 32 bits. - if wORD_SIZE == 4 + if wORD_SIZE dflags == 4 then do _ <- Binary.get bh :: IO Word32; return () else do _ <- Binary.get bh :: IO Word64; return () @@ -168,7 +168,7 @@ writeBinIface dflags hi_path mod_iface = do -- dummy 32/64-bit field before the version/way for -- compatibility with older interface file formats. -- See Note [dummy iface field] above. - if wORD_SIZE == 4 + if wORD_SIZE dflags == 4 then Binary.put_ bh (0 :: Word32) else Binary.put_ bh (0 :: Word64) diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index bc5fc954eb..a41a9dac47 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 93ca3853e2..d92cb4a185 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) <- |