import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
IfaceRule(..), IfaceInst(..), IfaceExtName(..), IfaceTyCon(..),
eqIfDecl, eqIfRule, eqIfInst, IfaceEq(..), (&&&), bool,
- eqMaybeBy, eqListBy,
+ eqMaybeBy, eqListBy, visibleIfConDecls,
tyThingToIfaceDecl, dfunToIfaceInst, coreRuleToIfaceRule )
import LoadIface ( readIface, loadInterface, ifaceInstGates )
import BasicTypes ( Version, initialVersion, bumpVersion )
import TcRnMonad
import TcRnTypes ( ImportAvails(..), mkModDeps )
-import HscTypes ( ModIface(..),
+import TcType ( isFFITy )
+import HscTypes ( ModIface(..), TyThing(..),
ModGuts(..), ModGuts, IfaceExport,
- GhciMode(..),
+ GhciMode(..), isOneShot,
HscEnv(..), hscEPS,
Dependencies(..), FixItem(..),
- isImplicitTyThing,
mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
typeEnvElts,
Avails, AvailInfo, GenAvailInfo(..), availName,
extendOccSet, extendOccSetList,
isEmptyOccSet, intersectOccSet, intersectsOccSet,
occNameFS, isTcOcc )
-import TyCon ( visibleDataCons, tyConDataCons )
-import DataCon ( dataConName )
+import TyCon ( visibleDataCons, tyConDataCons, isNewTyCon, newTyConRep )
+import Class ( classSelIds )
+import DataCon ( dataConName, dataConFieldLabels )
+import FieldLabel ( fieldLabelName )
import Module ( Module, ModuleName, moduleNameFS, moduleName, isHomeModule,
ModLocation(..), mkSysModuleNameFS, moduleUserString,
ModuleEnv, emptyModuleEnv, lookupModuleEnv,
= do { eps <- hscEPS hsc_env
; let { this_mod_name = moduleName this_mod
; ext_nm = mkExtNameFn hsc_env eps this_mod_name
- ; decls = [ tyThingToIfaceDecl omit_prags omit_data_cons ext_nm thing
- | thing <- typeEnvElts type_env
- , not (isImplicitTyThing thing) && not (isWiredInName (getName thing)) ]
+ ; local_things = [thing | thing <- typeEnvElts type_env,
+ not (isWiredInName (getName thing)) ]
+ -- Do not export anything about wired-in things
+ -- (GHC knows about them already)
+
+ ; abstract_tcs :: NameSet -- TyCons and Classes whose representation is not exposed
+ ; abstract_tcs
+ | not omit_prags = emptyNameSet -- In the -O case, nothing is abstract
+ | otherwise = mkNameSet [ getName thing
+ | thing <- local_things
+ , not (mustExposeThing exports thing)]
+
+ ; decls = [ tyThingToIfaceDecl omit_prags abstract_tcs ext_nm thing
+ | thing <- local_things, wantDeclFor exports abstract_tcs thing ]
-- Don't put implicit Ids and class tycons in the interface file
- -- Nor wired-in things (GHC knows about them already)
; fixities = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env]
; deprecs = mkIfaceDeprec src_deprecs
| omit_prags = []
| otherwise = sortLt lt_rule $
map (coreRuleToIfaceRule this_mod_name ext_nm) rules
- ; iface_insts = sortLt lt_inst (map (dfunToIfaceInst this_mod_name) insts)
+ ; iface_insts = sortLt lt_inst (map dfunToIfaceInst insts)
; intermediate_iface = ModIface {
mi_module = this_mod,
ghci_mode = hsc_mode hsc_env
hi_file_path = ml_hi_file location
omit_prags = dopt Opt_OmitInterfacePragmas dflags
- omit_data_cons tycon -- Don't expose data constructors if none are
- -- exported and we are not optimising (i.e. not omit_prags)
- | omit_prags = not (any exported_data_con (tyConDataCons tycon))
- | otherwise = False
- exported_data_con con = dataConName con `elemNameSet` exports
+
+
+mustExposeThing :: NameSet -> TyThing -> Bool
+-- We are compiling without -O, and thus trying to write as little as
+-- possible into the interface file. But we must expose the details of
+-- any data types and classes whose constructors, fields, methods are
+-- visible to an importing module
+mustExposeThing exports (ATyCon tc)
+ = any exported_data_con (tyConDataCons tc)
+ -- Expose rep if any datacon or field is exported
+
+ || (isNewTyCon tc && isFFITy (snd (newTyConRep tc)))
+ -- Expose the rep for newtypes if the rep is an FFI type.
+ -- For a very annoying reason. 'Foreign import' is meant to
+ -- be able to look through newtypes transparently, but it
+ -- can only do that if it can "see" the newtype representation
+ where
+ exported_data_con con
+ = any (`elemNameSet` exports) (dataConName con : field_names)
+ where
+ field_names = map fieldLabelName (dataConFieldLabels con)
+
+mustExposeThing exports (AClass cls)
+ = any exported_class_op (classSelIds cls)
+ where -- Expose rep if any classs op is exported
+ exported_class_op op = getName op `elemNameSet` exports
+
+mustExposeThing exports other = False
+
+
+wantDeclFor :: NameSet -- User-exported things
+ -> NameSet -- Abstract things
+ -> TyThing -> Bool
+wantDeclFor exports abstracts thing
+ | Just parent <- nameParent_maybe name -- An implicit thing
+ = parent `elemNameSet` abstracts && name `elemNameSet` exports
+ | otherwise
+ = True
+ where
+ name = getName thing
+
deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
eq_ind_occs [op | IfaceClassOp op _ _ <- sigs]
eq_indirects (IfaceData {ifName = tc_occ, ifCons = cons})
= same_insts tc_occ &&& same_fixity tc_occ &&& -- The TyCon can have a fixity too
- eq_ind_occs [occ | IfaceConDecl occ _ _ _ _ _ <- visibleDataCons cons]
+ eq_ind_occs [occ | IfaceConDecl occ _ _ _ _ _ _ <- visibleIfConDecls cons]
eq_indirects other = Equal -- Synonyms and foreign declarations
eq_ind_occ :: OccName -> IfaceEq -- For class ops and Ids; check fixity and rules
-- ToDo: do we need to sort into canonical order?
import_all mod = case lookupModuleEnv dir_imp_mods mod of
- Just (_,imp_all) -> isNothing imp_all
- Nothing -> False
+ Just (_,imp_all,_) -> isNothing imp_all
+ Nothing -> False
-- We want to create a Usage for a home module if
-- a) we used something from; has something in used_names
mkIfaceExports :: NameSet -> [(ModuleName, [GenAvailInfo OccName])]
-- Group by module and sort by occurrence
-- This keeps the list in canonical order
-mkIfaceExports exports
+mkIfaceExports exports
= [ (mkSysModuleNameFS fs, eltsFM avails)
| (fs, avails) <- fmToList groupFM
]
occ = nameOccName name
occ_fs = occNameFS occ
mod_fs = moduleNameFS (nameModuleName name)
- avail | Just p <- nameParent_maybe name = AvailTC (nameOccName p) [occ]
+ avail | Just p <- nameParent_maybe name = AvailTC (nameOccName p) [occ]
| isTcOcc occ = AvailTC occ [occ]
| otherwise = Avail occ
avail_fs = occNameFS (availName avail)
| not source_unchanged
= returnM outOfDate
| otherwise
- = traceHiDiffs (text "Considering whether compilation is required for" <+>
- ppr (mi_module iface) <> colon) `thenM_`
+ = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
+ ppr (mi_module iface) <> colon)
-- Source code unchanged and no errors yet... carry on
+
-- First put the dependent-module info in the envt, just temporarily,
-- so that when we look for interfaces we look for the right one (.hi or .hi-boot)
-- It's just temporary because either the usage check will succeed
-- (in which case we are done with this module) or it'll fail (in which
-- case we'll compile the module from scratch anyhow).
- updGblEnv (\ gbl -> gbl { if_is_boot = mod_deps }) (
- checkList [checkModUsage u | u <- mi_usages iface]
- )
+ ; mode <- getGhciMode
+ ; ifM (isOneShot mode)
+ (updateEps_ $ \eps -> eps { eps_is_boot = mod_deps })
+
+ ; checkList [checkModUsage u | u <- mi_usages iface]
+ }
where
-- This is a bit of a hack really
mod_deps :: ModuleEnv (ModuleName, IsBootInterface)
projects / ghc-hetmet.git / blobdiff