#include "HsVersions.h"
import IfaceSyn
-import IfaceType
import LoadIface
import Id
import IdInfo
import RdrName
import NameEnv
import NameSet
-import OccName
import Module
import BinIface
import ErrUtils
import Binary
import Fingerprint
import Bag
-import Panic
import Control.Monad
import Data.List
-- on M.hi-boot, and hence that we should do the hi-boot consistency
-- check.)
- -- Modules don't compare lexicographically usually,
- -- but we want them to do so here.
- le_mod :: Module -> Module -> Bool
- le_mod m1 m2 = moduleNameFS (moduleName m1)
- <= moduleNameFS (moduleName m2)
-
- le_dep_mod :: (ModuleName, IsBootInterface)
- -> (ModuleName, IsBootInterface) -> Bool
- le_dep_mod (m1,_) (m2,_) = moduleNameFS m1 <= moduleNameFS m2
-
-
pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
| otherwise = imp_dep_pkgs imports
- return Deps { dep_mods = sortLe le_dep_mod dep_mods,
- dep_pkgs = sortLe (<=) pkgs,
- dep_orphs = sortLe le_mod (imp_orphs imports),
- dep_finsts = sortLe le_mod (imp_finsts imports) }
+ return Deps { dep_mods = sortBy (stableModuleNameCmp `on` fst) dep_mods,
+ dep_pkgs = sortBy stablePackageIdCmp pkgs,
+ dep_orphs = sortBy stableModuleCmp (imp_orphs imports),
+ dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
-- sort to get into canonical order
-
+ -- NB. remember to use lexicographic ordering
mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
-> NameSet -> Dependencies -> GlobalRdrEnv
data IfaceDeclExtras
= IfaceIdExtras Fixity [IfaceRule]
| IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
- | IfaceClassExtras [IfaceInstABI] [(Fixity,[IfaceRule])]
+ | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
+ | IfaceSynExtras Fixity
| IfaceOtherDeclExtras
freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
= unionManyNameSets (map freeNamesIfRule rules)
freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
= unionManyNameSets (map freeNamesSub subs)
-freeNamesDeclExtras (IfaceClassExtras _insts subs)
+freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
= unionManyNameSets (map freeNamesSub subs)
+freeNamesDeclExtras (IfaceSynExtras _)
+ = emptyNameSet
freeNamesDeclExtras IfaceOtherDeclExtras
= emptyNameSet
putByte bh 1; put_ bh fix; put_ bh rules
put_ bh (IfaceDataExtras fix insts cons) = do
putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
- put_ bh (IfaceClassExtras insts methods) = do
- putByte bh 3; put_ bh insts; put_ bh methods
+ put_ bh (IfaceClassExtras fix insts methods) = do
+ putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
+ put_ bh (IfaceSynExtras fix) = do
+ putByte bh 4; put_ bh fix
put_ bh IfaceOtherDeclExtras = do
- putByte bh 4
+ putByte bh 5
declExtras :: (OccName -> Fixity)
-> OccEnv [IfaceRule]
(map IfaceInstABI $ lookupOccEnvL inst_env n)
(map (id_extras . ifConOcc) (visibleIfConDecls cons))
IfaceClass{ifSigs=sigs} ->
- IfaceClassExtras
+ IfaceClassExtras (fix_fn n)
(map IfaceInstABI $ lookupOccEnvL inst_env n)
[id_extras op | IfaceClassOp op _ _ <- sigs]
+ IfaceSyn{} -> IfaceSynExtras (fix_fn n)
_other -> IfaceOtherDeclExtras
where
n = ifName decl
\begin{code}
mkIfaceExports :: [AvailInfo]
-> [(Module, [GenAvailInfo OccName])]
- -- Group by module and sort by occurrence
- -- This keeps the list in canonical order
+ -- Group by module and sort by occurrence
mkIfaceExports exports
= [ (mod, eltsFM avails)
- | (mod, avails) <- fmToList groupFM
+ | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
+ (moduleEnvToList groupFM)
+ -- NB. the fmToList is in a random order,
+ -- because Ord Module is not a predictable
+ -- ordering. Hence we perform a final sort
+ -- using the stable Module ordering.
]
where
-- Group by the module where the exported entities are defined
toIfaceIdDetails :: IdDetails -> IfaceIdDetails
toIfaceIdDetails VanillaId = IfVanillaId
toIfaceIdDetails DFunId = IfVanillaId
-toIfaceIdDetails (RecSelId { sel_naughty = n }) = IfRecSelId n
+toIfaceIdDetails (RecSelId { sel_naughty = n
+ , sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
IfVanillaId -- Unexpected