Commit 49ac6c39 authored by simonpj's avatar simonpj
Browse files

[project @ 2004-02-25 13:54:30 by simonpj]

Yet another fix to the -Onot optimisation that hides data type
representations in .hi files.

1.  Expose the representation if any fields are exposed

2.  Don't expose newtypes whose data-cons are abstract, unless the
    rep type is a FFI type.  (Previously we were more conservative
    and always exposed newtypes, just in case of a foreign decl.)
parent 60170b40
......@@ -183,6 +183,7 @@ import LoadIface ( readIface, loadInterface, ifaceInstGates )
import BasicTypes ( Version, initialVersion, bumpVersion )
import TcRnMonad
import TcRnTypes ( ImportAvails(..), mkModDeps )
import TcType ( isFFITy )
import HscTypes ( ModIface(..), TyThing(..),
ModGuts(..), ModGuts, IfaceExport,
GhciMode(..),
......@@ -208,9 +209,10 @@ import OccName ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv, extendOc
extendOccSet, extendOccSetList,
isEmptyOccSet, intersectOccSet, intersectsOccSet,
occNameFS, isTcOcc )
import TyCon ( visibleDataCons, tyConDataCons, isNewTyCon )
import TyCon ( visibleDataCons, tyConDataCons, isNewTyCon, newTyConRep )
import Class ( classSelIds )
import DataCon ( dataConName )
import DataCon ( dataConName, dataConFieldLabels )
import FieldLabel ( fieldLabelName )
import Module ( Module, ModuleName, moduleNameFS, moduleName, isHomeModule,
ModLocation(..), mkSysModuleNameFS, moduleUserString,
ModuleEnv, emptyModuleEnv, lookupModuleEnv,
......@@ -274,7 +276,7 @@ mkIface hsc_env location maybe_old_iface
| not omit_prags = emptyNameSet -- In the -O case, nothing is abstract
| otherwise = mkNameSet [ getName thing
| thing <- local_things
, isAbstractThing exports thing]
, not (mustExposeThing exports thing)]
; decls = [ tyThingToIfaceDecl omit_prags abstract_tcs ext_nm thing
| thing <- local_things, wantDeclFor exports abstract_tcs thing ]
......@@ -340,24 +342,33 @@ mkIface hsc_env location maybe_old_iface
omit_prags = dopt Opt_OmitInterfacePragmas dflags
isAbstractThing :: NameSet -> TyThing -> Bool
isAbstractThing exports (ATyCon tc)
= not (isNewTyCon tc)
-- Always expose the rep for newtypes. This is for a
-- very annoying reason. 'Foreign import' is meant to
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
-- So, for now anyway, we always expose the rep of newtypes. Sigh.
&& not (any exported_data_con (tyConDataCons tc))
-- Don't expose rep if no datacons are exported
where
exported_data_con con = dataConName con `elemNameSet` exports
exported_data_con con
= any (`elemNameSet` exports) (dataConName con : field_names)
where
field_names = map fieldLabelName (dataConFieldLabels con)
isAbstractThing exports (AClass cls) = not (any exported_class_op (classSelIds cls))
where -- Don't expose rep if no classs op is exported
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
isAbstractThing exports other = False
mustExposeThing exports other = False
wantDeclFor :: NameSet -- User-exported things
-> NameSet -- Abstract things
......
......@@ -73,6 +73,7 @@ module TcType (
isFFILabelTy, -- :: Type -> Bool
isFFIDotnetTy, -- :: DynFlags -> Type -> Bool
isFFIDotnetObjTy, -- :: Type -> Bool
isFFITy, -- :: Type -> Bool
toDNType, -- :: Type -> DNType
......@@ -770,6 +771,10 @@ restricted set of types as arguments and results (the restricting factor
being the )
\begin{code}
isFFITy :: Type -> Bool
-- True for any TyCon that can possibly be an arg or result of an FFI call
isFFITy ty = checkRepTyCon legalFFITyCon ty
isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
-- Checks for valid argument type for a 'foreign import'
isFFIArgumentTy dflags safety ty
......@@ -909,6 +914,11 @@ legalOutgoingTyCon dflags safety tc
| otherwise
= marshalableTyCon dflags tc
legalFFITyCon :: TyCon -> Bool
-- True for any TyCon that can possibly be an arg or result of an FFI call
legalFFITyCon tc
= isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
marshalableTyCon dflags tc
= (dopt Opt_GlasgowExts dflags && isUnLiftedTyCon tc)
|| boxedMarshalableTyCon tc
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment