diff options
Diffstat (limited to 'compiler/main')
| -rw-r--r-- | compiler/main/DriverPipeline.hs | 2 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 2 | ||||
| -rw-r--r-- | compiler/main/DynamicLoading.hs | 2 | ||||
| -rw-r--r-- | compiler/main/GHC.hs | 6 | ||||
| -rw-r--r-- | compiler/main/GhcMake.hs | 4 | ||||
| -rw-r--r-- | compiler/main/GhcPlugins.hs | 2 | ||||
| -rw-r--r-- | compiler/main/HscMain.hs | 20 | ||||
| -rw-r--r-- | compiler/main/HscTypes.hs | 10 | ||||
| -rw-r--r-- | compiler/main/InteractiveEval.hs | 6 | ||||
| -rw-r--r-- | compiler/main/Plugins.hs | 2 | ||||
| -rw-r--r-- | compiler/main/PprTyThing.hs | 28 | ||||
| -rw-r--r-- | compiler/main/TidyPgm.hs | 1486 |
12 files changed, 42 insertions, 1528 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index fd2dc261c4..d212722d8d 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -66,7 +66,7 @@ import FileCleanup import Ar import Bag ( unitBag ) import FastString ( mkFastString ) -import MkIface ( mkFullIface ) +import GHC.Iface.Utils ( mkFullIface ) import Exception import System.Directory diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 94cee4a7cd..72da94cb44 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -4787,7 +4787,7 @@ didn't. Reason was: * Eta reduction wasn't happening in the simplifier, but it was happening in CorePrep, on $fBla = MkDict (/\a. K a) - * Result: rhsIsStatic told TidyPgm that $fBla might have CAF refs + * Result: rhsIsStatic told GHC.Iface.Tidy that $fBla might have CAF refs but the eta-reduced version (MkDict K) obviously doesn't Simple solution: just let the simplifier do eta-reduction even in -O0. After all, CorePrep does it unconditionally! Not a big deal, but diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs index 265cef390b..53ae31f8ef 100644 --- a/compiler/main/DynamicLoading.hs +++ b/compiler/main/DynamicLoading.hs @@ -28,7 +28,7 @@ import GHCi ( wormhole ) import SrcLoc ( noSrcSpan ) import Finder ( findPluginModule, cannotFindModule ) import TcRnMonad ( initTcInteractive, initIfaceTcRn ) -import LoadIface ( loadPluginInterface ) +import GHC.Iface.Load ( loadPluginInterface ) import RdrName ( RdrName, ImportSpec(..), ImpDeclSpec(..) , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName , gre_name, mkRdrQual ) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 140c8904e2..4030e87eff 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -306,7 +306,7 @@ import GhcMake import DriverPipeline ( compileOne' ) import GhcMonad import TcRnMonad ( finalSafeMode, fixSafeInstances, initIfaceTcRn ) -import LoadIface ( loadSysInterface ) +import GHC.Iface.Load ( loadSysInterface ) import TcRnTypes import Predicate import Packages @@ -327,7 +327,7 @@ import InstEnv import FamInstEnv ( FamInst ) import SrcLoc import CoreSyn -import TidyPgm +import GHC.Iface.Tidy import DriverPhases ( Phase(..), isHaskellSrcFilename ) import Finder import HscTypes @@ -1335,7 +1335,7 @@ pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a)) -- ToDo: check for small transformations that happen to the syntax in -- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral) --- ToDo: maybe use TH syntax instead of IfaceSyn? There's already a way +-- ToDo: maybe use TH syntax instead of Iface syntax? There's already a way -- to get from TyCons, Ids etc. to TH syntax (reify). -- :browse will use either lm_toplev or inspect lm_interface, depending diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 93bdb85f19..60cef1b8d0 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -44,7 +44,7 @@ import GhcMonad import HeaderInfo import HscTypes import Module -import TcIface ( typecheckIface ) +import GHC.IfaceToCore ( typecheckIface ) import TcRnMonad ( initIfaceCheck ) import HscMain @@ -1781,7 +1781,7 @@ file, we re-generate the ModDetails for each of the modules that depends on the .hs-boot file, so that everyone points to the proper TyCons, Ids etc. defined by the real module, not the boot module. Fortunately re-generating a ModDetails from a ModIface is easy: the -function TcIface.typecheckIface does exactly that. +function GHC.IfaceToCore.typecheckIface does exactly that. Picking the modules to re-typecheck is slightly tricky. Starting from the module graph consisting of the modules that have already been diff --git a/compiler/main/GhcPlugins.hs b/compiler/main/GhcPlugins.hs index 351f0b268a..63c52d8e20 100644 --- a/compiler/main/GhcPlugins.hs +++ b/compiler/main/GhcPlugins.hs @@ -87,7 +87,7 @@ import Unique ( Unique, Uniquable(..) ) import FastString import Data.Maybe -import IfaceEnv ( lookupOrigIO ) +import GHC.Iface.Env ( lookupOrigIO ) import GhcPrelude import MonadUtils ( mapMaybeM ) import GHC.ThToHs ( thRdrNameGuesses ) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index e98184e056..0e0b853c9a 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -113,18 +113,18 @@ import Parser import Lexer import SrcLoc import TcRnDriver -import TcIface ( typecheckIface ) +import GHC.IfaceToCore ( typecheckIface ) import TcRnMonad import TcHsSyn ( ZonkFlexi (DefaultFlexi) ) import NameCache ( initNameCache ) -import LoadIface ( ifaceStats, initExternalPackageState ) +import GHC.Iface.Load ( ifaceStats, initExternalPackageState ) import PrelInfo -import MkIface +import GHC.Iface.Utils import Desugar import SimplCore -import TidyPgm +import GHC.Iface.Tidy import GHC.CoreToStg.Prep -import GHC.CoreToStg ( coreToStg ) +import GHC.CoreToStg ( coreToStg ) import GHC.Stg.Syntax import GHC.Stg.FVs ( annTopBindingsFreeVars ) import GHC.Stg.Pipeline ( stg2stg ) @@ -175,10 +175,10 @@ import qualified Data.Set as S import Data.Set (Set) import Control.DeepSeq (force) -import HieAst ( mkHieFile ) -import HieTypes ( getAsts, hie_asts, hie_module ) -import HieBin ( readHieFile, writeHieFile , hie_file_result) -import HieDebug ( diffFile, validateScopes ) +import GHC.Iface.Ext.Ast ( mkHieFile ) +import GHC.Iface.Ext.Types ( getAsts, hie_asts, hie_module ) +import GHC.Iface.Ext.Binary ( readHieFile, writeHieFile , hie_file_result) +import GHC.Iface.Ext.Debug ( diffFile, validateScopes ) #include "HsVersions.h" @@ -1745,7 +1745,7 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do , isExternalName (idName id) , not (isDFunId id || isImplicitId id) ] -- We only need to keep around the external bindings - -- (as decided by TidyPgm), since those are the only ones + -- (as decided by GHC.Iface.Tidy), since those are the only ones -- that might later be looked up by name. But we can exclude -- - DFunIds, which are in 'cls_insts' (see Note [ic_tythings] in HscTypes -- - Implicit Ids, which are implicit in tcs diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 4a848864f8..5974b4ec63 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -195,7 +195,7 @@ import DriverPhases ( Phase, HscSource(..), hscSourceString , isHsBootOrSig, isHsigFile ) import qualified DriverPhases as Phase import BasicTypes -import IfaceSyn +import GHC.Iface.Syntax import Maybes import Outputable import SrcLoc @@ -1607,7 +1607,7 @@ Where do interactively-bound Ids come from? TcRnDriver.externaliseAndTidyId, so they get Names like Ghic4.foo. - Ids bound by the debugger etc have Names constructed by - IfaceEnv.newInteractiveBinder; at the call sites it is followed by + GHC.Iface.Env.newInteractiveBinder; at the call sites it is followed by mkVanillaGlobal or mkVanillaGlobalWithInfo. So again, they are all Global, External. @@ -2042,9 +2042,9 @@ Examples: -- scope, just for a start! -- N.B. the set of TyThings returned here *must* match the set of --- names returned by LoadIface.ifaceDeclImplicitBndrs, in the sense that +-- names returned by GHC.Iface.Load.ifaceDeclImplicitBndrs, in the sense that -- TyThing.getOccName should define a bijection between the two lists. --- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop]) +-- This invariant is used in GHC.Iface.Load.loadDecl (see note [Tricky iface loop]) -- The order of the list does not matter. implicitTyThings :: TyThing -> [TyThing] implicitTyThings (AnId _) = [] @@ -2490,7 +2490,7 @@ data Dependencies -- ^ All the plugins used while compiling this module. } deriving( Eq ) - -- Equality used only for old/new comparison in MkIface.addFingerprints + -- Equality used only for old/new comparison in GHC.Iface.Utils.addFingerprints -- See 'TcRnTypes.ImportAvails' for details on dependencies. instance Binary Dependencies where diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index eefa93ea02..b97360bab9 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -56,9 +56,9 @@ import HscMain import GHC.Hs import HscTypes import InstEnv -import IfaceEnv ( newInteractiveBinder ) -import FamInstEnv ( FamInst ) -import CoreFVs ( orphNamesOfFamInst ) +import GHC.Iface.Env ( newInteractiveBinder ) +import FamInstEnv ( FamInst ) +import CoreFVs ( orphNamesOfFamInst ) import TyCon import Type hiding( typeKind ) import GHC.Types.RepType diff --git a/compiler/main/Plugins.hs b/compiler/main/Plugins.hs index 790acdc2fc..649aa476c1 100644 --- a/compiler/main/Plugins.hs +++ b/compiler/main/Plugins.hs @@ -119,7 +119,7 @@ data Plugin = Plugin { , interfaceLoadAction :: forall lcl . [CommandLineOption] -> ModIface -> IfM lcl ModIface -- ^ Modify an interface that have been loaded. This is called by - -- LoadIface when an interface is successfully loaded. Not applied to + -- GHC.Iface.Load when an interface is successfully loaded. Not applied to -- the loading of the plugin interface. Tools that rely on information from -- modules other than the currently compiled one should implement this -- function. diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs index b918943c8e..226986f7b5 100644 --- a/compiler/main/PprTyThing.hs +++ b/compiler/main/PprTyThing.hs @@ -22,11 +22,11 @@ module PprTyThing ( import GhcPrelude import Type ( Type, ArgFlag(..), TyThing(..), mkTyVarBinders, tidyOpenType ) -import IfaceSyn ( ShowSub(..), ShowHowMuch(..), AltPpr(..) +import GHC.Iface.Syntax ( ShowSub(..), ShowHowMuch(..), AltPpr(..) , showToHeader, pprIfaceDecl ) import CoAxiom ( coAxiomTyCon ) import HscTypes( tyThingParent_maybe ) -import MkIface ( tyThingToIfaceDecl ) +import GHC.Iface.Utils ( tyThingToIfaceDecl ) import FamInstEnv( FamInst(..), FamFlavor(..) ) import TyCoPpr ( pprUserForAll, pprTypeApp, pprSigmaType ) import Name @@ -36,8 +36,8 @@ import Outputable -- ----------------------------------------------------------------------------- -- Pretty-printing entities that we get from the GHC API -{- Note [Pretty printing via IfaceSyn] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Pretty printing via Iface syntax] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Our general plan for pretty-printing - Types - TyCons @@ -45,19 +45,19 @@ Our general plan for pretty-printing - Pattern synonyms ...etc... -is to convert them to IfaceSyn, and pretty-print that. For example +is to convert them to Iface syntax, and pretty-print that. For example - pprType converts a Type to an IfaceType, and pretty prints that. - pprTyThing converts the TyThing to an IfaceDecl, and pretty prints that. -So IfaceSyn play a dual role: +So Iface syntax plays a dual role: - it's the internal version of an interface files - it's used for pretty-printing Why do this? * A significant reason is that we need to be able - to pretty-print IfaceSyn (to display Foo.hi), and it was a + to pretty-print Iface syntax (to display Foo.hi), and it was a pain to duplicate masses of pretty-printing goop, esp for Type and IfaceType. @@ -72,7 +72,7 @@ Why do this? * Interface files contains fast-strings, not uniques, so the very same tidying must take place when we convert to IfaceDecl. E.g. - MkIface.tyThingToIfaceDecl which converts a TyThing (i.e. TyCon, + GHC.Iface.Utils.tyThingToIfaceDecl which converts a TyThing (i.e. TyCon, Class etc) to an IfaceDecl. Bottom line: IfaceDecls are already 'tidy', so it's straightforward @@ -87,17 +87,17 @@ Why do this? Consequences: -- IfaceSyn (and IfaceType) must contain enough information to +- Iface syntax (and IfaceType) must contain enough information to print nicely. Hence, for example, the IfaceAppArgs type, which allows us to suppress invisible kind arguments in types - (see Note [Suppressing invisible arguments] in IfaceType) + (see Note [Suppressing invisible arguments] in GHC.Iface.Type) - In a few places we have info that is used only for pretty-printing, - and is totally ignored when turning IfaceSyn back into TyCons - etc (in TcIface). For example, IfaceClosedSynFamilyTyCon + and is totally ignored when turning Iface syntax back into Core + (in GHC.IfaceToCore). For example, IfaceClosedSynFamilyTyCon stores a [IfaceAxBranch] that is used only for pretty-printing. -- See Note [Free tyvars in IfaceType] in IfaceType +- See Note [Free tyvars in IfaceType] in GHC.Iface.Type See #7730, #8776 for details -} @@ -121,7 +121,7 @@ pprFamInst (FamInst { fi_flavor = SynFamilyInst, fi_axiom = axiom hang (text "type instance" <+> pprUserForAll (mkTyVarBinders Specified tvs) -- See Note [Printing foralls in type family instances] - -- in IfaceType + -- in GHC.Iface.Type <+> pprTypeApp (coAxiomTyCon axiom) lhs_tys) 2 (equals <+> ppr rhs) diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs deleted file mode 100644 index e94e0aaac0..0000000000 --- a/compiler/main/TidyPgm.hs +++ /dev/null @@ -1,1486 +0,0 @@ -{- -(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 - -\section{Tidying up Core} --} - -{-# LANGUAGE CPP, DeriveFunctor, ViewPatterns #-} - -module TidyPgm ( - mkBootModDetailsTc, tidyProgram - ) where - -#include "HsVersions.h" - -import GhcPrelude - -import TcRnTypes -import DynFlags -import CoreSyn -import CoreUnfold -import CoreFVs -import CoreTidy -import CoreMonad -import GHC.CoreToStg.Prep -import CoreUtils (rhsIsStatic) -import CoreStats (coreBindsStats, CoreStats(..)) -import CoreSeq (seqBinds) -import CoreLint -import Literal -import Rules -import PatSyn -import ConLike -import CoreArity ( exprArity, exprBotStrictness_maybe ) -import StaticPtrTable -import VarEnv -import VarSet -import Var -import Id -import MkId ( mkDictSelRhs ) -import IdInfo -import InstEnv -import Type ( tidyTopType ) -import Demand ( appIsBottom, isTopSig, isBottomingSig ) -import BasicTypes -import Name hiding (varName) -import NameSet -import NameCache -import Avail -import IfaceEnv -import TcEnv -import TcRnMonad -import DataCon -import TyCon -import Class -import Module -import Packages( isDllName ) -import HscTypes -import Maybes -import UniqSupply -import Outputable -import Util( filterOut ) -import qualified ErrUtils as Err - -import Control.Monad -import Data.Function -import Data.List ( sortBy, mapAccumL ) -import Data.IORef ( atomicModifyIORef' ) - -{- -Constructing the TypeEnv, Instances, Rules from which the -ModIface is constructed, and which goes on to subsequent modules in ---make mode. - -Most of the interface file is obtained simply by serialising the -TypeEnv. One important consequence is that if the *interface file* -has pragma info if and only if the final TypeEnv does. This is not so -important for *this* module, but it's essential for ghc --make: -subsequent compilations must not see (e.g.) the arity if the interface -file does not contain arity If they do, they'll exploit the arity; -then the arity might change, but the iface file doesn't change => -recompilation does not happen => disaster. - -For data types, the final TypeEnv will have a TyThing for the TyCon, -plus one for each DataCon; the interface file will contain just one -data type declaration, but it is de-serialised back into a collection -of TyThings. - -************************************************************************ -* * - Plan A: simpleTidyPgm -* * -************************************************************************ - - -Plan A: mkBootModDetails: omit pragmas, make interfaces small -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -* Ignore the bindings - -* Drop all WiredIn things from the TypeEnv - (we never want them in interface files) - -* Retain all TyCons and Classes in the TypeEnv, to avoid - having to find which ones are mentioned in the - types of exported Ids - -* Trim off the constructors of non-exported TyCons, both - from the TyCon and from the TypeEnv - -* Drop non-exported Ids from the TypeEnv - -* Tidy the types of the DFunIds of Instances, - make them into GlobalIds, (they already have External Names) - and add them to the TypeEnv - -* Tidy the types of the (exported) Ids in the TypeEnv, - make them into GlobalIds (they already have External Names) - -* Drop rules altogether - -* Tidy the bindings, to ensure that the Caf and Arity - information is correct for each top-level binder; the - code generator needs it. And to ensure that local names have - distinct OccNames in case of object-file splitting - -* If this an hsig file, drop the instances altogether too (they'll - get pulled in by the implicit module import. --} - --- This is Plan A: make a small type env when typechecking only, --- or when compiling a hs-boot file, or simply when not using -O --- --- We don't look at the bindings at all -- there aren't any --- for hs-boot files - -mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails -mkBootModDetailsTc hsc_env - TcGblEnv{ tcg_exports = exports, - tcg_type_env = type_env, -- just for the Ids - tcg_tcs = tcs, - tcg_patsyns = pat_syns, - tcg_insts = insts, - tcg_fam_insts = fam_insts, - tcg_complete_matches = complete_sigs, - tcg_mod = this_mod - } - = -- This timing isn't terribly useful since the result isn't forced, but - -- the message is useful to locating oneself in the compilation process. - Err.withTiming dflags - (text "CoreTidy"<+>brackets (ppr this_mod)) - (const ()) $ - return (ModDetails { md_types = type_env' - , md_insts = insts' - , md_fam_insts = fam_insts - , md_rules = [] - , md_anns = [] - , md_exports = exports - , md_complete_sigs = complete_sigs - }) - where - dflags = hsc_dflags hsc_env - - -- Find the LocalIds in the type env that are exported - -- Make them into GlobalIds, and tidy their types - -- - -- It's very important to remove the non-exported ones - -- because we don't tidy the OccNames, and if we don't remove - -- the non-exported ones we'll get many things with the - -- same name in the interface file, giving chaos. - -- - -- Do make sure that we keep Ids that are already Global. - -- When typechecking an .hs-boot file, the Ids come through as - -- GlobalIds. - final_ids = [ globaliseAndTidyBootId id - | id <- typeEnvIds type_env - , keep_it id ] - - final_tcs = filterOut isWiredIn tcs - -- See Note [Drop wired-in things] - type_env1 = typeEnvFromEntities final_ids final_tcs fam_insts - insts' = mkFinalClsInsts type_env1 insts - pat_syns' = mkFinalPatSyns type_env1 pat_syns - type_env' = extendTypeEnvWithPatSyns pat_syns' type_env1 - - -- Default methods have their export flag set (isExportedId), - -- but everything else doesn't (yet), because this is - -- pre-desugaring, so we must test against the exports too. - keep_it id | isWiredInName id_name = False - -- See Note [Drop wired-in things] - | isExportedId id = True - | id_name `elemNameSet` exp_names = True - | otherwise = False - where - id_name = idName id - - exp_names = availsToNameSet exports - -lookupFinalId :: TypeEnv -> Id -> Id -lookupFinalId type_env id - = case lookupTypeEnv type_env (idName id) of - Just (AnId id') -> id' - _ -> pprPanic "lookup_final_id" (ppr id) - -mkFinalClsInsts :: TypeEnv -> [ClsInst] -> [ClsInst] -mkFinalClsInsts env = map (updateClsInstDFun (lookupFinalId env)) - -mkFinalPatSyns :: TypeEnv -> [PatSyn] -> [PatSyn] -mkFinalPatSyns env = map (updatePatSynIds (lookupFinalId env)) - -extendTypeEnvWithPatSyns :: [PatSyn] -> TypeEnv -> TypeEnv -extendTypeEnvWithPatSyns tidy_patsyns type_env - = extendTypeEnvList type_env [AConLike (PatSynCon ps) | ps <- tidy_patsyns ] - -globaliseAndTidyBootId :: Id -> Id --- For a LocalId with an External Name, --- makes it into a GlobalId --- * unchanged Name (might be Internal or External) --- * unchanged details --- * VanillaIdInfo (makes a conservative assumption about Caf-hood and arity) --- * BootUnfolding (see Note [Inlining and hs-boot files] in ToIface) -globaliseAndTidyBootId id - = globaliseId id `setIdType` tidyTopType (idType id) - `setIdUnfolding` BootUnfolding - -{- -************************************************************************ -* * - Plan B: tidy bindings, make TypeEnv full of IdInfo -* * -************************************************************************ - -Plan B: include pragmas, make interfaces -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -* Step 1: Figure out which Ids are externally visible - See Note [Choosing external Ids] - -* Step 2: Gather the externally visible rules, separately from - the top-level bindings. - See Note [Finding external rules] - -* Step 3: Tidy the bindings, externalising appropriate Ids - See Note [Tidy the top-level bindings] - -* Drop all Ids from the TypeEnv, and add all the External Ids from - the bindings. (This adds their IdInfo to the TypeEnv; and adds - floated-out Ids that weren't even in the TypeEnv before.) - -Note [Choosing external Ids] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also the section "Interface stability" in the -recompilation-avoidance commentary: - https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance - -First we figure out which Ids are "external" Ids. An -"external" Id is one that is visible from outside the compilation -unit. These are - a) the user exported ones - b) the ones bound to static forms - c) ones mentioned in the unfoldings, workers, or - rules of externally-visible ones - -While figuring out which Ids are external, we pick a "tidy" OccName -for each one. That is, we make its OccName distinct from the other -external OccNames in this module, so that in interface files and -object code we can refer to it unambiguously by its OccName. The -OccName for each binder is prefixed by the name of the exported Id -that references it; e.g. if "f" references "x" in its unfolding, then -"x" is renamed to "f_x". This helps distinguish the different "x"s -from each other, and means that if "f" is later removed, things that -depend on the other "x"s will not need to be recompiled. Of course, -if there are multiple "f_x"s, then we have to disambiguate somehow; we -use "f_x0", "f_x1" etc. - -As far as possible we should assign names in a deterministic fashion. -Each time this module is compiled with the same options, we should end -up with the same set of external names with the same types. That is, -the ABI hash in the interface should not change. This turns out to be -quite tricky, since the order of the bindings going into the tidy -phase is already non-deterministic, as it is based on the ordering of -Uniques, which are assigned unpredictably. - -To name things in a stable way, we do a depth-first-search of the -bindings, starting from the exports sorted by name. This way, as long -as the bindings themselves are deterministic (they sometimes aren't!), -the order in which they are presented to the tidying phase does not -affect the names we assign. - -Note [Tidy the top-level bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Next we traverse the bindings top to bottom. For each *top-level* -binder - - 1. Make it into a GlobalId; its IdDetails becomes VanillaGlobal, - reflecting the fact that from now on we regard it as a global, - not local, Id - - 2. Give it a system-wide Unique. - [Even non-exported things need system-wide Uniques because the - byte-code generator builds a single Name->BCO symbol table.] - - We use the NameCache kept in the HscEnv as the - source of such system-wide uniques. - - For external Ids, use the original-name cache in the NameCache - to ensure that the unique assigned is the same as the Id had - in any previous compilation run. - - 3. Rename top-level Ids according to the names we chose in step 1. - If it's an external Id, make it have a External Name, otherwise - make it have an Internal Name. This is used by the code generator - to decide whether to make the label externally visible - - 4. Give it its UTTERLY FINAL IdInfo; in ptic, - * its unfolding, if it should have one - - * its arity, computed from the number of visible lambdas - - * its CAF info, computed from what is free in its RHS - - -Finally, substitute these new top-level binders consistently -throughout, including in unfoldings. We also tidy binders in -RHSs, so that they print nicely in interfaces. --} - -tidyProgram :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails) -tidyProgram hsc_env (ModGuts { mg_module = mod - , mg_exports = exports - , mg_rdr_env = rdr_env - , mg_tcs = tcs - , mg_insts = cls_insts - , mg_fam_insts = fam_insts - , mg_binds = binds - , mg_patsyns = patsyns - , mg_rules = imp_rules - , mg_anns = anns - , mg_complete_sigs = complete_sigs - , mg_deps = deps - , mg_foreign = foreign_stubs - , mg_foreign_files = foreign_files - , mg_hpc_info = hpc_info - , mg_modBreaks = modBreaks - }) - - = Err.withTiming dflags - (text "CoreTidy"<+>brackets (ppr mod)) - (const ()) $ - do { let { omit_prags = gopt Opt_OmitInterfacePragmas dflags - ; expose_all = gopt Opt_ExposeAllUnfoldings dflags - ; print_unqual = mkPrintUnqualified dflags rdr_env - ; implicit_binds = concatMap getImplicitBinds tcs - } - - ; (unfold_env, tidy_occ_env) - <- chooseExternalIds hsc_env mod omit_prags expose_all - binds implicit_binds imp_rules - ; let { (trimmed_binds, trimmed_rules) - = findExternalRules omit_prags binds imp_rules unfold_env } - - ; (tidy_env, tidy_binds) - <- tidyTopBinds hsc_env mod unfold_env tidy_occ_env trimmed_binds - - -- See Note [Grand plan for static forms] in StaticPtrTable. - ; (spt_entries, tidy_binds') <- - sptCreateStaticBinds hsc_env mod tidy_binds - ; let { spt_init_code = sptModuleInitCode mod spt_entries - ; add_spt_init_code = - case hscTarget dflags of - -- If we are compiling for the interpreter we will insert - -- any necessary SPT entries dynamically - HscInterpreted -> id - -- otherwise add a C stub to do so - _ -> (`appendStubC` spt_init_code) - - -- The completed type environment is gotten from - -- a) the types and classes defined here (plus implicit things) - -- b) adding Ids with correct IdInfo, including unfoldings, - -- gotten from the bindings - -- From (b) we keep only those Ids with External names; - -- the CoreTidy pass makes sure these are all and only - -- the externally-accessible ones - -- This truncates the type environment to include only the - -- exported Ids and things needed from them, which saves space - -- - -- See Note [Don't attempt to trim data types] - ; final_ids = [ if omit_prags then trimId id else id - | id <- bindersOfBinds tidy_binds - , isExternalName (idName id) - , not (isWiredIn id) - ] -- See Note [Drop wired-in things] - - ; final_tcs = filterOut isWiredIn tcs - -- See Note [Drop wired-in things] - ; type_env = typeEnvFromEntities final_ids final_tcs fam_insts - ; tidy_cls_insts = mkFinalClsInsts type_env cls_insts - ; tidy_patsyns = mkFinalPatSyns type_env patsyns - ; tidy_type_env = extendTypeEnvWithPatSyns tidy_patsyns type_env - ; tidy_rules = tidyRules tidy_env trimmed_rules - - ; -- See Note [Injecting implicit bindings] - all_tidy_binds = implicit_binds ++ tidy_binds' - - -- Get the TyCons to generate code for. Careful! We must use - -- the untidied TyCons here, because we need - -- (a) implicit TyCons arising from types and classes defined - -- in this module - -- (b) wired-in TyCons, which are normally removed from the - -- TypeEnv we put in the ModDetails - -- (c) Constructors even if they are not exported (the - -- tidied TypeEnv has trimmed these away) - ; alg_tycons = filter isAlgTyCon tcs - } - - ; endPassIO hsc_env print_unqual CoreTidy all_tidy_binds tidy_rules - - -- If the endPass didn't print the rules, but ddump-rules is - -- on, print now - ; unless (dopt Opt_D_dump_simpl dflags) $ - Err.dumpIfSet_dyn dflags Opt_D_dump_rules - (showSDoc dflags (ppr CoreTidy <+> text "rules")) - Err.FormatText - (pprRulesForUser dflags tidy_rules) - - -- Print one-line size info - ; let cs = coreBindsStats tidy_binds - ; Err.dumpIfSet_dyn dflags Opt_D_dump_core_stats "Core Stats" - Err.FormatText - (text "Tidy size (terms,types,coercions)" - <+> ppr (moduleName mod) <> colon - <+> int (cs_tm cs) - <+> int (cs_ty cs) - <+> int (cs_co cs) ) - - ; return (CgGuts { cg_module = mod, - cg_tycons = alg_tycons, - cg_binds = all_tidy_binds, - cg_foreign = add_spt_init_code foreign_stubs, - cg_foreign_files = foreign_files, - cg_dep_pkgs = map fst $ dep_pkgs deps, - cg_hpc_info = hpc_info, - cg_modBreaks = modBreaks, - cg_spt_entries = spt_entries }, - - ModDetails { md_types = tidy_type_env, - md_rules = tidy_rules, - md_insts = tidy_cls_insts, - md_fam_insts = fam_insts, - md_exports = exports, - md_anns = anns, -- are already tidy - md_complete_sigs = complete_sigs - }) - } - where - dflags = hsc_dflags hsc_env - --------------------------- -trimId :: Id -> Id -trimId id - | not (isImplicitId id) - = id `setIdInfo` vanillaIdInfo - | otherwise - = id - -{- Note [Drop wired-in things] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We never put wired-in TyCons or Ids in an interface file. -They are wired-in, so the compiler knows about them already. - -Note [Don't attempt to trim data types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For some time GHC tried to avoid exporting the data constructors -of a data type if it wasn't strictly necessary to do so; see #835. -But "strictly necessary" accumulated a longer and longer list -of exceptions, and finally I gave up the battle: - - commit 9a20e540754fc2af74c2e7392f2786a81d8d5f11 - Author: Simon Peyton Jones <simonpj@microsoft.com> - Date: Thu Dec 6 16:03:16 2012 +0000 - - Stop attempting to "trim" data types in interface files - - Without -O, we previously tried to make interface files smaller - by not including the data constructors of data types. But - there are a lot of exceptions, notably when Template Haskell is - involved or, more recently, DataKinds. - - However #7445 shows that even without TemplateHaskell, using - the Data class and invoking Language.Haskell.TH.Quote.dataToExpQ - is enough to require us to expose the data constructors. - - So I've given up on this "optimisation" -- it's probably not - important anyway. Now I'm simply not attempting to trim off - the data constructors. The gain in simplicity is worth the - modest cost in interface file growth, which is limited to the - bits reqd to describe those data constructors. - -************************************************************************ -* * - Implicit bindings -* * -************************************************************************ - -Note [Injecting implicit bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We inject the implicit bindings right at the end, in CoreTidy. -Some of these bindings, notably record selectors, are not -constructed in an optimised form. E.g. record selector for - data T = MkT { x :: {-# UNPACK #-} !Int } -Then the unfolding looks like - x = \t. case t of MkT x1 -> let x = I# x1 in x -This generates bad code unless it's first simplified a bit. That is -why CoreUnfold.mkImplicitUnfolding uses simpleOptExpr to do a bit of -optimisation first. (Only matters when the selector is used curried; -eg map x ys.) See #2070. - -[Oct 09: in fact, record selectors are no longer implicit Ids at all, -because we really do want to optimise them properly. They are treated -much like any other Id. But doing "light" optimisation on an implicit -Id still makes sense.] - -At one time I tried injecting the implicit bindings *early*, at the -beginning of SimplCore. But that gave rise to real difficulty, -because GlobalIds are supposed to have *fixed* IdInfo, but the -simplifier and other core-to-core passes mess with IdInfo all the -time. The straw that broke the camels back was when a class selector -got the wrong arity -- ie the simplifier gave it arity 2, whereas -importing modules were expecting it to have arity 1 (#2844). -It's much safer just to inject them right at the end, after tidying. - -Oh: two other reasons for injecting them late: - - - If implicit Ids are already in the bindings when we start TidyPgm, - we'd have to be careful not to treat them as external Ids (in - the sense of chooseExternalIds); else the Ids mentioned in *their* - RHSs will be treated as external and you get an interface file - saying a18 = <blah> - but nothing referring to a18 (because the implicit Id is the - one that does, and implicit Ids don't appear in interface files). - - - More seriously, the tidied type-envt will include the implicit - Id replete with a18 in its unfolding; but we won't take account - of a18 when computing a fingerprint for the class; result chaos. - -There is one sort of implicit binding that is injected still later, -namely those for data constructor workers. Reason (I think): it's -really just a code generation trick.... binding itself makes no sense. -See Note [Data constructor workers] in CorePrep. --} - -getImplicitBinds :: TyCon -> [CoreBind] -getImplicitBinds tc = cls_binds ++ getTyConImplicitBinds tc - where - cls_binds = maybe [] getClassImplicitBinds (tyConClass_maybe tc) - -getTyConImplicitBinds :: TyCon -> [CoreBind] -getTyConImplicitBinds tc - | isNewTyCon tc = [] -- See Note [Compulsory newtype unfolding] in MkId - | otherwise = map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc)) - -getClassImplicitBinds :: Class -> [CoreBind] -getClassImplicitBinds cls - = [ NonRec op (mkDictSelRhs cls val_index) - | (op, val_index) <- classAllSelIds cls `zip` [0..] ] - -get_defn :: Id -> CoreBind -get_defn id = NonRec id (unfoldingTemplate (realIdUnfolding id)) - -{- -************************************************************************ -* * -\subsection{Step 1: finding externals} -* * -************************************************************************ - -See Note [Choosing external Ids]. --} - -type UnfoldEnv = IdEnv (Name{-new name-}, Bool {-show unfolding-}) - -- Maps each top-level Id to its new Name (the Id is tidied in step 2) - -- The Unique is unchanged. If the new Name is external, it will be - -- visible in the interface file. - -- - -- Bool => expose unfolding or not. - -chooseExternalIds :: HscEnv - -> Module - -> Bool -> Bool - -> [CoreBind] - -> [CoreBind] - -> [CoreRule] - -> IO (UnfoldEnv, TidyOccEnv) - -- Step 1 from the notes above - -chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_rules - = do { (unfold_env1,occ_env1) <- search init_work_list emptyVarEnv init_occ_env - ; let internal_ids = filter (not . (`elemVarEnv` unfold_env1)) binders - ; tidy_internal internal_ids unfold_env1 occ_env1 } - where - nc_var = hsc_NC hsc_env - - -- init_ext_ids is the initial list of Ids that should be - -- externalised. It serves as the starting point for finding a - -- deterministic, tidy, renaming for all external Ids in this - -- module. - -- - -- It is sorted, so that it has a deterministic order (i.e. it's the - -- same list every time this module is compiled), in contrast to the - -- bindings, which are ordered non-deterministically. - init_work_list = zip init_ext_ids init_ext_ids - init_ext_ids = sortBy (compare `on` getOccName) $ filter is_external binders - - -- An Id should be external if either (a) it is exported, - -- (b) it appears in the RHS of a local rule for an imported Id, or - -- See Note [Which rules to expose] - is_external id = isExportedId id || id `elemVarSet` rule_rhs_vars - - rule_rhs_vars = mapUnionVarSet ruleRhsFreeVars imp_id_rules - - binders = map fst $ flattenBinds binds - implicit_binders = bindersOfBinds implicit_binds - binder_set = mkVarSet binders - - avoids = [getOccName name | bndr <- binders ++ implicit_binders, - let name = idName bndr, - isExternalName name ] - -- In computing our "avoids" list, we must include - -- all implicit Ids - -- all things with global names (assigned once and for - -- all by the renamer) - -- since their names are "taken". - -- The type environment is a convenient source of such things. - -- In particular, the set of binders doesn't include - -- implicit Ids at this stage. - - -- We also make sure to avoid any exported binders. Consider - -- f{-u1-} = 1 -- Local decl - -- ... - -- f{-u2-} = 2 -- Exported decl - -- - -- The second exported decl must 'get' the name 'f', so we - -- have to put 'f' in the avoids list before we get to the first - -- decl. tidyTopId then does a no-op on exported binders. - init_occ_env = initTidyOccEnv avoids - - - search :: [(Id,Id)] -- The work-list: (external id, referring id) - -- Make a tidy, external Name for the external id, - -- add it to the UnfoldEnv, and do the same for the - -- transitive closure of Ids it refers to - -- The referring id is used to generate a tidy - --- name for the external id - -> UnfoldEnv -- id -> (new Name, show_unfold) - -> TidyOccEnv -- occ env for choosing new Names - -> IO (UnfoldEnv, TidyOccEnv) - - search [] unfold_env occ_env = return (unfold_env, occ_env) - - search ((idocc,referrer) : rest) unfold_env occ_env - | idocc `elemVarEnv` unfold_env = search rest unfold_env occ_env - | otherwise = do - (occ_env', name') <- tidyTopName mod nc_var (Just referrer) occ_env idocc - let - (new_ids, show_unfold) - | omit_prags = ([], False) - | otherwise = addExternal expose_all refined_id - - -- 'idocc' is an *occurrence*, but we need to see the - -- unfolding in the *definition*; so look up in binder_set - refined_id = case lookupVarSet binder_set idocc of - Just id -> id - Nothing -> WARN( True, ppr idocc ) idocc - - unfold_env' = extendVarEnv unfold_env idocc (name',show_unfold) - referrer' | isExportedId refined_id = refined_id - | otherwise = referrer - -- - search (zip new_ids (repeat referrer') ++ rest) unfold_env' occ_env' - - tidy_internal :: [Id] -> UnfoldEnv -> TidyOccEnv - -> IO (UnfoldEnv, TidyOccEnv) - tidy_internal [] unfold_env occ_env = return (unfold_env,occ_env) - tidy_internal (id:ids) unfold_env occ_env = do - (occ_env', name') <- tidyTopName mod nc_var Nothing occ_env id - let unfold_env' = extendVarEnv unfold_env id (name',False) - tidy_internal ids unfold_env' occ_env' - -addExternal :: Bool -> Id -> ([Id], Bool) -addExternal expose_all id = (new_needed_ids, show_unfold) - where - new_needed_ids = bndrFvsInOrder show_unfold id - idinfo = idInfo id - show_unfold = show_unfolding (unfoldingInfo idinfo) - never_active = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo)) - loop_breaker = isStrongLoopBreaker (occInfo idinfo) - bottoming_fn = isBottomingSig (strictnessInfo idinfo) - - -- Stuff to do with the Id's unfolding - -- We leave the unfolding there even if there is a worker - -- In GHCi the unfolding is used by importers - - show_unfolding (CoreUnfolding { uf_src = src, uf_guidance = guidance }) - = expose_all -- 'expose_all' says to expose all - -- unfoldings willy-nilly - - || isStableSource src -- Always expose things whose - -- source is an inline rule - - || not (bottoming_fn -- No need to inline bottom functions - || never_active -- Or ones that say not to - || loop_breaker -- Or that are loop breakers - || neverUnfoldGuidance guidance) - show_unfolding (DFunUnfolding {}) = True - show_unfolding _ = False - -{- -************************************************************************ -* * - Deterministic free variables -* * -************************************************************************ - -We want a deterministic free-variable list. exprFreeVars gives us -a VarSet, which is in a non-deterministic order when converted to a -list. Hence, here we define a free-variable finder that returns -the free variables in the order that they are encountered. - -See Note [Choosing external Ids] --} - -bndrFvsInOrder :: Bool -> Id -> [Id] -bndrFvsInOrder show_unfold id - = run (dffvLetBndr show_unfold id) - -run :: DFFV () -> [Id] -run (DFFV m) = case m emptyVarSet (emptyVarSet, []) of - ((_,ids),_) -> ids - -newtype DFFV a - = DFFV (VarSet -- Envt: non-top-level things that are in scope - -- we don't want to record these as free vars - -> (VarSet, [Var]) -- Input State: (set, list) of free vars so far - -> ((VarSet,[Var]),a)) -- Output state - deriving (Functor) - -instance Applicative DFFV where - pure a = DFFV $ \_ st -> (st, a) - (<*>) = ap - -instance Monad DFFV where - (DFFV m) >>= k = DFFV $ \env st -> - case m env st of - (st',a) -> case k a of - DFFV f -> f env st' - -extendScope :: Var -> DFFV a -> DFFV a -extendScope v (DFFV f) = DFFV (\env st -> f (extendVarSet env v) st) - -extendScopeList :: [Var] -> DFFV a -> DFFV a -extendScopeList vs (DFFV f) = DFFV (\env st -> f (extendVarSetList env vs) st) - -insert :: Var -> DFFV () -insert v = DFFV $ \ env (set, ids) -> - let keep_me = isLocalId v && - not (v `elemVarSet` env) && - not (v `elemVarSet` set) - in if keep_me - then ((extendVarSet set v, v:ids), ()) - else ((set, ids), ()) - - -dffvExpr :: CoreExpr -> DFFV () -dffvExpr (Var v) = insert v -dffvExpr (App e1 e2) = dffvExpr e1 >> dffvExpr e2 -dffvExpr (Lam v e) = extendScope v (dffvExpr e) -dffvExpr (Tick (Breakpoint _ ids) e) = mapM_ insert ids >> dffvExpr e -dffvExpr (Tick _other e) = dffvExpr e -dffvExpr (Cast e _) = dffvExpr e -dffvExpr (Let (NonRec x r) e) = dffvBind (x,r) >> extendScope x (dffvExpr e) -dffvExpr (Let (Rec prs) e) = extendScopeList (map fst prs) $ - (mapM_ dffvBind prs >> dffvExpr e) -dffvExpr (Case e b _ as) = dffvExpr e >> extendScope b (mapM_ dffvAlt as) -dffvExpr _other = return () - -dffvAlt :: (t, [Var], CoreExpr) -> DFFV () -dffvAlt (_,xs,r) = extendScopeList xs (dffvExpr r) - -dffvBind :: (Id, CoreExpr) -> DFFV () -dffvBind(x,r) - | not (isId x) = dffvExpr r - | otherwise = dffvLetBndr False x >> dffvExpr r - -- Pass False because we are doing the RHS right here - -- If you say True you'll get *exponential* behaviour! - -dffvLetBndr :: Bool -> Id -> DFFV () --- Gather the free vars of the RULES and unfolding of a binder --- We always get the free vars of a *stable* unfolding, but --- for a *vanilla* one (InlineRhs), the flag controls what happens: --- True <=> get fvs of even a *vanilla* unfolding --- False <=> ignore an InlineRhs --- For nested bindings (call from dffvBind) we always say "False" because --- we are taking the fvs of the RHS anyway --- For top-level bindings (call from addExternal, via bndrFvsInOrder) --- we say "True" if we are exposing that unfolding -dffvLetBndr vanilla_unfold id - = do { go_unf (unfoldingInfo idinfo) - ; mapM_ go_rule (ruleInfoRules (ruleInfo idinfo)) } - where - idinfo = idInfo id - - go_unf (CoreUnfolding { uf_tmpl = rhs, uf_src = src }) - = case src of - InlineRhs | vanilla_unfold -> dffvExpr rhs - | otherwise -> return () - _ -> dffvExpr rhs - - go_unf (DFunUnfolding { df_bndrs = bndrs, df_args = args }) - = extendScopeList bndrs $ mapM_ dffvExpr args - go_unf _ = return () - - go_rule (BuiltinRule {}) = return () - go_rule (Rule { ru_bndrs = bndrs, ru_rhs = rhs }) - = extendScopeList bndrs (dffvExpr rhs) - -{- -************************************************************************ -* * - findExternalRules -* * -************************************************************************ - -Note [Finding external rules] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The complete rules are gotten by combining - a) local rules for imported Ids - b) rules embedded in the top-level Ids - -There are two complications: - * Note [Which rules to expose] - * Note [Trimming auto-rules] - -Note [Which rules to expose] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The function 'expose_rule' filters out rules that mention, on the LHS, -Ids that aren't externally visible; these rules can't fire in a client -module. - -The externally-visible binders are computed (by chooseExternalIds) -assuming that all orphan rules are externalised (see init_ext_ids in -function 'search'). So in fact it's a bit conservative and we may -export more than we need. (It's a sort of mutual recursion.) - -Note [Trimming auto-rules] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Second, with auto-specialisation we may specialise local or imported -dfuns or INLINE functions, and then later inline them. That may leave -behind something like - RULE "foo" forall d. f @ Int d = f_spec -where f is either local or imported, and there is no remaining -reference to f_spec except from the RULE. - -Now that RULE *might* be useful to an importing module, but that is -purely speculative, and meanwhile the code is taking up space and -codegen time. I found that binary sizes jumped by 6-10% when I -started to specialise INLINE functions (again, Note [Inline -specialisations] in Specialise). - -So it seems better to drop the binding for f_spec, and the rule -itself, if the auto-generated rule is the *only* reason that it is -being kept alive. - -(The RULE still might have been useful in the past; that is, it was -the right thing to have generated it in the first place. See Note -[Inline specialisations] in Specialise. But now it has served its -purpose, and can be discarded.) - -So findExternalRules does this: - * Remove all bindings that are kept alive *only* by isAutoRule rules - (this is done in trim_binds) - * Remove all auto rules that mention bindings that have been removed - (this is done by filtering by keep_rule) - -NB: if a binding is kept alive for some *other* reason (e.g. f_spec is -called in the final code), we keep the rule too. - -This stuff is the only reason for the ru_auto field in a Rule. --} - -findExternalRules :: Bool -- Omit pragmas - -> [CoreBind] - -> [CoreRule] -- Local rules for imported fns - -> UnfoldEnv -- Ids that are exported, so we need their rules - -> ([CoreBind], [CoreRule]) --- See Note [Finding external rules] -findExternalRules omit_prags binds imp_id_rules unfold_env - = (trimmed_binds, filter keep_rule all_rules) - where - imp_rules = filter expose_rule imp_id_rules - imp_user_rule_fvs = mapUnionVarSet user_rule_rhs_fvs imp_rules - - user_rule_rhs_fvs rule | isAutoRule rule = emptyVarSet - | otherwise = ruleRhsFreeVars rule - - (trimmed_binds, local_bndrs, _, all_rules) = trim_binds binds - - keep_rule rule = ruleFreeVars rule `subVarSet` local_bndrs - -- Remove rules that make no sense, because they mention a - -- local binder (on LHS or RHS) that we have now discarded. - -- (NB: ruleFreeVars only includes LocalIds) - -- - -- LHS: we have already filtered out rules that mention internal Ids - -- on LHS but that isn't enough because we might have by now - -- discarded a binding with an external Id. (How? - -- chooseExternalIds is a bit conservative.) - -- - -- RHS: the auto rules that might mention a binder that has - -- been discarded; see Note [Trimming auto-rules] - - expose_rule rule - | omit_prags = False - | otherwise = all is_external_id (ruleLhsFreeIdsList rule) - -- Don't expose a rule whose LHS mentions a locally-defined - -- Id that is completely internal (i.e. not visible to an - -- importing module). NB: ruleLhsFreeIds only returns LocalIds. - -- See Note [Which rules to expose] - - is_external_id id = case lookupVarEnv unfold_env id of - Just (name, _) -> isExternalName name - Nothing -> False - - trim_binds :: [CoreBind] - -> ( [CoreBind] -- Trimmed bindings - , VarSet -- Binders of those bindings - , VarSet -- Free vars of those bindings + rhs of user rules - -- (we don't bother to delete the binders) - , [CoreRule]) -- All rules, imported + from the bindings - -- This function removes unnecessary bindings, and gathers up rules from - -- the bindings we keep. See Note [Trimming auto-rules] - trim_binds [] -- Base case, start with imp_user_rule_fvs - = ([], emptyVarSet, imp_user_rule_fvs, imp_rules) - - trim_binds (bind:binds) - | any needed bndrs -- Keep binding - = ( bind : binds', bndr_set', needed_fvs', local_rules ++ rules ) - | otherwise -- Discard binding altogether - = stuff - where - stuff@(binds', bndr_set, needed_fvs, rules) - = trim_binds binds - needed bndr = isExportedId bndr || bndr `elemVarSet` needed_fvs - - bndrs = bindersOf bind - rhss = rhssOfBind bind - bndr_set' = bndr_set `extendVarSetList` bndrs - - needed_fvs' = needed_fvs `unionVarSet` - mapUnionVarSet idUnfoldingVars bndrs `unionVarSet` - -- Ignore type variables in the type of bndrs - mapUnionVarSet exprFreeVars rhss `unionVarSet` - mapUnionVarSet user_rule_rhs_fvs local_rules - -- In needed_fvs', we don't bother to delete binders from the fv set - - local_rules = [ rule - | id <- bndrs - , is_external_id id -- Only collect rules for external Ids - , rule <- idCoreRules id - , expose_rule rule ] -- and ones that can fire in a client - -{- -************************************************************************ -* * - tidyTopName -* * -************************************************************************ - -This is where we set names to local/global based on whether they really are -externally visible (see comment at the top of this module). If the name -was previously local, we have to give it a unique occurrence name if -we intend to externalise it. --} - -tidyTopName :: Module -> IORef NameCache -> Maybe Id -> TidyOccEnv - -> Id -> IO (TidyOccEnv, Name) -tidyTopName mod nc_var maybe_ref occ_env id - | global && internal = return (occ_env, localiseName name) - - | global && external = return (occ_env, name) - -- Global names are assumed to have been allocated by the renamer, - -- so they already have the "right" unique - -- And it's a system-wide unique too - - -- Now we get to the real reason that all this is in the IO Monad: - -- we have to update the name cache in a nice atomic fashion - - | local && internal = do { new_local_name <- atomicModifyIORef' nc_var mk_new_local - ; return (occ_env', new_local_name) } - -- Even local, internal names must get a unique occurrence, because - -- if we do -split-objs we externalise the name later, in the code generator - -- - -- Similarly, we must make sure it has a system-wide Unique, because - -- the byte-code generator builds a system-wide Name->BCO symbol table - - | local && external = do { new_external_name <- atomicModifyIORef' nc_var mk_new_external - ; return (occ_env', new_external_name) } - - | otherwise = panic "tidyTopName" - where - name = idName id - external = isJust maybe_ref - global = isExternalName name - local = not global - internal = not external - loc = nameSrcSpan name - - old_occ = nameOccName name - new_occ | Just ref <- maybe_ref - , ref /= id - = mkOccName (occNameSpace old_occ) $ - let - ref_str = occNameString (getOccName ref) - occ_str = occNameString old_occ - in - case occ_str of - '$':'w':_ -> occ_str - -- workers: the worker for a function already - -- includes the occname for its parent, so there's - -- no need to prepend the referrer. - _other | isSystemName name -> ref_str - | otherwise -> ref_str ++ '_' : occ_str - -- If this name was system-generated, then don't bother - -- to retain its OccName, just use the referrer. These - -- system-generated names will become "f1", "f2", etc. for - -- a referrer "f". - | otherwise = old_occ - - (occ_env', occ') = tidyOccName occ_env new_occ - - mk_new_local nc = (nc { nsUniqs = us }, mkInternalName uniq occ' loc) - where - (uniq, us) = takeUniqFromSupply (nsUniqs nc) - - mk_new_external nc = allocateGlobalBinder nc mod occ' loc - -- If we want to externalise a currently-local name, check - -- whether we have already assigned a unique for it. - -- If so, use it; if not, extend the table. - -- All this is done by allcoateGlobalBinder. - -- This is needed when *re*-compiling a module in GHCi; we must - -- use the same name for externally-visible things as we did before. - -{- -************************************************************************ -* * -\subsection{Step 2: top-level tidying} -* * -************************************************************************ --} - --- TopTidyEnv: when tidying we need to know --- * nc_var: The NameCache, containing a unique supply and any pre-ordained Names. --- These may have arisen because the --- renamer read in an interface file mentioning M.$wf, say, --- and assigned it unique r77. If, on this compilation, we've --- invented an Id whose name is $wf (but with a different unique) --- we want to rename it to have unique r77, so that we can do easy --- comparisons with stuff from the interface file --- --- * occ_env: The TidyOccEnv, which tells us which local occurrences --- are 'used' --- --- * subst_env: A Var->Var mapping that substitutes the new Var for the old - -tidyTopBinds :: HscEnv - -> Module - -> UnfoldEnv - -> TidyOccEnv - -> CoreProgram - -> IO (TidyEnv, CoreProgram) - -tidyTopBinds hsc_env this_mod unfold_env init_occ_env binds - = do mkIntegerId <- lookupMkIntegerName dflags hsc_env - mkNaturalId <- lookupMkNaturalName dflags hsc_env - integerSDataCon <- lookupIntegerSDataConName dflags hsc_env - naturalSDataCon <- lookupNaturalSDataConName dflags hsc_env - let cvt_literal nt i = case nt of - LitNumInteger -> Just (cvtLitInteger dflags mkIntegerId integerSDataCon i) - LitNumNatural -> Just (cvtLitNatural dflags mkNaturalId naturalSDataCon i) - _ -> Nothing - result = tidy cvt_literal init_env binds - seqBinds (snd result) `seq` return result - -- This seqBinds avoids a spike in space usage (see #13564) - where - dflags = hsc_dflags hsc_env - - init_env = (init_occ_env, emptyVarEnv) - - tidy cvt_literal = mapAccumL (tidyTopBind dflags this_mod cvt_literal unfold_env) - ------------------------- -tidyTopBind :: DynFlags - -> Module - -> (LitNumType -> Integer -> Maybe CoreExpr) - -> UnfoldEnv - -> TidyEnv - -> CoreBind - -> (TidyEnv, CoreBind) - -tidyTopBind dflags this_mod cvt_literal unfold_env - (occ_env,subst1) (NonRec bndr rhs) - = (tidy_env2, NonRec bndr' rhs') - where - Just (name',show_unfold) = lookupVarEnv unfold_env bndr - caf_info = hasCafRefs dflags this_mod - (subst1, cvt_literal) - (idArity bndr) rhs - (bndr', rhs') = tidyTopPair dflags show_unfold tidy_env2 caf_info name' - (bndr, rhs) - subst2 = extendVarEnv subst1 bndr bndr' - tidy_env2 = (occ_env, subst2) - -tidyTopBind dflags this_mod cvt_literal unfold_env - (occ_env, subst1) (Rec prs) - = (tidy_env2, Rec prs') - where - prs' = [ tidyTopPair dflags show_unfold tidy_env2 caf_info name' (id,rhs) - | (id,rhs) <- prs, - let (name',show_unfold) = - expectJust "tidyTopBind" $ lookupVarEnv unfold_env id - ] - - subst2 = extendVarEnvList subst1 (bndrs `zip` map fst prs') - tidy_env2 = (occ_env, subst2) - - bndrs = map fst prs - - -- the CafInfo for a recursive group says whether *any* rhs in - -- the group may refer indirectly to a CAF (because then, they all do). - caf_info - | or [ mayHaveCafRefs (hasCafRefs dflags this_mod - (subst1, cvt_literal) - (idArity bndr) rhs) - | (bndr,rhs) <- prs ] = MayHaveCafRefs - | otherwise = NoCafRefs - ------------------------------------------------------------ -tidyTopPair :: DynFlags - -> Bool -- show unfolding - -> TidyEnv -- The TidyEnv is used to tidy the IdInfo - -- It is knot-tied: don't look at it! - -> CafInfo - -> Name -- New name - -> (Id, CoreExpr) -- Binder and RHS before tidying - -> (Id, CoreExpr) - -- This function is the heart of Step 2 - -- The rec_tidy_env is the one to use for the IdInfo - -- It's necessary because when we are dealing with a recursive - -- group, a variable late in the group might be mentioned - -- in the IdInfo of one early in the group - -tidyTopPair dflags show_unfold rhs_tidy_env caf_info name' (bndr, rhs) - = (bndr1, rhs1) - where - bndr1 = mkGlobalId details name' ty' idinfo' - details = idDetails bndr -- Preserve the IdDetails - ty' = tidyTopType (idType bndr) - rhs1 = tidyExpr rhs_tidy_env rhs - idinfo' = tidyTopIdInfo dflags rhs_tidy_env name' rhs rhs1 (idInfo bndr) - show_unfold caf_info - --- tidyTopIdInfo creates the final IdInfo for top-level --- binders. There are two delicate pieces: --- --- * Arity. After CoreTidy, this arity must not change any more. --- Indeed, CorePrep must eta expand where necessary to make --- the manifest arity equal to the claimed arity. --- --- * CAF info. This must also remain valid through to code generation. --- We add the info here so that it propagates to all --- occurrences of the binders in RHSs, and hence to occurrences in --- unfoldings, which are inside Ids imported by GHCi. Ditto RULES. --- CoreToStg makes use of this when constructing SRTs. -tidyTopIdInfo :: DynFlags -> TidyEnv -> Name -> CoreExpr -> CoreExpr - -> IdInfo -> Bool -> CafInfo -> IdInfo -tidyTopIdInfo dflags rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold caf_info - | not is_external -- For internal Ids (not externally visible) - = vanillaIdInfo -- we only need enough info for code generation - -- Arity and strictness info are enough; - -- c.f. CoreTidy.tidyLetBndr - `setCafInfo` caf_info - `setArityInfo` arity - `setStrictnessInfo` final_sig - `setUnfoldingInfo` minimal_unfold_info -- See note [Preserve evaluatedness] - -- in CoreTidy - - | otherwise -- Externally-visible Ids get the whole lot - = vanillaIdInfo - `setCafInfo` caf_info - `setArityInfo` arity - `setStrictnessInfo` final_sig - `setOccInfo` robust_occ_info - `setInlinePragInfo` (inlinePragInfo idinfo) - `setUnfoldingInfo` unfold_info - -- NB: we throw away the Rules - -- They have already been extracted by findExternalRules - where - is_external = isExternalName name - - --------- OccInfo ------------ - robust_occ_info = zapFragileOcc (occInfo idinfo) - -- It's important to keep loop-breaker information - -- when we are doing -fexpose-all-unfoldings - - --------- Strictness ------------ - mb_bot_str = exprBotStrictness_maybe orig_rhs - - sig = strictnessInfo idinfo - final_sig | not $ isTopSig sig - = WARN( _bottom_hidden sig , ppr name ) sig - -- try a cheap-and-cheerful bottom analyser - | Just (_, nsig) <- mb_bot_str = nsig - | otherwise = sig - - _bottom_hidden id_sig = case mb_bot_str of - Nothing -> False - Just (arity, _) -> not (appIsBottom id_sig arity) - - --------- Unfolding ------------ - unf_info = unfoldingInfo idinfo - unfold_info | show_unfold = tidyUnfolding rhs_tidy_env unf_info unf_from_rhs - | otherwise = minimal_unfold_info - minimal_unfold_info = zapUnfolding unf_info - unf_from_rhs = mkTopUnfolding dflags is_bot tidy_rhs - is_bot = isBottomingSig final_sig - -- NB: do *not* expose the worker if show_unfold is off, - -- because that means this thing is a loop breaker or - -- marked NOINLINE or something like that - -- This is important: if you expose the worker for a loop-breaker - -- then you can make the simplifier go into an infinite loop, because - -- in effect the unfolding is exposed. See #1709 - -- - -- You might think that if show_unfold is False, then the thing should - -- not be w/w'd in the first place. But a legitimate reason is this: - -- the function returns bottom - -- In this case, show_unfold will be false (we don't expose unfoldings - -- for bottoming functions), but we might still have a worker/wrapper - -- split (see Note [Worker-wrapper for bottoming functions] in WorkWrap.hs - - - --------- Arity ------------ - -- Usually the Id will have an accurate arity on it, because - -- the simplifier has just run, but not always. - -- One case I found was when the last thing the simplifier - -- did was to let-bind a non-atomic argument and then float - -- it to the top level. So it seems more robust just to - -- fix it here. - arity = exprArity orig_rhs - -{- -************************************************************************ -* * - Figuring out CafInfo for an expression -* * -************************************************************************ - -hasCafRefs decides whether a top-level closure can point into the dynamic heap. -We mark such things as `MayHaveCafRefs' because this information is -used to decide whether a particular closure needs to be referenced -in an SRT or not. - -There are two reasons for setting MayHaveCafRefs: - a) The RHS is a CAF: a top-level updatable thunk. - b) The RHS refers to something that MayHaveCafRefs - -Possible improvement: In an effort to keep the number of CAFs (and -hence the size of the SRTs) down, we could also look at the expression and -decide whether it requires a small bounded amount of heap, so we can ignore -it as a CAF. In these cases however, we would need to use an additional -CAF list to keep track of non-collectable CAFs. - -Note [Disgusting computation of CafRefs] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We compute hasCafRefs here, because IdInfo is supposed to be finalised -after TidyPgm. But CorePrep does some transformations that affect CAF-hood. -So we have to *predict* the result here, which is revolting. - -In particular CorePrep expands Integer and Natural literals. So in the -prediction code here we resort to applying the same expansion (cvt_literal). -There are also numerous other ways in which we can introduce inconsistencies -between CorePrep and TidyPgm. See Note [CAFfyness inconsistencies due to eta -expansion in TidyPgm] for one such example. - -Ugh! What ugliness we hath wrought. - - -Note [CAFfyness inconsistencies due to eta expansion in TidyPgm] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Eta expansion during CorePrep can have non-obvious negative consequences on -the CAFfyness computation done by TidyPgm (see Note [Disgusting computation of -CafRefs] in TidyPgm). This late expansion happens/happened for a few reasons: - - * CorePrep previously eta expanded unsaturated primop applications, as - described in Note [Primop wrappers]). - - * CorePrep still does eta expand unsaturated data constructor applications. - -In particular, consider the program: - - data Ty = Ty (RealWorld# -> (# RealWorld#, Int #)) - - -- Is this CAFfy? - x :: STM Int - x = Ty (retry# @Int) - -Consider whether x is CAFfy. One might be tempted to answer "no". -Afterall, f obviously has no CAF references and the application (retry# -@Int) is essentially just a variable reference at runtime. - -However, when CorePrep expanded the unsaturated application of 'retry#' -it would rewrite this to - - x = \u [] - let sat = retry# @Int - in Ty sat - -This is now a CAF. Failing to handle this properly was the cause of -#16846. We fixed this by eliminating the need to eta expand primops, as -described in Note [Primop wrappers]), However we have not yet done the same for -data constructor applications. - --} - -type CafRefEnv = (VarEnv Id, LitNumType -> Integer -> Maybe CoreExpr) - -- The env finds the Caf-ness of the Id - -- The LitNumType -> Integer -> CoreExpr is the desugaring functions for - -- Integer and Natural literals - -- See Note [Disgusting computation of CafRefs] - -hasCafRefs :: DynFlags -> Module - -> CafRefEnv -> Arity -> CoreExpr - -> CafInfo -hasCafRefs dflags this_mod (subst, cvt_literal) arity expr - | is_caf || mentions_cafs = MayHaveCafRefs - | otherwise = NoCafRefs - where - mentions_cafs = cafRefsE expr - is_dynamic_name = isDllName dflags this_mod - is_caf = not (arity > 0 || rhsIsStatic (targetPlatform dflags) is_dynamic_name - cvt_literal expr) - - -- NB. we pass in the arity of the expression, which is expected - -- to be calculated by exprArity. This is because exprArity - -- knows how much eta expansion is going to be done by - -- CorePrep later on, and we don't want to duplicate that - -- knowledge in rhsIsStatic below. - - cafRefsE :: Expr a -> Bool - cafRefsE (Var id) = cafRefsV id - cafRefsE (Lit lit) = cafRefsL lit - cafRefsE (App f a) = cafRefsE f || cafRefsE a - cafRefsE (Lam _ e) = cafRefsE e - cafRefsE (Let b e) = cafRefsEs (rhssOfBind b) || cafRefsE e - cafRefsE (Case e _ _ alts) = cafRefsE e || cafRefsEs (rhssOfAlts alts) - cafRefsE (Tick _n e) = cafRefsE e - cafRefsE (Cast e _co) = cafRefsE e - cafRefsE (Type _) = False - cafRefsE (Coercion _) = False - - cafRefsEs :: [Expr a] -> Bool - cafRefsEs [] = False - cafRefsEs (e:es) = cafRefsE e || cafRefsEs es - - cafRefsL :: Literal -> Bool - -- Don't forget that mk_integer id might have Caf refs! - -- We first need to convert the Integer into its final form, to - -- see whether mkInteger is used. Same for LitNatural. - cafRefsL (LitNumber nt i _) = case cvt_literal nt i of - Just e -> cafRefsE e - Nothing -> False - cafRefsL _ = False - - cafRefsV :: Id -> Bool - cafRefsV id - | not (isLocalId id) = mayHaveCafRefs (idCafInfo id) - | Just id' <- lookupVarEnv subst id = mayHaveCafRefs (idCafInfo id') - | otherwise = False - - -{- -************************************************************************ -* * - Old, dead, type-trimming code -* * -************************************************************************ - -We used to try to "trim off" the constructors of data types that are -not exported, to reduce the size of interface files, at least without --O. But that is not always possible: see the old Note [When we can't -trim types] below for exceptions. - -Then (#7445) I realised that the TH problem arises for any data type -that we have deriving( Data ), because we can invoke - Language.Haskell.TH.Quote.dataToExpQ -to get a TH Exp representation of a value built from that data type. -You don't even need {-# LANGUAGE TemplateHaskell #-}. - -At this point I give up. The pain of trimming constructors just -doesn't seem worth the gain. So I've dumped all the code, and am just -leaving it here at the end of the module in case something like this -is ever resurrected. - - -Note [When we can't trim types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The basic idea of type trimming is to export algebraic data types -abstractly (without their data constructors) when compiling without --O, unless of course they are explicitly exported by the user. - -We always export synonyms, because they can be mentioned in the type -of an exported Id. We could do a full dependency analysis starting -from the explicit exports, but that's quite painful, and not done for -now. - -But there are some times we can't do that, indicated by the 'no_trim_types' flag. - -First, Template Haskell. Consider (#2386) this - module M(T, makeOne) where - data T = Yay String - makeOne = [| Yay "Yep" |] -Notice that T is exported abstractly, but makeOne effectively exports it too! -A module that splices in $(makeOne) will then look for a declaration of Yay, -so it'd better be there. Hence, brutally but simply, we switch off type -constructor trimming if TH is enabled in this module. - -Second, data kinds. Consider (#5912) - {-# LANGUAGE DataKinds #-} - module M() where - data UnaryTypeC a = UnaryDataC a - type Bug = 'UnaryDataC -We always export synonyms, so Bug is exposed, and that means that -UnaryTypeC must be too, even though it's not explicitly exported. In -effect, DataKinds means that we'd need to do a full dependency analysis -to see what data constructors are mentioned. But we don't do that yet. - -In these two cases we just switch off type trimming altogether. - -mustExposeTyCon :: Bool -- Type-trimming flag - -> NameSet -- Exports - -> TyCon -- The tycon - -> Bool -- Can its rep be hidden? --- 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 whose constructors or fields are exported -mustExposeTyCon no_trim_types exports tc - | no_trim_types -- See Note [When we can't trim types] - = True - - | not (isAlgTyCon tc) -- Always expose synonyms (otherwise we'd have to - -- figure out whether it was mentioned in the type - -- of any other exported thing) - = True - - | isEnumerationTyCon tc -- For an enumeration, exposing the constructors - = True -- won't lead to the need for further exposure - - | isFamilyTyCon tc -- Open type family - = True - - -- Below here we just have data/newtype decls or family instances - - | null data_cons -- Ditto if there are no data constructors - = True -- (NB: empty data types do not count as enumerations - -- see Note [Enumeration types] in TyCon - - | any exported_con data_cons -- Expose rep if any datacon or field is exported - = True - - | isNewTyCon tc && isFFITy (snd (newTyConRhs tc)) - = True -- 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 - - | otherwise - = False - where - data_cons = tyConDataCons tc - exported_con con = any (`elemNameSet` exports) - (dataConName con : dataConFieldLabels con) --} |