diff options
Diffstat (limited to 'compiler')
92 files changed, 342 insertions, 324 deletions
diff --git a/compiler/iface/ToIface.hs b/compiler/GHC/CoreToIface.hs index d32a0529af..65d0da34af 100644 --- a/compiler/iface/ToIface.hs +++ b/compiler/GHC/CoreToIface.hs @@ -2,7 +2,7 @@ {-# LANGUAGE Strict #-} -- See Note [Avoiding space leaks in toIface*] -- | Functions for converting Core things to interface file things. -module ToIface +module GHC.CoreToIface ( -- * Binders toIfaceTvBndr , toIfaceTvBndrs @@ -47,7 +47,7 @@ module ToIface import GhcPrelude -import IfaceSyn +import GHC.Iface.Syntax import DataCon import Id import IdInfo @@ -86,8 +86,9 @@ after code gen has run, in which case we might carry megabytes of core AST in the heap which is no longer needed. We avoid this in two ways. -* First we use -XStrict in ToIface which avoids many thunks to begin with. -* Second we define NFData instance for IFaceSyn and use them to +* First we use -XStrict in GHC.CoreToIface which avoids many thunks + to begin with. +* Second we define NFData instance for Iface syntax and use them to force any remaining thunks. -XStrict is not sufficient as patterns of the form `f (g x)` would still @@ -156,13 +157,13 @@ toIfaceTypeX :: VarSet -> Type -> IfaceType -- translates the tyvars in 'free' as IfaceFreeTyVars -- -- Synonyms are retained in the interface type -toIfaceTypeX fr (TyVarTy tv) -- See Note [TcTyVars in IfaceType] in IfaceType +toIfaceTypeX fr (TyVarTy tv) -- See Note [TcTyVars in IfaceType] in GHC.Iface.Type | tv `elemVarSet` fr = IfaceFreeTyVar tv | otherwise = IfaceTyVar (toIfaceTyVar tv) toIfaceTypeX fr ty@(AppTy {}) = -- Flatten as many argument AppTys as possible, then turn them into an -- IfaceAppArgs list. - -- See Note [Suppressing invisible arguments] in IfaceType. + -- See Note [Suppressing invisible arguments] in GHC.Iface.Type. let (head, args) = splitAppTys ty in IfaceAppTy (toIfaceTypeX fr head) (toIfaceAppTyArgsX fr head args) toIfaceTypeX _ (LitTy n) = IfaceLitTy (toIfaceTyLit n) @@ -268,7 +269,7 @@ toIfaceCoercionX fr co go (Refl ty) = IfaceReflCo (toIfaceTypeX fr ty) go (GRefl r ty mco) = IfaceGReflCo r (toIfaceTypeX fr ty) (go_mco mco) go (CoVarCo cv) - -- See [TcTyVars in IfaceType] in IfaceType + -- See [TcTyVars in IfaceType] in GHC.Iface.Type | cv `elemVarSet` fr = IfaceFreeCoVar cv | otherwise = IfaceCoVarCo (toIfaceCoVar cv) go (HoleCo h) = IfaceHoleCo (coHoleCoVar h) @@ -314,7 +315,7 @@ toIfaceAppTyArgsX :: VarSet -> Type -> [Type] -> IfaceAppArgs toIfaceAppTyArgsX fr ty ty_args = toIfaceAppArgsX fr (typeKind ty) ty_args toIfaceAppArgsX :: VarSet -> Kind -> [Type] -> IfaceAppArgs --- See Note [Suppressing invisible arguments] in IfaceType +-- See Note [Suppressing invisible arguments] in GHC.Iface.Type -- We produce a result list of args describing visibility -- The awkward case is -- T :: forall k. * -> k @@ -422,7 +423,7 @@ toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id)) (toIfaceIdInfo (idInfo id)) (toIfaceJoinInfo (isJoinId_maybe id)) -- Put into the interface file any IdInfo that CoreTidy.tidyLetBndr - -- has left on the Id. See Note [IdInfo on nested let-bindings] in IfaceSyn + -- has left on the Id. See Note [IdInfo on nested let-bindings] in GHC.Iface.Syntax toIfaceIdDetails :: IdDetails -> IfaceIdDetails toIfaceIdDetails VanillaId = IfVanillaId @@ -446,7 +447,7 @@ toIfaceIdInfo id_info [] -> NoInfo infos -> HasInfo infos -- NB: strictness and arity must appear in the list before unfolding - -- See TcIface.tcUnfolding + -- See GHC.IfaceToCore.tcUnfolding where ------------ Arity -------------- arity_info = arityInfo id_info @@ -497,7 +498,7 @@ toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs InlineCompulsory -> IfCompulsory if_rhs InlineRhs -> IfCoreUnfold False if_rhs -- Yes, even if guidance is UnfNever, expose the unfolding - -- If we didn't want to expose the unfolding, TidyPgm would + -- If we didn't want to expose the unfolding, GHC.Iface.Tidy would -- have stuck in NoUnfolding. For supercompilation we want -- to see that unfolding! where diff --git a/compiler/iface/ToIface.hs-boot b/compiler/GHC/CoreToIface.hs-boot index 38b6dbcd15..24fb1a148b 100644 --- a/compiler/iface/ToIface.hs-boot +++ b/compiler/GHC/CoreToIface.hs-boot @@ -1,8 +1,8 @@ -module ToIface where +module GHC.CoreToIface where import {-# SOURCE #-} TyCoRep ( Type, TyLit, Coercion ) -import {-# SOURCE #-} IfaceType( IfaceType, IfaceTyCon, IfaceForAllBndr - , IfaceCoercion, IfaceTyLit, IfaceAppArgs ) +import {-# SOURCE #-} GHC.Iface.Type( IfaceType, IfaceTyCon, IfaceForAllBndr + , IfaceCoercion, IfaceTyLit, IfaceAppArgs ) import Var ( TyCoVarBinder ) import VarEnv ( TidyEnv ) import TyCon ( TyCon ) diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs index ea020c5f9e..1512ab3842 100644 --- a/compiler/GHC/CoreToStg/Prep.hs +++ b/compiler/GHC/CoreToStg/Prep.hs @@ -228,7 +228,7 @@ corePrepTopBinds initialCorePrepEnv binds mkDataConWorkers :: DynFlags -> ModLocation -> [TyCon] -> [CoreBind] -- See Note [Data constructor workers] --- c.f. Note [Injecting implicit bindings] in TidyPgm +-- c.f. Note [Injecting implicit bindings] in GHC.Iface.Tidy mkDataConWorkers dflags mod_loc data_tycons = [ NonRec id (tick_it (getName data_con) (Var id)) -- The ice is thin here, but it works @@ -1070,8 +1070,8 @@ unsaturated applications (identified by 'hasNoBinding', currently just foreign calls and unboxed tuple/sum constructors). Note that eta expansion in CorePrep is very fragile due to the "prediction" of -CAFfyness made by TidyPgm (see Note [CAFfyness inconsistencies due to eta -expansion in CorePrep] in TidyPgm for details. We previously saturated primop +CAFfyness made during tidying (see Note [CAFfyness inconsistencies due to eta +expansion in CorePrep] in GHC.Iface.Tidy for details. We previously saturated primop applications here as well but due to this fragility (see #16846) we now deal with this another way, as described in Note [Primop wrappers] in PrimOp. diff --git a/compiler/GHC/Hs/Types.hs b/compiler/GHC/Hs/Types.hs index 324b1dd3d2..46cc1ecb24 100644 --- a/compiler/GHC/Hs/Types.hs +++ b/compiler/GHC/Hs/Types.hs @@ -1686,7 +1686,7 @@ hsTypeNeedsParens p = go maybeAddSpace :: [LHsType pass] -> SDoc -> SDoc -- See Note [Printing promoted type constructors] --- in IfaceType. This code implements the same +-- in GHC.Iface.Type. This code implements the same -- logic for printing HsType maybeAddSpace tys doc | (ty : _) <- tys diff --git a/compiler/iface/BinIface.hs b/compiler/GHC/Iface/Binary.hs index faee723bd2..af0e9bfac6 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/GHC/Iface/Binary.hs @@ -9,7 +9,7 @@ -- compiler is severely affected -- | Binary interface file support. -module BinIface ( +module GHC.Iface.Binary ( -- * Public API for interface file serialisation writeBinIface, readBinIface, @@ -37,7 +37,7 @@ import GhcPrelude import TcRnMonad import PrelInfo ( isKnownKeyName, lookupKnownKeyName ) -import IfaceEnv +import GHC.Iface.Env import HscTypes import Module import Name diff --git a/compiler/iface/IfaceEnv.hs b/compiler/GHC/Iface/Env.hs index 2bcfa82c96..fcb1e2dcfb 100644 --- a/compiler/iface/IfaceEnv.hs +++ b/compiler/GHC/Iface/Env.hs @@ -2,7 +2,7 @@ {-# LANGUAGE CPP, RankNTypes, BangPatterns #-} -module IfaceEnv ( +module GHC.Iface.Env ( newGlobalBinder, newInteractiveBinder, externaliseName, lookupIfaceTop, @@ -33,7 +33,7 @@ import Avail import Module import FastString import FastStringEnv -import IfaceType +import GHC.Iface.Type import NameCache import UniqSupply import SrcLoc @@ -149,7 +149,7 @@ updNameCacheIO hsc_env mod occ upd_fn = do { -- we read the name-cache -- then pull on mod (say) -- which does some stuff that modifies the name cache - -- This did happen, with tycon_mod in TcIface.tcIfaceAlt (DataAlt..) + -- This did happen, with tycon_mod in GHC.IfaceToCore.tcIfaceAlt (DataAlt..) mod `seq` occ `seq` return () ; updNameCache (hsc_NC hsc_env) upd_fn } diff --git a/compiler/iface/IfaceEnv.hs-boot b/compiler/GHC/Iface/Env.hs-boot index 025c3711a0..2c326ab0ad 100644 --- a/compiler/iface/IfaceEnv.hs-boot +++ b/compiler/GHC/Iface/Env.hs-boot @@ -1,4 +1,4 @@ -module IfaceEnv where +module GHC.Iface.Env where import Module import OccName diff --git a/compiler/hieFile/HieAst.hs b/compiler/GHC/Iface/Ext/Ast.hs index e77dcd3768..03ccc6bdd4 100644 --- a/compiler/hieFile/HieAst.hs +++ b/compiler/GHC/Iface/Ext/Ast.hs @@ -12,7 +12,7 @@ Main functions for .hie file generation {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} -module HieAst ( mkHieFile ) where +module GHC.Iface.Ext.Ast ( mkHieFile ) where import GhcPrelude @@ -37,11 +37,11 @@ import Type ( mkVisFunTys, Type ) import TysWiredIn ( mkListTy, mkSumTy ) import Var ( Id, Var, setVarName, varName, varType ) import TcRnTypes -import MkIface ( mkIfaceExports ) +import GHC.Iface.Utils ( mkIfaceExports ) import Panic -import HieTypes -import HieUtils +import GHC.Iface.Ext.Types +import GHC.Iface.Ext.Utils import qualified Data.Array as A import qualified Data.ByteString as BS @@ -81,7 +81,7 @@ instance ToHie (IEContext (Located ModuleName)) where ... data Context a = C ContextInfo a -- Used for names and bindings -`ContextInfo` is defined in `HieTypes`, and looks like +`ContextInfo` is defined in `GHC.Iface.Ext.Types`, and looks like data ContextInfo = Use -- ^ regular variable @@ -112,7 +112,7 @@ provide a `Scope` and a `Span` for your binding. Both of these are basically The `SrcSpan` in the `Scope` is supposed to span over the part of the source where the symbol can be legally allowed to occur. For more details on how to calculate this, see Note [Capturing Scopes and other non local information] -in HieAst. +in GHC.Iface.Ext.Ast. The binding `Span` is supposed to be the span of the entire binding for the name. diff --git a/compiler/hieFile/HieBin.hs b/compiler/GHC/Iface/Ext/Binary.hs index 866c0f007f..91fe256cc8 100644 --- a/compiler/hieFile/HieBin.hs +++ b/compiler/GHC/Iface/Ext/Binary.hs @@ -2,14 +2,25 @@ Binary serialization for .hie files. -} {-# LANGUAGE ScopedTypeVariables #-} -module HieBin ( readHieFile, readHieFileWithVersion, HieHeader, writeHieFile, HieName(..), toHieName, HieFileResult(..), hieMagic, hieNameOcc) where +module GHC.Iface.Ext.Binary + ( readHieFile + , readHieFileWithVersion + , HieHeader + , writeHieFile + , HieName(..) + , toHieName + , HieFileResult(..) + , hieMagic + , hieNameOcc + ) +where import GHC.Settings ( maybeRead ) import Config ( cProjectVersion ) import GhcPrelude import Binary -import BinIface ( getDictFastString ) +import GHC.Iface.Binary ( getDictFastString ) import FastMutInt import FastString ( FastString ) import Module ( Module ) @@ -33,7 +44,7 @@ import Control.Monad ( replicateM, when ) import System.Directory ( createDirectoryIfMissing ) import System.FilePath ( takeDirectory ) -import HieTypes +import GHC.Iface.Ext.Types -- | `Name`'s get converted into `HieName`'s before being written into @.hie@ -- files. See 'toHieName' and 'fromHieName' for logic on how to convert between @@ -389,4 +400,4 @@ getHieName bh = do 2 -> do (c,i) <- get bh return $ KnownKeyName $ mkUnique c i - _ -> panic "HieBin.getHieName: invalid tag" + _ -> panic "GHC.Iface.Ext.Binary.getHieName: invalid tag" diff --git a/compiler/hieFile/HieDebug.hs b/compiler/GHC/Iface/Ext/Debug.hs index 855b89861e..25cc940834 100644 --- a/compiler/hieFile/HieDebug.hs +++ b/compiler/GHC/Iface/Ext/Debug.hs @@ -4,7 +4,8 @@ Functions to validate and check .hie file ASTs generated by GHC. {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} -module HieDebug where + +module GHC.Iface.Ext.Debug where import GhcPrelude @@ -13,9 +14,9 @@ import Module import FastString import Outputable -import HieTypes -import HieBin -import HieUtils +import GHC.Iface.Ext.Types +import GHC.Iface.Ext.Binary +import GHC.Iface.Ext.Utils import Name import qualified Data.Map as M diff --git a/compiler/hieFile/HieTypes.hs b/compiler/GHC/Iface/Ext/Types.hs index 7f500a7453..e56864bc04 100644 --- a/compiler/hieFile/HieTypes.hs +++ b/compiler/GHC/Iface/Ext/Types.hs @@ -8,14 +8,14 @@ For more information see https://gitlab.haskell.org/ghc/ghc/wikis/hie-files {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} -module HieTypes where +module GHC.Iface.Ext.Types where import GhcPrelude import Config import Binary import FastString ( FastString ) -import IfaceType +import GHC.Iface.Type import Module ( ModuleName, Module ) import Name ( Name ) import Outputable hiding ( (<>) ) diff --git a/compiler/hieFile/HieUtils.hs b/compiler/GHC/Iface/Ext/Utils.hs index 9231317bd0..b0d71f34b4 100644 --- a/compiler/hieFile/HieUtils.hs +++ b/compiler/GHC/Iface/Ext/Utils.hs @@ -2,25 +2,25 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} -module HieUtils where +module GHC.Iface.Ext.Utils where import GhcPrelude import CoreMap import DynFlags ( DynFlags ) import FastString ( FastString, mkFastString ) -import IfaceType +import GHC.Iface.Type import Name hiding (varName) import Outputable ( renderWithStyle, ppr, defaultUserStyle ) import SrcLoc -import ToIface +import GHC.CoreToIface import TyCon import TyCoRep import Type import Var import VarEnv -import HieTypes +import GHC.Iface.Ext.Types import qualified Data.Map as M import qualified Data.Set as S diff --git a/compiler/iface/LoadIface.hs b/compiler/GHC/Iface/Load.hs index 176b6cd0d0..77eefc4c7b 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/GHC/Iface/Load.hs @@ -9,7 +9,7 @@ Loading interface files {-# LANGUAGE CPP, BangPatterns, RecordWildCards, NondecreasingIndentation #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module LoadIface ( +module GHC.Iface.Load ( -- Importing one thing tcLookupImported_maybe, importDecl, checkWiredInTyCon, ifCheckWiredInThing, @@ -23,7 +23,7 @@ module LoadIface ( loadInterface, loadSysInterface, loadUserInterface, loadPluginInterface, findAndReadIface, readIface, -- Used when reading the module's old interface - loadDecls, -- Should move to TcIface and be renamed + loadDecls, -- Should move to GHC.IfaceToCore and be renamed initExternalPackageState, moduleFreeHolesPrecise, needWiredInHomeIface, loadWiredInHomeIface, @@ -36,13 +36,13 @@ module LoadIface ( import GhcPrelude -import {-# SOURCE #-} TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst, - tcIfaceFamInst, - tcIfaceAnnotations, tcIfaceCompleteSigs ) +import {-# SOURCE #-} GHC.IfaceToCore + ( tcIfaceDecl, tcIfaceRules, tcIfaceInst, tcIfaceFamInst + , tcIfaceAnnotations, tcIfaceCompleteSigs ) import DynFlags -import IfaceSyn -import IfaceEnv +import GHC.Iface.Syntax +import GHC.Iface.Env import HscTypes import BasicTypes hiding (SuccessFlag(..)) @@ -69,14 +69,14 @@ import Finder import UniqFM import SrcLoc import Outputable -import BinIface +import GHC.Iface.Binary import Panic import Util import FastString import Fingerprint import Hooks import FieldLabel -import RnModIface +import GHC.Iface.Rename import UniqDSet import Plugins @@ -187,8 +187,8 @@ for any module with an instance decl or RULE that we might want. * BUT, if the TyCon is a wired-in TyCon, we don't really need its interface; but we must make sure we read its interface in case it has instances or - rules. That is what LoadIface.loadWiredInHomeIface does. It's called - from TcIface.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing} + rules. That is what GHC.Iface.Load.loadWiredInHomeIface does. It's called + from GHC.IfaceToCore.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing} * HOWEVER, only do this for TyCons. There are no wired-in Classes. There are some wired-in Ids, but we don't want to load their interfaces. For @@ -486,7 +486,7 @@ loadInterface doc_str mod from -- Warn warn against an EPS-updating import -- of one's own boot file! (one-shot only) -- See Note [Loading your own hi-boot file] - -- in MkIface. + -- in GHC.Iface.Utils. ; WARN( bad_boot, ppr mod ) updateEps_ $ \ eps -> @@ -535,7 +535,7 @@ loadInterface doc_str mod from Generally speaking, when compiling module M, we should not load M.hi boot into the EPS. After all, we are very shortly going to have full information about M. Moreover, see -Note [Do not update EPS with your own hi-boot] in MkIface. +Note [Do not update EPS with your own hi-boot] in GHC.Iface.Utils. But there is a HORRIBLE HACK here. diff --git a/compiler/iface/LoadIface.hs-boot b/compiler/GHC/Iface/Load.hs-boot index ff2b3efb1a..e3dce1d68f 100644 --- a/compiler/iface/LoadIface.hs-boot +++ b/compiler/GHC/Iface/Load.hs-boot @@ -1,4 +1,5 @@ -module LoadIface where +module GHC.Iface.Load where + import Module (Module) import TcRnMonad (IfM) import HscTypes (ModIface) diff --git a/compiler/backpack/RnModIface.hs b/compiler/GHC/Iface/Rename.hs index af24fcced7..94a7dbc06e 100644 --- a/compiler/backpack/RnModIface.hs +++ b/compiler/GHC/Iface/Rename.hs @@ -6,7 +6,7 @@ -- are doing indefinite typechecking and need instantiations -- of modules which do not necessarily exist yet. -module RnModIface( +module GHC.Iface.Rename ( rnModIface, rnModExports, tcRnModIface, @@ -23,7 +23,7 @@ import HscTypes import Module import UniqFM import Avail -import IfaceSyn +import GHC.Iface.Syntax import FieldLabel import Var import ErrUtils @@ -35,7 +35,7 @@ import Fingerprint import BasicTypes -- a bit vexing -import {-# SOURCE #-} LoadIface +import {-# SOURCE #-} GHC.Iface.Load import DynFlags import qualified Data.Traversable as T @@ -43,7 +43,7 @@ import qualified Data.Traversable as T import Bag import Data.IORef import NameShape -import IfaceEnv +import GHC.Iface.Env tcRnMsgMaybe :: IO (Either ErrorMessages a) -> TcM a tcRnMsgMaybe do_this = do diff --git a/compiler/iface/IfaceSyn.hs b/compiler/GHC/Iface/Syntax.hs index 78eb3ea271..723401cb7e 100644 --- a/compiler/iface/IfaceSyn.hs +++ b/compiler/GHC/Iface/Syntax.hs @@ -6,8 +6,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} -module IfaceSyn ( - module IfaceType, +module GHC.Iface.Syntax ( + module GHC.Iface.Type, IfaceDecl(..), IfaceFamTyConFlav(..), IfaceClassOp(..), IfaceAT(..), IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec, @@ -44,7 +44,7 @@ module IfaceSyn ( import GhcPrelude -import IfaceType +import GHC.Iface.Type import BinFingerprint import CoreSyn( IsOrphan, isOrphan ) import DynFlags( gopt, GeneralFlag (Opt_PrintAxiomIncomps) ) @@ -90,8 +90,8 @@ infixl 3 &&& -- | A binding top-level 'Name' in an interface file (e.g. the name of an -- 'IfaceDecl'). type IfaceTopBndr = Name - -- It's convenient to have a Name in the IfaceSyn, although in each - -- case the namespace is implied by the context. However, having an + -- It's convenient to have a Name in the Iface syntax, although in each + -- case the namespace is implied by the context. However, having a -- Name makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints -- very convenient. Moreover, having the key of the binder means that -- we can encode known-key things cleverly in the symbol table. See Note @@ -187,8 +187,8 @@ data IfaceTyConParent = IfNoParent | IfDataInstance IfExtName -- Axiom name - IfaceTyCon -- Family TyCon (pretty-printing only, not used in TcIface) - -- see Note [Pretty printing via IfaceSyn] in PprTyThing + IfaceTyCon -- Family TyCon (pretty-printing only, not used in GHC.IfaceToCore) + -- see Note [Pretty printing via Iface syntax] in PprTyThing IfaceAppArgs -- Arguments of the family TyCon data IfaceFamTyConFlav @@ -197,7 +197,7 @@ data IfaceFamTyConFlav | IfaceClosedSynFamilyTyCon (Maybe (IfExtName, [IfaceAxBranch])) -- ^ Name of associated axiom and branches for pretty printing purposes, -- or 'Nothing' for an empty closed family without an axiom - -- See Note [Pretty printing via IfaceSyn] in PprTyThing + -- See Note [Pretty printing via Iface syntax] in PprTyThing | IfaceAbstractClosedSynFamilyTyCon | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only @@ -405,7 +405,7 @@ ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName] -- N.B. the set of names returned here *must* match the set of -- TyThings returned by HscTypes.implicitTyThings, 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. ifaceDeclImplicitBndrs (IfaceData {ifName = tc_name, ifCons = cons }) @@ -528,9 +528,9 @@ data IfaceJoinInfo = IfaceNotJoinPoint {- Note [Empty case alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In IfaceSyn an IfaceCase does not record the types of the alternatives, -unlike CorSyn Case. But we need this type if the alternatives are empty. -Hence IfaceECase. See Note [Empty case alternatives] in CoreSyn. +In Iface syntax an IfaceCase does not record the types of the alternatives, +unlike Core syntax Case. But we need this type if the alternatives are empty. +Hence IfaceECase. See Note [Empty case alternatives] in CoreSyn. Note [Expose recursive functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -599,7 +599,7 @@ pprAxBranch pp_tc idx (IfaceAxBranch { ifaxbTyVars = tvs $+$ nest 4 maybe_incomps where - -- See Note [Printing foralls in type family instances] in IfaceType + -- See Note [Printing foralls in type family instances] in GHC.Iface.Type ppr_binders = maybe_index <+> pprUserIfaceForAll (map (mkIfaceForAllTvBndr Specified) tvs) pp_lhs = hang pp_tc 2 (pprParendIfaceAppArgs pat_tys) @@ -763,7 +763,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, , nest 2 $ ppShowIface ss pp_extra ] where is_data_instance = isIfaceDataInstance parent - -- See Note [Printing foralls in type family instances] in IfaceType + -- See Note [Printing foralls in type family instances] in GHC.Iface.Type pp_data_inst_forall :: SDoc pp_data_inst_forall = pprUserIfaceForAll forall_bndrs @@ -807,7 +807,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, pp_ki_sig = ppWhen ki_sig_printable $ pprStandaloneKindSig name_doc (mkIfaceTyConKind binders kind) - -- See Note [Suppressing binder signatures] in IfaceType + -- See Note [Suppressing binder signatures] in GHC.Iface.Type suppress_bndr_sig = SuppressBndrSig ki_sig_printable name_doc = pprPrefixIfDeclBndr (ss_how_much ss) (occName tycon) @@ -837,7 +837,7 @@ pprIfaceDecl ss (IfaceClass { ifName = clas , pprClassStandaloneKindSig ss clas (mkIfaceTyConKind binders constraintIfaceKind) , text "class" <+> pprIfaceDeclHead suppress_bndr_sig [] ss clas binders <+> pprFundeps fds ] where - -- See Note [Suppressing binder signatures] in IfaceType + -- See Note [Suppressing binder signatures] in GHC.Iface.Type suppress_bndr_sig = SuppressBndrSig True pprIfaceDecl ss (IfaceClass { ifName = clas @@ -878,7 +878,7 @@ pprIfaceDecl ss (IfaceClass { ifName = clas (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+> text "#-}" - -- See Note [Suppressing binder signatures] in IfaceType + -- See Note [Suppressing binder signatures] in GHC.Iface.Type suppress_bndr_sig = SuppressBndrSig True pprIfaceDecl ss (IfaceSynonym { ifName = tc @@ -894,7 +894,7 @@ pprIfaceDecl ss (IfaceSynonym { ifName = tc (tvs, theta, tau) = splitIfaceSigmaTy mono_ty name_doc = pprPrefixIfDeclBndr (ss_how_much ss) (occName tc) - -- See Note [Suppressing binder signatures] in IfaceType + -- See Note [Suppressing binder signatures] in GHC.Iface.Type suppress_bndr_sig = SuppressBndrSig True pprIfaceDecl ss (IfaceFamily { ifName = tycon @@ -951,7 +951,7 @@ pprIfaceDecl ss (IfaceFamily { ifName = tycon $$ ppShowIface ss (text "axiom" <+> ppr ax) pp_branches _ = Outputable.empty - -- See Note [Suppressing binder signatures] in IfaceType + -- See Note [Suppressing binder signatures] in GHC.Iface.Type suppress_bndr_sig = SuppressBndrSig True pprIfaceDecl _ (IfacePatSyn { ifName = name, @@ -1417,11 +1417,11 @@ instance Outputable IfaceUnfolding where {- ************************************************************************ * * - Finding the Names in IfaceSyn + Finding the Names in Iface syntax * * ************************************************************************ -This is used for dependency analysis in MkIface, so that we +This is used for dependency analysis in GHC.Iface.Utils, so that we fingerprint a declaration before the things that depend on it. It is specific to interface-file fingerprinting in the sense that we don't collect *all* Names: for example, the DFun of an instance is @@ -1945,7 +1945,7 @@ knot in the type checker. It saved ~1% of the total build time of GHC. When we read an interface file, we extend the PTE, a mapping of Names to TyThings, with the declarations we have read. The extension of the PTE is strict in the Names, but not in the TyThings themselves. -LoadIface.loadDecl calculates the list of (Name, TyThing) bindings to +GHC.Iface.Load.loadDecl calculates the list of (Name, TyThing) bindings to add to the PTE. For an IfaceId, there's just one binding to add; and the ty, details, and idinfo fields of an IfaceId are used only in the TyThing. So by reading those fields lazily we may be able to save the @@ -2423,7 +2423,7 @@ instance Binary IfaceCompleteMatch where ************************************************************************ * * NFData instances - See Note [Avoiding space leaks in toIface*] in ToIface + See Note [Avoiding space leaks in toIface*] in GHC.CoreToIface * * ************************************************************************ -} diff --git a/compiler/main/TidyPgm.hs b/compiler/GHC/Iface/Tidy.hs index e94e0aaac0..1a7f9f0026 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/GHC/Iface/Tidy.hs @@ -6,7 +6,7 @@ {-# LANGUAGE CPP, DeriveFunctor, ViewPatterns #-} -module TidyPgm ( +module GHC.Iface.Tidy ( mkBootModDetailsTc, tidyProgram ) where @@ -46,7 +46,7 @@ import Name hiding (varName) import NameSet import NameCache import Avail -import IfaceEnv +import GHC.Iface.Env import TcEnv import TcRnMonad import DataCon @@ -216,7 +216,7 @@ globaliseAndTidyBootId :: Id -> Id -- * 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) +-- * BootUnfolding (see Note [Inlining and hs-boot files] in GHC.CoreToIface) globaliseAndTidyBootId id = globaliseId id `setIdType` tidyTopType (idType id) `setIdUnfolding` BootUnfolding @@ -528,7 +528,7 @@ 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, + - If implicit Ids are already in the bindings when we start tidying, 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 @@ -1277,14 +1277,14 @@ 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. +after tidying. 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. +between CorePrep and GHC.Iface.Tidy. See Note [CAFfyness inconsistencies due to +eta expansion in TidyPgm] for one such example. Ugh! What ugliness we hath wrought. @@ -1292,8 +1292,9 @@ 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: +the CAFfyness computation done by tidying (see Note [Disgusting computation of +CafRefs] in GHC.Iface.Tidy). This late expansion happens/happened for a few +reasons: * CorePrep previously eta expanded unsaturated primop applications, as described in Note [Primop wrappers]). diff --git a/compiler/iface/IfaceType.hs b/compiler/GHC/Iface/Type.hs index 7a8c617bb7..fbabb5b8b5 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/GHC/Iface/Type.hs @@ -12,7 +12,7 @@ This module defines interface types and binders {-# LANGUAGE LambdaCase #-} -- FlexibleInstances for Binary (DefMethSpec IfaceType) -module IfaceType ( +module GHC.Iface.Type ( IfExtName, IfLclName, IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..), @@ -92,7 +92,7 @@ import Control.DeepSeq type IfLclName = FastString -- A local name in iface syntax -type IfExtName = Name -- An External or WiredIn Name can appear in IfaceSyn +type IfExtName = Name -- An External or WiredIn Name can appear in Iface syntax -- (However Internal or System Names never should) data IfaceBndr -- Local (non-top-level) binders @@ -137,7 +137,7 @@ type IfaceKind = IfaceType -- | A kind of universal type, used for types and kinds. -- -- Any time a 'Type' is pretty-printed, it is first converted to an 'IfaceType' --- before being printed. See Note [Pretty printing via IfaceSyn] in PprTyThing +-- before being printed. See Note [Pretty printing via Iface syntax] in PprTyThing data IfaceType = IfaceFreeTyVar TyVar -- See Note [Free tyvars in IfaceType] | IfaceTyVar IfLclName -- Type/coercion variable only, not tycon @@ -238,11 +238,11 @@ data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon deriving (Eq) {- Note [Free tyvars in IfaceType] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to an IfaceType and pretty printing that. This eliminates a lot of pretty-print duplication, and it matches what we do with pretty- -printing TyThings. See Note [Pretty printing via IfaceSyn] in PprTyThing. +printing TyThings. See Note [Pretty printing via Iface syntax] in PprTyThing. It works fine for closed types, but when printing debug traces (e.g. when using -ddump-tc-trace) we print a lot of /open/ types. These @@ -611,9 +611,9 @@ since the corresponding Core constructor: | TyConApp TyCon [Type] Already puts all of its arguments into a list. So when converting a Type to an -IfaceType (see toIfaceAppArgsX in ToIface), we simply use the kind of the TyCon -(which is cached) to guide the process of converting the argument Types into an -IfaceAppArgs list. +IfaceType (see toIfaceAppArgsX in GHC.Core.ToIface), we simply use the kind of +the TyCon (which is cached) to guide the process of converting the argument +Types into an IfaceAppArgs list. We also want this behavior for IfaceAppTy, since given: @@ -629,7 +629,7 @@ tycon case, because the corresponding Core constructor for IfaceAppTy: | AppTy Type Type Only stores one argument at a time. Therefore, when converting an AppTy to an -IfaceAppTy (in toIfaceTypeX in ToIface), we: +IfaceAppTy (in toIfaceTypeX in GHC.CoreToIface), we: 1. Flatten the chain of AppTys down as much as possible 2. Use typeKind to determine the function Type's kind @@ -1110,7 +1110,7 @@ pprIfaceForAllBndr bndr = pprIfaceTvBndr tv suppress_sig (UseBndrParens True) Bndr (IfaceIdBndr idv) _ -> pprIfaceIdBndr idv where - -- See Note [Suppressing binder signatures] in IfaceType + -- See Note [Suppressing binder signatures] suppress_sig = SuppressBndrSig False pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc diff --git a/compiler/iface/IfaceType.hs-boot b/compiler/GHC/Iface/Type.hs-boot index 44f1f3cfc2..30a0033c86 100644 --- a/compiler/iface/IfaceType.hs-boot +++ b/compiler/GHC/Iface/Type.hs-boot @@ -1,7 +1,8 @@ --- Used only by ToIface.hs-boot - -module IfaceType( IfaceType, IfaceTyCon, IfaceForAllBndr - , IfaceCoercion, IfaceTyLit, IfaceAppArgs ) where +module GHC.Iface.Type + ( IfaceType, IfaceTyCon, IfaceForAllBndr + , IfaceCoercion, IfaceTyLit, IfaceAppArgs + ) +where import Var (VarBndr, ArgFlag) diff --git a/compiler/iface/MkIface.hs b/compiler/GHC/Iface/Utils.hs index 02948d67c8..d410a2c461 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/GHC/Iface/Utils.hs @@ -9,7 +9,7 @@ -- | Module for constructing @ModIface@ values (interface files), -- writing them to disk and comparing two versions to see if -- recompilation is required. -module MkIface ( +module GHC.Iface.Utils ( mkPartialIface, mkFullIface, @@ -62,10 +62,10 @@ Basic idea: import GhcPrelude -import IfaceSyn +import GHC.Iface.Syntax import BinFingerprint -import LoadIface -import ToIface +import GHC.Iface.Load +import GHC.CoreToIface import FlagChecker import DsUsage ( mkUsageInfo, mkUsedNames, mkDependencies ) @@ -94,7 +94,7 @@ import RdrName import NameEnv import NameSet import Module -import BinIface +import GHC.Iface.Binary import ErrUtils import Digraph import SrcLoc @@ -977,14 +977,14 @@ declExtras fix_fn ann_fn rule_env inst_env fi_env dm_env decl {- Note [default method Name] (see also #15970) -The Names for the default methods aren't available in the IfaceSyn. +The Names for the default methods aren't available in Iface syntax. * We originally start with a DefMethInfo from the class, contain a Name for the default method -* We turn that into IfaceSyn as a DefMethSpec which lacks a Name +* We turn that into Iface syntax as a DefMethSpec which lacks a Name entirely. Why? Because the Name can be derived from the method name - (in TcIface), so doesn't need to be serialised into the interface + (in GHC.IfaceToCore), so doesn't need to be serialised into the interface file. But now we have to get the Name back, because the class declaration's @@ -1094,7 +1094,7 @@ That is, in Y, - but the parent (used for grouping and naming in T(..) exports) is X.T - and in this case we export X.T too -In the result of MkIfaceExports, the names are grouped by defining module, +In the result of mkIfaceExports, the names are grouped by defining module, so we may need to split up a single Avail into multiple ones. Note [Internal used_names] @@ -1913,7 +1913,7 @@ tyConToIfaceDecl env tycon -- (b) when pretty-printing an Iface data declaration in H98-style syntax, -- we know that the type variables will line up -- The latter (b) is important because we pretty-print type constructors - -- by converting to IfaceSyn and pretty-printing that + -- by converting to Iface syntax and pretty-printing that con_env1 = (fst tc_env1, mkVarEnv (zipEqual "ifaceConDecl" univ_tvs tc_tyvars)) -- A bit grimy, perhaps, but it's simple! diff --git a/compiler/iface/TcIface.hs b/compiler/GHC/IfaceToCore.hs index 34cf2c247e..6b7b623389 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/GHC/IfaceToCore.hs @@ -9,7 +9,7 @@ Type checking of type signatures in interface files {-# LANGUAGE CPP #-} {-# LANGUAGE NondecreasingIndentation #-} -module TcIface ( +module GHC.IfaceToCore ( tcLookupImported_maybe, importDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface, typecheckIfacesForMerging, @@ -25,9 +25,9 @@ module TcIface ( import GhcPrelude import TcTypeNats(typeNatCoAxiomRules) -import IfaceSyn -import LoadIface -import IfaceEnv +import GHC.Iface.Syntax +import GHC.Iface.Load +import GHC.Iface.Env import BuildTyCl import TcRnMonad import TcType @@ -120,11 +120,11 @@ Suppose we are typechecking an interface A.hi, and we come across a Name for another entity defined in A.hi. How do we get the 'TyCon', in this case? There are three cases: - 1) tcHiBootIface in TcIface: We're typechecking an hi-boot file in - preparation of checking if the hs file we're building - is compatible. In this case, we want all of the internal - TyCons to MATCH the ones that we just constructed during - typechecking: the knot is thus tied through if_rec_types. + 1) tcHiBootIface in GHC.IfaceToCore: We're typechecking an + hi-boot file in preparation of checking if the hs file we're + building is compatible. In this case, we want all of the + internal TyCons to MATCH the ones that we just constructed + during typechecking: the knot is thus tied through if_rec_types. 2) retypecheckLoop in GhcMake: We are retypechecking a mutually recursive cluster of hi files, in order to ensure @@ -356,7 +356,7 @@ typecheckIfacesForMerging mod ifaces tc_env_var = ignore_prags <- goptM Opt_IgnoreInterfacePragmas -- Build the initial environment -- NB: Don't include dfuns here, because we don't want to - -- serialize them out. See Note [rnIfaceNeverExported] in RnModIface + -- serialize them out. See Note [rnIfaceNeverExported] in GHC.Iface.Rename -- NB: But coercions are OK, because they will have the right OccName. let mk_decl_env decls = mkOccEnv [ (getOccName decl, decl) @@ -376,7 +376,7 @@ typecheckIfacesForMerging mod ifaces tc_env_var = -- OK, now typecheck each ModIface using this environment details <- forM ifaces $ \iface -> do - -- See Note [Resolving never-exported Names in TcIface] + -- See Note [Resolving never-exported Names] in GHC.IfaceToCore type_env <- fixM $ \type_env -> do setImplicitEnvM type_env $ do decls <- loadDecls ignore_prags (mi_decls iface) @@ -416,7 +416,7 @@ typecheckIfaceForInstantiate nsubst iface = (text "typecheckIfaceForInstantiate") (mi_boot iface) nsubst $ do ignore_prags <- goptM Opt_IgnoreInterfacePragmas - -- See Note [Resolving never-exported Names in TcIface] + -- See Note [Resolving never-exported Names] in GHC.IfaceToCore type_env <- fixM $ \type_env -> do setImplicitEnvM type_env $ do decls <- loadDecls ignore_prags (mi_decls iface) @@ -438,8 +438,8 @@ typecheckIfaceForInstantiate nsubst iface = , md_complete_sigs = complete_sigs } --- Note [Resolving never-exported Names in TcIface] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Note [Resolving never-exported Names] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- For the high-level overview, see -- Note [Handling never-exported TyThings under Backpack] -- @@ -1711,7 +1711,7 @@ tcIfaceExtId name = do { thing <- tcIfaceGlobal name AnId id -> return id _ -> pprPanic "tcIfaceExtId" (ppr name$$ ppr thing) } --- See Note [Resolving never-exported Names in TcIface] +-- See Note [Resolving never-exported Names] in GHC.IfaceToCore tcIfaceImplicit :: Name -> IfL TyThing tcIfaceImplicit n = do lcl_env <- getLclEnv diff --git a/compiler/iface/TcIface.hs-boot b/compiler/GHC/IfaceToCore.hs-boot index f137f13305..4a888f51f7 100644 --- a/compiler/iface/TcIface.hs-boot +++ b/compiler/GHC/IfaceToCore.hs-boot @@ -1,8 +1,9 @@ -module TcIface where +module GHC.IfaceToCore where import GhcPrelude -import IfaceSyn ( IfaceDecl, IfaceClsInst, IfaceFamInst, IfaceRule, - IfaceAnnotation, IfaceCompleteMatch ) +import GHC.Iface.Syntax + ( IfaceDecl, IfaceClsInst, IfaceFamInst, IfaceRule + , IfaceAnnotation, IfaceCompleteMatch ) import TyCoRep ( TyThing ) import TcRnTypes ( IfL ) import InstEnv ( ClsInst ) diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs index b82fea5de2..256be34ce8 100644 --- a/compiler/GHC/Stg/Syntax.hs +++ b/compiler/GHC/Stg/Syntax.hs @@ -479,13 +479,13 @@ stgRhsArity (StgRhsCon _ _ _) = 0 -- ~~~~~~~~~~~~~~~~~~~~~~ -- -- `topStgBindHasCafRefs` is only used by an assert (`consistentCafInfo` in --- `CoreToStg`) to make sure CAF-ness predicted by `TidyPgm` is consistent with +-- `CoreToStg`) to make sure CAF-ness predicted by `GHC.Iface.Tidy` is consistent with -- reality. -- -- Specifically, if the RHS mentions any Id that itself is marked -- `MayHaveCafRefs`; or if the binding is a top-level updateable thunk; then the -- `Id` for the binding should be marked `MayHaveCafRefs`. The potential trouble --- is that `TidyPgm` computed the CAF info on the `Id` but some transformations +-- is that `GHC.Iface.Tidy` computed the CAF info on the `Id` but some transformations -- have taken place since then. topStgBindHasCafRefs :: GenStgTopBinding pass -> Bool @@ -547,7 +547,7 @@ stgArgHasCafRefs _ stgIdHasCafRefs :: Id -> Bool stgIdHasCafRefs id = -- We are looking for occurrences of an Id that is bound at top level, and may - -- have CAF refs. At this point (after TidyPgm) top-level Ids (whether + -- have CAF refs. At this point (after GHC.Iface.Tidy) top-level Ids (whether -- imported or defined in this module) are GlobalIds, so the test is easy. isGlobalId id && mayHaveCafRefs (idCafInfo id) diff --git a/compiler/backpack/DriverBkp.hs b/compiler/backpack/DriverBkp.hs index f30c676e26..828a39c57f 100644 --- a/compiler/backpack/DriverBkp.hs +++ b/compiler/backpack/DriverBkp.hs @@ -43,7 +43,7 @@ import UniqDFM import Outputable import Maybes import HeaderInfo -import MkIface +import GHC.Iface.Utils import GhcMake import UniqDSet import PrelNames diff --git a/compiler/backpack/NameShape.hs b/compiler/backpack/NameShape.hs index a1a0b1893b..f4c9976b48 100644 --- a/compiler/backpack/NameShape.hs +++ b/compiler/backpack/NameShape.hs @@ -25,7 +25,7 @@ import Name import NameEnv import TcRnMonad import Util -import IfaceEnv +import GHC.Iface.Env import Control.Monad diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index d48ecead11..fcc5fcfed0 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -366,7 +366,7 @@ data DataCon dcExTyCoVars :: [TyCoVar], -- INVARIANT: the UnivTyVars and ExTyCoVars all have distinct OccNames - -- Reason: less confusing, and easier to generate IfaceSyn + -- Reason: less confusing, and easier to generate Iface syntax -- The type/coercion vars in the order the user wrote them [c,y,x,b] -- INVARIANT: the set of tyvars in dcUserTyVarBinders is exactly the set diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index d29a25cc02..adf775b4c7 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -387,7 +387,7 @@ of reasons: In CoreTidy we must make all these LocalIds into GlobalIds, so that in importing modules (in --make mode) we treat them as properly global. -That is what is happening in, say tidy_insts in TidyPgm. +That is what is happening in, say tidy_insts in GHC.Iface.Tidy. ************************************************************************ * * diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs index dea309de1a..b514df64f4 100644 --- a/compiler/basicTypes/IdInfo.hs +++ b/compiler/basicTypes/IdInfo.hs @@ -409,7 +409,7 @@ differently because: a) they might be nested, in which case a global table won't work b) the RULE might mention free variables, which we use to keep things alive -In TidyPgm, when the LocalId becomes a GlobalId, its RULES are stripped off +In GHC.Iface.Tidy, when the LocalId becomes a GlobalId, its RULES are stripped off and put in the global list. -} diff --git a/compiler/basicTypes/Literal.hs b/compiler/basicTypes/Literal.hs index 1e088a8d1a..b567dcc6ba 100644 --- a/compiler/basicTypes/Literal.hs +++ b/compiler/basicTypes/Literal.hs @@ -177,14 +177,14 @@ that e.g. literalType can return the right Type for them. They only get converted into real Core, mkInteger [c1, c2, .., cn] -during the CorePrep phase, although TidyPgm looks ahead at what the +during the CorePrep phase, although GHC.Iface.Tidy looks ahead at what the core will be, so that it can see whether it involves CAFs. When we initially build an Integer literal, notably when deserialising it from an interface file (see the Binary instance below), we don't have convenient access to the mkInteger Id. So we just use an error thunk, and fill in the real Id when we do tcIfaceLit -in TcIface. +in GHC.IfaceToCore. Note [Natural literals] ~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index 681ddfe8a7..658b9de529 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -362,8 +362,8 @@ The solution is simple, though: just make the newtype wrappers as ephemeral as the newtype workers. In other words, give the wrappers compulsory unfoldings and no bindings. The compulsory unfolding is given in wrap_unf in mkDataConRep, and the lack of a binding happens in -TidyPgm.getTyConImplicitBinds, where we say that a newtype has no implicit -bindings. +GHC.Iface.Tidy.getTyConImplicitBinds, where we say that a newtype has no +implicit bindings. ************************************************************************ * * @@ -649,7 +649,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con `setInlinePragInfo` wrap_prag `setUnfoldingInfo` wrap_unf `setStrictnessInfo` wrap_sig - -- We need to get the CAF info right here because TidyPgm + -- We need to get the CAF info right here because GHC.Iface.Tidy -- does not tidy the IdInfo of implicit bindings (like the wrapper) -- so it not make sure that the CAF info is sane `setLevityInfoWithType` wrap_ty @@ -1496,7 +1496,7 @@ Note [seqId magic] ~~~~~~~~~~~~~~~~~~ 'GHC.Prim.seq' is special in several ways. -a) Its fixity is set in LoadIface.ghcPrimIface +a) Its fixity is set in GHC.Iface.Load.ghcPrimIface b) It has quite a bit of desugaring magic. See DsUtils.hs Note [Desugaring seq (1)] and (2) and (3) @@ -1601,7 +1601,7 @@ running the simplifier. 'noinline' needs to be wired-in because it gets inserted automatically when we serialize an expression to the interface format. See -Note [Inlining and hs-boot files] in ToIface +Note [Inlining and hs-boot files] in GHC.CoreToIface Note that noinline as currently implemented can hide some simplifications since it hides strictness from the demand analyser. Specifically, the demand analyser diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs index 2cbd50ed6f..341cc79bb6 100644 --- a/compiler/basicTypes/Name.hs +++ b/compiler/basicTypes/Name.hs @@ -162,7 +162,7 @@ Note [About the NameSorts] 2. In any invocation of GHC, an External Name for "M.x" has one and only one unique. This unique association is ensured via the Name Cache; - see Note [The Name Cache] in IfaceEnv. + see Note [The Name Cache] in GHC.Iface.Env. 3. Things with a External name are given C static labels, so they finally appear in the .o file's symbol table. They appear in the symbol table @@ -367,7 +367,7 @@ mkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc }) -- | Create a name which definitely originates in the given module mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name -- WATCH OUT! External Names should be in the Name Cache --- (see Note [The Name Cache] in IfaceEnv), so don't just call mkExternalName +-- (see Note [The Name Cache] in GHC.Iface.Env), so don't just call mkExternalName -- with some fresh unique without populating the Name Cache mkExternalName uniq mod occ loc = Name { n_uniq = uniq, n_sort = External mod, @@ -502,8 +502,9 @@ instance Data Name where -} -- | Assumes that the 'Name' is a non-binding one. See --- 'IfaceSyn.putIfaceTopBndr' and 'IfaceSyn.getIfaceTopBndr' for serializing --- binding 'Name's. See 'UserData' for the rationale for this distinction. +-- 'GHC.Iface.Syntax.putIfaceTopBndr' and 'GHC.Iface.Syntax.getIfaceTopBndr' for +-- serializing binding 'Name's. See 'UserData' for the rationale for this +-- distinction. instance Binary Name where put_ bh name = case getUserData bh of diff --git a/compiler/basicTypes/NameCache.hs b/compiler/basicTypes/NameCache.hs index f845bc9562..3bbdf745c8 100644 --- a/compiler/basicTypes/NameCache.hs +++ b/compiler/basicTypes/NameCache.hs @@ -51,7 +51,7 @@ their cost we use two tricks, Namely these names are encoded as by their Uniques. We know how to get from a Unique back to the Name which it represents via the mapping defined in the SumTupleUniques module. See Note [Symbol table representation of names] - in BinIface and for details. + in GHC.Iface.Binary and for details. b. We don't include them in the Orig name cache but instead parse their OccNames (in isBuiltInOcc_maybe) to avoid bloating the name cache with diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs index 1b25f08c2b..f0edc56778 100644 --- a/compiler/basicTypes/OccName.hs +++ b/compiler/basicTypes/OccName.hs @@ -893,7 +893,7 @@ tidyOccName env occ@(OccName occ_sp fs) ************************************************************************ * * Binary instance - Here rather than BinIface because OccName is abstract + Here rather than in GHC.Iface.Binary because OccName is abstract * * ************************************************************************ -} diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index eabbaae7f9..89b70b1f7b 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -24,7 +24,7 @@ module RdrName ( -- * The main type - RdrName(..), -- Constructors exported only to BinIface + RdrName(..), -- Constructors exported only to GHC.Iface.Binary -- ** Construction mkRdrUnqual, mkRdrQual, diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index cbae06d1ca..4a646aa70a 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -31,7 +31,7 @@ module Unique ( mkUniqueGrimily, -- Used in UniqSupply only! getKey, -- Used in Var, UniqFM, Name only! - mkUnique, unpkUnique, -- Used in BinIface only + mkUnique, unpkUnique, -- Used in GHC.Iface.Binary only eqUnique, ltUnique, incrUnique, @@ -178,7 +178,7 @@ unpkUnique (MkUnique u) -- | The interface file symbol-table encoding assumes that known-key uniques fit -- in 30-bits; verify this. -- --- See Note [Symbol table representation of names] in BinIface for details. +-- See Note [Symbol table representation of names] in GHC.Iface.Binary for details. isValidKnownKeyUnique :: Unique -> Bool isValidKnownKeyUnique u = case unpkUnique u of diff --git a/compiler/cmm/cmm-notes b/compiler/cmm/cmm-notes index c1907f5908..699f218257 100644 --- a/compiler/cmm/cmm-notes +++ b/compiler/cmm/cmm-notes @@ -139,7 +139,7 @@ a dominator analysis, using the Dataflow Engine. a CAF (or refers to CAFs). See the IdLabel constructor of CLabel. * The CAF-ness of the original top-level definitions is figured out - (by TidyPgm) before we generate C--. This CafInfo is only set for + (by GHC.Iface.Tidy) before we generate C--. This CafInfo is only set for top-level Ids; nested bindings stay with MayHaveCafRefs. * Currently an SRT contains (only) pointers to (top-level) closures. @@ -182,4 +182,3 @@ a dominator analysis, using the Dataflow Engine. * DECIDED: we can generate SRTs based on the final Cmm program without knowledge of how it is generated. - diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs index 8931725896..d3f24fa7bf 100644 --- a/compiler/coreSyn/CoreArity.hs +++ b/compiler/coreSyn/CoreArity.hs @@ -174,13 +174,13 @@ exprArity has the following invariants: can get "n" manifest lambdas to the top. Why is this important? Because - - In TidyPgm we use exprArity to fix the *final arity* of + - In GHC.Iface.Tidy we use exprArity to fix the *final arity* of each top-level Id, and in - In CorePrep we use etaExpand on each rhs, so that the visible lambdas actually match that arity, which in turn means that the StgRhs has the right number of lambdas -An alternative would be to do the eta-expansion in TidyPgm, at least +An alternative would be to do the eta-expansion in GHC.Iface.Tidy, at least for top-level bindings, in which case we would not need the trim_arity in exprArity. That is a less local change, so I'm going to leave it for today! diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 7c4137e9b5..21f4fd5c0e 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -489,7 +489,7 @@ We use this to check all top-level unfoldings that come in from interfaces We do not need to call lintUnfolding on unfoldings that are nested within top-level unfoldings; they are linted when we lint the top-level unfolding; -hence the `TopLevelFlag` on `tcPragExpr` in TcIface. +hence the `TopLevelFlag` on `tcPragExpr` in GHC.IfaceToCore. -} diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index 919e2300be..3d2f6be299 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -1278,7 +1278,7 @@ has two major consequences In contrast, orphans are all fingerprinted together in the mi_orph_hash field of the ModIface. - See MkIface.addFingerprints. + See GHC.Iface.Utils.addFingerprints. Orphan-hood is computed * For class instances: @@ -1286,8 +1286,8 @@ Orphan-hood is computed (because it is needed during instance lookup) * For rules and family instances: - when we generate an IfaceRule (MkIface.coreRuleToIfaceRule) - or IfaceFamInst (MkIface.instanceToIfaceInst) + when we generate an IfaceRule (GHC.Iface.Utils.coreRuleToIfaceRule) + or IfaceFamInst (GHC.Iface.Utils.instanceToIfaceInst) -} {- @@ -1351,7 +1351,7 @@ data CoreRule ru_auto :: Bool, -- ^ @True@ <=> this rule is auto-generated -- (notably by Specialise or SpecConstr) -- @False@ <=> generated at the user's behest - -- See Note [Trimming auto-rules] in TidyPgm + -- See Note [Trimming auto-rules] in GHC.Iface.Tidy -- for the sole purpose of this field. ru_origin :: !Module, -- ^ 'Module' the rule was defined in, used @@ -1447,7 +1447,7 @@ data Unfolding | BootUnfolding -- ^ We have no information about the unfolding, because -- this 'Id' came from an @hi-boot@ file. - -- See Note [Inlining and hs-boot files] in ToIface + -- See Note [Inlining and hs-boot files] in GHC.CoreToIface -- for what this is used for. | OtherCon [AltCon] -- ^ It ain't one of these constructors. diff --git a/compiler/coreSyn/CoreTidy.hs b/compiler/coreSyn/CoreTidy.hs index 7642606813..5183d26622 100644 --- a/compiler/coreSyn/CoreTidy.hs +++ b/compiler/coreSyn/CoreTidy.hs @@ -4,7 +4,7 @@ This module contains "tidying" code for *nested* expressions, bindings, rules. -The code for *top-level* bindings is in TidyPgm. +The code for *top-level* bindings is in GHC.Iface.Tidy. -} {-# LANGUAGE CPP #-} @@ -229,7 +229,7 @@ tidyUnfolding tidy_env = seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs } -- Preserves OccInfo -- This seqIt avoids a space leak: otherwise the uf_is_value, -- uf_is_conlike, ... fields may retain a reference to the - -- pre-tidied expression forever (ToIface doesn't look at them) + -- pre-tidied expression forever (GHC.CoreToIface doesn't look at them) | otherwise = unf_from_rhs diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index 50fdcd9c7b..cd2221246e 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -2502,9 +2502,9 @@ rhsIsStatic -> (Name -> Bool) -- Which names are dynamic -> (LitNumType -> Integer -> Maybe CoreExpr) -- Desugaring for some literals (disgusting) - -- C.f. Note [Disgusting computation of CafRefs] in TidyPgm + -- C.f. Note [Disgusting computation of CafRefs] in GHC.Iface.Tidy -> CoreExpr -> Bool --- It's called (i) in TidyPgm.hasCafRefs to decide if the rhs is, or +-- It's called (i) in GHC.Iface.Tidy.hasCafRefs to decide if the rhs is, or -- refers to, CAFs; (ii) in CoreToStg to decide whether to put an -- update flag on it and (iii) in DsExpr to decide how to expand -- list literals diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index dbfc6f52fd..87aca99136 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -367,7 +367,7 @@ dsAbsBinds dflags tyvars dicts exports -- -- Other decisions about whether to inline are made in -- `calcUnfoldingGuidance` but the decision about whether to then expose --- the unfolding in the interface file is made in `TidyPgm.addExternal` +-- the unfolding in the interface file is made in `GHC.Iface.Tidy.addExternal` -- using this information. ------------------------ makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs index 59e1d32fd3..2af170be5f 100644 --- a/compiler/deSugar/DsMonad.hs +++ b/compiler/deSugar/DsMonad.hs @@ -60,7 +60,7 @@ import CoreSyn import MkCore ( unitExpr ) import CoreUtils ( exprType, isExprLevPoly ) import GHC.Hs -import TcIface +import GHC.IfaceToCore import TcMType ( checkForLevPolyX, formatLevPolyErr ) import PrelNames import RdrName diff --git a/compiler/deSugar/DsUsage.hs b/compiler/deSugar/DsUsage.hs index ed9f4cd371..9db10806d5 100644 --- a/compiler/deSugar/DsUsage.hs +++ b/compiler/deSugar/DsUsage.hs @@ -3,7 +3,7 @@ {-# LANGUAGE ViewPatterns #-} module DsUsage ( - -- * Dependency/fingerprinting code (used by MkIface) + -- * Dependency/fingerprinting code (used by GHC.Iface.Utils) mkUsageInfo, mkUsedNames, mkDependencies ) where diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 7fd83c9d8b..1e966e01a5 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -180,24 +180,23 @@ Library typecheck types utils - hieFile -- we use an explicit Prelude Default-Extensions: NoImplicitPrelude Exposed-Modules: - HieTypes - HieDebug - HieBin - HieUtils - HieAst + GHC.Iface.Ext.Types + GHC.Iface.Ext.Debug + GHC.Iface.Ext.Binary + GHC.Iface.Ext.Utils + GHC.Iface.Ext.Ast Ar FileCleanup DriverBkp BkpSyn NameShape - RnModIface + GHC.Iface.Rename Avail AsmUtils BasicTypes @@ -355,16 +354,16 @@ Library GHC.Hs.Types GHC.Hs.Utils GHC.Hs.Dump - BinIface + GHC.Iface.Binary BinFingerprint BuildTyCl - IfaceEnv - IfaceSyn - IfaceType - ToIface - LoadIface - MkIface - TcIface + GHC.Iface.Env + GHC.Iface.Syntax + GHC.Iface.Type + GHC.CoreToIface + GHC.Iface.Load + GHC.Iface.Utils + GHC.IfaceToCore FlagChecker Annotations CmdLineParser @@ -406,7 +405,7 @@ Library SysTools.Tasks SysTools.Settings Elf - TidyPgm + GHC.Iface.Tidy Ctype HaddockUtils Lexer diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs index 373369e733..616890a2e6 100644 --- a/compiler/ghci/Debugger.hs +++ b/compiler/ghci/Debugger.hs @@ -24,8 +24,8 @@ import GHCi.RemoteTypes import GhcMonad import HscTypes import Id -import IfaceSyn ( showToHeader ) -import IfaceEnv( newInteractiveBinder ) +import GHC.Iface.Syntax ( showToHeader ) +import GHC.Iface.Env ( newInteractiveBinder ) import Name import Var hiding ( varName ) import VarSet diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index f8bf25b642..ec717d7399 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -24,7 +24,7 @@ import GhcPrelude import GHCi import GHCi.RemoteTypes -import LoadIface +import GHC.Iface.Load import ByteCodeLink import ByteCodeAsm import ByteCodeTypes diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index da60eff5b6..96df8b547c 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -47,7 +47,7 @@ import TyCon import Name import OccName import Module -import IfaceEnv +import GHC.Iface.Env import Util import VarSet import BasicTypes ( Boxity(..) ) diff --git a/compiler/iface/BuildTyCl.hs b/compiler/iface/BuildTyCl.hs index 827b89983f..1ea61cf0c5 100644 --- a/compiler/iface/BuildTyCl.hs +++ b/compiler/iface/BuildTyCl.hs @@ -17,7 +17,7 @@ module BuildTyCl ( import GhcPrelude -import IfaceEnv +import GHC.Iface.Env import FamInstEnv( FamInstEnvs, mkNewTypeCoAxiom ) import TysWiredIn( isCTupleTyConName ) import TysPrim ( voidPrimTy ) @@ -78,7 +78,7 @@ mkNewTyConRhs tycon_name tycon con etad_tvs :: [TyVar] -- Matched lazily, so that mkNewTypeCo can etad_roles :: [Role] -- return a TyCon without pulling on rhs_ty - etad_rhs :: Type -- See Note [Tricky iface loop] in LoadIface + etad_rhs :: Type -- See Note [Tricky iface loop] in GHC.Iface.Load (etad_tvs, etad_roles, etad_rhs) = eta_reduce (reverse tvs) (reverse roles) rhs_ty eta_reduce :: [TyVar] -- Reversed @@ -386,7 +386,7 @@ newImplicitBinder :: Name -- Base name -> TcRnIf m n Name -- Implicit name -- Called in BuildTyCl to allocate the implicit binders of type/class decls -- For source type/class decls, this is the first occurrence --- For iface ones, the LoadIface has already allocated a suitable name in the cache +-- For iface ones, GHC.Iface.Load has already allocated a suitable name in the cache newImplicitBinder base_name mk_sys_occ = newImplicitBinderLoc base_name mk_sys_occ (nameSrcSpan base_name) 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/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs index 204b7ce9f9..7d2aa3a163 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/prelude/PrelInfo.hs @@ -100,7 +100,7 @@ Note [About wired-in things] checker sees if the Name is wired in before looking up the name in the type environment. -* MkIface prunes out wired-in things before putting them in an interface file. +* GHC.Iface.Utils prunes out wired-in things before putting them in an interface file. So interface files never contain wired-in things. -} diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 3bcc8670ff..8c0d25de46 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -64,8 +64,8 @@ This is accomplished through a combination of mechanisms: 2. The knownKeyNames (which consist of the basicKnownKeyNames from the module, and those names reachable via the wired-in stuff from TysWiredIn) are used to initialise the "OrigNameCache" in - IfaceEnv. This initialization ensures that when the type checker - or renamer (both of which use IfaceEnv) look up an original name + GHC.Iface.Env. This initialization ensures that when the type checker + or renamer (both of which use GHC.Iface.Env) look up an original name (i.e. a pair of a Module and an OccName) for a known-key name they get the correct Unique. @@ -95,17 +95,17 @@ things, looked up in the orig-name cache) b) The known infinite families of names are specially serialised by - BinIface.putName, with that special treatment detected when we read back to - ensure that we get back to the correct uniques. See Note [Symbol table - representation of names] in BinIface and Note [How tuples work] in - TysWiredIn. + GHC.Iface.Binary.putName, with that special treatment detected when we read + back to ensure that we get back to the correct uniques. See Note [Symbol + table representation of names] in GHC.Iface.Binary and Note [How tuples + work] in TysWiredIn. Most of the infinite families cannot occur in source code, so mechanisms (a) and (b) suffice to ensure that they always have the right Unique. In particular, implicit param TyCon names, constraint tuples and Any TyCons cannot be mentioned by the user. For those things that *can* appear in source programs, - c) IfaceEnv.lookupOrigNameCache uses isBuiltInOcc_maybe to map built-in syntax + c) GHC.Iface.Env.lookupOrigNameCache uses isBuiltInOcc_maybe to map built-in syntax directly onto the corresponding name, rather than trying to find it in the original-name cache. diff --git a/compiler/prelude/PrimOp.hs b/compiler/prelude/PrimOp.hs index 55a8bf339f..81220140bb 100644 --- a/compiler/prelude/PrimOp.hs +++ b/compiler/prelude/PrimOp.hs @@ -581,7 +581,7 @@ function definition. This caused quite some trouble as we would be forced to eta expand unsaturated primop applications very late in the Core pipeline. Not only would this produce unnecessary thunks, but it would also result in nasty inconsistencies in CAFfy-ness determinations (see #16846 and -Note [CAFfyness inconsistencies due to late eta expansion] in TidyPgm). +Note [CAFfyness inconsistencies due to late eta expansion] in GHC.Iface.Tidy). However, it was quite unnecessary for hasNoBinding to claim this; primops in fact *do* have curried definitions which are found in GHC.PrimopWrappers, which diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index f4db7572c0..eb9c04fdc9 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -685,7 +685,7 @@ Note [How tuples work] See also Note [Known-key names] in PrelNames E.g. tupleTyCon has a Boxity argument * When looking up an OccName in the original-name cache - (IfaceEnv.lookupOrigNameCache), we spot the tuple OccName to make sure + (GHC.Iface.Env.lookupOrigNameCache), we spot the tuple OccName to make sure we get the right wired-in name. This guy can't tell the difference between BoxedTuple and ConstraintTuple (same OccName!), so tuples are not serialised into interface files using OccNames at all. diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index f22a94614c..4180152460 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -204,7 +204,7 @@ primtype (->) a b } with fixity = infixr -1 -- This fixity is only the one picked up by Haddock. If you - -- change this, do update 'ghcPrimIface' in 'LoadIface.hs'. + -- change this, do update 'ghcPrimIface' in 'GHC.Iface.Load'. ------------------------------------------------------------------------ section "Char#" @@ -3367,7 +3367,7 @@ pseudoop "seq" you must use the function {\tt pseq} from the "parallel" package. } with fixity = infixr 0 -- This fixity is only the one picked up by Haddock. If you - -- change this, do update 'ghcPrimIface' in 'LoadIface.hs'. + -- change this, do update 'ghcPrimIface' in 'GHC.Iface.Load'. pseudoop "unsafeCoerce#" a -> b diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 6f615a1721..4ce5805785 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -46,8 +46,8 @@ module RnEnv ( import GhcPrelude -import LoadIface ( loadInterfaceForName, loadSrcInterface_maybe ) -import IfaceEnv +import GHC.Iface.Load ( loadInterfaceForName, loadSrcInterface_maybe ) +import GHC.Iface.Env import GHC.Hs import RdrName import HscTypes diff --git a/compiler/rename/RnFixity.hs b/compiler/rename/RnFixity.hs index 68d1348871..aeff25094f 100644 --- a/compiler/rename/RnFixity.hs +++ b/compiler/rename/RnFixity.hs @@ -13,7 +13,7 @@ module RnFixity ( MiniFixityEnv, import GhcPrelude -import LoadIface +import GHC.Iface.Load import GHC.Hs import RdrName import HscTypes diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 7614fb1932..7cb2aeafbb 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -38,7 +38,7 @@ import TcEnv import RnEnv import RnFixity import RnUtils ( warnUnusedTopBinds, mkFieldEnv ) -import LoadIface ( loadSrcInterface ) +import GHC.Iface.Load ( loadSrcInterface ) import TcRnMonad import PrelNames import Module @@ -285,9 +285,9 @@ rnImportDecl this_mod -- Check for self-import, which confuses the typechecker (#9032) -- ghc --make rejects self-import cycles already, but batch-mode may not - -- at least not until TcIface.tcHiBootIface, which is too late to avoid + -- at least not until GHC.IfaceToCore.tcHiBootIface, which is too late to avoid -- typechecker crashes. (Indirect self imports are not caught until - -- TcIface, see #10337 tracking how to make this error better.) + -- GHC.IfaceToCore, see #10337 tracking how to make this error better.) -- -- Originally, we also allowed 'import {-# SOURCE #-} M', but this -- caused bug #10182: in one-shot mode, we should never load an hs-boot @@ -453,7 +453,7 @@ calculateAvails dflags iface mod_safe' want_boot imported_by = -- finished dealing with the direct imports we want to -- know if any of them depended on CM.hi-boot, in -- which case we should do the hi-boot consistency - -- check. See LoadIface.loadHiBootInterface + -- check. See GHC.Iface.Load.loadHiBootInterface ((moduleName imp_mod,want_boot):dep_mods deps,dep_pkgs deps,ptrust) | otherwise = diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs index 500dc7a912..99bdaeeec4 100644 --- a/compiler/simplCore/OccurAnal.hs +++ b/compiler/simplCore/OccurAnal.hs @@ -283,8 +283,8 @@ Loop breaking is surprisingly subtle. First read the section 4 of We avoid infinite inlinings by choosing loop breakers, and ensuring that a loop breaker cuts each loop. -See also Note [Inlining and hs-boot files] in ToIface, which deals -with a closely related source of infinite loops. +See also Note [Inlining and hs-boot files] in GHC.Core.ToIface, which +deals with a closely related source of infinite loops. Fundamentally, we do SCC analysis on a graph. For each recursive group we choose a loop breaker, delete all edges to that node, diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index f5d8f1aeb0..e671378d11 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -3501,7 +3501,7 @@ mkLetUnfolding dflags top_lvl src id new_rhs return (mkUnfolding dflags src is_top_lvl is_bottoming new_rhs) -- We make an unfolding *even for loop-breakers*. -- Reason: (a) It might be useful to know that they are WHNF - -- (b) In TidyPgm we currently assume that, if we want to + -- (b) In GHC.Iface.Tidy we currently assume that, if we want to -- expose the unfolding then indeed we *have* an unfolding -- to expose. (We could instead use the RHS, but currently -- we don't.) The simple thing is always to have one. diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs index 72e293421c..1eb1dab812 100644 --- a/compiler/specialise/Rules.hs +++ b/compiler/specialise/Rules.hs @@ -77,7 +77,7 @@ Note [Overall plumbing for rules] the IdInfo for that Id. See Note [Attach rules to local ids] in DsBinds -* TidyPgm strips off all the rules from local Ids and adds them to +* GHC.Iface.Tidy strips off all the rules from local Ids and adds them to mg_rules, so that the ModGuts has *all* the locally-declared rules. * The HomePackageTable contains a ModDetails for each home package diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs index ee9a148eaa..72415b331b 100644 --- a/compiler/typecheck/FamInst.hs +++ b/compiler/typecheck/FamInst.hs @@ -21,7 +21,7 @@ import InstEnv( roughMatchTcs ) import Coercion import CoreLint import TcEvidence -import LoadIface +import GHC.Iface.Load import TcRnMonad import SrcLoc import TyCon @@ -142,7 +142,7 @@ addressed yet. * The call to checkFamConsistency for imported functions occurs very early (in tcRnImports) and that causes problems if the imported instances use type declared in the module being compiled. - See Note [Loading your own hi-boot file] in LoadIface. + See Note [Loading your own hi-boot file] in GHC.Iface.Load. -} {- diff --git a/compiler/typecheck/TcBackpack.hs b/compiler/typecheck/TcBackpack.hs index fccc373368..2df8478123 100644 --- a/compiler/typecheck/TcBackpack.hs +++ b/compiler/typecheck/TcBackpack.hs @@ -30,13 +30,13 @@ import TcTyDecls import InstEnv import FamInstEnv import Inst -import TcIface +import GHC.IfaceToCore import TcMType import TcType import TcSimplify import Constraint import TcOrigin -import LoadIface +import GHC.Iface.Load import RnNames import ErrUtils import Id @@ -54,7 +54,7 @@ import RnFixity ( lookupFixityRn ) import Maybes import TcEnv import Var -import IfaceSyn +import GHC.Iface.Syntax import PrelNames import qualified Data.Map as Map @@ -63,7 +63,7 @@ import UniqDSet import NameShape import TcErrors import TcUnify -import RnModIface +import GHC.Iface.Rename import Util import Control.Monad @@ -462,7 +462,7 @@ inheritedSigPvpWarning = -- to 'Name's, so this case needs to be handled specially. -- -- The details are in the documentation for 'typecheckIfacesForMerging'. --- and the Note [Resolving never-exported Names in TcIface]. +-- and the Note [Resolving never-exported Names] in GHC.IfaceToCore. -- -- * When we rename modules and signatures, we use the export lists to -- decide how the declarations should be renamed. However, this @@ -471,7 +471,7 @@ inheritedSigPvpWarning = -- *consistently*, so that 'typecheckIfacesForMerging' can wire them -- up as needed. -- --- The details are in Note [rnIfaceNeverExported] in 'RnModIface'. +-- The details are in Note [rnIfaceNeverExported] in 'GHC.Iface.Rename'. -- -- The root cause for all of these complications is the fact that these -- logically "implicit" entities are defined indirectly in an interface @@ -859,7 +859,7 @@ mergeSignatures -- when we have a ClsInst, we can pull up the correct DFun to check if -- the types match. -- - -- See also Note [rnIfaceNeverExported] in RnModIface + -- See also Note [rnIfaceNeverExported] in GHC.Iface.Rename dfun_insts <- forM (tcg_insts tcg_env) $ \inst -> do n <- newDFunName (is_cls inst) (is_tys inst) (nameSrcSpan (is_dfun_name inst)) let dfun = setVarName (is_dfun inst) n diff --git a/compiler/typecheck/TcDerivUtils.hs b/compiler/typecheck/TcDerivUtils.hs index 9005f738a4..092e97983b 100644 --- a/compiler/typecheck/TcDerivUtils.hs +++ b/compiler/typecheck/TcDerivUtils.hs @@ -35,8 +35,8 @@ import HscTypes (lookupFixity, mi_fix) import GHC.Hs import Inst import InstEnv -import LoadIface (loadInterfaceForName) -import Module (getModule) +import GHC.Iface.Load (loadInterfaceForName) +import Module (getModule) import Name import Outputable import PrelNames diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index 725274bbaf..4e6e367b48 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -74,11 +74,11 @@ module TcEnv( import GhcPrelude import GHC.Hs -import IfaceEnv +import GHC.Iface.Env import TcRnMonad import TcMType import TcType -import LoadIface +import GHC.Iface.Load import PrelNames import TysWiredIn import Id @@ -209,7 +209,7 @@ span of the Name. tcLookupLocatedGlobal :: Located Name -> TcM TyThing --- c.f. IfaceEnvEnv.tcIfaceGlobal +-- c.f. GHC.IfaceToCore.tcIfaceGlobal tcLookupLocatedGlobal name = addLocM tcLookupGlobal name diff --git a/compiler/typecheck/TcGenGenerics.hs b/compiler/typecheck/TcGenGenerics.hs index 2f068343fb..3f59cb08fd 100644 --- a/compiler/typecheck/TcGenGenerics.hs +++ b/compiler/typecheck/TcGenGenerics.hs @@ -27,7 +27,7 @@ import FamInstEnv ( FamInst, FamFlavor(..), mkSingleCoAxiom ) import FamInst import Module ( moduleName, moduleNameFS , moduleUnitId, unitIdFS, getModule ) -import IfaceEnv ( newGlobalBinder ) +import GHC.Iface.Env ( newGlobalBinder ) import Name hiding ( varName ) import RdrName import BasicTypes diff --git a/compiler/typecheck/TcHoleErrors.hs b/compiler/typecheck/TcHoleErrors.hs index 0e8f0a6d06..f6b71c8378 100644 --- a/compiler/typecheck/TcHoleErrors.hs +++ b/compiler/typecheck/TcHoleErrors.hs @@ -54,7 +54,7 @@ import ExtractDocs ( extractDocs ) import qualified Data.Map as Map import GHC.Hs.Doc ( unpackHDS, DeclDocMap(..) ) import HscTypes ( ModIface_(..) ) -import LoadIface ( loadInterfaceForNameMaybe ) +import GHC.Iface.Load ( loadInterfaceForNameMaybe ) import PrelInfo (knownKeyNames) diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index c4f67bbb64..950c8687ce 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -79,7 +79,7 @@ import TcEnv import TcMType import TcValidity import TcUnify -import TcIface +import GHC.IfaceToCore import TcSimplify import TcHsSyn import TyCoRep @@ -3101,7 +3101,7 @@ for D, to fill out its kind. Ideally we don't want this type variable to be 'a', because when pretty printing we'll get class C a b where data D b a0 -(NB: the tidying happens in the conversion to IfaceSyn, which happens +(NB: the tidying happens in the conversion to Iface syntax, which happens as part of pretty-printing a TyThing.) That's why we look in the LocalRdrEnv to see what's in scope. This is diff --git a/compiler/typecheck/TcPluginM.hs b/compiler/typecheck/TcPluginM.hs index d88e25cc87..eefde31120 100644 --- a/compiler/typecheck/TcPluginM.hs +++ b/compiler/typecheck/TcPluginM.hs @@ -57,7 +57,7 @@ import qualified TcSMonad as TcS import qualified TcEnv as TcM import qualified TcMType as TcM import qualified FamInst as TcM -import qualified IfaceEnv +import qualified GHC.Iface.Env as IfaceEnv import qualified Finder import FamInstEnv ( FamInstEnv ) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 19b074954d..8bec345b82 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -50,7 +50,7 @@ import GhcPrelude import {-# SOURCE #-} TcSplice ( finishTH, runRemoteModFinalizers ) import RnSplice ( rnTopSpliceDecls, traceSplice, SpliceInfo(..) ) -import IfaceEnv( externaliseName ) +import GHC.Iface.Env( externaliseName ) import TcHsType import TcValidity( checkValidType ) import TcMatches @@ -65,8 +65,8 @@ import TysWiredIn ( unitTy, mkListTy ) import Plugins import DynFlags import GHC.Hs -import IfaceSyn ( ShowSub(..), showToHeader ) -import IfaceType( ShowForAllFlag(..) ) +import GHC.Iface.Syntax ( ShowSub(..), showToHeader ) +import GHC.Iface.Type ( ShowForAllFlag(..) ) import PatSyn( pprPatSynType ) import PrelNames import PrelInfo @@ -87,21 +87,21 @@ import FamInstEnv( FamInst, pprFamInst, famInstsRepTyCons , famInstEnvElts, extendFamInstEnvList, normaliseType ) import TcAnnotations import TcBinds -import MkIface ( coAxiomToIfaceDecl ) +import GHC.Iface.Utils ( coAxiomToIfaceDecl ) import HeaderInfo ( mkPrelImports ) import TcDefaults import TcEnv import TcRules import TcForeign import TcInstDcls -import TcIface +import GHC.IfaceToCore import TcMType import TcType import TcSimplify import TcTyClsDecls import TcTypeable ( mkTypeableBinds ) import TcBackpack -import LoadIface +import GHC.Iface.Load import RnNames import RnEnv import RnSource @@ -767,7 +767,7 @@ the new tycons and ids. This most works well, but there is one problem: DFuns! We do not want to look at the mb_insts of the ModDetails in SelfBootInfo, because a -dfun in one of those ClsInsts is gotten (in TcIface.tcIfaceInst) by a +dfun in one of those ClsInsts is gotten (in GHC.IfaceToCore.tcIfaceInst) by a (lazily evaluated) lookup in the if_rec_types. We could extend the type env, do a setGloblaTypeEnv etc; but that all seems very indirect. It is much more directly simply to extract the DFunIds from the @@ -1834,7 +1834,7 @@ being called "Main.main". That's why root_main_id has a fixed module ":Main".) This is unusual: it's a LocalId whose Name has a Module from another -module. Tiresomely, we must filter it out again in MkIface, les we +module. Tiresomely, we must filter it out again in GHC.Iface.Utils, less we get two defns for 'main' in the interface file! @@ -2813,7 +2813,7 @@ ppr_tycons debug fam_insts type_env roles = tyConRoles tc boring_role | isClassTyCon tc = Nominal | otherwise = Representational - -- Matches the choice in IfaceSyn, calls to pprRoles + -- Matches the choice in GHC.Iface.Syntax, calls to pprRoles ppr_ax ax = ppr (coAxiomToIfaceDecl ax) -- We go via IfaceDecl rather than using pprCoAxiom diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 3445d5b793..b2248073d8 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -142,7 +142,7 @@ import qualified Language.Haskell.TH as TH -- | A 'NameShape' is a substitution on 'Name's that can be used -- to refine the identities of a hole while we are renaming interfaces --- (see 'RnModIface'). Specifically, a 'NameShape' for +-- (see 'GHC.Iface.Rename'). Specifically, a 'NameShape' for -- 'ns_module_name' @A@, defines a mapping from @{A.T}@ -- (for some 'OccName' @T@) to some arbitrary other 'Name'. -- @@ -242,7 +242,7 @@ data IfGblEnv -- was originally a hi-boot file. -- We need the module name so we can test when it's appropriate -- to look in this env. - -- See Note [Tying the knot] in TcIface + -- See Note [Tying the knot] in GHC.IfaceToCore if_rec_types :: Maybe (Module, IfG TypeEnv) -- Allows a read effect, so it can be in a mutable -- variable; c.f. handling the external package type env @@ -275,8 +275,8 @@ data IfLclEnv -- This field is used to make sure "implicit" declarations -- (anything that cannot be exported in mi_exports) get -- wired up correctly in typecheckIfacesForMerging. Most - -- of the time it's @Nothing@. See Note [Resolving never-exported Names in TcIface] - -- in TcIface. + -- of the time it's @Nothing@. See Note [Resolving never-exported Names] + -- in GHC.IfaceToCore. if_implicits_env :: Maybe TypeEnv, if_tv_env :: FastStringEnv TyVar, -- Nested tyvar bindings @@ -385,14 +385,14 @@ data FrontendResult -- then moduleUnitId this_mod == thisPackage dflags -- -- - For any code involving Names, we want semantic modules. --- See lookupIfaceTop in IfaceEnv, mkIface and addFingerprints --- in MkIface, and tcLookupGlobal in TcEnv +-- See lookupIfaceTop in GHC.Iface.Env, mkIface and addFingerprints +-- in GHC.Iface.Utils, and tcLookupGlobal in TcEnv -- -- - When reading interfaces, we want the identity module to -- identify the specific interface we want (such interfaces -- should never be loaded into the EPS). However, if a -- hole module <A> is requested, we look for A.hi --- in the home library we are compiling. (See LoadIface.) +-- in the home library we are compiling. (See GHC.Iface.Load.) -- Similarly, in RnNames we check for self-imports using -- identity modules, to allow signatures to import their implementor. -- @@ -666,7 +666,7 @@ We gather three sorts of usage information Used (a) to report "defined but not used" (see RnNames.reportUnusedNames) (b) to generate version-tracking usage info in interface - files (see MkIface.mkUsedNames) + files (see GHC.Iface.Utils.mkUsedNames) This usage info is mainly gathered by the renamer's gathering of free-variables @@ -1433,7 +1433,7 @@ data WhereFrom = ImportByUser IsBootInterface -- Ordinary user import (perhaps {-# SOURCE #-}) | ImportBySystem -- Non user import. | ImportByPlugin -- Importing a plugin; - -- See Note [Care with plugin imports] in LoadIface + -- See Note [Care with plugin imports] in GHC.Iface.Load instance Outputable WhereFrom where ppr (ImportByUser is_boot) | is_boot = text "{- SOURCE -}" diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index c2803571cf..b256edb911 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -73,7 +73,7 @@ import Type import NameSet import TcMType import TcHsType -import TcIface +import GHC.IfaceToCore import TyCoRep import FamInst import FamInstEnv @@ -86,7 +86,7 @@ import OccName import Hooks import Var import Module -import LoadIface +import GHC.Iface.Load import Class import TyCon import CoAxiom diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index 60a0f5e3b3..1568768f55 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -15,7 +15,7 @@ module TcTypeable(mkTypeableBinds, tyConIsTypeable) where import GhcPrelude import BasicTypes ( Boxity(..), neverInlinePragma, SourceText(..) ) -import IfaceEnv( newGlobalBinder ) +import GHC.Iface.Env( newGlobalBinder ) import TyCoRep( Type(..), TyLit(..) ) import TcEnv import TcEvidence ( mkWpTyApps ) @@ -83,7 +83,7 @@ The overall plan is this: to use for these M.$tcT "tycon rep names". Note that these must be treated as "never exported" names by Backpack (see Note [Handling never-exported TyThings under Backpack]). Consequently - they get slightly special treatment in RnModIface.rnIfaceDecl. + they get slightly special treatment in GHC.Iface.Rename.rnIfaceDecl. 3. Record the TyConRepName in T's TyCon, including for promoted data and type constructors, and kinds like * and #. @@ -344,7 +344,7 @@ mkPrimTypeableTodos -- The majority of the types we need here are contained in 'primTyCons'. -- However, not all of them: in particular unboxed tuples are absent since we -- don't want to include them in the original name cache. See --- Note [Built-in syntax and the OrigNameCache] in IfaceEnv for more. +-- Note [Built-in syntax and the OrigNameCache] in GHC.Iface.Env for more. ghcPrimTypeableTyCons :: [TyCon] ghcPrimTypeableTyCons = concat [ [ runtimeRepTyCon, vecCountTyCon, vecElemTyCon, funTyCon ] diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 1b5777e33b..8942956c67 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -43,8 +43,8 @@ import Predicate import TcOrigin -- others: -import IfaceType( pprIfaceType, pprIfaceTypeApp ) -import ToIface ( toIfaceTyCon, toIfaceTcArgs, toIfaceType ) +import GHC.Iface.Type ( pprIfaceType, pprIfaceTypeApp ) +import GHC.CoreToIface ( toIfaceTyCon, toIfaceTcArgs, toIfaceType ) import GHC.Hs -- HsType import TcRnMonad -- TcType, amongst others import TcEnv ( tcInitTidyEnv, tcInitOpenTidyEnv ) diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 16db7c5f6c..8a8fc3d838 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -116,11 +116,11 @@ module Coercion ( #include "HsVersions.h" -import {-# SOURCE #-} ToIface (toIfaceTyCon, tidyToIfaceTcArgs) +import {-# SOURCE #-} GHC.CoreToIface (toIfaceTyCon, tidyToIfaceTcArgs) import GhcPrelude -import IfaceType +import GHC.Iface.Type import TyCoRep import TyCoFVs import TyCoPpr @@ -231,7 +231,7 @@ ppr_co_ax_branch :: (TidyEnv -> Type -> SDoc) ppr_co_ax_branch ppr_rhs fam_tc branch = foldr1 (flip hangNotEmpty 2) [ pprUserForAll (mkTyCoVarBinders Inferred bndrs') - -- See Note [Printing foralls in type family instances] in IfaceType + -- See Note [Printing foralls in type family instances] in GHC.Iface.Type , pp_lhs <+> ppr_rhs tidy_env ee_rhs , text "-- Defined" <+> pp_loc ] where diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index a21933c631..0cf329c4ca 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -245,7 +245,7 @@ pprFamInsts finsts = vcat (map pprFamInst finsts) Note [Lazy axiom match] ~~~~~~~~~~~~~~~~~~~~~~~ It is Vitally Important that mkImportedFamInst is *lazy* in its axiom -parameter. The axiom is loaded lazily, via a forkM, in TcIface. Sometime +parameter. The axiom is loaded lazily, via a forkM, in GHC.IfaceToCore. Sometime later, mkImportedFamInst is called using that axiom. However, the axiom may itself depend on entities which are not yet loaded as of the time of the mkImportedFamInst. Thus, if mkImportedFamInst eagerly looks at the diff --git a/compiler/types/InstEnv.hs b/compiler/types/InstEnv.hs index 13a0b30555..e9960978d5 100644 --- a/compiler/types/InstEnv.hs +++ b/compiler/types/InstEnv.hs @@ -320,7 +320,7 @@ mkImportedInstance cls_nm mb_tcs dfun_name dfun oflag orphan {- Note [When exactly is an instance decl an orphan?] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - (see MkIface.instanceToIfaceInst, which implements this) + (see GHC.Iface.Utils.instanceToIfaceInst, which implements this) Roughly speaking, an instance is an orphan if its head (after the =>) mentions nothing defined in this module. diff --git a/compiler/types/TyCoPpr.hs b/compiler/types/TyCoPpr.hs index e46b299cc5..fbbdfbd7a0 100644 --- a/compiler/types/TyCoPpr.hs +++ b/compiler/types/TyCoPpr.hs @@ -27,8 +27,10 @@ module TyCoPpr import GhcPrelude -import {-# SOURCE #-} ToIface( toIfaceTypeX, toIfaceTyLit, toIfaceForAllBndr - , toIfaceTyCon, toIfaceTcArgs, toIfaceCoercionX ) +import {-# SOURCE #-} GHC.CoreToIface + ( toIfaceTypeX, toIfaceTyLit, toIfaceForAllBndr + , toIfaceTyCon, toIfaceTcArgs, toIfaceCoercionX ) + import {-# SOURCE #-} DataCon( dataConFullSig , dataConUserTyVarBinders , DataCon ) @@ -42,7 +44,7 @@ import TyCoFVs import Class import Var -import IfaceType +import GHC.Iface.Type import VarSet import VarEnv @@ -68,7 +70,7 @@ parens around the type, except for the atomic cases. @pprParendType@ works just by setting the initial context precedence very high. Note that any function which pretty-prints a @Type@ first converts the @Type@ -to an @IfaceType@. See Note [IfaceType and pretty-printing] in IfaceType. +to an @IfaceType@. See Note [IfaceType and pretty-printing] in GHC.Iface.Type. See Note [Precedence in types] in BasicTypes. -} @@ -76,7 +78,7 @@ See Note [Precedence in types] in BasicTypes. -------------------------------------------------------- -- When pretty-printing types, we convert to IfaceType, -- and pretty-print that. --- See Note [Pretty printing via IfaceSyn] in PprTyThing +-- See Note [Pretty printing via Iface syntax] in PprTyThing -------------------------------------------------------- pprType, pprParendType :: Type -> SDoc diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index be2f74c731..b1ecf74d3d 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -76,7 +76,7 @@ import {-# SOURCE #-} TyCoPpr ( pprType, pprCo, pprTyLit ) import {-# SOURCE #-} ConLike ( ConLike(..), conLikeName ) -- friends: -import IfaceType +import GHC.Iface.Type import Var import VarSet import Name hiding ( varName ) diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 9157c33c4e..ea3ef90b49 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -479,7 +479,7 @@ isInvisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool isInvisibleTyConBinder tcb = not (isVisibleTyConBinder tcb) -- Build the 'tyConKind' from the binders and the result kind. --- Keep in sync with 'mkTyConKind' in iface/IfaceType. +-- Keep in sync with 'mkTyConKind' in GHC.Iface.Type. mkTyConKind :: [TyConBinder] -> Kind -> Kind mkTyConKind bndrs res_kind = foldr mk res_kind bndrs where diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 749578d78f..4e32824b09 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -1170,7 +1170,7 @@ We have :: * -> * -> * So again we must instantiate. -The same thing happens in ToIface.toIfaceAppArgsX. +The same thing happens in GHC.CoreToIface.toIfaceAppArgsX. --------------------------------------------------------------------- @@ -2937,7 +2937,7 @@ classifiesTypeWithValues k = isJust (kindRep_maybe k) %* * %************************************************************************ -Most pretty-printing is either in TyCoRep or IfaceType. +Most pretty-printing is either in TyCoRep or GHC.Iface.Type. -} diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index f363976626..498c4924de 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -1037,7 +1037,7 @@ lazyGet bh = do -- These two settings have different needs while serializing Names: -- -- * Names in interface files are serialized via a symbol table (see Note --- [Symbol table representation of names] in BinIface). +-- [Symbol table representation of names] in GHC.Iface.Binary). -- -- * During fingerprinting a binding Name is serialized as the OccName and a -- non-binding Name is serialized as the fingerprint of the thing they |