diff --git a/compiler/GHC.hs b/compiler/GHC.hs index 1682f1685e4b0eadd03d07b4b42c60a42a34d5b0..b78883c42e20a2aef963476d2cda7a5ee7c56970 100644 --- a/compiler/GHC.hs +++ b/compiler/GHC.hs @@ -319,7 +319,7 @@ import GHC.Hs import GHC.Core.Type hiding( typeKind ) import GHC.Tc.Utils.TcType import GHC.Types.Id -import TysPrim ( alphaTyVars ) +import GHC.Builtin.Types.Prim ( alphaTyVars ) import GHC.Core.TyCon import GHC.Core.TyCo.Ppr ( pprForAll ) import GHC.Core.Class @@ -338,8 +338,8 @@ import GHC.Driver.Types import GHC.Driver.CmdLine import GHC.Driver.Session hiding (WarnReason(..)) import GHC.Driver.Ways -import SysTools -import SysTools.BaseDir +import GHC.SysTools +import GHC.SysTools.BaseDir import GHC.Types.Annotations import GHC.Types.Module import Panic @@ -352,15 +352,15 @@ import StringBuffer import Outputable import GHC.Types.Basic import FastString -import qualified Parser -import Lexer -import ApiAnnotation +import qualified GHC.Parser as Parser +import GHC.Parser.Lexer +import GHC.Parser.Annotation import qualified GHC.LanguageExtensions as LangExt import GHC.Types.Name.Env import GHC.Tc.Module import GHC.Tc.Utils.Instantiate import GHC.Tc.Instance.Family -import FileCleanup +import GHC.SysTools.FileCleanup import Data.Foldable import qualified Data.Map.Strict as Map @@ -857,7 +857,7 @@ data ParsedModule = , pm_parsed_source :: ParsedSource , pm_extra_src_files :: [FilePath] , pm_annotations :: ApiAnns } - -- See Note [Api annotations] in ApiAnnotation.hs + -- See Note [Api annotations] in GHC.Parser.Annotation instance ParsedMod ParsedModule where modSummary m = pm_mod_summary m @@ -951,7 +951,7 @@ parseModule ms = do hpm <- liftIO $ hscParse hsc_env_tmp ms return (ParsedModule ms (hpm_module hpm) (hpm_src_files hpm) (hpm_annotations hpm)) - -- See Note [Api annotations] in ApiAnnotation.hs + -- See Note [Api annotations] in GHC.Parser.Annotation -- | Typecheck and rename a parsed module. -- diff --git a/compiler/prelude/PrelNames.hs b/compiler/GHC/Builtin/Names.hs similarity index 98% rename from compiler/prelude/PrelNames.hs rename to compiler/GHC/Builtin/Names.hs index 583cbf9c444d681c3296e541e02d4b75ce130fd9..1b1bfdf7fe6480bb4aab870b3c937edb7bfe48ff 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -1,7 +1,7 @@ {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -\section[PrelNames]{Definitions of prelude modules and names} +\section[GHC.Builtin.Names]{Definitions of prelude modules and names} Nota Bene: all Names defined in here should come from the base package @@ -63,7 +63,7 @@ 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 + GHC.Builtin.Types) are used to initialise the "OrigNameCache" in 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 @@ -98,7 +98,7 @@ things, 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. + work] in GHC.Builtin.Types. 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, @@ -145,16 +145,17 @@ Note [Wired-in packages] in GHC.Types.Module. This is done in Packages.findWired {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module PrelNames ( - Unique, Uniquable(..), hasKey, -- Re-exported for convenience +module GHC.Builtin.Names + ( Unique, Uniquable(..), hasKey, -- Re-exported for convenience - ----------------------------------------------------------- - module PrelNames, -- A huge bunch of (a) Names, e.g. intTyConName - -- (b) Uniques e.g. intTyConKey - -- (c) Groups of classes and types - -- (d) miscellaneous things - -- So many that we export them all - ) where + ----------------------------------------------------------- + module GHC.Builtin.Names, -- A huge bunch of (a) Names, e.g. intTyConName + -- (b) Uniques e.g. intTyConKey + -- (c) Groups of classes and types + -- (d) miscellaneous things + -- So many that we export them all + ) +where #include "HsVersions.h" @@ -210,7 +211,7 @@ isUnboundName name = name `hasKey` unboundKey This section tells what the compiler knows about the association of names with uniques. These ones are the *non* wired-in ones. The -wired in ones are defined in TysWiredIn etc. +wired in ones are defined in GHC.Builtin.Types etc. -} basicKnownKeyNames :: [Name] -- See Note [Known-key names] @@ -1648,7 +1649,7 @@ hasFieldClassNameKey = mkPreludeClassUnique 49 ---------------- Template Haskell ------------------- --- THNames.hs: USES ClassUniques 200-299 +-- GHC.Builtin.Names.TH: USES ClassUniques 200-299 ----------------------------------------------------- {- @@ -1895,7 +1896,7 @@ unsafeEqualityTyConKey = mkPreludeTyConUnique 191 ---------------- Template Haskell ------------------- --- THNames.hs: USES TyConUniques 200-299 +-- GHC.Builtin.Names.TH: USES TyConUniques 200-299 ----------------------------------------------------- ----------------------- SIMD ------------------------ @@ -2025,7 +2026,7 @@ vecRepDataConKey = mkPreludeDataConUnique 71 tupleRepDataConKey = mkPreludeDataConUnique 72 sumRepDataConKey = mkPreludeDataConUnique 73 --- See Note [Wiring in RuntimeRep] in TysWiredIn +-- See Note [Wiring in RuntimeRep] in GHC.Builtin.Types runtimeRepSimpleDataConKeys, unliftedSimpleRepDataConKeys, unliftedRepDataConKeys :: [Unique] liftedRepDataConKey :: Unique runtimeRepSimpleDataConKeys@(liftedRepDataConKey : unliftedSimpleRepDataConKeys) @@ -2036,12 +2037,12 @@ unliftedRepDataConKeys = vecRepDataConKey : sumRepDataConKey : unliftedSimpleRepDataConKeys --- See Note [Wiring in RuntimeRep] in TysWiredIn +-- See Note [Wiring in RuntimeRep] in GHC.Builtin.Types -- VecCount vecCountDataConKeys :: [Unique] vecCountDataConKeys = map mkPreludeDataConUnique [89..94] --- See Note [Wiring in RuntimeRep] in TysWiredIn +-- See Note [Wiring in RuntimeRep] in GHC.Builtin.Types -- VecElem vecElemDataConKeys :: [Unique] vecElemDataConKeys = map mkPreludeDataConUnique [95..104] @@ -2068,7 +2069,7 @@ unsafeReflDataConKey :: Unique unsafeReflDataConKey = mkPreludeDataConUnique 114 ---------------- Template Haskell ------------------- --- THNames.hs: USES DataUniques 200-250 +-- GHC.Builtin.Names.TH: USES DataUniques 200-250 ----------------------------------------------------- @@ -2319,7 +2320,7 @@ proxyHashKey :: Unique proxyHashKey = mkPreludeMiscIdUnique 502 ---------------- Template Haskell ------------------- --- THNames.hs: USES IdUniques 200-499 +-- GHC.Builtin.Names.TH: USES IdUniques 200-499 ----------------------------------------------------- -- Used to make `Typeable` dictionaries diff --git a/compiler/prelude/PrelNames.hs-boot b/compiler/GHC/Builtin/Names.hs-boot similarity index 75% rename from compiler/prelude/PrelNames.hs-boot rename to compiler/GHC/Builtin/Names.hs-boot index 9906496b37928911237a904fc5bda5580990795f..8dcd62e7164cdcf23ca4462b3fdf491700febf17 100644 --- a/compiler/prelude/PrelNames.hs-boot +++ b/compiler/GHC/Builtin/Names.hs-boot @@ -1,4 +1,4 @@ -module PrelNames where +module GHC.Builtin.Names where import GHC.Types.Module import GHC.Types.Unique diff --git a/compiler/prelude/THNames.hs b/compiler/GHC/Builtin/Names/TH.hs similarity index 99% rename from compiler/prelude/THNames.hs rename to compiler/GHC/Builtin/Names/TH.hs index e2efbdaa0d4f1c8f253053b5f5c387b35bbf0a2a..7f83cd7521a8c060649e6e4745f555bdd148502d 100644 --- a/compiler/prelude/THNames.hs +++ b/compiler/GHC/Builtin/Names/TH.hs @@ -4,11 +4,11 @@ -- %* * -- %************************************************************************ -module THNames where +module GHC.Builtin.Names.TH where import GhcPrelude () -import PrelNames( mk_known_key_name ) +import GHC.Builtin.Names( mk_known_key_name ) import GHC.Types.Module( Module, mkModuleNameFS, mkModule, thUnitId ) import GHC.Types.Name( Name ) import GHC.Types.Name.Occurrence( tcName, clsName, dataName, varName ) @@ -608,7 +608,7 @@ incoherentDataConName = thCon (fsLit "Incoherent") incoherentDataConKey ********************************************************************* -} -- ClassUniques available: 200-299 --- Check in PrelNames if you want to change this +-- Check in GHC.Builtin.Names if you want to change this liftClassKey :: Unique liftClassKey = mkPreludeClassUnique 200 @@ -623,7 +623,7 @@ quoteClassKey = mkPreludeClassUnique 201 ********************************************************************* -} -- TyConUniques available: 200-299 --- Check in PrelNames if you want to change this +-- Check in GHC.Builtin.Names if you want to change this expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey, patTyConKey, @@ -675,7 +675,7 @@ decsTyConKey = mkPreludeTyConUnique 236 ********************************************************************* -} -- DataConUniques available: 100-150 --- If you want to change this, make sure you check in PrelNames +-- If you want to change this, make sure you check in GHC.Builtin.Names -- data Inline = ... noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique @@ -715,7 +715,7 @@ incoherentDataConKey = mkPreludeDataConUnique 212 ********************************************************************* -} -- IdUniques available: 200-499 --- If you want to change this, make sure you check in PrelNames +-- If you want to change this, make sure you check in GHC.Builtin.Names returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey, mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey, diff --git a/compiler/prelude/PrimOp.hs b/compiler/GHC/Builtin/PrimOps.hs similarity index 99% rename from compiler/prelude/PrimOp.hs rename to compiler/GHC/Builtin/PrimOps.hs index 61df05840cfeb6ced530d779f0a54819eebac9ee..e85c12a55d8fc0ff13e58b0681a21fd936d002af 100644 --- a/compiler/prelude/PrimOp.hs +++ b/compiler/GHC/Builtin/PrimOps.hs @@ -6,7 +6,7 @@ {-# LANGUAGE CPP #-} -module PrimOp ( +module GHC.Builtin.PrimOps ( PrimOp(..), PrimOpVecCat(..), allThePrimOps, primOpType, primOpSig, primOpTag, maxPrimOpTag, primOpOcc, @@ -27,15 +27,15 @@ module PrimOp ( import GhcPrelude -import TysPrim -import TysWiredIn +import GHC.Builtin.Types.Prim +import GHC.Builtin.Types import GHC.Cmm.Type import GHC.Types.Demand import GHC.Types.Id ( Id, mkVanillaGlobalWithInfo ) import GHC.Types.Id.Info ( vanillaIdInfo, setCafInfo, CafInfo(NoCafRefs) ) import GHC.Types.Name -import PrelNames ( gHC_PRIMOPWRAPPERS ) +import GHC.Builtin.Names ( gHC_PRIMOPWRAPPERS ) import GHC.Core.TyCon ( TyCon, isPrimTyCon, PrimRep(..) ) import GHC.Core.Type import GHC.Types.RepType ( typePrimRep1, tyConPrimRep1 ) diff --git a/compiler/prelude/PrimOp.hs-boot b/compiler/GHC/Builtin/PrimOps.hs-boot similarity index 51% rename from compiler/prelude/PrimOp.hs-boot rename to compiler/GHC/Builtin/PrimOps.hs-boot index f10ef449720e9bed2d16b3f8d7a358367565853e..e9f913f602f3b47f0c8b82892a85b6da88e756d3 100644 --- a/compiler/prelude/PrimOp.hs-boot +++ b/compiler/GHC/Builtin/PrimOps.hs-boot @@ -1,4 +1,4 @@ -module PrimOp where +module GHC.Builtin.PrimOps where import GhcPrelude () diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/GHC/Builtin/Types.hs similarity index 98% rename from compiler/prelude/TysWiredIn.hs rename to compiler/GHC/Builtin/Types.hs index 682c9d7d8a5b07067bed7a82f00e9634c901d3d3..2e4ba28b6a4c35d68fb72350ceaf4e48bac1d1a3 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/GHC/Builtin/Types.hs @@ -1,7 +1,7 @@ {- (c) The GRASP Project, Glasgow University, 1994-1998 -\section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types} +Wired-in knowledge about {\em non-primitive} types -} {-# LANGUAGE CPP #-} @@ -10,10 +10,10 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | This module is about types that can be defined in Haskell, but which --- must be wired into the compiler nonetheless. C.f module TysPrim -module TysWiredIn ( +-- must be wired into the compiler nonetheless. C.f module GHC.Builtin.Types.Prim +module GHC.Builtin.Types ( -- * Helper functions defined here - mkWiredInTyConName, -- This is used in TcTypeNats to define the + mkWiredInTyConName, -- This is used in GHC.Builtin.Types.Literals to define the -- built-in functions for evaluation. mkWiredInIdName, -- used in GHC.Types.Id.Make @@ -135,14 +135,14 @@ import GhcPrelude import {-# SOURCE #-} GHC.Types.Id.Make ( mkDataConWorkId, mkDictSelId ) -- friends: -import PrelNames -import TysPrim -import {-# SOURCE #-} KnownUniques +import GHC.Builtin.Names +import GHC.Builtin.Types.Prim +import {-# SOURCE #-} GHC.Builtin.Uniques -- others: import GHC.Core.Coercion.Axiom import GHC.Types.Id -import Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) +import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import GHC.Types.Module ( Module ) import GHC.Core.Type import GHC.Types.RepType @@ -193,10 +193,10 @@ See also Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType. ************************************************************************ If you change which things are wired in, make sure you change their -names in PrelNames, so they use wTcQual, wDataQual, etc +names in GHC.Builtin.Names, so they use wTcQual, wDataQual, etc -} --- This list is used only to define PrelInfo.wiredInThings. That in turn +-- This list is used only to define GHC.Builtin.Utils.wiredInThings. That in turn -- is used to initialise the name environment carried around by the renamer. -- This means that if we look up the name of a TyCon (or its implicit binders) -- that occurs in this list that name will be assigned the wired-in key we @@ -375,7 +375,7 @@ It has these properties: * If (Any k) is the type of a value, it must be a /lifted/ value. So if we have (Any @(TYPE rr)) then rr must be 'LiftedRep. See - Note [TYPE and RuntimeRep] in TysPrim. This is a convenient + Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim. This is a convenient invariant, and makes isUnliftedTyCon well-defined; otherwise what would (isUnliftedTyCon Any) be? @@ -654,7 +654,7 @@ constraintKind = mkTyConApp constraintKindTyCon [] * * ************************************************************************ -Note [How tuples work] See also Note [Known-key names] in PrelNames +Note [How tuples work] See also Note [Known-key names] in GHC.Builtin.Names ~~~~~~~~~~~~~~~~~~~~~~ * There are three families of tuple TyCons and corresponding DataCons, expressed by the type BasicTypes.TupleSort: @@ -701,7 +701,7 @@ Note [How tuples work] See also Note [Known-key names] in PrelNames * Serialization to interface files works via the usual mechanism for known-key things: instead of serializing the OccName we just serialize the key. During deserialization we lookup the Name associated with the unique with the logic - in KnownUniques. See Note [Symbol table representation of names] for details. + in GHC.Builtin.Uniques. See Note [Symbol table representation of names] for details. Note [One-tuples] ~~~~~~~~~~~~~~~~~ @@ -1091,7 +1091,7 @@ mk_sum arity = (tycon, sum_cons) * * ********************************************************************* -} --- See Note [The equality types story] in TysPrim +-- See Note [The equality types story] in GHC.Builtin.Types.Prim -- ((~~) :: forall k1 k2 (a :: k1) (b :: k2). a -> b -> Constraint) -- -- It's tempting to put functional dependencies on (~~), but it's not @@ -1171,11 +1171,11 @@ mk_class tycon sc_pred sc_sel_id ********************************************************************* -} -- For information about the usage of the following type, --- see Note [TYPE and RuntimeRep] in module TysPrim +-- see Note [TYPE and RuntimeRep] in module GHC.Builtin.Types.Prim runtimeRepTy :: Type runtimeRepTy = mkTyConTy runtimeRepTyCon --- Type synonyms; see Note [TYPE and RuntimeRep] in TysPrim +-- Type synonyms; see Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim -- type Type = tYPE 'LiftedRep liftedTypeKindTyCon :: TyCon liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName diff --git a/compiler/prelude/TysWiredIn.hs-boot b/compiler/GHC/Builtin/Types.hs-boot similarity index 97% rename from compiler/prelude/TysWiredIn.hs-boot rename to compiler/GHC/Builtin/Types.hs-boot index 426c1015a68d33652c65cf3209ccaffae9ee0105..b575fd2de38a7625e1b6ba0c63bd0127a40a83a0 100644 --- a/compiler/prelude/TysWiredIn.hs-boot +++ b/compiler/GHC/Builtin/Types.hs-boot @@ -1,4 +1,4 @@ -module TysWiredIn where +module GHC.Builtin.Types where import {-# SOURCE #-} GHC.Core.TyCon ( TyCon ) import {-# SOURCE #-} GHC.Core.TyCo.Rep (Type, Kind) diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/GHC/Builtin/Types/Literals.hs similarity index 97% rename from compiler/typecheck/TcTypeNats.hs rename to compiler/GHC/Builtin/Types/Literals.hs index 12ec08f89fd9110732bc9e7a534e81ba427c2394..d5c1d209c6f673925ec4b0584160178d562d8b16 100644 --- a/compiler/typecheck/TcTypeNats.hs +++ b/compiler/GHC/Builtin/Types/Literals.hs @@ -1,6 +1,6 @@ {-# LANGUAGE LambdaCase #-} -module TcTypeNats +module GHC.Builtin.Types.Literals ( typeNatTyCons , typeNatCoAxiomRules , BuiltInSynFamily(..) @@ -32,9 +32,10 @@ import GHC.Core.Coercion ( Role(..) ) import GHC.Tc.Types.Constraint ( Xi ) import GHC.Core.Coercion.Axiom ( CoAxiomRule(..), BuiltInSynFamily(..), TypeEqn ) import GHC.Types.Name ( Name, BuiltInSyntax(..) ) -import TysWiredIn -import TysPrim ( mkTemplateAnonTyConBinders ) -import PrelNames ( gHC_TYPELITS +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim ( mkTemplateAnonTyConBinders ) +import GHC.Builtin.Names + ( gHC_TYPELITS , gHC_TYPENATS , typeNatAddTyFamNameKey , typeNatMulTyFamNameKey @@ -60,7 +61,7 @@ import Data.List ( isPrefixOf, isSuffixOf ) Note [Type-level literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~ There are currently two forms of type-level literals: natural numbers, and -symbols (even though this module is named TcTypeNats, it covers both). +symbols (even though this module is named GHC.Builtin.Types.Literals, it covers both). Type-level literals are supported by CoAxiomRules (conditional axioms), which power the built-in type families (see Note [Adding built-in type families]). @@ -77,20 +78,20 @@ There are a few steps to adding a built-in type family: * Adding a unique for the type family TyCon - These go in PrelNames. It will likely be of the form + These go in GHC.Builtin.Names. It will likely be of the form @myTyFamNameKey = mkPreludeTyConUnique xyz@, where @xyz@ is a number that - has not been chosen before in PrelNames. There are several examples already - in PrelNames—see, for instance, typeNatAddTyFamNameKey. + has not been chosen before in GHC.Builtin.Names. There are several examples already + in GHC.Builtin.Names—see, for instance, typeNatAddTyFamNameKey. * Adding the type family TyCon itself - This goes in TcTypeNats. There are plenty of examples of how to define + This goes in GHC.Builtin.Types.Literals. There are plenty of examples of how to define these—see, for instance, typeNatAddTyCon. Once your TyCon has been defined, be sure to: - - Export it from TcTypeNats. (Not doing so caused #14632.) - - Include it in the typeNatTyCons list, defined in TcTypeNats. + - Export it from GHC.Builtin.Types.Literals. (Not doing so caused #14632.) + - Include it in the typeNatTyCons list, defined in GHC.Builtin.Types.Literals. * Exposing associated type family axioms @@ -100,7 +101,7 @@ There are a few steps to adding a built-in type family: axAdd0L and axAdd0R). After you have defined all of these axioms, be sure to include them in the - typeNatCoAxiomRules list, defined in TcTypeNats. + typeNatCoAxiomRules list, defined in GHC.Builtin.Types.Literals. (Not doing so caused #14934.) * Define the type family somewhere @@ -109,7 +110,7 @@ There are a few steps to adding a built-in type family: Currently, all of the built-in type families are defined in GHC.TypeLits or GHC.TypeNats, so those are likely candidates. - Since the behavior of your built-in type family is specified in TcTypeNats, + Since the behavior of your built-in type family is specified in GHC.Builtin.Types.Literals, you should give an open type family definition with no instances, like so: type family MyTypeFam (m :: Nat) (n :: Nat) :: Nat diff --git a/compiler/prelude/TysPrim.hs b/compiler/GHC/Builtin/Types/Prim.hs similarity index 97% rename from compiler/prelude/TysPrim.hs rename to compiler/GHC/Builtin/Types/Prim.hs index a5f17870f90f8b3c73a9c4dafc83789d5ef22df8..4bee18b9644d5766c7f0d04485c5111e43b7751a 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/GHC/Builtin/Types/Prim.hs @@ -2,16 +2,16 @@ (c) The AQUA Project, Glasgow University, 1994-1998 -\section[TysPrim]{Wired-in knowledge about primitive types} +Wired-in knowledge about primitive types -} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | This module defines TyCons that can't be expressed in Haskell. --- They are all, therefore, wired-in TyCons. C.f module TysWiredIn -module TysPrim( - mkPrimTyConName, -- For implicit parameters in TysWiredIn only +-- They are all, therefore, wired-in TyCons. C.f module GHC.Builtin.Types +module GHC.Builtin.Types.Prim( + mkPrimTyConName, -- For implicit parameters in GHC.Builtin.Types only mkTemplateKindVars, mkTemplateTyVars, mkTemplateTyVarsFrom, mkTemplateKiTyVars, mkTemplateKiTyVar, @@ -92,7 +92,7 @@ module TysPrim( import GhcPrelude -import {-# SOURCE #-} TysWiredIn +import {-# SOURCE #-} GHC.Builtin.Types ( runtimeRepTy, unboxedTupleKind, liftedTypeKind , vecRepDataConTyCon, tupleRepDataConTyCon , liftedRepDataConTy, unliftedRepDataConTy @@ -115,7 +115,7 @@ import GHC.Types.Name import GHC.Core.TyCon import GHC.Types.SrcLoc import GHC.Types.Unique -import PrelNames +import GHC.Builtin.Names import FastString import Outputable import GHC.Core.TyCo.Rep -- Doesn't need special access, but this is easier to avoid @@ -467,7 +467,7 @@ generator never has to manipulate a value of type 'a :: TYPE rr'. (a :: TYPE r1) (b :: TYPE r2). a -> b -* Unboxed tuples, and unboxed sums, defined in TysWiredIn +* Unboxed tuples, and unboxed sums, defined in GHC.Builtin.Types Always inlined, and hence specialised to the call site (#,#) :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a :: TYPE r1) (b :: TYPE r2). @@ -532,7 +532,7 @@ tYPE rr = TyConApp tYPETyCon [rr] {- ************************************************************************ * * -\subsection[TysPrim-basic]{Basic primitive types (@Char#@, @Int#@, etc.)} + Basic primitive types (@Char#@, @Int#@, etc.) * * ************************************************************************ -} @@ -665,7 +665,7 @@ doublePrimTyCon = pcPrimTyCon0 doublePrimTyConName DoubleRep {- ************************************************************************ * * -\subsection[TysPrim-state]{The @State#@ type (and @_RealWorld@ types)} + The @State#@ type (and @_RealWorld@ types) * * ************************************************************************ @@ -711,7 +711,7 @@ All wanted constraints of this type are built with coercion holes. Note [Deferred errors for coercion holes] in GHC.Tc.Errors to see how equality constraints are deferred. -Within GHC, ~# is called eqPrimTyCon, and it is defined in TysPrim. +Within GHC, ~# is called eqPrimTyCon, and it is defined in GHC.Builtin.Types.Prim. -------------------------- @@ -745,7 +745,7 @@ equalities. There is some special-casing in GHC.Tc.Solver.Interact.matchClassIns pretend that there is an instance of this class, as we can't write the instance in Haskell. -Within GHC, ~~ is called heqTyCon, and it is defined in TysWiredIn. +Within GHC, ~~ is called heqTyCon, and it is defined in GHC.Builtin.Types. -------------------------- @@ -761,7 +761,7 @@ It is an almost-ordinary class defined as if by * In addition (~) is magical syntax, as ~ is a reserved symbol. It cannot be exported or imported. -Within GHC, ~ is called eqTyCon, and it is defined in TysWiredIn. +Within GHC, ~ is called eqTyCon, and it is defined in GHC.Builtin.Types. Historical note: prior to July 18 (~) was defined as a more-ordinary class with (~~) as a superclass. But that made it @@ -785,7 +785,7 @@ The is the representational analogue of ~#. This is the type of representational equalities that the solver works on. All wanted constraints of this type are built with coercion holes. -Within GHC, ~R# is called eqReprPrimTyCon, and it is defined in TysPrim. +Within GHC, ~R# is called eqReprPrimTyCon, and it is defined in GHC.Builtin.Types.Prim. -------------------------- @@ -803,7 +803,7 @@ split required that both types be fully wired-in. Instead of doing this, I just got rid of HCoercible, as I'm not sure who would use it, anyway. Within GHC, Coercible is called coercibleTyCon, and it is defined in -TysWiredIn. +GHC.Builtin.Types. -------------------------- @@ -865,7 +865,7 @@ realWorldStatePrimTy :: Type realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld -- Note: the ``state-pairing'' types are not truly primitive, --- so they are defined in \tr{TysWiredIn.hs}, not here. +-- so they are defined in \tr{GHC.Builtin.Types}, not here. voidPrimTy :: Type @@ -980,7 +980,7 @@ mkMutVarPrimTy s elt = TyConApp mutVarPrimTyCon [s, elt] {- ************************************************************************ * * -\subsection[TysPrim-synch-var]{The synchronizing variable type} + The synchronizing variable type * * ************************************************************************ -} @@ -994,7 +994,7 @@ mkMVarPrimTy s elt = TyConApp mVarPrimTyCon [s, elt] {- ************************************************************************ * * -\subsection[TysPrim-stm-var]{The transactional variable type} + The transactional variable type * * ************************************************************************ -} @@ -1008,7 +1008,7 @@ mkTVarPrimTy s elt = TyConApp tVarPrimTyCon [s, elt] {- ************************************************************************ * * -\subsection[TysPrim-stable-ptrs]{The stable-pointer type} + The stable-pointer type * * ************************************************************************ -} @@ -1022,7 +1022,7 @@ mkStablePtrPrimTy ty = TyConApp stablePtrPrimTyCon [ty] {- ************************************************************************ * * -\subsection[TysPrim-stable-names]{The stable-name type} + The stable-name type * * ************************************************************************ -} @@ -1036,7 +1036,7 @@ mkStableNamePrimTy ty = TyConApp stableNamePrimTyCon [ty] {- ************************************************************************ * * -\subsection[TysPrim-compact-nfdata]{The Compact NFData (CNF) type} + The Compact NFData (CNF) type * * ************************************************************************ -} @@ -1050,7 +1050,7 @@ compactPrimTy = mkTyConTy compactPrimTyCon {- ************************************************************************ * * -\subsection[TysPrim-BCOs]{The ``bytecode object'' type} + The ``bytecode object'' type * * ************************************************************************ -} @@ -1066,7 +1066,7 @@ bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName LiftedRep {- ************************************************************************ * * -\subsection[TysPrim-Weak]{The ``weak pointer'' type} + The ``weak pointer'' type * * ************************************************************************ -} @@ -1080,7 +1080,7 @@ mkWeakPrimTy v = TyConApp weakPrimTyCon [v] {- ************************************************************************ * * -\subsection[TysPrim-thread-ids]{The ``thread id'' type} + The ``thread id'' type * * ************************************************************************ diff --git a/compiler/prelude/KnownUniques.hs b/compiler/GHC/Builtin/Uniques.hs similarity index 99% rename from compiler/prelude/KnownUniques.hs rename to compiler/GHC/Builtin/Uniques.hs index 75b6719bba64a77f6b61f6b406320df87c3eb6bc..d73544378be07571d6662f81ae66fc5f96bbf2bb 100644 --- a/compiler/prelude/KnownUniques.hs +++ b/compiler/GHC/Builtin/Uniques.hs @@ -7,7 +7,7 @@ -- names] for details. -- -module KnownUniques +module GHC.Builtin.Uniques ( -- * Looking up known-key names knownUniqueName @@ -28,7 +28,7 @@ module KnownUniques import GhcPrelude -import TysWiredIn +import GHC.Builtin.Types import GHC.Core.TyCon import GHC.Core.DataCon import GHC.Types.Id diff --git a/compiler/prelude/KnownUniques.hs-boot b/compiler/GHC/Builtin/Uniques.hs-boot similarity index 86% rename from compiler/prelude/KnownUniques.hs-boot rename to compiler/GHC/Builtin/Uniques.hs-boot index b43598cc17d869ec2553eb4de07a430f982cca6a..f00490b53831df8a17437d0f9cc97c56fff0d818 100644 --- a/compiler/prelude/KnownUniques.hs-boot +++ b/compiler/GHC/Builtin/Uniques.hs-boot @@ -1,11 +1,11 @@ -module KnownUniques where +module GHC.Builtin.Uniques where import GhcPrelude import GHC.Types.Unique import GHC.Types.Name import GHC.Types.Basic --- Needed by TysWiredIn +-- Needed by GHC.Builtin.Types knownUniqueName :: Unique -> Maybe Name mkSumTyConUnique :: Arity -> Unique diff --git a/compiler/prelude/PrelInfo.hs b/compiler/GHC/Builtin/Utils.hs similarity index 96% rename from compiler/prelude/PrelInfo.hs rename to compiler/GHC/Builtin/Utils.hs index 7cb6c6e22f2c009629d8cc3c76ed5906a51e62b0..0725ee85facb9ab6b3e04fffade3cf8390a46ad3 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/GHC/Builtin/Utils.hs @@ -5,7 +5,7 @@ {-# LANGUAGE CPP #-} --- | The @PrelInfo@ interface to the compiler's prelude knowledge. +-- | The @GHC.Builtin.Utils@ interface to the compiler's prelude knowledge. -- -- This module serves as the central gathering point for names which the -- compiler knows something about. This includes functions for, @@ -17,7 +17,7 @@ -- See Note [Known-key names] and Note [About wired-in things] for information -- about the two types of prelude things in GHC. -- -module PrelInfo ( +module GHC.Builtin.Utils ( -- * Known-key names isKnownKeyName, lookupKnownKeyName, @@ -48,29 +48,29 @@ module PrelInfo ( import GhcPrelude -import KnownUniques +import GHC.Builtin.Uniques import GHC.Types.Unique ( isValidKnownKeyUnique ) import GHC.Core.ConLike ( ConLike(..) ) -import THNames ( templateHaskellNames ) -import PrelNames +import GHC.Builtin.Names.TH ( templateHaskellNames ) +import GHC.Builtin.Names import GHC.Core.Opt.ConstantFold import GHC.Types.Avail -import PrimOp +import GHC.Builtin.PrimOps import GHC.Core.DataCon import GHC.Types.Id import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Id.Make import Outputable -import TysPrim -import TysWiredIn +import GHC.Builtin.Types.Prim +import GHC.Builtin.Types import GHC.Driver.Types import GHC.Core.Class import GHC.Core.TyCon import GHC.Types.Unique.FM import Util -import TcTypeNats ( typeNatTyCons ) +import GHC.Builtin.Types.Literals ( typeNatTyCons ) import Control.Applicative ((<|>)) import Data.List ( intercalate ) @@ -107,7 +107,7 @@ Note [About wired-in things] -- | This list is used to ensure that when you say "Prelude.map" in your source -- code, or in an interface file, you get a Name with the correct known key (See --- Note [Known-key names] in PrelNames) +-- Note [Known-key names] in GHC.Builtin.Names) knownKeyNames :: [Name] knownKeyNames | debugIsOn diff --git a/compiler/prelude/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp similarity index 100% rename from compiler/prelude/primops.txt.pp rename to compiler/GHC/Builtin/primops.txt.pp diff --git a/compiler/GHC/ByteCode/Instr.hs b/compiler/GHC/ByteCode/Instr.hs index be1da0a2ef686afa795243af6ba09b187046407d..b473f418e3365a228516442311f5ecaedb347bcb 100644 --- a/compiler/GHC/ByteCode/Instr.hs +++ b/compiler/GHC/ByteCode/Instr.hs @@ -27,7 +27,7 @@ import GHC.Core import GHC.Types.Literal import GHC.Core.DataCon import GHC.Types.Var.Set -import PrimOp +import GHC.Builtin.PrimOps import GHC.Runtime.Heap.Layout import Data.Word diff --git a/compiler/GHC/ByteCode/Linker.hs b/compiler/GHC/ByteCode/Linker.hs index 0e0dc3ca92add4e987afbf1c1fbd49cb1c1f83c6..9ad218e35e2c79fafb7e38b07cdd5e63c599c7b9 100644 --- a/compiler/GHC/ByteCode/Linker.hs +++ b/compiler/GHC/ByteCode/Linker.hs @@ -30,7 +30,7 @@ import GHC.ByteCode.Types import GHC.Driver.Types import GHC.Types.Name import GHC.Types.Name.Env -import PrimOp +import GHC.Builtin.PrimOps import GHC.Types.Module import FastString import Panic diff --git a/compiler/GHC/ByteCode/Types.hs b/compiler/GHC/ByteCode/Types.hs index dbd5152b5c15214c214e4d7cf001cf47f5906f04..7073da63c2abcb3b1baacdc8ef764e406e63ddc7 100644 --- a/compiler/GHC/ByteCode/Types.hs +++ b/compiler/GHC/ByteCode/Types.hs @@ -20,7 +20,7 @@ import GHC.Types.Id import GHC.Types.Name import GHC.Types.Name.Env import Outputable -import PrimOp +import GHC.Builtin.PrimOps import SizedSeq import GHC.Core.Type import GHC.Types.SrcLoc diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs index a12adc543ae6c9b38b7c0f0fe9c66979104204a8..807f6adb64d5518313cd9cd047f2a54249b4351f 100644 --- a/compiler/GHC/Cmm/CLabel.hs +++ b/compiler/GHC/Cmm/CLabel.hs @@ -122,7 +122,7 @@ import GHC.Driver.Packages import GHC.Types.Module import GHC.Types.Name import GHC.Types.Unique -import PrimOp +import GHC.Builtin.PrimOps import GHC.Types.CostCentre import Outputable import FastString diff --git a/compiler/GHC/Cmm/Lexer.x b/compiler/GHC/Cmm/Lexer.x index a1aebc9fb9e6aee6bd633b64b55a1b14dde1a88f..d0fca50bd357c99dd0726540ad9d446bbbe6f8c5 100644 --- a/compiler/GHC/Cmm/Lexer.x +++ b/compiler/GHC/Cmm/Lexer.x @@ -19,13 +19,13 @@ import GhcPrelude import GHC.Cmm.Expr -import Lexer +import GHC.Parser.Lexer import GHC.Cmm.Monad import GHC.Types.SrcLoc import GHC.Types.Unique.FM import StringBuffer import FastString -import Ctype +import GHC.Parser.CharClass import Util --import TRACE diff --git a/compiler/GHC/Cmm/Monad.hs b/compiler/GHC/Cmm/Monad.hs index d6c8a5b3cc6ebe21ec1f4df70ab0eae290002ec8..d97df7719e003a8054d3372c5750a0dc0c20566b 100644 --- a/compiler/GHC/Cmm/Monad.hs +++ b/compiler/GHC/Cmm/Monad.hs @@ -18,7 +18,7 @@ import GhcPrelude import Control.Monad import GHC.Driver.Session -import Lexer +import GHC.Parser.Lexer newtype PD a = PD { unPD :: DynFlags -> PState -> ParseResult a } diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y index 535c8fd5d079a7d783082681a5b103a317092110..9ff637de706b69f09dcc8caf35c92653a3144bfd 100644 --- a/compiler/GHC/Cmm/Parser.y +++ b/compiler/GHC/Cmm/Parser.y @@ -232,7 +232,7 @@ import GHC.Cmm.Lexer import GHC.Cmm.CLabel import GHC.Cmm.Monad import GHC.Runtime.Heap.Layout -import Lexer +import GHC.Parser.Lexer import GHC.Types.CostCentre import GHC.Types.ForeignCall @@ -247,7 +247,7 @@ import ErrUtils import StringBuffer import FastString import Panic -import Constants +import GHC.Settings.Constants import Outputable import GHC.Types.Basic import Bag ( emptyBag, unitBag ) diff --git a/compiler/GHC/CmmToLlvm.hs b/compiler/GHC/CmmToLlvm.hs index 1ac2a0fa34047104d86b86cba907930fd4c0e142..77a4f0003519301a9e7c8fc22c3774792f297181 100644 --- a/compiler/GHC/CmmToLlvm.hs +++ b/compiler/GHC/CmmToLlvm.hs @@ -34,7 +34,7 @@ import GHC.Platform ( platformArch, Arch(..) ) import ErrUtils import FastString import Outputable -import SysTools ( figureLlvmVersion ) +import GHC.SysTools ( figureLlvmVersion ) import qualified Stream import Control.Monad ( when, forM_ ) diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs index a45292079c3bad47a83b5fac0c6330790b8afd7a..17384f0d438bba1c1c63bfa33713f34d9efbe52f 100644 --- a/compiler/GHC/Core.hs +++ b/compiler/GHC/Core.hs @@ -451,7 +451,7 @@ The let/app invariant is initially enforced by mkCoreLet and mkCoreApp in GHC.Core.Make. For discussion of some implications of the let/app invariant primops see -Note [Checking versus non-checking primops] in PrimOp. +Note [Checking versus non-checking primops] in GHC.Builtin.PrimOps. Note [Case expression invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/GHC/Core/Class.hs b/compiler/GHC/Core/Class.hs index 7b73f3a4236d8e9d1ee7eb3b07b8a4e24495955a..5fb1fc9ea9211498f1b10e68c3da3c7d2e5f4921 100644 --- a/compiler/GHC/Core/Class.hs +++ b/compiler/GHC/Core/Class.hs @@ -79,7 +79,7 @@ data Class -- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'', --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation type FunDep a = ([a],[a]) type ClassOpItem = (Id, DefMethInfo) diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs index 1fccb0a84b43b7b0f00d5bb5fe03479755b4f70f..ad97c4d7e9a65ea267897d90c979ec32ea1862f8 100644 --- a/compiler/GHC/Core/Coercion.hs +++ b/compiler/GHC/Core/Coercion.hs @@ -142,8 +142,8 @@ import Outputable import GHC.Types.Unique import Pair import GHC.Types.SrcLoc -import PrelNames -import TysPrim +import GHC.Builtin.Names +import GHC.Builtin.Types.Prim import ListSetOps import Maybes import GHC.Types.Unique.FM diff --git a/compiler/GHC/Core/Coercion/Axiom.hs b/compiler/GHC/Core/Coercion/Axiom.hs index 7f38b3dcd60ba9c9ccefc8af370f507b1ede63c7..cc4cbeff6d2824e4ee7dccf21ad69428b8e04560 100644 --- a/compiler/GHC/Core/Coercion/Axiom.hs +++ b/compiler/GHC/Core/Coercion/Axiom.hs @@ -500,7 +500,7 @@ data Role = Nominal | Representational | Phantom -- These names are slurped into the parser code. Changing these strings -- will change the **surface syntax** that GHC accepts! If you want to -- change only the pretty-printing, do some replumbing. See --- mkRoleAnnotDecl in RdrHsSyn +-- mkRoleAnnotDecl in GHC.Parser.PostProcess fsFromRole :: Role -> FastString fsFromRole Nominal = fsLit "nominal" fsFromRole Representational = fsLit "representational" diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs index 7d767a2416b4877b5c6b3c48ccce63ae7cbf28e3..a4521d688cdc4028351390e0353f2abc7f75e4a5 100644 --- a/compiler/GHC/Core/DataCon.hs +++ b/compiler/GHC/Core/DataCon.hs @@ -71,7 +71,7 @@ import GHC.Core.TyCon import GHC.Types.FieldLabel import GHC.Core.Class import GHC.Types.Name -import PrelNames +import GHC.Builtin.Names import GHC.Core.Predicate import GHC.Types.Var import Outputable @@ -298,7 +298,7 @@ Note that (Foo a) might not be an instance of Ord. -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen', -- 'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma' --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation data DataCon = MkData { dcName :: Name, -- This is the name of the *source data con* diff --git a/compiler/GHC/Core/FVs.hs b/compiler/GHC/Core/FVs.hs index 6995cc71a1ba1d9f848edc1a3b078204233a49fc..6e7fa259ff26f41295ddbbe2dfec83107ab1f15f 100644 --- a/compiler/GHC/Core/FVs.hs +++ b/compiler/GHC/Core/FVs.hs @@ -76,7 +76,7 @@ import GHC.Core.TyCo.FVs import GHC.Core.TyCon import GHC.Core.Coercion.Axiom import GHC.Core.FamInstEnv -import TysPrim( funTyConName ) +import GHC.Builtin.Types.Prim( funTyConName ) import Maybes( orElse ) import Util import GHC.Types.Basic( Activation ) diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs index ea1ab371a7dbe739e30b87799bea18d5f5e102d9..b496b87484122b016a5b038937137e7e56366add 100644 --- a/compiler/GHC/Core/Lint.hs +++ b/compiler/GHC/Core/Lint.hs @@ -33,7 +33,7 @@ import GHC.Core.Opt.Monad import Bag import GHC.Types.Literal import GHC.Core.DataCon -import TysPrim +import GHC.Builtin.Types.Prim import GHC.Tc.Utils.TcType ( isFloatingTy ) import GHC.Types.Var as Var import GHC.Types.Var.Env @@ -57,7 +57,7 @@ import GHC.Core.Coercion.Axiom import GHC.Types.Basic import ErrUtils as Err import ListSetOps -import PrelNames +import GHC.Builtin.Names import Outputable import FastString import Util diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs index 51d706ff23895defa55d9e8dc89d734987c8afbb..bf927ebd4d8beaf507a0ee3fb20c2e245bea2582 100644 --- a/compiler/GHC/Core/Make.hs +++ b/compiler/GHC/Core/Make.hs @@ -65,14 +65,14 @@ import GHC.Types.Literal import GHC.Driver.Types import GHC.Platform -import TysWiredIn -import PrelNames +import GHC.Builtin.Types +import GHC.Builtin.Names import GHC.Hs.Utils ( mkChunkified, chunkify ) import GHC.Core.Type import GHC.Core.Coercion ( isCoVar ) import GHC.Core.DataCon ( DataCon, dataConWorkId ) -import TysPrim +import GHC.Builtin.Types.Prim import GHC.Types.Id.Info import GHC.Types.Demand import GHC.Types.Cpr @@ -343,7 +343,7 @@ We could do one of two things: * Flatten it out, so that mkCoreTup [e1] = e1 -* Build a one-tuple (see Note [One-tuples] in TysWiredIn) +* Build a one-tuple (see Note [One-tuples] in GHC.Builtin.Types) mkCoreTup1 [e1] = Unit e1 We use a suffix "1" to indicate this. diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index 4c291b05ba53620ca7cbbcc70aa7c1382a4f5dc2..91b44af996541a8a46e3667ba500015c88b9a920 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -35,9 +35,9 @@ import GHC.Core.Make import GHC.Types.Id import GHC.Types.Literal import GHC.Core.SimpleOpt ( exprIsLiteral_maybe ) -import PrimOp ( PrimOp(..), tagToEnumKey ) -import TysWiredIn -import TysPrim +import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey ) +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim import GHC.Core.TyCon ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons @@ -48,7 +48,7 @@ import GHC.Core.Utils ( cheapEqExpr, cheapEqExpr', exprIsHNF, exprType import GHC.Core.Unfold ( exprIsConApp_maybe ) import GHC.Core.Type import GHC.Types.Name.Occurrence ( occNameFS ) -import PrelNames +import GHC.Builtin.Names import Maybes ( orElse ) import GHC.Types.Name ( Name, nameOccName ) import Outputable diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs index 9e46884960b404d3db5d4c87c1316600410d2e32..30956fd76859b5a674d6fd123de29ebcf6b1232e 100644 --- a/compiler/GHC/Core/Opt/DmdAnal.hs +++ b/compiler/GHC/Core/Opt/DmdAnal.hs @@ -34,8 +34,8 @@ import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv import Util import Maybes ( isJust ) -import TysWiredIn -import TysPrim ( realWorldStatePrimTy ) +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) import ErrUtils ( dumpIfSet_dyn, DumpFormat (..) ) import GHC.Types.Unique.Set diff --git a/compiler/GHC/Core/Opt/FloatIn.hs b/compiler/GHC/Core/Opt/FloatIn.hs index 3b25e4276420a9401a7d7621d2d64ca407bb1820..c5b8acc7f629bdba044d55756f1584bc6a3ee3d5 100644 --- a/compiler/GHC/Core/Opt/FloatIn.hs +++ b/compiler/GHC/Core/Opt/FloatIn.hs @@ -407,7 +407,7 @@ floating in cases with a single alternative that may bind values. But there are wrinkles -* Which unlifted cases do we float? See PrimOp.hs +* Which unlifted cases do we float? See GHC.Builtin.PrimOps Note [PrimOp can_fail and has_side_effects] which explains: - We can float-in can_fail primops, but we can't float them out. - But we can float a has_side_effects primop, but NOT inside a lambda, diff --git a/compiler/GHC/Core/Opt/LiberateCase.hs b/compiler/GHC/Core/Opt/LiberateCase.hs index 4f2bf380811531ac5867941d324a21338b809ddb..2e284e3611d544c1d3aa3a562b87918a74fa570f 100644 --- a/compiler/GHC/Core/Opt/LiberateCase.hs +++ b/compiler/GHC/Core/Opt/LiberateCase.hs @@ -14,7 +14,7 @@ import GhcPrelude import GHC.Driver.Session import GHC.Core import GHC.Core.Unfold ( couldBeSmallEnoughToInline ) -import TysWiredIn ( unitDataConId ) +import GHC.Builtin.Types ( unitDataConId ) import GHC.Types.Id import GHC.Types.Var.Env import Util ( notNull ) diff --git a/compiler/GHC/Core/Opt/SetLevels.hs b/compiler/GHC/Core/Opt/SetLevels.hs index 278370d439f0976d4979995a790b228c52f66e9b..710a8cf70f3bc63d17e87c902a9df1647f9158f8 100644 --- a/compiler/GHC/Core/Opt/SetLevels.hs +++ b/compiler/GHC/Core/Opt/SetLevels.hs @@ -95,7 +95,7 @@ import GHC.Core.Type ( Type, mkLamTypes, splitTyConApp_maybe, tyCoVarsOfType , mightBeUnliftedType, closeOverKindsDSet ) import GHC.Types.Basic ( Arity, RecFlag(..), isRec ) import GHC.Core.DataCon ( dataConOrigResTy ) -import TysWiredIn +import GHC.Builtin.Types import GHC.Types.Unique.Supply import Util import Outputable diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs index 44d2eee8a6c11a9c57cfc1ab4ea45e0fffc61419..d2b63ecb9417f70c4ec064af4a2b9eb03f9b7ed6 100644 --- a/compiler/GHC/Core/Opt/Simplify.hs +++ b/compiler/GHC/Core/Opt/Simplify.hs @@ -58,7 +58,7 @@ import FastString import Util import ErrUtils import GHC.Types.Module ( moduleName, pprModuleName ) -import PrimOp ( PrimOp (SeqOp) ) +import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) {- @@ -2516,7 +2516,7 @@ rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont -- The entire case is dead, so we can drop it -- if the scrutinee converges without having imperative -- side effects or raising a Haskell exception - -- See Note [PrimOp can_fail and has_side_effects] in PrimOp + -- See Note [PrimOp can_fail and has_side_effects] in GHC.Builtin.PrimOps = simplExprF env rhs cont -- 2b. Turn the case into a let, if diff --git a/compiler/GHC/Core/Opt/Simplify/Env.hs b/compiler/GHC/Core/Opt/Simplify/Env.hs index 27b846c564d7eedf183081ec578158173c08fbfc..2827ba037d9850a3292c1aac48e799f7aca34c33 100644 --- a/compiler/GHC/Core/Opt/Simplify/Env.hs +++ b/compiler/GHC/Core/Opt/Simplify/Env.hs @@ -58,7 +58,7 @@ import OrdList import GHC.Types.Id as Id import GHC.Core.Make ( mkWildValBinder ) import GHC.Driver.Session ( DynFlags ) -import TysWiredIn +import GHC.Builtin.Types import qualified GHC.Core.Type as Type import GHC.Core.Type hiding ( substTy, substTyVar, substTyVarBndr, extendTvSubst, extendCvSubst ) import qualified GHC.Core.Coercion as Coercion diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs index 048357321ee48bc0ba299b0f99fa053ab450f802..1de946f7244aec87ff84c295787f4b81b15e86ac 100644 --- a/compiler/GHC/Core/Opt/Simplify/Utils.hs +++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs @@ -58,7 +58,7 @@ import GHC.Types.Var import GHC.Types.Demand import GHC.Types.Var.Set import GHC.Types.Basic -import PrimOp +import GHC.Builtin.PrimOps import GHC.Core.Opt.Simplify.Monad import GHC.Core.Type hiding( substTy ) import GHC.Core.Coercion hiding( substCo ) diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs index 206143ab4de6212c6e35f03064a27c1fa3ebc474..f0a7821b1f89c60f4ce3f8f60d4dcc537b275aee 100644 --- a/compiler/GHC/Core/Opt/SpecConstr.hs +++ b/compiler/GHC/Core/Opt/SpecConstr.hs @@ -59,7 +59,7 @@ import GHC.Types.Unique.FM import MonadUtils import Control.Monad ( zipWithM ) import Data.List -import PrelNames ( specTyConName ) +import GHC.Builtin.Names ( specTyConName ) import GHC.Types.Module import GHC.Core.TyCon ( TyCon ) import GHC.Exts( SpecConstrAnnotation(..) ) diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs index 6ca48ca5ca311aacf7cefc8788e985c0fffd9d3f..b1a85fa93f84e938bfc9b893001c627ead7544f5 100644 --- a/compiler/GHC/Core/Opt/Specialise.hs +++ b/compiler/GHC/Core/Opt/Specialise.hs @@ -37,7 +37,7 @@ import GHC.Core.Arity ( etaExpandToJoinPointRule ) import GHC.Types.Unique.Supply import GHC.Types.Name import GHC.Types.Id.Make ( voidArgId, voidPrimId ) -import TysPrim ( voidPrimTy ) +import GHC.Builtin.Types.Prim ( voidPrimTy ) import Maybes ( mapMaybe, maybeToList, isJust ) import MonadUtils ( foldlM ) import GHC.Types.Basic diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs index 1964233ca73aacddfc117173f7c214a4ab155992..cbd8788d667a4f084ffe40f405c3d1a0b371cf77 100644 --- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs +++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs @@ -28,8 +28,8 @@ import GHC.Types.Cpr import GHC.Core.Make ( mkAbsentErrorApp, mkCoreUbxTup , mkCoreApp, mkCoreLet ) import GHC.Types.Id.Make ( voidArgId, voidPrimId ) -import TysWiredIn ( tupleDataCon ) -import TysPrim ( voidPrimTy ) +import GHC.Builtin.Types ( tupleDataCon ) +import GHC.Builtin.Types.Prim ( voidPrimTy ) import GHC.Types.Literal ( absentLiteralOf, rubbishLit ) import GHC.Types.Var.Env ( mkInScopeSet ) import GHC.Types.Var.Set ( VarSet ) diff --git a/compiler/GHC/Core/Predicate.hs b/compiler/GHC/Core/Predicate.hs index c9894655f70402553fe60edc2c30cf27a8724d95..dbeb099440b9adc6b3304e69f04b53db80f43b5c 100644 --- a/compiler/GHC/Core/Predicate.hs +++ b/compiler/GHC/Core/Predicate.hs @@ -36,7 +36,7 @@ import GHC.Core.TyCon import GHC.Types.Var import GHC.Core.Coercion -import PrelNames +import GHC.Builtin.Names import FastString import Outputable diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs index 907c7104a55ad9fbd6e8c7ad332c71ce8fa6599c..899ae25d1b8b6af1a3a0885a66b63bdabb65e2e5 100644 --- a/compiler/GHC/Core/Rules.hs +++ b/compiler/GHC/Core/Rules.hs @@ -44,7 +44,7 @@ import GHC.Core.Type as Type ( Type, TCvSubst, extendTvSubst, extendCvSubst , mkEmptyTCvSubst, substTy ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) -import TysWiredIn ( anyTypeOfKind ) +import GHC.Builtin.Types ( anyTypeOfKind ) import GHC.Core.Coercion as Coercion import GHC.Core.Tidy ( tidyRules ) import GHC.Types.Id diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs index 419d4088d432c4fe1700b93fe123288e0adc5083..0728ea11c842097a8daf0d6f68436da92e610118 100644 --- a/compiler/GHC/Core/SimpleOpt.hs +++ b/compiler/GHC/Core/SimpleOpt.hs @@ -45,8 +45,8 @@ import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSub , isInScope, substTyVarBndr, cloneTyVarBndr ) import GHC.Core.Coercion hiding ( substCo, substCoVarBndr ) import GHC.Core.TyCon ( tyConArity ) -import TysWiredIn -import PrelNames +import GHC.Builtin.Types +import GHC.Builtin.Names import GHC.Types.Basic import GHC.Types.Module ( Module ) import ErrUtils diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs index 7a4c14edf2730b46291424a35f90fa1fa42323ca..9963875bf3a5cf6460e8d73d329c8e4dc72e58f3 100644 --- a/compiler/GHC/Core/Subst.hs +++ b/compiler/GHC/Core/Subst.hs @@ -52,7 +52,7 @@ import GHC.Core.Type hiding , isInScope, substTyVarBndr, cloneTyVarBndr ) import GHC.Core.Coercion hiding ( substCo, substCoVarBndr ) -import PrelNames +import GHC.Builtin.Names import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Id diff --git a/compiler/GHC/Core/TyCo/Rep.hs b/compiler/GHC/Core/TyCo/Rep.hs index 8fe8f6e97db1989fb7dfd88ac619166611cdb3b2..00d3f95c43b3ddbffd0c29c67f8f36c0dabf3cba 100644 --- a/compiler/GHC/Core/TyCo/Rep.hs +++ b/compiler/GHC/Core/TyCo/Rep.hs @@ -7,14 +7,14 @@ Note [The Type-related module hierarchy] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHC.Core.Class GHC.Core.Coercion.Axiom - GHC.Core.TyCon imports GHC.Core.{Class, Coercion.Axiom} - GHC.Core.TyCo.Rep imports GHC.Core.{Class, Coercion.Axiom, TyCon} - GHC.Core.TyCo.Ppr imports GHC.Core.TyCo.Rep - GHC.Core.TyCo.FVs imports GHC.Core.TyCo.Rep - GHC.Core.TyCo.Subst imports GHC.Core.TyCo.{Rep, FVs, Ppr} - GHC.Core.TyCo.Tidy imports GHC.Core.TyCo.{Rep, FVs} - TysPrim imports GHC.Core.TyCo.Rep ( including mkTyConTy ) - GHC.Core.Coercion imports GHC.Core.Type + GHC.Core.TyCon imports GHC.Core.{Class, Coercion.Axiom} + GHC.Core.TyCo.Rep imports GHC.Core.{Class, Coercion.Axiom, TyCon} + GHC.Core.TyCo.Ppr imports GHC.Core.TyCo.Rep + GHC.Core.TyCo.FVs imports GHC.Core.TyCo.Rep + GHC.Core.TyCo.Subst imports GHC.Core.TyCo.{Rep, FVs, Ppr} + GHC.Core.TyCo.Tidy imports GHC.Core.TyCo.{Rep, FVs} + GHC.Builtin.Types.Prim imports GHC.Core.TyCo.Rep ( including mkTyConTy ) + GHC.Core.Coercion imports GHC.Core.Type -} -- We expose the relevant stuff from this module via the Type module @@ -105,7 +105,7 @@ import Data.IORef ( IORef ) -- for CoercionHole Despite the fact that DataCon has to be imported via a hi-boot route, this module seems the right place for TyThing, because it's needed for -funTyCon and all the types in TysPrim. +funTyCon and all the types in GHC.Builtin.Types.Prim. It is also SOURCE-imported into Name.hs @@ -377,7 +377,7 @@ How does this work? * We support both homogeneous (~) and heterogeneous (~~) equality. (See Note [The equality types story] - in TysPrim for a primer on these equality types.) + in GHC.Builtin.Types.Prim for a primer on these equality types.) * How do we prevent a MkT having an illegal constraint like Eq a? We check for this at use-sites; see GHC.Tc.Gen.HsType.tcTyVar, @@ -948,7 +948,7 @@ represented by evidence of type p. %* * %************************************************************************ -These functions are here so that they can be used by TysPrim, +These functions are here so that they can be used by GHC.Builtin.Types.Prim, which in turn is imported by Type -} @@ -1594,7 +1594,7 @@ During typechecking, constraint solving for type classes works by which actually binds d7 to the (Num a) evidence For equality constraints we use a different strategy. See Note [The -equality types story] in TysPrim for background on equality constraints. +equality types story] in GHC.Builtin.Types.Prim for background on equality constraints. - For /boxed/ equality constraints, (t1 ~N t2) and (t1 ~R t2), it's just like type classes above. (Indeed, boxed equality constraints *are* classes.) - But for /unboxed/ equality constraints (t1 ~R# t2) and (t1 ~N# t2) diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs index d28d8b0f0c61bc9fb09326bb6b5de093b20f43a6..e82cb2e21930ed1d9c80c194a1d7bd89f0e79232 100644 --- a/compiler/GHC/Core/TyCon.hs +++ b/compiler/GHC/Core/TyCon.hs @@ -141,7 +141,7 @@ import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Kind, Type, PredType, mkForAllTy, mkFunTy ) import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprType ) -import {-# SOURCE #-} TysWiredIn +import {-# SOURCE #-} GHC.Builtin.Types ( runtimeRepTyCon, constraintKind , vecCountTyCon, vecElemTyCon, liftedTypeKind ) import {-# SOURCE #-} GHC.Core.DataCon @@ -158,12 +158,12 @@ import GHC.Types.ForeignCall import GHC.Types.Name import GHC.Types.Name.Env import GHC.Core.Coercion.Axiom -import PrelNames +import GHC.Builtin.Names import Maybes import Outputable import FastStringEnv import GHC.Types.FieldLabel -import Constants +import GHC.Settings.Constants import Util import GHC.Types.Unique( tyConRepNameUnique, dataConTyRepNameUnique ) import GHC.Types.Unique.Set diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index 9f86e98fd83e7d1b292404a251b68efd542c610a..a6521801b432c938cb9d9b7416d47ee6cf1d09cf 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -240,13 +240,14 @@ import GHC.Types.Var.Set import GHC.Types.Unique.Set import GHC.Core.TyCon -import TysPrim -import {-# SOURCE #-} TysWiredIn ( listTyCon, typeNatKind +import GHC.Builtin.Types.Prim +import {-# SOURCE #-} GHC.Builtin.Types + ( listTyCon, typeNatKind , typeSymbolKind, liftedTypeKind , liftedTypeKindTyCon , constraintKind ) import GHC.Types.Name( Name ) -import PrelNames +import GHC.Builtin.Names import GHC.Core.Coercion.Axiom import {-# SOURCE #-} GHC.Core.Coercion ( mkNomReflCo, mkGReflCo, mkReflCo diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs index f30720638469fbc2b8ba0e544e42dd68cc664782..6c88c5a24dd49ea440e32018062386a4cb20d177 100644 --- a/compiler/GHC/Core/Unfold.hs +++ b/compiler/GHC/Core/Unfold.hs @@ -56,12 +56,12 @@ import GHC.Types.Id import GHC.Types.Demand ( StrictSig, isBottomingSig ) import GHC.Core.DataCon import GHC.Types.Literal -import PrimOp +import GHC.Builtin.PrimOps import GHC.Types.Id.Info import GHC.Types.Basic ( Arity, InlineSpec(..), inlinePragmaSpec ) import GHC.Core.Type -import PrelNames -import TysPrim ( realWorldStatePrimTy ) +import GHC.Builtin.Names +import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) import Bag import Util import Outputable diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs index 63d269875c9f32d10974b46d09980d564e083012..a0704ef03a0ff0781ffc3cbc8f1c5b23921ffe1a 100644 --- a/compiler/GHC/Core/Utils.hs +++ b/compiler/GHC/Core/Utils.hs @@ -66,7 +66,7 @@ import GhcPrelude import GHC.Platform import GHC.Core -import PrelNames ( makeStaticName ) +import GHC.Builtin.Names ( makeStaticName ) import GHC.Core.Ppr import GHC.Core.FVs( exprFreeVars ) import GHC.Types.Var @@ -76,10 +76,10 @@ import GHC.Types.Var.Set import GHC.Types.Name import GHC.Types.Literal import GHC.Core.DataCon -import PrimOp +import GHC.Builtin.PrimOps import GHC.Types.Id import GHC.Types.Id.Info -import PrelNames( absentErrorIdKey ) +import GHC.Builtin.Names( absentErrorIdKey ) import GHC.Core.Type as Type import GHC.Core.Predicate import GHC.Core.TyCo.Rep( TyCoBinder(..), TyBinder ) @@ -87,7 +87,7 @@ import GHC.Core.Coercion import GHC.Core.TyCon import GHC.Types.Unique import Outputable -import TysPrim +import GHC.Builtin.Types.Prim import FastString import Maybes import ListSetOps ( minusList ) @@ -1499,7 +1499,7 @@ it's applied only to dictionaries. -- exprIsHNF implies exprOkForSpeculation -- exprOkForSpeculation implies exprOkForSideEffects -- --- See Note [PrimOp can_fail and has_side_effects] in PrimOp +-- See Note [PrimOp can_fail and has_side_effects] in GHC.Builtin.PrimOps -- and Note [Transformations affected by can_fail and has_side_effects] -- -- As an example of the considerations in this test, consider: @@ -1628,7 +1628,7 @@ altsAreExhaustive ((con1,_,_) : alts) -- | True of dyadic operators that can fail only if the second arg is zero! isDivOp :: PrimOp -> Bool --- This function probably belongs in PrimOp, or even in +-- This function probably belongs in GHC.Builtin.PrimOps, or even in -- an automagically generated file.. but it's such a -- special case I thought I'd leave it here for now. isDivOp IntQuotOp = True diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs index 75a2110e1d0a746cbc655f167a350b8cabcf0a28..b2f185498c342319bbb1c867da14586e775127ac 100644 --- a/compiler/GHC/CoreToByteCode.hs +++ b/compiler/GHC/CoreToByteCode.hs @@ -35,7 +35,7 @@ import GHC.Core.Utils import GHC.Core import GHC.Core.Ppr import GHC.Types.Literal -import PrimOp +import GHC.Builtin.PrimOps import GHC.Core.FVs import GHC.Core.Type import GHC.Types.RepType @@ -43,7 +43,7 @@ import GHC.Core.DataCon import GHC.Core.TyCon import Util import GHC.Types.Var.Set -import TysPrim +import GHC.Builtin.Types.Prim import GHC.Core.TyCo.Ppr ( pprType ) import ErrUtils import GHC.Types.Unique @@ -56,7 +56,7 @@ import GHC.Data.Bitmap import OrdList import Maybes import GHC.Types.Var.Env -import PrelNames ( unsafeEqualityProofName ) +import GHC.Builtin.Names ( unsafeEqualityProofName ) import Data.List import Foreign diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs index 85a5e52b7986631c20b3532ce95e8c6dbe56f1f2..dcce320ed9536c4c6caaf6010430a810b2d736c9 100644 --- a/compiler/GHC/CoreToIface.hs +++ b/compiler/GHC/CoreToIface.hs @@ -54,10 +54,10 @@ import GHC.Types.Id.Info import GHC.Core import GHC.Core.TyCon hiding ( pprPromotionQuote ) import GHC.Core.Coercion.Axiom -import TysPrim ( eqPrimTyCon, eqReprPrimTyCon ) -import TysWiredIn ( heqTyCon ) +import GHC.Builtin.Types.Prim ( eqPrimTyCon, eqReprPrimTyCon ) +import GHC.Builtin.Types ( heqTyCon ) import GHC.Types.Id.Make ( noinlineIdName ) -import PrelNames +import GHC.Builtin.Names import GHC.Types.Name import GHC.Types.Basic import GHC.Core.Type diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs index 0ebe4a8f90b81465ce40c374a63faaedc6e9931d..a35c81789b8eb8900f1abec5f31bb019b3318e90 100644 --- a/compiler/GHC/CoreToStg.hs +++ b/compiler/GHC/CoreToStg.hs @@ -35,7 +35,7 @@ import GHC.Types.Var.Env import GHC.Types.Module import GHC.Types.Name ( isExternalName, nameModule_maybe ) import GHC.Types.Basic ( Arity ) -import TysWiredIn ( unboxedUnitDataCon, unitDataConId ) +import GHC.Builtin.Types ( unboxedUnitDataCon, unitDataConId ) import GHC.Types.Literal import Outputable import MonadUtils @@ -44,10 +44,10 @@ import Util import GHC.Driver.Session import GHC.Driver.Ways import GHC.Types.ForeignCall -import GHC.Types.Demand ( isUsedOnce ) -import PrimOp ( PrimCall(..), primOpWrapperId ) -import GHC.Types.SrcLoc ( mkGeneralSrcSpan ) -import PrelNames ( unsafeEqualityProofName ) +import GHC.Types.Demand ( isUsedOnce ) +import GHC.Builtin.PrimOps ( PrimCall(..), primOpWrapperId ) +import GHC.Types.SrcLoc ( mkGeneralSrcSpan ) +import GHC.Builtin.Names ( unsafeEqualityProofName ) import Data.List.NonEmpty (nonEmpty, toList) import Data.Maybe (fromMaybe) @@ -539,7 +539,7 @@ coreToStgApp f args ticks = do (dropRuntimeRepArgs (fromMaybe [] (tyConAppArgs_maybe res_ty))) -- Some primitive operator that might be implemented as a library call. - -- As described in Note [Primop wrappers] in PrimOp.hs, here we + -- As described in Note [Primop wrappers] in GHC.Builtin.PrimOps, here we -- turn unsaturated primop applications into applications of -- the primop's wrapper. PrimOpId op diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs index dd7419a89a41504c77b1aeb61dbf3a531c352990..50ae474cdf0a5c370f8172a1a658243daaf58331 100644 --- a/compiler/GHC/CoreToStg/Prep.hs +++ b/compiler/GHC/CoreToStg/Prep.hs @@ -23,7 +23,7 @@ import GHC.Platform import GHC.Core.Opt.OccurAnal import GHC.Driver.Types -import PrelNames +import GHC.Builtin.Names import GHC.Types.Id.Make ( realWorldPrimId ) import GHC.Core.Utils import GHC.Core.Arity @@ -43,7 +43,7 @@ import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Id import GHC.Types.Id.Info -import TysWiredIn +import GHC.Builtin.Types import GHC.Core.DataCon import GHC.Types.Basic import GHC.Types.Module @@ -1071,7 +1071,7 @@ Note that eta expansion in CorePrep is very fragile due to the "prediction" of 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. +with this another way, as described in Note [Primop wrappers] in GHC.Builtin.PrimOps. It's quite likely that eta expansion of constructor applications will eventually break in a similar way to how primops did. We really should @@ -1469,7 +1469,7 @@ lookupMkNaturalName dflags hsc_env = guardNaturalUse dflags $ liftM tyThingId $ lookupGlobal hsc_env mkNaturalName --- See Note [The integer library] in PrelNames +-- See Note [The integer library] in GHC.Builtin.Names lookupIntegerSDataConName :: DynFlags -> HscEnv -> IO (Maybe DataCon) lookupIntegerSDataConName dflags hsc_env = case integerLibrary dflags of IntegerGMP -> guardIntegerUse dflags $ liftM (Just . tyThingDataCon) $ diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs index 6ab71b7fec9c79e0a995372f74851543c6bae056..4f179f4aa1f7c5167e0fd99643fca3bb93b8af02 100644 --- a/compiler/GHC/Driver/Backpack.hs +++ b/compiler/GHC/Driver/Backpack.hs @@ -23,11 +23,11 @@ import GhcPrelude -- In a separate module because it hooks into the parser. import GHC.Driver.Backpack.Syntax -import ApiAnnotation +import GHC.Parser.Annotation import GHC hiding (Failed, Succeeded) import GHC.Driver.Packages -import Parser -import Lexer +import GHC.Parser +import GHC.Parser.Lexer import GHC.Driver.Monad import GHC.Driver.Session import GHC.Tc.Utils.Monad @@ -43,11 +43,11 @@ import GHC.Types.Unique.FM import GHC.Types.Unique.DFM import Outputable import Maybes -import HeaderInfo +import GHC.Parser.Header import GHC.Iface.Recomp import GHC.Driver.Make import GHC.Types.Unique.DSet -import PrelNames +import GHC.Builtin.Names import GHC.Types.Basic hiding (SuccessFlag(..)) import GHC.Driver.Finder import Util diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs index d9078e9ca172b298be7a3a2492690131c286ab08..f87661846e808d5200422b0b9afd3562da9b2658 100644 --- a/compiler/GHC/Driver/CodeOutput.hs +++ b/compiler/GHC/Driver/CodeOutput.hs @@ -32,7 +32,7 @@ import GHC.Driver.Types import GHC.Driver.Session import Stream ( Stream ) import qualified Stream -import FileCleanup +import GHC.SysTools.FileCleanup import ErrUtils import Outputable diff --git a/compiler/GHC/Driver/Finder.hs b/compiler/GHC/Driver/Finder.hs index d2538d90e87c168c793a8c90758a928f0ba0bd1d..0a4b07509fe5073cec41f89d33a6e733389cb87d 100644 --- a/compiler/GHC/Driver/Finder.hs +++ b/compiler/GHC/Driver/Finder.hs @@ -40,7 +40,7 @@ import GHC.Driver.Types import GHC.Driver.Packages import FastString import Util -import PrelNames ( gHC_PRIM ) +import GHC.Builtin.Names ( gHC_PRIM ) import GHC.Driver.Session import Outputable import Maybes ( expectJust ) diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs index da19a6aa96aa685767af7a5949cd598db3baab1e..2e867ac85f37280fa5c65b669b6e1225648e5cf0 100644 --- a/compiler/GHC/Driver/Flags.hs +++ b/compiler/GHC/Driver/Flags.hs @@ -351,7 +351,7 @@ data GeneralFlag -- Check whether a flag should be considered an "optimisation flag" -- for purposes of recompilation avoidance (see --- Note [Ignoring some flag changes] in FlagChecker). Being listed here is +-- Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags). Being listed here is -- not a guarantee that the flag has no other effect. We could, and -- perhaps should, separate out the flags that have some minor impact on -- program semantics and/or error behavior (e.g., assertions), but diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 2eda36cd90923b06692708d0fe2a6ca2d0768cc7..2b5dfb2b11b7c04fa05aa508933f092f241ccf46 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -100,7 +100,7 @@ import GHC.Types.Var.Env ( emptyTidyEnv ) import Panic import GHC.Core.ConLike -import ApiAnnotation +import GHC.Parser.Annotation import GHC.Types.Module import GHC.Driver.Packages import GHC.Types.Name.Reader @@ -108,15 +108,15 @@ import GHC.Hs import GHC.Hs.Dump import GHC.Core import StringBuffer -import Parser -import Lexer +import GHC.Parser +import GHC.Parser.Lexer as Lexer import GHC.Types.SrcLoc import GHC.Tc.Module import GHC.IfaceToCore ( typecheckIface ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Zonk ( ZonkFlexi (DefaultFlexi) ) import GHC.Types.Name.Cache ( initNameCache ) -import PrelInfo +import GHC.Builtin.Utils import GHC.Core.Opt.Driver import GHC.HsToCore import GHC.Iface.Load ( ifaceStats, initExternalPackageState, writeIface ) @@ -144,7 +144,7 @@ import GHC.Core.FamInstEnv import Fingerprint ( Fingerprint ) import GHC.Driver.Hooks import GHC.Tc.Utils.Env -import PrelNames +import GHC.Builtin.Names import GHC.Driver.Plugins import GHC.Runtime.Loader ( initializePlugins ) diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index 359e602be822ca70a9e0d5b8de7003cfb3cbe551..7df02dd7c8faab466514b696fe26b6f3585eafcb 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -43,7 +43,7 @@ import GHC.Driver.Session import ErrUtils import GHC.Driver.Finder import GHC.Driver.Monad -import HeaderInfo +import GHC.Parser.Header import GHC.Driver.Types import GHC.Types.Module import GHC.IfaceToCore ( typecheckIface ) @@ -70,7 +70,7 @@ import GHC.Types.Unique.Set import Util import qualified GHC.LanguageExtensions as LangExt import GHC.Types.Name.Env -import FileCleanup +import GHC.SysTools.FileCleanup import Data.Either ( rights, partitionEithers ) import qualified Data.Map as Map diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs index 385b1de791a8728d479bee576fcc3d3f57ade3c4..d45b39e3b3d5a835b01f1a302d4f052d6b7fd0e9 100644 --- a/compiler/GHC/Driver/MakeFile.hs +++ b/compiler/GHC/Driver/MakeFile.hs @@ -23,7 +23,7 @@ import GHC.Driver.Session import GHC.Driver.Ways import Util import GHC.Driver.Types -import qualified SysTools +import qualified GHC.SysTools as SysTools import GHC.Types.Module import Digraph ( SCC(..) ) import GHC.Driver.Finder @@ -32,7 +32,7 @@ import Panic import GHC.Types.SrcLoc import Data.List import FastString -import FileCleanup +import GHC.SysTools.FileCleanup import Exception import ErrUtils diff --git a/compiler/GHC/Driver/Packages.hs b/compiler/GHC/Driver/Packages.hs index d7ecbeb39b253f08037a0b8cff6a29406435ddca..b2299a1403d98517cd0e67e487edaa4f963e0a3e 100644 --- a/compiler/GHC/Driver/Packages.hs +++ b/compiler/GHC/Driver/Packages.hs @@ -924,7 +924,7 @@ sortByPreference prec_map = sortBy (flip (compareByPreference prec_map)) -- package to use in place of @integer-wired-in@ and that two different -- package databases supply a different integer library. For more about -- the fake @integer-wired-in@ package, see Note [The integer library] --- in the @PrelNames@ module. +-- in the @GHC.Builtin.Names@ module. compareByPreference :: PackagePrecedenceIndex -> UnitInfo @@ -1022,7 +1022,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do let matches :: UnitInfo -> WiredInUnitId -> Bool pc `matches` pid - -- See Note [The integer library] in PrelNames + -- See Note [The integer library] in GHC.Builtin.Names | pid == unitIdString integerUnitId = packageNameString pc `elem` ["integer-gmp", "integer-simple"] pc `matches` pid = packageNameString pc == pid @@ -1126,7 +1126,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do -- compiler, as described in Note [Wired-in packages] in GHC.Types.Module. -- -- For instance, base-4.9.0.0 will be rewritten to just base, to match --- what appears in PrelNames. +-- what appears in GHC.Builtin.Names. upd_wired_in_mod :: WiredPackagesMap -> Module -> Module upd_wired_in_mod wiredInMap (Module uid m) = Module (upd_wired_in_uid wiredInMap uid) m diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index 53d7b5f0acc2bff3687c38d88e382deb17e9ff7e..f61430b475921a26d0707771f02de6c1de3806bd 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -41,10 +41,10 @@ import GhcPrelude import GHC.Driver.Pipeline.Monad import GHC.Driver.Packages import GHC.Driver.Ways -import HeaderInfo +import GHC.Parser.Header import GHC.Driver.Phases -import SysTools -import SysTools.ExtraObj +import GHC.SysTools +import GHC.SysTools.ExtraObj import GHC.Driver.Main import GHC.Driver.Finder import GHC.Driver.Types hiding ( Hsc ) @@ -62,11 +62,11 @@ import GHC.CmmToLlvm ( llvmFixupAsm, llvmVersionList ) import MonadUtils import GHC.Platform import GHC.Tc.Types -import ToolSettings import GHC.Driver.Hooks import qualified GHC.LanguageExtensions as LangExt -import FileCleanup -import Ar +import GHC.SysTools.FileCleanup +import GHC.SysTools.Ar +import GHC.Settings import Bag ( unitBag ) import FastString ( mkFastString ) import GHC.Iface.Make ( mkFullIface ) @@ -955,14 +955,14 @@ runPhase (RealPhase (Unlit sf)) input_fn dflags let flags = [ -- The -h option passes the file name for unlit to -- put in a #line directive - SysTools.Option "-h" + GHC.SysTools.Option "-h" -- See Note [Don't normalise input filenames]. - , SysTools.Option $ escape input_fn - , SysTools.FileOption "" input_fn - , SysTools.FileOption "" output_fn + , GHC.SysTools.Option $ escape input_fn + , GHC.SysTools.FileOption "" input_fn + , GHC.SysTools.FileOption "" output_fn ] - liftIO $ SysTools.runUnlit dflags flags + liftIO $ GHC.SysTools.runUnlit dflags flags return (RealPhase (Cpp sf), output_fn) where @@ -1030,10 +1030,10 @@ runPhase (RealPhase (HsPp sf)) input_fn dflags PipeEnv{src_basename, src_suffix} <- getPipeEnv let orig_fn = src_basename <.> src_suffix output_fn <- phaseOutputFilename (Hsc sf) - liftIO $ SysTools.runPp dflags - ( [ SysTools.Option orig_fn - , SysTools.Option input_fn - , SysTools.FileOption "" output_fn + liftIO $ GHC.SysTools.runPp dflags + ( [ GHC.SysTools.Option orig_fn + , GHC.SysTools.Option input_fn + , GHC.SysTools.FileOption "" output_fn ] ) @@ -1311,12 +1311,12 @@ runPhase (RealPhase cc_phase) input_fn dflags ghcVersionH <- liftIO $ getGhcVersionPathName dflags - liftIO $ SysTools.runCc (phaseForeignLanguage cc_phase) dflags ( - [ SysTools.FileOption "" input_fn - , SysTools.Option "-o" - , SysTools.FileOption "" output_fn + liftIO $ GHC.SysTools.runCc (phaseForeignLanguage cc_phase) dflags ( + [ GHC.SysTools.FileOption "" input_fn + , GHC.SysTools.Option "-o" + , GHC.SysTools.FileOption "" output_fn ] - ++ map SysTools.Option ( + ++ map GHC.SysTools.Option ( pic_c_flags -- Stub files generated for foreign exports references the runIO_closure @@ -1370,8 +1370,8 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags -- assembler, so we use clang as the assembler instead. (#5636) let as_prog | hscTarget dflags == HscLlvm && platformOS (targetPlatform dflags) == OSDarwin - = SysTools.runClang - | otherwise = SysTools.runAs + = GHC.SysTools.runClang + | otherwise = GHC.SysTools.runAs let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -1384,9 +1384,9 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags liftIO $ createDirectoryIfMissing True (takeDirectory output_fn) ccInfo <- liftIO $ getCompilerInfo dflags - let global_includes = [ SysTools.Option ("-I" ++ p) + let global_includes = [ GHC.SysTools.Option ("-I" ++ p) | p <- includePathsGlobal cmdline_include_paths ] - let local_includes = [ SysTools.Option ("-iquote" ++ p) + let local_includes = [ GHC.SysTools.Option ("-iquote" ++ p) | p <- includePathsQuote cmdline_include_paths ] let runAssembler inputFilename outputFilename = liftIO $ do @@ -1395,9 +1395,9 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags dflags (local_includes ++ global_includes -- See Note [-fPIC for assembler] - ++ map SysTools.Option pic_c_flags + ++ map GHC.SysTools.Option pic_c_flags -- See Note [Produce big objects on Windows] - ++ [ SysTools.Option "-Wa,-mbig-obj" + ++ [ GHC.SysTools.Option "-Wa,-mbig-obj" | platformOS (targetPlatform dflags) == OSMinGW32 , not $ target32Bit (targetPlatform dflags) ] @@ -1410,19 +1410,19 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags -- -- This is a temporary hack. ++ (if platformArch (targetPlatform dflags) == ArchSPARC - then [SysTools.Option "-mcpu=v9"] + then [GHC.SysTools.Option "-mcpu=v9"] else []) ++ (if any (ccInfo ==) [Clang, AppleClang, AppleClang51] - then [SysTools.Option "-Qunused-arguments"] + then [GHC.SysTools.Option "-Qunused-arguments"] else []) - ++ [ SysTools.Option "-x" + ++ [ GHC.SysTools.Option "-x" , if with_cpp - then SysTools.Option "assembler-with-cpp" - else SysTools.Option "assembler" - , SysTools.Option "-c" - , SysTools.FileOption "" inputFilename - , SysTools.Option "-o" - , SysTools.FileOption "" temp_outputFilename + then GHC.SysTools.Option "assembler-with-cpp" + else GHC.SysTools.Option "assembler" + , GHC.SysTools.Option "-c" + , GHC.SysTools.FileOption "" inputFilename + , GHC.SysTools.Option "-o" + , GHC.SysTools.FileOption "" temp_outputFilename ]) liftIO $ debugTraceMsg dflags 4 (text "Running the assembler") @@ -1437,12 +1437,12 @@ runPhase (RealPhase LlvmOpt) input_fn dflags = do output_fn <- phaseOutputFilename LlvmLlc - liftIO $ SysTools.runLlvmOpt dflags + liftIO $ GHC.SysTools.runLlvmOpt dflags ( optFlag ++ defaultOptions ++ - [ SysTools.FileOption "" input_fn - , SysTools.Option "-o" - , SysTools.FileOption "" output_fn] + [ GHC.SysTools.FileOption "" input_fn + , GHC.SysTools.Option "-o" + , GHC.SysTools.FileOption "" output_fn] ) return (RealPhase LlvmLlc, output_fn) @@ -1461,10 +1461,10 @@ runPhase (RealPhase LlvmOpt) input_fn dflags -- passes only, so if the user is passing us extra options we assume -- they know what they are doing and don't get in the way. optFlag = if null (getOpts dflags opt_lo) - then map SysTools.Option $ words llvmOpts + then map GHC.SysTools.Option $ words llvmOpts else [] - defaultOptions = map SysTools.Option . concat . fmap words . fst + defaultOptions = map GHC.SysTools.Option . concat . fmap words . fst $ unzip (llvmOptions dflags) ----------------------------------------------------------------------------- @@ -1479,12 +1479,12 @@ runPhase (RealPhase LlvmLlc) input_fn dflags output_fn <- phaseOutputFilename next_phase - liftIO $ SysTools.runLlvmLlc dflags + liftIO $ GHC.SysTools.runLlvmLlc dflags ( optFlag ++ defaultOptions - ++ [ SysTools.FileOption "" input_fn - , SysTools.Option "-o" - , SysTools.FileOption "" output_fn + ++ [ GHC.SysTools.FileOption "" input_fn + , GHC.SysTools.Option "-o" + , GHC.SysTools.FileOption "" output_fn ] ) @@ -1535,10 +1535,10 @@ runPhase (RealPhase LlvmLlc) input_fn dflags _ -> "-O2" optFlag = if null (getOpts dflags opt_lc) - then map SysTools.Option $ words llvmOpts + then map GHC.SysTools.Option $ words llvmOpts else [] - defaultOptions = map SysTools.Option . concatMap words . snd + defaultOptions = map GHC.SysTools.Option . concatMap words . snd $ unzip (llvmOptions dflags) @@ -1781,15 +1781,15 @@ linkBinary' staticLink dflags o_files dep_packages = do rc_objs <- maybeCreateManifest dflags output_fn let link = if staticLink - then SysTools.runLibtool - else SysTools.runLink + then GHC.SysTools.runLibtool + else GHC.SysTools.runLink link dflags ( - map SysTools.Option verbFlags - ++ [ SysTools.Option "-o" - , SysTools.FileOption "" output_fn + map GHC.SysTools.Option verbFlags + ++ [ GHC.SysTools.Option "-o" + , GHC.SysTools.FileOption "" output_fn ] ++ libmLinkOpts - ++ map SysTools.Option ( + ++ map GHC.SysTools.Option ( [] -- See Note [No PIE when linking] @@ -1841,7 +1841,7 @@ linkBinary' staticLink dflags o_files dep_packages = do ++ o_files ++ lib_path_opts) ++ extra_ld_inputs - ++ map SysTools.Option ( + ++ map GHC.SysTools.Option ( rc_objs ++ framework_opts ++ pkg_lib_path_opts @@ -1911,7 +1911,7 @@ maybeCreateManifest dflags exe_filename -- show is a bit hackish above, but we need to escape the -- backslashes in the path. - runWindres dflags $ map SysTools.Option $ + runWindres dflags $ map GHC.SysTools.Option $ ["--input="++rc_filename, "--output="++rc_obj_filename, "--output-format=coff"] @@ -1963,7 +1963,7 @@ linkStaticLib dflags o_files dep_packages = do else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar -- run ranlib over the archive. write*Ar does *not* create the symbol index. - runRanlib dflags [SysTools.FileOption "" output_fn] + runRanlib dflags [GHC.SysTools.FileOption "" output_fn] -- ----------------------------------------------------------------------------- -- Running CPP @@ -1982,8 +1982,8 @@ doCpp dflags raw input_fn output_fn = do let verbFlags = getVerbFlags dflags - let cpp_prog args | raw = SysTools.runCpp dflags args - | otherwise = SysTools.runCc Nothing dflags (SysTools.Option "-E" : args) + let cpp_prog args | raw = GHC.SysTools.runCpp dflags args + | otherwise = GHC.SysTools.runCc Nothing dflags (GHC.SysTools.Option "-E" : args) let targetArch = stringEncodeArch $ platformArch $ targetPlatform dflags targetOS = stringEncodeOS $ platformOS $ targetPlatform dflags @@ -2027,26 +2027,26 @@ doCpp dflags raw input_fn output_fn = do -- size of 1000 packages, it takes cpp an estimated 2 -- milliseconds to process this file. See #10970 -- comment 8. - return [SysTools.FileOption "-include" macro_stub] + return [GHC.SysTools.FileOption "-include" macro_stub] else return [] - cpp_prog ( map SysTools.Option verbFlags - ++ map SysTools.Option include_paths - ++ map SysTools.Option hsSourceCppOpts - ++ map SysTools.Option target_defs - ++ map SysTools.Option backend_defs - ++ map SysTools.Option th_defs - ++ map SysTools.Option hscpp_opts - ++ map SysTools.Option sse_defs - ++ map SysTools.Option avx_defs + cpp_prog ( map GHC.SysTools.Option verbFlags + ++ map GHC.SysTools.Option include_paths + ++ map GHC.SysTools.Option hsSourceCppOpts + ++ map GHC.SysTools.Option target_defs + ++ map GHC.SysTools.Option backend_defs + ++ map GHC.SysTools.Option th_defs + ++ map GHC.SysTools.Option hscpp_opts + ++ map GHC.SysTools.Option sse_defs + ++ map GHC.SysTools.Option avx_defs ++ mb_macro_include -- Set the language mode to assembler-with-cpp when preprocessing. This -- alleviates some of the C99 macro rules relating to whitespace and the hash -- operator, which we tend to abuse. Clang in particular is not very happy -- about this. - ++ [ SysTools.Option "-x" - , SysTools.Option "assembler-with-cpp" - , SysTools.Option input_fn + ++ [ GHC.SysTools.Option "-x" + , GHC.SysTools.Option "assembler-with-cpp" + , GHC.SysTools.Option input_fn -- We hackily use Option instead of FileOption here, so that the file -- name is not back-slashed on Windows. cpp is capable of -- dealing with / in filenames, so it works fine. Furthermore @@ -2055,8 +2055,8 @@ doCpp dflags raw input_fn output_fn = do -- our error messages get double backslashes in them. -- In due course we should arrange that the lexer deals -- with these \\ escapes properly. - , SysTools.Option "-o" - , SysTools.FileOption "" output_fn + , GHC.SysTools.Option "-o" + , GHC.SysTools.FileOption "" output_fn ]) getBackendDefs :: DynFlags -> IO [String] @@ -2137,20 +2137,20 @@ joinObjectFiles dflags o_files output_fn = do let toolSettings' = toolSettings dflags ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings' osInfo = platformOS (targetPlatform dflags) - ld_r args cc = SysTools.runLink dflags ([ - SysTools.Option "-nostdlib", - SysTools.Option "-Wl,-r" + ld_r args cc = GHC.SysTools.runLink dflags ([ + GHC.SysTools.Option "-nostdlib", + GHC.SysTools.Option "-Wl,-r" ] -- See Note [No PIE while linking] in GHC.Driver.Session ++ (if toolSettings_ccSupportsNoPie toolSettings' - then [SysTools.Option "-no-pie"] + then [GHC.SysTools.Option "-no-pie"] else []) ++ (if any (cc ==) [Clang, AppleClang, AppleClang51] then [] - else [SysTools.Option "-nodefaultlibs"]) + else [GHC.SysTools.Option "-nodefaultlibs"]) ++ (if osInfo == OSFreeBSD - then [SysTools.Option "-L/usr/lib"] + then [GHC.SysTools.Option "-L/usr/lib"] else []) -- gcc on sparc sets -Wl,--relax implicitly, but -- -r and --relax are incompatible for ld, so @@ -2158,16 +2158,16 @@ joinObjectFiles dflags o_files output_fn = do ++ (if platformArch (targetPlatform dflags) `elem` [ArchSPARC, ArchSPARC64] && ldIsGnuLd - then [SysTools.Option "-Wl,-no-relax"] + then [GHC.SysTools.Option "-Wl,-no-relax"] else []) -- See Note [Produce big objects on Windows] - ++ [ SysTools.Option "-Wl,--oformat,pe-bigobj-x86-64" + ++ [ GHC.SysTools.Option "-Wl,--oformat,pe-bigobj-x86-64" | OSMinGW32 == osInfo , not $ target32Bit (targetPlatform dflags) ] - ++ map SysTools.Option ld_build_id - ++ [ SysTools.Option "-o", - SysTools.FileOption "" output_fn ] + ++ map GHC.SysTools.Option ld_build_id + ++ [ GHC.SysTools.Option "-o", + GHC.SysTools.FileOption "" output_fn ] ++ args) -- suppress the generation of the .note.gnu.build-id section, @@ -2183,15 +2183,15 @@ joinObjectFiles dflags o_files output_fn = do cwd <- getCurrentDirectory let o_files_abs = map (\x -> "\"" ++ (cwd x) ++ "\"") o_files writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")" - ld_r [SysTools.FileOption "" script] ccInfo + ld_r [GHC.SysTools.FileOption "" script] ccInfo else if toolSettings_ldSupportsFilelist toolSettings' then do filelist <- newTempName dflags TFL_CurrentModule "filelist" writeFile filelist $ unlines o_files - ld_r [SysTools.Option "-Wl,-filelist", - SysTools.FileOption "-Wl," filelist] ccInfo + ld_r [GHC.SysTools.Option "-Wl,-filelist", + GHC.SysTools.FileOption "-Wl," filelist] ccInfo else do - ld_r (map (SysTools.FileOption "") o_files) ccInfo + ld_r (map (GHC.SysTools.FileOption "") o_files) ccInfo -- ----------------------------------------------------------------------------- -- Misc. @@ -2228,7 +2228,7 @@ hscPostBackendPhase _ hsc_lang = touchObjectFile :: DynFlags -> FilePath -> IO () touchObjectFile dflags path = do createDirectoryIfMissing True $ takeDirectory path - SysTools.touch dflags "Touching object file" path + GHC.SysTools.touch dflags "Touching object file" path -- | Find out path to @ghcversion.h@ file getGhcVersionPathName :: DynFlags -> IO FilePath diff --git a/compiler/GHC/Driver/Pipeline/Monad.hs b/compiler/GHC/Driver/Pipeline/Monad.hs index 6e07924d1e6e6af85032ff6d111114df5f957e02..753f829f3c6448bfc26df3066ddc2e8eec76fbaa 100644 --- a/compiler/GHC/Driver/Pipeline/Monad.hs +++ b/compiler/GHC/Driver/Pipeline/Monad.hs @@ -19,7 +19,7 @@ import GHC.Driver.Session import GHC.Driver.Phases import GHC.Driver.Types import GHC.Types.Module -import FileCleanup (TempFileLifetime) +import GHC.SysTools.FileCleanup (TempFileLifetime) import Control.Monad diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 2f8fb99162d741216db93faef3aaba3e980f88f1..5ed6e093d7ee0c975256d5b8df4fbfa595740dd3 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -242,11 +242,10 @@ import GhcPrelude import GHC.Platform import GHC.UniqueSubdir (uniqueSubdir) -import PlatformConstants import GHC.Types.Module import {-# SOURCE #-} GHC.Driver.Plugins import {-# SOURCE #-} GHC.Driver.Hooks -import {-# SOURCE #-} PrelNames ( mAIN ) +import {-# SOURCE #-} GHC.Builtin.Names ( mAIN ) import {-# SOURCE #-} GHC.Driver.Packages (PackageState, emptyPackageState, PackageDatabase, mkComponentId) import GHC.Driver.Phases ( Phase(..), phaseInputExt ) import GHC.Driver.Flags @@ -255,8 +254,7 @@ import Config import CliOption import GHC.Driver.CmdLine hiding (WarnReason(..)) import qualified GHC.Driver.CmdLine as Cmd -import Constants -import GhcNameVersion +import GHC.Settings.Constants import Panic import qualified PprColour as Col import Util @@ -267,17 +265,15 @@ import GHC.Types.SrcLoc import GHC.Types.Basic ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf ) import FastString import Fingerprint -import FileSettings import Outputable -import Settings -import ToolSettings +import GHC.Settings import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessageAnn , getCaretDiagnostic, DumpAction, TraceAction , defaultDumpAction, defaultTraceAction ) import Json -import SysTools.Terminal ( stderrSupportsAnsiColors ) -import SysTools.BaseDir ( expandToolDir, expandTopDir ) +import GHC.SysTools.Terminal ( stderrSupportsAnsiColors ) +import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir ) import System.IO.Unsafe ( unsafePerformIO ) import Data.IORef @@ -457,10 +453,10 @@ data DynFlags = DynFlags { integerLibrary :: IntegerLibrary, -- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overridden - -- by GHC-API users. See Note [The integer library] in PrelNames + -- by GHC-API users. See Note [The integer library] in GHC.Builtin.Names llvmConfig :: LlvmConfig, -- ^ N.B. It's important that this field is lazy since we load the LLVM - -- configuration lazily. See Note [LLVM Configuration] in SysTools. + -- configuration lazily. See Note [LLVM Configuration] in GHC.SysTools. verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] optLevel :: Int, -- ^ Optimisation level debugLevel :: Int, -- ^ How much debug information to produce @@ -888,7 +884,7 @@ data LlvmTarget = LlvmTarget , lAttributes :: [String] } --- | See Note [LLVM Configuration] in SysTools. +-- | See Note [LLVM Configuration] in GHC.SysTools. data LlvmConfig = LlvmConfig { llvmTargets :: [(String, LlvmTarget)] , llvmPasses :: [(Int, String)] } diff --git a/compiler/GHC/Driver/Types.hs b/compiler/GHC/Driver/Types.hs index d532ef09b02b5dc7fdd15b98cedd230aea2e70e3..581a90ea1d16082e0e7d80b66a00590ecb22d02a 100644 --- a/compiler/GHC/Driver/Types.hs +++ b/compiler/GHC/Driver/Types.hs @@ -182,7 +182,7 @@ import GHC.Types.Id import GHC.Types.Id.Info ( IdDetails(..), RecSelParent(..)) import GHC.Core.Type -import ApiAnnotation ( ApiAnns ) +import GHC.Parser.Annotation ( ApiAnns ) import GHC.Types.Annotations ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv ) import GHC.Core.Class import GHC.Core.TyCon @@ -190,8 +190,8 @@ import GHC.Core.Coercion.Axiom import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.PatSyn -import PrelNames ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule ) -import TysWiredIn +import GHC.Builtin.Names ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule ) +import GHC.Builtin.Types import GHC.Driver.Packages hiding ( Version(..) ) import GHC.Driver.CmdLine import GHC.Driver.Session @@ -1561,7 +1561,7 @@ as if they were defined in modules ...etc... with each bunch of declarations using a new module, all sharing a common package 'interactive' (see Module.interactiveUnitId, and -PrelNames.mkInteractiveModule). +GHC.Builtin.Names.mkInteractiveModule). This scheme deals well with shadowing. For example: @@ -3154,7 +3154,7 @@ data HsParsedModule = HsParsedModule { -- the .hi file, so that we can force recompilation if any of -- them change (#3589) hpm_annotations :: ApiAnns - -- See note [Api annotations] in ApiAnnotation.hs + -- See note [Api annotations] in GHC.Parser.Annotation } {- diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs index 98509398aad19b7d3ce37f990f44de0328993176..72710c68302ae1abaa6b9d7a93ad530ce65513e5 100644 --- a/compiler/GHC/Hs.hs +++ b/compiler/GHC/Hs.hs @@ -79,7 +79,7 @@ data HsModule -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen' -- ,'ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation hsmodImports :: [LImportDecl GhcPs], -- ^ We snaffle interesting stuff out of the imported interfaces early -- on, adding that info to TyDecls/etc; so this list is often empty, @@ -93,14 +93,14 @@ data HsModule -- ,'ApiAnnotation.AnnClose' -- - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation hsmodHaddockModHeader :: Maybe LHsDocString -- ^ Haddock module info and description, unparsed -- -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen' -- ,'ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation } -- ^ 'ApiAnnotation.AnnKeywordId's -- @@ -110,7 +110,7 @@ data HsModule -- 'ApiAnnotation.AnnClose' for explicit braces and semi around -- hsmodImports,hsmodDecls if this style is used. - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation deriving instance Data HsModule diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs index 54718d289f0a65056f2fa09fd0ff9789edb05ef1..5068f082ce4acead54c7b7b4382aac2f5ef1170c 100644 --- a/compiler/GHC/Hs/Binds.hs +++ b/compiler/GHC/Hs/Binds.hs @@ -218,7 +218,7 @@ data HsBindLR idL idR -- - 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere', -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation FunBind { fun_ext :: XFunBind idL idR, @@ -259,7 +259,7 @@ data HsBindLR idL idR -- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere', -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | PatBind { pat_ext :: XPatBind idL idR, -- ^ See Note [Bind free vars] pat_lhs :: LPat idL, @@ -310,7 +310,7 @@ data HsBindLR idL idR -- 'ApiAnnotation.AnnWhere' -- 'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | XHsBindsLR !(XXHsBindsLR idL idR) @@ -365,7 +365,7 @@ type instance XXABExport (GhcPass p) = NoExtCon -- 'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen' @'{'@, -- 'ApiAnnotation.AnnClose' @'}'@, --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation -- | Pattern Synonym binding data PatSynBind idL idR @@ -824,7 +824,7 @@ type LIPBind id = Located (IPBind id) -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a -- list --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation -- | Implicit parameter bindings. -- @@ -835,7 +835,7 @@ type LIPBind id = Located (IPBind id) -- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual' --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation data IPBind id = IPBind (XCIPBind id) @@ -890,7 +890,7 @@ data Sig pass -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon', -- 'ApiAnnotation.AnnComma' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation TypeSig (XTypeSig pass) [Located (IdP pass)] -- LHS of the signature; e.g. f,g,h :: blah @@ -904,7 +904,7 @@ data Sig pass -- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnForall' -- 'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | PatSynSig (XPatSynSig pass) [Located (IdP pass)] (LHsSigType pass) -- P :: forall a b. Req => Prov => ty @@ -935,7 +935,7 @@ data Sig pass -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInfix', -- 'ApiAnnotation.AnnVal' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | FixSig (XFixSig pass) (FixitySig pass) -- | An inline pragma @@ -948,7 +948,7 @@ data Sig pass -- 'ApiAnnotation.AnnVal','ApiAnnotation.AnnTilde', -- 'ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | InlineSig (XInlineSig pass) (Located (IdP pass)) -- Function name InlinePragma -- Never defaultInlinePragma @@ -964,7 +964,7 @@ data Sig pass -- 'ApiAnnotation.AnnClose' @']'@ and @'\#-}'@, -- 'ApiAnnotation.AnnDcolon' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | SpecSig (XSpecSig pass) (Located (IdP pass)) -- Specialise a function or datatype ... [LHsSigType pass] -- ... to these types @@ -982,7 +982,7 @@ data Sig pass -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen', -- 'ApiAnnotation.AnnInstance','ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass) -- Note [Pragma source text] in GHC.Types.Basic @@ -994,7 +994,7 @@ data Sig pass -- 'ApiAnnotation.AnnVbar','ApiAnnotation.AnnComma', -- 'ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | MinimalSig (XMinimalSig pass) SourceText (LBooleanFormula (Located (IdP pass))) -- Note [Pragma source text] in GHC.Types.Basic diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index c3388b636252f7c88991d14664ec5bef2d4a2659..0be89127a50539166614c392e062fcbd9f783c46 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -135,7 +135,7 @@ type LHsDecl p = Located (HsDecl p) -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' -- --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation -- | A Haskell Declaration data HsDecl p @@ -452,7 +452,7 @@ have (Just binds) in the tcdMeths field, whereas interface decls have Nothing. In *source-code* class declarations: - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName - This is done by RdrHsSyn.mkClassOpSigDM + This is done by GHC.Parser.PostProcess.mkClassOpSigDM - The renamer renames it to a Name @@ -546,7 +546,7 @@ data TyClDecl pass -- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnRarrow', -- 'ApiAnnotation.AnnVbar' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation FamDecl { tcdFExt :: XFamDecl pass, tcdFam :: FamilyDecl pass } | -- | @type@ declaration @@ -554,7 +554,7 @@ data TyClDecl pass -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType', -- 'ApiAnnotation.AnnEqual', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation SynDecl { tcdSExt :: XSynDecl pass -- ^ Post renameer, FVs , tcdLName :: Located (IdP pass) -- ^ Type constructor , tcdTyVars :: LHsQTyVars pass -- ^ Type variables; for an @@ -571,7 +571,7 @@ data TyClDecl pass -- 'ApiAnnotation.AnnNewType','ApiAnnotation.AnnDcolon' -- 'ApiAnnotation.AnnWhere', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation DataDecl { tcdDExt :: XDataDecl pass -- ^ Post renamer, CUSK flag, FVs , tcdLName :: Located (IdP pass) -- ^ Type constructor , tcdTyVars :: LHsQTyVars pass -- ^ Type variables @@ -598,7 +598,7 @@ data TyClDecl pass -- 'ApiAnnotation.AnnComma' -- 'ApiAnnotation.AnnRarrow' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | XTyClDecl !(XXTyClDecl pass) type LHsFunDep pass = Located (FunDep (Located (IdP pass))) @@ -1047,14 +1047,14 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig] NoSig (XNoSig pass) -- ^ - 'ApiAnnotation.AnnKeywordId' : - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | KindSig (XCKindSig pass) (LHsKind pass) -- ^ - 'ApiAnnotation.AnnKeywordId' : -- 'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon', -- 'ApiAnnotation.AnnCloseP' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | TyVarSig (XTyVarSig pass) (LHsTyVarBndr pass) -- ^ - 'ApiAnnotation.AnnKeywordId' : @@ -1062,7 +1062,7 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig] -- 'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual' | XFamilyResultSig !(XXFamilyResultSig pass) - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation type instance XNoSig (GhcPass _) = NoExtField type instance XCKindSig (GhcPass _) = NoExtField @@ -1093,7 +1093,7 @@ data FamilyDecl pass = FamilyDecl -- 'ApiAnnotation.AnnEqual', 'ApiAnnotation.AnnRarrow', -- 'ApiAnnotation.AnnVbar' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation type instance XCFamilyDecl (GhcPass _) = NoExtField type instance XXFamilyDecl (GhcPass _) = NoExtCon @@ -1115,7 +1115,7 @@ data InjectivityAnn pass -- ^ - 'ApiAnnotation.AnnKeywordId' : -- 'ApiAnnotation.AnnRarrow', 'ApiAnnotation.AnnVbar' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation data FamilyInfo pass = DataFamily @@ -1231,7 +1231,7 @@ data HsDataDefn pass -- The payload of a data type defn dd_derivs :: HsDeriving pass -- ^ Optional 'deriving' clause - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation } | XHsDataDefn !(XXHsDataDefn pass) @@ -1348,7 +1348,7 @@ type LConDecl pass = Located (ConDecl pass) -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when -- in a GADT constructor list - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- | -- @@ -1372,7 +1372,7 @@ type LConDecl pass = Located (ConDecl pass) -- 'ApiAnnotation.AnnDarrow','ApiAnnotation.AnnDarrow', -- 'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot' --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation -- | data Constructor Declaration data ConDecl pass @@ -1444,7 +1444,7 @@ There's a wrinkle in ConDeclGADT so it's hard to split up the arguments until we've done the precedence resolution (in the renamer). - So: - In the parser (RdrHsSyn.mkGadtDecl), we put the whole constr + So: - In the parser (GHC.Parser.PostProcess.mkGadtDecl), we put the whole constr type into the res_ty for a ConDeclGADT for now, and use PrefixCon [] con_args = PrefixCon [] @@ -1593,7 +1593,7 @@ type LTyFamInstEqn pass = Located (TyFamInstEqn pass) -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' -- when in a list --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation -- | Haskell Type Patterns type HsTyPats pass = [LHsTypeArg pass] @@ -1652,7 +1652,7 @@ newtype TyFamInstDecl pass = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass } -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType', -- 'ApiAnnotation.AnnInstance', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation ----------------- Data family instances ------------- @@ -1669,7 +1669,7 @@ newtype DataFamInstDecl pass -- 'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen', -- 'ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation ----------------- Family instances (common types) ------------- @@ -1700,7 +1700,7 @@ data FamEqn pass rhs -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual' | XFamEqn !(XXFamEqn pass rhs) - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation type instance XCFamEqn (GhcPass _) r = NoExtField type instance XXFamEqn (GhcPass _) r = NoExtCon @@ -1725,14 +1725,14 @@ data ClsInstDecl pass -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen', -- 'ApiAnnotation.AnnClose', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation } -- ^ -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInstance', -- 'ApiAnnotation.AnnWhere', -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | XClsInstDecl !(XXClsInstDecl pass) type instance XCClsInstDecl (GhcPass _) = NoExtField @@ -1922,7 +1922,7 @@ data DerivDecl pass = DerivDecl -- 'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype', -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation } | XDerivDecl !(XXDerivDecl pass) @@ -2023,7 +2023,7 @@ data DefaultDecl pass -- ^ - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnDefault', -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | XDefaultDecl !(XXDefaultDecl pass) type instance XCDefaultDecl (GhcPass _) = NoExtField @@ -2069,7 +2069,7 @@ data ForeignDecl pass -- 'ApiAnnotation.AnnImport','ApiAnnotation.AnnExport', -- 'ApiAnnotation.AnnDcolon' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | XForeignDecl !(XXForeignDecl pass) {- @@ -2250,7 +2250,7 @@ data RuleBndr pass -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen', -- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation type instance XCRuleBndr (GhcPass _) = NoExtField type instance XRuleBndrSig (GhcPass _) = NoExtField @@ -2386,7 +2386,7 @@ data AnnDecl pass = HsAnnotation -- 'ApiAnnotation.AnnModule' -- 'ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | XAnnDecl !(XXAnnDecl pass) type instance XHsAnnotation (GhcPass _) = NoExtField @@ -2438,7 +2438,7 @@ data RoleAnnotDecl pass -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType', -- 'ApiAnnotation.AnnRole' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | XRoleAnnotDecl !(XXRoleAnnotDecl pass) type instance XCRoleAnnotDecl (GhcPass _) = NoExtField diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs index 050ba91d6b03fa140f357f1507e9f63a3fa7b8d4..d52f9cac65b774b1be096b28f768983deef4a356 100644 --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -47,7 +47,7 @@ import Util import Outputable import FastString import GHC.Core.Type -import TysWiredIn (mkTupleStr) +import GHC.Builtin.Types (mkTupleStr) import GHC.Tc.Utils.TcType (TcType) import {-# SOURCE #-} GHC.Tc.Types (TcLclEnv) @@ -75,7 +75,7 @@ type LHsExpr p = Located (HsExpr p) -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when -- in a list - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation ------------------------- -- | Post-Type checking Expression @@ -281,7 +281,7 @@ data HsExpr p -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam', -- 'ApiAnnotation.AnnRarrow', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsLamCase (XLamCase p) (MatchGroup p (LHsExpr p)) -- ^ Lambda-case -- @@ -289,7 +289,7 @@ data HsExpr p -- 'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen', -- 'ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsApp (XApp p) (LHsExpr p) (LHsExpr p) -- ^ Application @@ -316,7 +316,7 @@ data HsExpr p -- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnMinus' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | NegApp (XNegApp p) (LHsExpr p) (SyntaxExpr p) @@ -324,7 +324,7 @@ data HsExpr p -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@, -- 'ApiAnnotation.AnnClose' @')'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsPar (XPar p) (LHsExpr p) -- ^ Parenthesised expr; see Note [Parens in HsSyn] @@ -340,7 +340,7 @@ data HsExpr p -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen', -- 'ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- Note [ExplicitTuple] | ExplicitTuple (XExplicitTuple p) @@ -364,7 +364,7 @@ data HsExpr p -- 'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@, -- 'ApiAnnotation.AnnClose' @'}'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsCase (XCase p) (LHsExpr p) (MatchGroup p (LHsExpr p)) @@ -374,7 +374,7 @@ data HsExpr p -- 'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi', -- 'ApiAnnotation.AnnElse', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsIf (XIf p) -- GhcPs: this is a Bool; False <=> do not use -- rebindable syntax (SyntaxExpr p) -- cond function @@ -389,7 +389,7 @@ data HsExpr p -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf' -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsMultiIf (XMultiIf p) [LGRHS p (LHsExpr p)] -- | let(rec) @@ -398,7 +398,7 @@ data HsExpr p -- 'ApiAnnotation.AnnOpen' @'{'@, -- 'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsLet (XLet p) (LHsLocalBinds p) (LHsExpr p) @@ -408,7 +408,7 @@ data HsExpr p -- 'ApiAnnotation.AnnVbar', -- 'ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsDo (XDo p) -- Type of the whole expression (HsStmtContext GhcRn) -- The parameterisation is unimportant -- because in this context we never use @@ -420,7 +420,7 @@ data HsExpr p -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@, -- 'ApiAnnotation.AnnClose' @']'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- See Note [Empty lists] | ExplicitList (XExplicitList p) -- Gives type of components of list @@ -433,7 +433,7 @@ data HsExpr p -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@, -- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | RecordCon { rcon_ext :: XRecordCon p , rcon_con_name :: Located (IdP p) -- The constructor name; @@ -445,7 +445,7 @@ data HsExpr p -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@, -- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | RecordUpd { rupd_ext :: XRecordUpd p , rupd_expr :: LHsExpr p @@ -458,7 +458,7 @@ data HsExpr p -- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | ExprWithTySig (XExprWithTySig p) @@ -471,14 +471,14 @@ data HsExpr p -- 'ApiAnnotation.AnnComma','ApiAnnotation.AnnDotdot', -- 'ApiAnnotation.AnnClose' @']'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | ArithSeq (XArithSeq p) (Maybe (SyntaxExpr p)) -- For OverloadedLists, the fromList witness (ArithSeqInfo p) - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation ----------------------------------------------------------- -- MetaHaskell Extensions @@ -487,7 +487,7 @@ data HsExpr p -- 'ApiAnnotation.AnnOpenE','ApiAnnotation.AnnOpenEQ', -- 'ApiAnnotation.AnnClose','ApiAnnotation.AnnCloseQ' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsBracket (XBracket p) (HsBracket p) -- See Note [Pending Splices] @@ -509,7 +509,7 @@ data HsExpr p -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen', -- 'ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsSpliceE (XSpliceE p) (HsSplice p) ----------------------------------------------------------- @@ -520,7 +520,7 @@ data HsExpr p -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnProc', -- 'ApiAnnotation.AnnRarrow' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsProc (XProc p) (LPat p) -- arrow abstraction, proc (LHsCmdTop p) -- body of the abstraction @@ -530,7 +530,7 @@ data HsExpr p -- static pointers extension -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnStatic', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsStatic (XStatic p) -- Free variables of the body (LHsExpr p) -- Body @@ -681,7 +681,7 @@ data HsPragE p -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CORE'@, -- 'ApiAnnotation.AnnVal', 'ApiAnnotation.AnnClose' @'\#-}'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsPragCore (XCoreAnn p) SourceText -- Note [Pragma source text] in GHC.Types.Basic StringLiteral -- hdaume: core annotation @@ -695,7 +695,7 @@ data HsPragE p -- 'ApiAnnotation.AnnVal', -- 'ApiAnnotation.AnnClose' @'\#-}'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsPragTick -- A pragma introduced tick (XTickPragma p) SourceText -- Note [Pragma source text] in GHC.Types.Basic @@ -721,7 +721,7 @@ type instance XXPragE (GhcPass _) = NoExtCon type LHsTupArg id = Located (HsTupArg id) -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation -- | Haskell Tuple Argument data HsTupArg id @@ -841,7 +841,7 @@ A tuple data constructor like () or (,,,) is parsed as an `HsVar`, not an Sadly, the grammar for this is actually ambiguous, and it's only thanks to the preference of a shift in a shift/reduce conflict that the parser works as this -Note details. Search for a reference to this Note in Parser.y for further +Note details. Search for a reference to this Note in GHC.Parser for further explanation. Note [Empty lists] @@ -853,7 +853,7 @@ various phases and why. Parsing ------- An empty list is parsed by the sysdcon nonterminal. It thus comes to life via -HsVar nilDataCon (defined in TysWiredIn). A freshly-parsed (HsExpr GhcPs) empty list +HsVar nilDataCon (defined in GHC.Builtin.Types). A freshly-parsed (HsExpr GhcPs) empty list is never a ExplicitList. Renaming @@ -1270,7 +1270,7 @@ data HsCmd id -- 'ApiAnnotation.Annrarrowtail','ApiAnnotation.AnnLarrowtail', -- 'ApiAnnotation.AnnRarrowtail' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation = HsCmdArrApp -- Arrow tail, or arrow application (f -< arg) (XCmdArrApp id) -- type of the arrow expressions f, -- of the form a t t', where arg :: t @@ -1283,7 +1283,7 @@ data HsCmd id -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpenB' @'(|'@, -- 'ApiAnnotation.AnnCloseB' @'|)'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsCmdArrForm -- Command formation, (| e cmd1 .. cmdn |) (XCmdArrForm id) (LHsExpr id) -- The operator. @@ -1304,14 +1304,14 @@ data HsCmd id -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam', -- 'ApiAnnotation.AnnRarrow', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsCmdPar (XCmdPar id) (LHsCmd id) -- parenthesised command -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@, -- 'ApiAnnotation.AnnClose' @')'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsCmdCase (XCmdCase id) (LHsExpr id) @@ -1320,7 +1320,7 @@ data HsCmd id -- 'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@, -- 'ApiAnnotation.AnnClose' @'}'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsCmdIf (XCmdIf id) (SyntaxExpr id) -- cond function @@ -1332,7 +1332,7 @@ data HsCmd id -- 'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi', -- 'ApiAnnotation.AnnElse', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsCmdLet (XCmdLet id) (LHsLocalBinds id) -- let(rec) @@ -1341,7 +1341,7 @@ data HsCmd id -- 'ApiAnnotation.AnnOpen' @'{'@, -- 'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsCmdDo (XCmdDo id) -- Type of the whole expression (Located [CmdLStmt id]) @@ -1350,7 +1350,7 @@ data HsCmd id -- 'ApiAnnotation.AnnVbar', -- 'ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | XCmd !(XXCmd id) -- Note [Trees that Grow] extension point @@ -1567,7 +1567,7 @@ type LMatch id body = Located (Match id body) -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a -- list --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation data Match p body = Match { m_ext :: XCMatch p body, @@ -1659,7 +1659,7 @@ hsLMatchPats (L _ (Match { m_pats = pats })) = pats -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose' -- 'ApiAnnotation.AnnRarrow','ApiAnnotation.AnnSemi' --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation data GRHSs p body = GRHSs { grhssExt :: XCGRHSs p body, @@ -1809,7 +1809,7 @@ type GhciStmt id = Stmt id (LHsExpr id) -- 'ApiAnnotation.AnnBy','ApiAnnotation.AnnBy', -- 'ApiAnnotation.AnnGroup','ApiAnnotation.AnnUsing' --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation data StmtLR idL idR body -- body should always be (LHs**** idR) = LastStmt -- Always the last Stmt in ListComp, MonadComp, -- and (after the renamer, see GHC.Rename.Expr.checkLastStmt) DoExpr, MDoExpr @@ -1827,7 +1827,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR) -- See Note [Monad Comprehensions] -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLarrow' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | BindStmt (XBindStmt idL idR body) -- ^ Post renaming has optional fail and bind / (>>=) operator. -- Post typechecking, also has result type of the @@ -1861,7 +1861,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR) -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet' -- 'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@, - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | LetStmt (XLetStmt idL idR body) (LHsLocalBindsLR idL idR) -- ParStmts only occur in a list/monad comprehension @@ -1899,7 +1899,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR) -- Recursive statement (see Note [How RecStmt works] below) -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRec' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | RecStmt { recS_ext :: XRecStmt idL idR body , recS_stmts :: [LStmtLR idL idR body] diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs index f0f62b9fb63910962e6828f62a06cacc782a58d3..d4ed3e64a0cb5d7988e723e575b84999bda38422 100644 --- a/compiler/GHC/Hs/ImpExp.hs +++ b/compiler/GHC/Hs/ImpExp.hs @@ -48,7 +48,7 @@ type LImportDecl pass = Located (ImportDecl pass) -- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- | If/how an import is 'qualified'. data ImportDeclQualifiedStyle @@ -59,7 +59,7 @@ data ImportDeclQualifiedStyle -- | Given two possible located 'qualified' tokens, compute a style -- (in a conforming Haskell program only one of the two can be not --- 'Nothing'). This is called from 'Parser.y'. +-- 'Nothing'). This is called from 'GHC.Parser'. importDeclQualifiedStyle :: Maybe (Located a) -> Maybe (Located a) -> ImportDeclQualifiedStyle @@ -107,7 +107,7 @@ data ImportDecl pass -- 'ApiAnnotation.AnnClose' attached -- to location in ideclHiding - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation type instance XCImportDecl (GhcPass _) = NoExtField type instance XXImportDecl (GhcPass _) = NoExtCon @@ -189,7 +189,7 @@ data IEWrappedName name -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnType', -- 'ApiAnnotation.AnnPattern' type LIEWrappedName name = Located (IEWrappedName name) --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation -- | Located Import or Export @@ -198,7 +198,7 @@ type LIE pass = Located (IE pass) -- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- | Imported or exported entity. data IE pass @@ -212,7 +212,7 @@ data IE pass -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnPattern', -- 'ApiAnnotation.AnnType','ApiAnnotation.AnnVal' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- See Note [Located RdrNames] in GHC.Hs.Expr | IEThingAll (XIEThingAll pass) (LIEWrappedName (IdP pass)) -- ^ Imported or exported Thing with All imported or exported @@ -223,7 +223,7 @@ data IE pass -- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose', -- 'ApiAnnotation.AnnType' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- See Note [Located RdrNames] in GHC.Hs.Expr | IEThingWith (XIEThingWith pass) @@ -240,7 +240,7 @@ data IE pass -- 'ApiAnnotation.AnnComma', -- 'ApiAnnotation.AnnType' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | IEModuleContents (XIEModuleContents pass) (Located ModuleName) -- ^ Imported or exported module contents -- @@ -248,7 +248,7 @@ data IE pass -- -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnModule' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | IEGroup (XIEGroup pass) Int HsDocString -- ^ Doc section heading | IEDoc (XIEDoc pass) HsDocString -- ^ Some documentation | IEDocNamed (XIEDocNamed pass) String -- ^ Reference to named doc diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs index bfa8bb9ed0fabe7d8cecffb492c28b156c3d10bb..2b5c871ab1ac89d6a7b63a768e5582787d4f7e05 100644 --- a/compiler/GHC/Hs/Pat.hs +++ b/compiler/GHC/Hs/Pat.hs @@ -60,7 +60,7 @@ import GHC.Types.Basic -- others: import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} ) import GHC.Driver.Session ( gopt, GeneralFlag(Opt_PrintTypecheckerElaboration) ) -import TysWiredIn +import GHC.Builtin.Types import GHC.Types.Var import GHC.Types.Name.Reader ( RdrName ) import GHC.Core.ConLike @@ -83,7 +83,7 @@ type LPat p = XRec p Pat -- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang' --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation data Pat p = ------------ Simple patterns --------------- WildPat (XWildPat p) -- ^ Wildcard Pattern @@ -99,13 +99,13 @@ data Pat p (LPat p) -- ^ Lazy Pattern -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | AsPat (XAsPat p) (Located (IdP p)) (LPat p) -- ^ As pattern -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | ParPat (XParPat p) (LPat p) -- ^ Parenthesised pattern @@ -113,12 +113,12 @@ data Pat p -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@, -- 'ApiAnnotation.AnnClose' @')'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | BangPat (XBangPat p) (LPat p) -- ^ Bang pattern -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation ------------ Lists, tuples, arrays --------------- | ListPat (XListPat p) @@ -132,7 +132,7 @@ data Pat p -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@, -- 'ApiAnnotation.AnnClose' @']'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | TuplePat (XTuplePat p) -- after typechecking, holds the types of the tuple components @@ -170,7 +170,7 @@ data Pat p -- 'ApiAnnotation.AnnOpen' @'(#'@, -- 'ApiAnnotation.AnnClose' @'#)'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation ------------ Constructor patterns --------------- | ConPatIn (Located (IdP p)) @@ -201,7 +201,7 @@ data Pat p ------------ View patterns --------------- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | ViewPat (XViewPat p) -- The overall type of the pattern -- (= the argument type of the view function) -- for hsPatType. @@ -213,7 +213,7 @@ data Pat p -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@ -- 'ApiAnnotation.AnnClose' @')'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | SplicePat (XSplicePat p) (HsSplice p) -- ^ Splice Pattern (Includes quasi-quotes) @@ -239,7 +239,7 @@ data Pat p -- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVal' @'+'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | NPlusKPat (XNPlusKPat p) -- Type of overall pattern (Located (IdP p)) -- n+k pattern (Located (HsOverLit p)) -- It'll always be an HsIntegral @@ -254,7 +254,7 @@ data Pat p ------------ Pattern type signatures --------------- -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | SigPat (XSigPat p) -- After typechecker: Type (LPat p) -- Pattern with a type signature (LHsSigWcType (NoGhcTc p)) -- Signature can bind both @@ -389,7 +389,7 @@ type HsRecUpdField p = HsRecField' (AmbiguousFieldOcc p) (LHsExpr p) -- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual', -- --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation data HsRecField' id arg = HsRecField { hsRecFieldLbl :: Located id, hsRecFieldArg :: arg, -- ^ Filled in by renamer when punning diff --git a/compiler/GHC/Hs/Types.hs b/compiler/GHC/Hs/Types.hs index d9a8ae306635ffd932bdefcea198b0510c9d5d00..38a0300a8f68624fe6fd429915cd0bf755a42aa2 100644 --- a/compiler/GHC/Hs/Types.hs +++ b/compiler/GHC/Hs/Types.hs @@ -83,7 +83,7 @@ import GHC.Types.Name( Name, NamedThing(getName) ) import GHC.Types.Name.Reader ( RdrName ) import GHC.Core.DataCon( HsSrcBang(..), HsImplBang(..), SrcStrictness(..), SrcUnpackedness(..) ) -import TysWiredIn( mkTupleStr ) +import GHC.Builtin.Types( mkTupleStr ) import GHC.Core.Type import GHC.Hs.Doc import GHC.Types.Basic @@ -284,7 +284,7 @@ quantified in left-to-right order in kind signatures is nice since: -- | Located Haskell Context type LHsContext pass = Located (HsContext pass) -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnUnit' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation noLHsContext :: LHsContext pass -- Use this when there is no context in the original program @@ -302,7 +302,7 @@ type LHsType pass = Located (HsType pass) -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when -- in a list - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- | Haskell Kind type HsKind pass = HsType pass @@ -311,7 +311,7 @@ type HsKind pass = HsType pass type LHsKind pass = Located (HsKind pass) -- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation -------------------------------------------------- -- LHsQTyVars @@ -495,7 +495,7 @@ data HsTyVarBndr pass -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen', -- 'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnClose' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | XTyVarBndr !(XXTyVarBndr pass) @@ -531,7 +531,7 @@ data HsType pass } -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnForall', -- 'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsQualTy -- See Note [HsType binders] { hst_xqual :: XQualTy pass @@ -547,14 +547,14 @@ data HsType pass -- See Note [Located RdrNames] in GHC.Hs.Expr -- ^ - 'ApiAnnotation.AnnKeywordId' : None - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsAppTy (XAppTy pass) (LHsType pass) (LHsType pass) -- ^ - 'ApiAnnotation.AnnKeywordId' : None - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsAppKindTy (XAppKindTy pass) -- type level type app (LHsType pass) @@ -565,14 +565,14 @@ data HsType pass (LHsType pass) -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow', - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsListTy (XListTy pass) (LHsType pass) -- Element type -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@, -- 'ApiAnnotation.AnnClose' @']'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsTupleTy (XTupleTy pass) HsTupleSort @@ -580,20 +580,20 @@ data HsType pass -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(' or '(#'@, -- 'ApiAnnotation.AnnClose' @')' or '#)'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsSumTy (XSumTy pass) [LHsType pass] -- Element types (length gives arity) -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(#'@, -- 'ApiAnnotation.AnnClose' '#)'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsOpTy (XOpTy pass) (LHsType pass) (Located (IdP pass)) (LHsType pass) -- ^ - 'ApiAnnotation.AnnKeywordId' : None - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsParTy (XParTy pass) (LHsType pass) -- See Note [Parens in HsSyn] in GHC.Hs.Expr @@ -603,7 +603,7 @@ data HsType pass -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@, -- 'ApiAnnotation.AnnClose' @')'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsIParamTy (XIParamTy pass) (Located HsIPName) -- (?x :: ty) @@ -614,7 +614,7 @@ data HsType pass -- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsStarTy (XStarTy pass) Bool -- Is this the Unicode variant? @@ -630,20 +630,20 @@ data HsType pass -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@, -- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose' @')'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsSpliceTy (XSpliceTy pass) (HsSplice pass) -- Includes quasi-quotes -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@, -- 'ApiAnnotation.AnnClose' @')'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsDocTy (XDocTy pass) (LHsType pass) LHsDocString -- A documented type -- ^ - 'ApiAnnotation.AnnKeywordId' : None - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsBangTy (XBangTy pass) HsSrcBang (LHsType pass) -- Bang-style type annotations @@ -652,20 +652,20 @@ data HsType pass -- 'ApiAnnotation.AnnClose' @'#-}'@ -- 'ApiAnnotation.AnnBang' @\'!\'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsRecTy (XRecTy pass) [LConDeclField pass] -- Only in data type declarations -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@, -- 'ApiAnnotation.AnnClose' @'}'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- | HsCoreTy (XCoreTy pass) Type -- An escape hatch for tunnelling a *closed* -- -- Core Type through HsSyn. -- -- ^ - 'ApiAnnotation.AnnKeywordId' : None - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsExplicitListTy -- A promoted explicit list (XExplicitListTy pass) @@ -674,7 +674,7 @@ data HsType pass -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'["@, -- 'ApiAnnotation.AnnClose' @']'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsExplicitTupleTy -- A promoted explicit tuple (XExplicitTupleTy pass) @@ -682,18 +682,18 @@ data HsType pass -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'("@, -- 'ApiAnnotation.AnnClose' @')'@ - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsTyLit (XTyLit pass) HsTyLit -- A promoted numeric literal. -- ^ - 'ApiAnnotation.AnnKeywordId' : None - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsWildCardTy (XWildCardTy pass) -- A type wildcard -- See Note [The wildcard story for types] -- ^ - 'ApiAnnotation.AnnKeywordId' : None - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- For adding new constructors via Trees that Grow | XHsType @@ -857,7 +857,7 @@ type LConDeclField pass = Located (ConDeclField pass) -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when -- in a list - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- | Constructor Declaration Field data ConDeclField pass -- Record fields have Haddock docs on them @@ -868,7 +868,7 @@ data ConDeclField pass -- Record fields have Haddock docs on them cd_fld_doc :: Maybe LHsDocString } -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon' - -- For details on above see note [Api annotations] in ApiAnnotation + -- For details on above see note [Api annotations] in GHC.Parser.Annotation | XConDeclField !(XXConDeclField pass) type instance XConDeclField (GhcPass _) = NoExtField diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index 0a6c2a66a619c4e512230e9a4fe2c05f9ee722a2..5daa380819bd9f95d0aa4c6d844f163ca57e8d40 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -9,7 +9,7 @@ which deal with the instantiated versions are located elsewhere: Parameterised by Module ---------------- ------------- - GhcPs/RdrName parser/RdrHsSyn + GhcPs/RdrName GHC.Parser.PostProcess GhcRn/Name GHC.Rename.* GhcTc/Id GHC.Tc.Utils.Zonk @@ -116,7 +116,7 @@ import GHC.Types.Var import GHC.Core.TyCo.Rep import GHC.Core.TyCon import GHC.Core.Type ( appTyArgFlags, splitAppTys, tyConArgFlags, tyConAppNeedsKindSig ) -import TysWiredIn ( unitTy ) +import GHC.Builtin.Types ( unitTy ) import GHC.Tc.Utils.TcType import GHC.Core.DataCon import GHC.Core.ConLike @@ -130,7 +130,7 @@ import FastString import Util import Bag import Outputable -import Constants +import GHC.Settings.Constants import Data.Either import Data.Function diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs index ea634615ed82662fd8a1b40b305f98a2cf4b5d24..ad445bf8bc5337aa52d7bb3d9d44da663671b1ce 100644 --- a/compiler/GHC/HsToCore.hs +++ b/compiler/GHC/HsToCore.hs @@ -43,10 +43,10 @@ import GHC.HsToCore.Monad import GHC.HsToCore.Expr import GHC.HsToCore.Binds import GHC.HsToCore.Foreign.Decl -import PrelNames -import TysPrim +import GHC.Builtin.Names +import GHC.Builtin.Types.Prim import GHC.Core.Coercion -import TysWiredIn +import GHC.Builtin.Types import GHC.Core.DataCon ( dataConWrapId ) import GHC.Core.Make import GHC.Types.Module @@ -558,7 +558,7 @@ subsequent transformations could fire. Note [Patching magic definitions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We sometimes need to have access to defined Ids in pure contexts. Usually, we -simply "wire in" these entities, as we do for types in TysWiredIn and for Ids +simply "wire in" these entities, as we do for types in GHC.Builtin.Types and for Ids in GHC.Types.Id.Make. See Note [Wired-in Ids] in GHC.Types.Id.Make. However, it is sometimes *much* easier to define entities in Haskell, diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs index 856d48d946ba40e1276a7268abe989138f9a1234..313961090277ebe8a7180dd705a5455d25ca90a5 100644 --- a/compiler/GHC/HsToCore/Arrows.hs +++ b/compiler/GHC/HsToCore/Arrows.hs @@ -47,9 +47,9 @@ import GHC.HsToCore.Binds (dsHsWrapper) import GHC.Types.Id import GHC.Core.ConLike -import TysWiredIn +import GHC.Builtin.Types import GHC.Types.Basic -import PrelNames +import GHC.Builtin.Names import Outputable import GHC.Types.Var.Set import GHC.Types.SrcLoc diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs index c2762d0255f5392e00883ac86a113628cae2ac66..cd2a786445e6d553d54539ae2b85d6b24f41f2e7 100644 --- a/compiler/GHC/HsToCore/Binds.hs +++ b/compiler/GHC/HsToCore/Binds.hs @@ -47,13 +47,13 @@ import GHC.Core.FVs import Digraph import GHC.Core.Predicate -import PrelNames +import GHC.Builtin.Names import GHC.Core.TyCon import GHC.Tc.Types.Evidence import GHC.Tc.Utils.TcType import GHC.Core.Type import GHC.Core.Coercion -import TysWiredIn ( typeNatKind, typeSymbolKind ) +import GHC.Builtin.Types ( typeNatKind, typeSymbolKind ) import GHC.Types.Id import GHC.Types.Id.Make(proxyHashId) import GHC.Types.Name diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs index 6dc59b978a8f29ebe6e7a06bdf9bc0fc98900721..24326809000e6324bb6c6a5419f47359e9979a65 100644 --- a/compiler/GHC/HsToCore/Expr.hs +++ b/compiler/GHC/HsToCore/Expr.hs @@ -57,8 +57,8 @@ import GHC.Types.Module import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.TyCo.Ppr( pprWithTYPE ) -import TysWiredIn -import PrelNames +import GHC.Builtin.Types +import GHC.Builtin.Names import GHC.Types.Basic import Maybes import GHC.Types.Var.Env diff --git a/compiler/GHC/HsToCore/Foreign/Call.hs b/compiler/GHC/HsToCore/Foreign/Call.hs index 1ae9f3de6552fb44809daa478359330e7f24b27b..b3ecd82cf8a2ad12fd59a7a93b031099c77add72 100644 --- a/compiler/GHC/HsToCore/Foreign/Call.hs +++ b/compiler/GHC/HsToCore/Foreign/Call.hs @@ -39,13 +39,13 @@ import GHC.Tc.Utils.TcType import GHC.Core.Type import GHC.Types.Id ( Id ) import GHC.Core.Coercion -import PrimOp -import TysPrim +import GHC.Builtin.PrimOps +import GHC.Builtin.Types.Prim import GHC.Core.TyCon -import TysWiredIn +import GHC.Builtin.Types import GHC.Types.Basic import GHC.Types.Literal -import PrelNames +import GHC.Builtin.Names import GHC.Driver.Session import Outputable import Util diff --git a/compiler/GHC/HsToCore/Foreign/Decl.hs b/compiler/GHC/HsToCore/Foreign/Decl.hs index f30e1bab1d4a1fd349695298ea062cd451ffbdd1..dadfc4000554951d5fd9368981ad1410a4e6858a 100644 --- a/compiler/GHC/HsToCore/Foreign/Decl.hs +++ b/compiler/GHC/HsToCore/Foreign/Decl.hs @@ -43,9 +43,9 @@ import GHC.Cmm.Expr import GHC.Cmm.Utils import GHC.Driver.Types import GHC.Types.ForeignCall -import TysWiredIn -import TysPrim -import PrelNames +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim +import GHC.Builtin.Names import GHC.Types.Basic import GHC.Types.SrcLoc import Outputable diff --git a/compiler/GHC/HsToCore/ListComp.hs b/compiler/GHC/HsToCore/ListComp.hs index 070b42a20fcd0c6a5bf3d1c6ad58639686de4648..368576cf30ae48d5a05a2044dc1d364e220397df 100644 --- a/compiler/GHC/HsToCore/ListComp.hs +++ b/compiler/GHC/HsToCore/ListComp.hs @@ -30,9 +30,9 @@ import GHC.Driver.Session import GHC.Core.Utils import GHC.Types.Id import GHC.Core.Type -import TysWiredIn +import GHC.Builtin.Types import GHC.HsToCore.Match -import PrelNames +import GHC.Builtin.Names import GHC.Types.SrcLoc import Outputable import GHC.Tc.Utils.TcType diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs index 02fb75359749ca8631b067e7ac5249ea35bfba47..c847bca068116771fb3499e380c80d585bf23f7e 100644 --- a/compiler/GHC/HsToCore/Match.hs +++ b/compiler/GHC/HsToCore/Match.hs @@ -52,7 +52,7 @@ import GHC.HsToCore.Match.Literal import GHC.Core.Type import GHC.Core.Coercion ( eqCoercion ) import GHC.Core.TyCon ( isNewTyCon ) -import TysWiredIn +import GHC.Builtin.Types import GHC.Types.SrcLoc import Maybes import Util diff --git a/compiler/GHC/HsToCore/Match/Literal.hs b/compiler/GHC/HsToCore/Match/Literal.hs index 882318b16300494fb582cab80a894b8d83221f90..d835e62e42b9c73a4a50d0eee36baefd02cbd732 100644 --- a/compiler/GHC/HsToCore/Match/Literal.hs +++ b/compiler/GHC/HsToCore/Match/Literal.hs @@ -43,9 +43,9 @@ import GHC.Tc.Utils.Zonk ( shortCutLit ) import GHC.Tc.Utils.TcType import GHC.Types.Name import GHC.Core.Type -import PrelNames -import TysWiredIn -import TysPrim +import GHC.Builtin.Names +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim import GHC.Types.Literal import GHC.Types.SrcLoc import Data.Ratio diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs index 78c643e478aa24aaa546980f7fc9e5ea888ed71b..d09473798a258bfab59d7d79d3196469f6ce4d6d 100644 --- a/compiler/GHC/HsToCore/Monad.hs +++ b/compiler/GHC/HsToCore/Monad.hs @@ -62,7 +62,7 @@ import GHC.Core.Utils ( exprType, isExprLevPoly ) import GHC.Hs import GHC.IfaceToCore import GHC.Tc.Utils.TcMType ( checkForLevPolyX, formatLevPolyErr ) -import PrelNames +import GHC.Builtin.Names import GHC.Types.Name.Reader import GHC.Driver.Types import Bag diff --git a/compiler/GHC/HsToCore/PmCheck.hs b/compiler/GHC/HsToCore/PmCheck.hs index 82dc98ee8b2284849217518929c2fe11d9f77578..7fd431c434783205643ed90c78f32d415bdd3604 100644 --- a/compiler/GHC/HsToCore/PmCheck.hs +++ b/compiler/GHC/HsToCore/PmCheck.hs @@ -37,7 +37,7 @@ import GHC.Types.Id import GHC.Core.ConLike import GHC.Types.Name import GHC.Tc.Instance.Family -import TysWiredIn +import GHC.Builtin.Types import GHC.Types.SrcLoc import Util import Outputable diff --git a/compiler/GHC/HsToCore/PmCheck/Oracle.hs b/compiler/GHC/HsToCore/PmCheck/Oracle.hs index e5c0e7ac924b4b969e9eb848a3ed6e74753d13c9..63cc4710ddda32453119391ea380fee58928fe9e 100644 --- a/compiler/GHC/HsToCore/PmCheck/Oracle.hs +++ b/compiler/GHC/HsToCore/PmCheck/Oracle.hs @@ -56,8 +56,8 @@ import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.PatSyn import GHC.Core.TyCon -import TysWiredIn -import TysPrim (tYPETyCon) +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim (tYPETyCon) import GHC.Core.TyCo.Rep import GHC.Core.Type import GHC.Tc.Solver (tcNormalise, tcCheckSatisfiability) diff --git a/compiler/GHC/HsToCore/PmCheck/Ppr.hs b/compiler/GHC/HsToCore/PmCheck/Ppr.hs index 2f62b5e9beae05f058e2e72b119f0a09517fd283..30a5a92f2b552c7137e51fb2cac106ff088e83af 100644 --- a/compiler/GHC/HsToCore/PmCheck/Ppr.hs +++ b/compiler/GHC/HsToCore/PmCheck/Ppr.hs @@ -18,7 +18,7 @@ import GHC.Types.Var.Env import GHC.Types.Unique.DFM import GHC.Core.ConLike import GHC.Core.DataCon -import TysWiredIn +import GHC.Builtin.Types import Outputable import Control.Monad.Trans.RWS.CPS import Util diff --git a/compiler/GHC/HsToCore/PmCheck/Types.hs b/compiler/GHC/HsToCore/PmCheck/Types.hs index 091e22f3ce9a7fe5290c9d7cbc16a26fbf7e0b8d..60ed0ce3567f980f71f88ab4cb25fdb3f49014ac 100644 --- a/compiler/GHC/HsToCore/PmCheck/Types.hs +++ b/compiler/GHC/HsToCore/PmCheck/Types.hs @@ -61,9 +61,9 @@ import GHC.Types.Literal import GHC.Core import GHC.Core.Map import GHC.Core.Utils (exprType) -import PrelNames -import TysWiredIn -import TysPrim +import GHC.Builtin.Names +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim import GHC.Tc.Utils.TcType (evVarPred) import Numeric (fromRat) diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs index 40df5ec734e72f73fe97b1bd2ca577fea1a4fd15..c96eaf4e1098e21d0caa99c8ee5cd9f13234eaae 100644 --- a/compiler/GHC/HsToCore/Quote.hs +++ b/compiler/GHC/HsToCore/Quote.hs @@ -17,8 +17,8 @@ -- CoreExpr's of the "smart constructors" of the Meta.Exp datatype. -- -- It also defines a bunch of knownKeyNames, in the same way as is done --- in prelude/PrelNames. It's much more convenient to do it here, because --- otherwise we have to recompile PrelNames whenever we add a Name, which is +-- in prelude/GHC.Builtin.Names. It's much more convenient to do it here, because +-- otherwise we have to recompile GHC.Builtin.Names whenever we add a Name, which is -- a Royal Pain (triggers other recompilation). ----------------------------------------------------------------------------- @@ -37,16 +37,16 @@ import GHC.HsToCore.Monad import qualified Language.Haskell.TH as TH import GHC.Hs -import PrelNames +import GHC.Builtin.Names import GHC.Types.Module import GHC.Types.Id import GHC.Types.Name hiding( varName, tcName ) -import THNames +import GHC.Builtin.Names.TH import GHC.Types.Name.Env import GHC.Tc.Utils.TcType import GHC.Core.TyCon -import TysWiredIn +import GHC.Builtin.Types import GHC.Core import GHC.Core.Make import GHC.Core.Utils diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs index 2e9c5987f8cbaa354251a708097b6cf3ad668f87..3f0637f3501e483eacb013d1875a5b5ead23bc13 100644 --- a/compiler/GHC/HsToCore/Utils.hs +++ b/compiler/GHC/HsToCore/Utils.hs @@ -65,14 +65,14 @@ import GHC.Core.DataCon import GHC.Core.PatSyn import GHC.Core.Type import GHC.Core.Coercion -import TysPrim -import TysWiredIn +import GHC.Builtin.Types.Prim +import GHC.Builtin.Types import GHC.Types.Basic import GHC.Core.ConLike import GHC.Types.Unique.Set import GHC.Types.Unique.Supply import GHC.Types.Module -import PrelNames +import GHC.Builtin.Names import GHC.Types.Name( isInternalName ) import Outputable import GHC.Types.SrcLoc @@ -578,7 +578,7 @@ There are two cases. let { t = case e of Just (Just v) -> Unit v ; v = case t of Unit v -> v } in t `seq` body - The 'Unit' is a one-tuple; see Note [One-tuples] in TysWiredIn + The 'Unit' is a one-tuple; see Note [One-tuples] in GHC.Builtin.Types Note that forcing 't' makes the pattern match happen, but does not force 'v'. @@ -599,7 +599,7 @@ There are two cases. - Forcing 't' will force the pattern to match fully; e.g. will diverge if (snd e) is bottom - But 'a' itself is not forced; it is wrapped in a one-tuple - (see Note [One-tuples] in TysWiredIn) + (see Note [One-tuples] in GHC.Builtin.Types) * !(Just x) = e ==> diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs index 07a9da4c96bd95ed0c2c8d0cd2f299b611f8a633..2e1953ade7c073fc7d2805fefaace74142ec6156 100644 --- a/compiler/GHC/Iface/Binary.hs +++ b/compiler/GHC/Iface/Binary.hs @@ -36,7 +36,7 @@ module GHC.Iface.Binary ( import GhcPrelude import GHC.Tc.Utils.Monad -import PrelInfo ( isKnownKeyName, lookupKnownKeyName ) +import GHC.Builtin.Utils ( isKnownKeyName, lookupKnownKeyName ) import GHC.Iface.Env import GHC.Driver.Types import GHC.Types.Module @@ -54,7 +54,7 @@ import Outputable import GHC.Types.Name.Cache import GHC.Platform import FastString -import Constants +import GHC.Settings.Constants import Util import Data.Array @@ -355,7 +355,7 @@ serialiseName bh name _ = do -- 10xxxxxx xxyyyyyy yyyyyyyy yyyyyyyy -- A known-key name. x is the Unique's Char, y is the int part. We assume that -- all known-key uniques fit in this space. This is asserted by --- PrelInfo.knownKeyNamesOkay. +-- GHC.Builtin.Utils.knownKeyNamesOkay. -- -- During serialization we check for known-key things using isKnownKeyName. -- During deserialization we use lookupKnownKeyName to get from the unique back diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs index 41610d162538f86c3c88762957d7c56162fb7993..c3b144dbfa86702dad97d9d61df5d9ffb998e554 100644 --- a/compiler/GHC/Iface/Ext/Ast.hs +++ b/compiler/GHC/Iface/Ext/Ast.hs @@ -37,7 +37,7 @@ import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnv, lookup import GHC.Types.SrcLoc import GHC.Tc.Utils.Zonk ( hsLitType, hsPatType ) import GHC.Core.Type ( mkVisFunTys, Type ) -import TysWiredIn ( mkListTy, mkSumTy ) +import GHC.Builtin.Types ( mkListTy, mkSumTy ) import GHC.Types.Var ( Id, Var, setVarName, varName, varType ) import GHC.Tc.Types import GHC.Iface.Make ( mkIfaceExports ) diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs index 1a231b95f7d8e073b722c953f946acd377d5a601..a90234c60fee1e21a0263ee79ad345e9cc695240 100644 --- a/compiler/GHC/Iface/Ext/Binary.hs +++ b/compiler/GHC/Iface/Ext/Binary.hs @@ -15,7 +15,7 @@ module GHC.Iface.Ext.Binary ) where -import GHC.Settings ( maybeRead ) +import GHC.Settings.Utils ( maybeRead ) import Config ( cProjectVersion ) import GhcPrelude @@ -27,7 +27,7 @@ import GHC.Types.Module ( Module ) import GHC.Types.Name import GHC.Types.Name.Cache import Outputable -import PrelInfo +import GHC.Builtin.Utils import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Unique.Supply ( takeUniqFromSupply ) import GHC.Types.Unique diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs index 2108e840798b8bf884a7f7792b9025e2749261f3..8fc46734c2caeaeaadab6da74b773dfda4dca9be 100644 --- a/compiler/GHC/Iface/Load.hs +++ b/compiler/GHC/Iface/Load.hs @@ -49,12 +49,12 @@ import GHC.Types.Basic hiding (SuccessFlag(..)) import GHC.Tc.Utils.Monad import Binary ( BinData(..) ) -import Constants -import PrelNames -import PrelInfo -import PrimOp ( allThePrimOps, primOpFixity, primOpOcc ) -import GHC.Types.Id.Make ( seqId ) -import TysPrim ( funTyConName ) +import GHC.Settings.Constants +import GHC.Builtin.Names +import GHC.Builtin.Utils +import GHC.Builtin.PrimOps ( allThePrimOps, primOpFixity, primOpOcc ) +import GHC.Types.Id.Make ( seqId ) +import GHC.Builtin.Types.Prim ( funTyConName ) import GHC.Core.Rules import GHC.Core.TyCon import GHC.Types.Annotations diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs index 4ecf9666eed28ea51d51f05c6e0621636d551f08..57809a6d5931c03410e68a1583634668b9f7b73b 100644 --- a/compiler/GHC/Iface/Recomp.hs +++ b/compiler/GHC/Iface/Recomp.hs @@ -15,9 +15,9 @@ where import GhcPrelude import GHC.Iface.Syntax -import BinFingerprint +import GHC.Iface.Recomp.Binary import GHC.Iface.Load -import FlagChecker +import GHC.Iface.Recomp.Flags import GHC.Types.Annotations import GHC.Core diff --git a/compiler/iface/BinFingerprint.hs b/compiler/GHC/Iface/Recomp/Binary.hs similarity index 97% rename from compiler/iface/BinFingerprint.hs rename to compiler/GHC/Iface/Recomp/Binary.hs index 51977968dbee847a16d80627192c26d53d8d0a85..55742b55eba79363758564f7c82f6a8ebe584db2 100644 --- a/compiler/iface/BinFingerprint.hs +++ b/compiler/GHC/Iface/Recomp/Binary.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} -- | Computing fingerprints of values serializeable with GHC's "Binary" module. -module BinFingerprint +module GHC.Iface.Recomp.Binary ( -- * Computing fingerprints fingerprintBinMem , computeFingerprint diff --git a/compiler/iface/FlagChecker.hs b/compiler/GHC/Iface/Recomp/Flags.hs similarity index 99% rename from compiler/iface/FlagChecker.hs rename to compiler/GHC/Iface/Recomp/Flags.hs index cab88ee5ccceb1cf02e5f42c2e76b5d53c74e960..ff5b23b709d2eb4d8ae29063d824c5eb51c4a302 100644 --- a/compiler/iface/FlagChecker.hs +++ b/compiler/GHC/Iface/Recomp/Flags.hs @@ -2,7 +2,7 @@ -- | This module manages storing the various GHC option flags in a modules -- interface file as part of the recompilation checking infrastructure. -module FlagChecker ( +module GHC.Iface.Recomp.Flags ( fingerprintDynFlags , fingerprintOptFlags , fingerprintHpcFlags @@ -16,7 +16,7 @@ import GHC.Driver.Types import GHC.Types.Module import GHC.Types.Name import Fingerprint -import BinFingerprint +import GHC.Iface.Recomp.Binary -- import Outputable import qualified EnumSet diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs index 131db67141c5f12811ae99da9fa45947afe3bfe5..3c707bc34818a9cf9f283f947edcbb146f0c5c1f 100644 --- a/compiler/GHC/Iface/Syntax.hs +++ b/compiler/GHC/Iface/Syntax.hs @@ -45,7 +45,7 @@ module GHC.Iface.Syntax ( import GhcPrelude import GHC.Iface.Type -import BinFingerprint +import GHC.Iface.Recomp.Binary import GHC.Core( IsOrphan, isOrphan ) import GHC.Types.Demand import GHC.Types.Cpr @@ -70,7 +70,7 @@ import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisArgFlag ) import Util( dropList, filterByList, notNull, unzipWith, debugIsOn ) import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import GHC.Utils.Lexeme (isLexSym) -import TysWiredIn ( constraintKindTyConName ) +import GHC.Builtin.Types ( constraintKindTyConName ) import Util (seqList) import Control.Monad diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs index 85b1a19f405341c742947ac66d208b0475f1eb9d..6aedf0fd4cfe07563e6284b964296bace218fa38 100644 --- a/compiler/GHC/Iface/Type.hs +++ b/compiler/GHC/Iface/Type.hs @@ -62,14 +62,15 @@ module GHC.Iface.Type ( import GhcPrelude -import {-# SOURCE #-} TysWiredIn ( coercibleTyCon, heqTyCon +import {-# SOURCE #-} GHC.Builtin.Types + ( coercibleTyCon, heqTyCon , liftedRepDataConTyCon, tupleTyConName ) import {-# SOURCE #-} GHC.Core.Type ( isRuntimeRepTy ) import GHC.Core.TyCon hiding ( pprPromotionQuote ) import GHC.Core.Coercion.Axiom import GHC.Types.Var -import PrelNames +import GHC.Builtin.Names import GHC.Types.Name import GHC.Types.Basic import Binary @@ -267,7 +268,7 @@ We do the same for covars, naturally. Note [Equality predicates in IfaceType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHC has several varieties of type equality (see Note [The equality types story] -in TysPrim for details). In an effort to avoid confusing users, we suppress +in GHC.Builtin.Types.Prim for details). In an effort to avoid confusing users, we suppress the differences during pretty printing unless certain flags are enabled. Here is how each equality predicate* is printed in homogeneous and heterogeneous contexts, depending on which combination of the @@ -318,7 +319,7 @@ possible since we can't see through type synonyms. Consequently, we need to record whether this particular application is homogeneous in IfaceTyConSort for the purposes of pretty-printing. -See Note [The equality types story] in TysPrim. +See Note [The equality types story] in GHC.Builtin.Types.Prim. -} data IfaceTyConInfo -- Used to guide pretty-printing @@ -343,7 +344,7 @@ data IfaceCoercion | IfaceAxiomRuleCo IfLclName [IfaceCoercion] -- There are only a fixed number of CoAxiomRules, so it suffices -- to use an IfaceLclName to distinguish them. - -- See Note [Adding built-in type families] in TcTypeNats + -- See Note [Adding built-in type families] in GHC.Builtin.Types.Literals | IfaceUnivCo IfaceUnivCoProv Role IfaceType IfaceType | IfaceSymCo IfaceCoercion | IfaceTransCo IfaceCoercion IfaceCoercion @@ -1345,7 +1346,7 @@ ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case -- heqTyCon (~~) -- -- See Note [Equality predicates in IfaceType] --- and Note [The equality types story] in TysPrim +-- and Note [The equality types story] in GHC.Builtin.Types.Prim ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc ppr_equality ctxt_prec tc args | hetero_eq_tc diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs index 0ea420840d2bc8402b779c262a5b17771aecda4a..5f3cd10cfb52f2e43bace4eff570c018b10bfdeb 100644 --- a/compiler/GHC/IfaceToCore.hs +++ b/compiler/GHC/IfaceToCore.hs @@ -26,7 +26,7 @@ module GHC.IfaceToCore ( import GhcPrelude -import TcTypeNats(typeNatCoAxiomRules) +import GHC.Builtin.Types.Literals(typeNatCoAxiomRules) import GHC.Iface.Syntax import GHC.Iface.Load import GHC.Iface.Env @@ -54,8 +54,8 @@ import GHC.Core.Class import GHC.Core.TyCon import GHC.Core.ConLike import GHC.Core.DataCon -import PrelNames -import TysWiredIn +import GHC.Builtin.Names +import GHC.Builtin.Types import GHC.Types.Literal import GHC.Types.Var as Var import GHC.Types.Var.Set diff --git a/compiler/parser/Parser.y b/compiler/GHC/Parser.y similarity index 99% rename from compiler/parser/Parser.y rename to compiler/GHC/Parser.y index 9333a22bd133982b8d682f68010108ba465e3718..90b23f7ca653a758ce2475ed35ac4e19317f16d4 100644 --- a/compiler/parser/Parser.y +++ b/compiler/GHC/Parser.y @@ -29,11 +29,14 @@ -- buffer = stringToStringBuffer str -- parseState = mkPState flags buffer location -- @ -module Parser (parseModule, parseSignature, parseImport, parseStatement, parseBackpack, - parseDeclaration, parseExpression, parsePattern, - parseTypeSignature, - parseStmt, parseIdentifier, - parseType, parseHeader) where +module GHC.Parser + ( parseModule, parseSignature, parseImport, parseStatement, parseBackpack + , parseDeclaration, parseExpression, parsePattern + , parseTypeSignature + , parseStmt, parseIdentifier + , parseType, parseHeader + ) +where -- base import Control.Monad ( unless, liftM, when, (<=<) ) @@ -75,18 +78,18 @@ import GHC.Core.Type ( funTyCon ) import GHC.Core.Class ( FunDep ) -- compiler/parser -import RdrHsSyn -import Lexer -import HaddockUtils -import ApiAnnotation +import GHC.Parser.PostProcess +import GHC.Parser.PostProcess.Haddock +import GHC.Parser.Lexer +import GHC.Parser.Annotation import GHC.Tc.Types.Evidence ( emptyTcEvBinds ) -- compiler/prelude -import TysPrim ( eqPrimTyCon ) -import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon, - unboxedUnitTyCon, unboxedUnitDataCon, - listTyCon_RDR, consDataCon_RDR, eqTyCon_RDR ) +import GHC.Builtin.Types.Prim ( eqPrimTyCon ) +import GHC.Builtin.Types ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon, + unboxedUnitTyCon, unboxedUnitDataCon, + listTyCon_RDR, consDataCon_RDR, eqTyCon_RDR ) } %expect 232 -- shift/reduce conflicts @@ -96,7 +99,7 @@ import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilD If you modify this parser and add a conflict, please update this comment. You can learn more about the conflicts by passing 'happy' the -i flag: - happy -agc --strict compiler/parser/Parser.y -idetailed-info + happy -agc --strict compiler/GHC/Parser.y -idetailed-info How is this section formatted? Look up the state the conflict is reported at, and copy the list of applicable rules (at the top, without the @@ -1680,7 +1683,7 @@ rule_activation :: { ([AddAnn],Maybe Activation) } -- Note that it can be written either -- without a space [~1] (the PREFIX_TILDE case), or -- with a space [~ 1] (the VARSYM case). --- See Note [Whitespace-sensitive operator parsing] in Lexer.x +-- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer rule_activation_marker :: { [AddAnn] } : PREFIX_TILDE { [mj AnnTilde $1] } | VARSYM {% if (getVARSYM $1 == fsLit "~") @@ -1736,7 +1739,8 @@ first or second case of the above. This is resolved by using rule_vars (which is more general) for both, and ensuring that type-level quantified variables do not have the names "forall", -"family", or "role" in the function 'checkRuleTyVarBndrNames' in RdrHsSyn.hs +"family", or "role" in the function 'checkRuleTyVarBndrNames' in +GHC.Parser.PostProcess. Thus, whenever the definition of tyvarid (used for tv_bndrs) is changed relative to varid (used for rule_vars), 'checkRuleTyVarBndrNames' must be updated. -} @@ -2036,7 +2040,7 @@ tyapps :: { [Located TyEl] } -- NB: This list is reversed tyapp :: { Located TyEl } : atype { sL1 $1 $ TyElOpd (unLoc $1) } - -- See Note [Whitespace-sensitive operator parsing] in Lexer.x + -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | PREFIX_AT atype { sLL $1 $> $ (TyElKindApp (comb2 $1 $2) $2) } | qtyconop { sL1 $1 $ TyElOpr (unLoc $1) } @@ -2053,7 +2057,7 @@ atype :: { LHsType GhcPs } | '*' {% do { warnStarIsType (getLoc $1) ; return $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } } - -- See Note [Whitespace-sensitive operator parsing] in Lexer.x + -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | PREFIX_TILDE atype {% ams (sLL $1 $> (mkBangTy SrcLazy $2)) [mj AnnTilde $1] } | PREFIX_BANG atype {% ams (sLL $1 $> (mkBangTy SrcStrict $2)) [mj AnnBang $1] } @@ -2718,7 +2722,7 @@ fexp :: { ECP } runECP_PV $2 >>= \ $2 -> mkHsAppPV (comb2 $1 $>) $1 $2 } - -- See Note [Whitespace-sensitive operator parsing] in Lexer.x + -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | fexp PREFIX_AT atype {% runECP_P $1 >>= \ $1 -> runPV (checkExpBlockArguments $1) >>= \_ -> fmap ecpFromExp $ @@ -2732,13 +2736,13 @@ fexp :: { ECP } | aexp { $1 } aexp :: { ECP } - -- See Note [Whitespace-sensitive operator parsing] in Lexer.x + -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer : qvar TIGHT_INFIX_AT aexp { ECP $ runECP_PV $3 >>= \ $3 -> amms (mkHsAsPatPV (comb2 $1 $>) $1 $3) [mj AnnAt $2] } - -- See Note [Whitespace-sensitive operator parsing] in Lexer.x + -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | PREFIX_TILDE aexp { ECP $ runECP_PV $2 >>= \ $2 -> amms (mkHsLazyPatPV (comb2 $1 $>) $2) [mj AnnTilde $1] } @@ -2893,13 +2897,13 @@ splice_exp :: { LHsExpr GhcPs } | splice_typed { mapLoc (HsSpliceE noExtField) $1 } splice_untyped :: { Located (HsSplice GhcPs) } - -- See Note [Whitespace-sensitive operator parsing] in Lexer.x + -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer : PREFIX_DOLLAR aexp2 {% runECP_P $2 >>= \ $2 -> ams (sLL $1 $> $ mkUntypedSplice DollarSplice $2) [mj AnnDollar $1] } splice_typed :: { Located (HsSplice GhcPs) } - -- See Note [Whitespace-sensitive operator parsing] in Lexer.x + -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer : PREFIX_DOLLAR_DOLLAR aexp2 {% runECP_P $2 >>= \ $2 -> ams (sLL $1 $> $ mkTypedSplice DollarSplice $2) @@ -3223,7 +3227,7 @@ pat :: { LPat GhcPs } pat : exp {% (checkPattern <=< runECP_P) $1 } bindpat :: { LPat GhcPs } -bindpat : exp {% -- See Note [Parser-Validator ReaderT SDoc] in RdrHsSyn +bindpat : exp {% -- See Note [Parser-Validator ReaderT SDoc] in GHC.Parser.PostProcess checkPattern_msg (text "Possibly caused by a missing 'do'?") (runECP_PV $1) } @@ -3536,7 +3540,7 @@ qtyconsym :: { Located RdrName } tyconsym :: { Located RdrName } : CONSYM { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) } | VARSYM { sL1 $1 $! - -- See Note [eqTyCon (~) is built-in syntax] in TysWiredIn + -- See Note [eqTyCon (~) is built-in syntax] in GHC.Builtin.Types if getVARSYM $1 == fsLit "~" then eqTyCon_RDR else mkUnqual tcClsName (getVARSYM $1) } @@ -3603,7 +3607,8 @@ tyvarid :: { Located RdrName } | 'unsafe' { sL1 $1 $! mkUnqual tvName (fsLit "unsafe") } | 'safe' { sL1 $1 $! mkUnqual tvName (fsLit "safe") } | 'interruptible' { sL1 $1 $! mkUnqual tvName (fsLit "interruptible") } - -- If this changes relative to varid, update 'checkRuleTyVarBndrNames' in RdrHsSyn.hs + -- If this changes relative to varid, update 'checkRuleTyVarBndrNames' + -- in GHC.Parser.PostProcess -- See Note [Parsing explicit foralls in Rules] ----------------------------------------------------------------------------- @@ -3631,7 +3636,7 @@ qvarid :: { Located RdrName } -- Note that 'role' and 'family' get lexed separately regardless of -- the use of extensions. However, because they are listed here, -- this is OK and they can be used as normal varids. --- See Note [Lexing type pseudo-keywords] in Lexer.x +-- See Note [Lexing type pseudo-keywords] in GHC.Parser.Lexer varid :: { Located RdrName } : VARID { sL1 $1 $! mkUnqual varName (getVARID $1) } | special_id { sL1 $1 $! mkUnqual varName (unLoc $1) } @@ -3641,7 +3646,8 @@ varid :: { Located RdrName } | 'forall' { sL1 $1 $! mkUnqual varName (fsLit "forall") } | 'family' { sL1 $1 $! mkUnqual varName (fsLit "family") } | 'role' { sL1 $1 $! mkUnqual varName (fsLit "role") } - -- If this changes relative to tyvarid, update 'checkRuleTyVarBndrNames' in RdrHsSyn.hs + -- If this changes relative to tyvarid, update 'checkRuleTyVarBndrNames' + -- in GHC.Parser.PostProcess -- See Note [Parsing explicit foralls in Rules] qvarsym :: { Located RdrName } @@ -4013,7 +4019,7 @@ reportEmptyDoubleQuotes span = do %************************************************************************ For the general principles of the following routines, see Note [Api annotations] -in ApiAnnotation.hs +in GHC.Parser.Annotation -} diff --git a/compiler/parser/ApiAnnotation.hs b/compiler/GHC/Parser/Annotation.hs similarity index 98% rename from compiler/parser/ApiAnnotation.hs rename to compiler/GHC/Parser/Annotation.hs index 5ad598da94ef62b9bf842e53b800e9b825ac27d1..dbd1f79e23c84b3950b7f88317d0349cd73c2521 100644 --- a/compiler/parser/ApiAnnotation.hs +++ b/compiler/GHC/Parser/Annotation.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} -module ApiAnnotation ( +module GHC.Parser.Annotation ( getAnnotation, getAndRemoveAnnotation, getAnnotationComments,getAndRemoveAnnotationComments, ApiAnns(..), @@ -83,8 +83,8 @@ For any given element in the AST, there is only a set number of keywords that are applicable for it (e.g., you'll never see an 'import' keyword associated with a let-binding.) The set of allowed keywords is documented in a comment associated with the constructor -of a given AST element, although the ground truth is in Parser -and RdrHsSyn (which actually add the annotations; see #13012). +of a given AST element, although the ground truth is in GHC.Parser +and GHC.Parser.PostProcess (which actually add the annotations; see #13012). COMMENT ELEMENTS @@ -329,7 +329,7 @@ data AnnotationComment = | AnnBlockComment String -- ^ comment in {- -} deriving (Eq, Ord, Data, Show) -- Note: these are based on the Token versions, but the Token type is --- defined in Lexer.x and bringing it in here would create a loop +-- defined in GHC.Parser.Lexer and bringing it in here would create a loop instance Outputable AnnotationComment where ppr x = text (show x) diff --git a/compiler/parser/Ctype.hs b/compiler/GHC/Parser/CharClass.hs similarity index 99% rename from compiler/parser/Ctype.hs rename to compiler/GHC/Parser/CharClass.hs index 57721da94d6343b8693ca409b5a9f5146362968a..dc98d48f944ee8c6a9699db22f7d07d43f220a01 100644 --- a/compiler/parser/Ctype.hs +++ b/compiler/GHC/Parser/CharClass.hs @@ -1,6 +1,6 @@ -- Character classification {-# LANGUAGE CPP #-} -module Ctype +module GHC.Parser.CharClass ( is_ident -- Char# -> Bool , is_symbol -- Char# -> Bool , is_any -- Char# -> Bool diff --git a/compiler/main/HeaderInfo.hs b/compiler/GHC/Parser/Header.hs similarity index 98% rename from compiler/main/HeaderInfo.hs rename to compiler/GHC/Parser/Header.hs index cb1b1e3c2b48d8bb18be007b0c633ffd7384a3e1..e2373827f4c97193e9c39478169c1bf4e562460d 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/GHC/Parser/Header.hs @@ -12,11 +12,15 @@ -- ----------------------------------------------------------------------------- -module HeaderInfo ( getImports - , mkPrelImports -- used by the renamer too - , getOptionsFromFile, getOptions - , optionsErrorMsgs, - checkProcessArgsResult ) where +module GHC.Parser.Header + ( getImports + , mkPrelImports -- used by the renamer too + , getOptionsFromFile + , getOptions + , optionsErrorMsgs + , checkProcessArgsResult + ) +where #include "HsVersions.h" @@ -24,12 +28,12 @@ import GhcPrelude import GHC.Platform import GHC.Driver.Types -import Parser ( parseHeader ) -import Lexer +import GHC.Parser ( parseHeader ) +import GHC.Parser.Lexer import FastString import GHC.Hs import GHC.Types.Module -import PrelNames +import GHC.Builtin.Names import StringBuffer import GHC.Types.SrcLoc import GHC.Driver.Session diff --git a/compiler/parser/Lexer.x b/compiler/GHC/Parser/Lexer.x similarity index 99% rename from compiler/parser/Lexer.x rename to compiler/GHC/Parser/Lexer.x index 1536b85bcae5f00d8d3d64ee2f71bda883279c43..17b6674c950641c56b333bbade81507bc105a37e 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/GHC/Parser/Lexer.x @@ -48,7 +48,7 @@ {-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module Lexer ( +module GHC.Parser.Lexer ( Token(..), lexer, lexerDbg, pragState, mkPState, mkPStatePure, PState(..), P(..), ParseResult(..), mkParserFlags, mkParserFlags', ParserFlags(..), appendWarning, @@ -112,9 +112,9 @@ import GHC.Types.Basic ( InlineSpec(..), RuleMatchInfo(..), SourceText(..) ) -- compiler/parser -import Ctype +import GHC.Parser.CharClass -import ApiAnnotation +import GHC.Parser.Annotation } -- ----------------------------------------------------------------------------- @@ -2121,7 +2121,7 @@ data PState = PState { -- The next three are used to implement Annotations giving the -- locations of 'noise' tokens in the source, so that users of -- the GHC API can do source to source conversions. - -- See note [Api annotations] in ApiAnnotation.hs + -- See note [Api annotations] in GHC.Parser.Annotation annotations :: [(ApiAnnKey,[RealSrcSpan])], eof_pos :: Maybe RealSrcSpan, comment_q :: [RealLocated AnnotationComment], @@ -2834,7 +2834,7 @@ lexer queueComments cont = do then queueComment (L (psRealSpan span) tok) >> lexer queueComments cont else cont (L (mkSrcSpanPs span) tok) --- Use this instead of 'lexer' in Parser.y to dump the tokens for debugging. +-- Use this instead of 'lexer' in GHC.Parser to dump the tokens for debugging. lexerDbg queueComments cont = lexer queueComments contDbg where contDbg tok = trace ("token: " ++ show (unLoc tok)) (cont tok) diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/GHC/Parser/PostProcess.hs similarity index 99% rename from compiler/parser/RdrHsSyn.hs rename to compiler/GHC/Parser/PostProcess.hs index 5efe975f111340f8faf92c5b55e9bb049fc42415..7ce2f4fb9ac2d5c26edef9997ee610a667c295c7 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -16,7 +16,9 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -module RdrHsSyn ( +{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} + +module GHC.Parser.PostProcess ( mkHsOpApp, mkHsIntegral, mkHsFractional, mkHsIsString, mkHsDo, mkSpliceDecl, @@ -98,8 +100,7 @@ module RdrHsSyn ( DisambECP(..), ecpFromExp, ecpFromCmd, - PatBuilder, - + PatBuilder ) where import GhcPrelude @@ -111,15 +112,15 @@ import GHC.Core.Coercion.Axiom ( Role, fsFromRole ) import GHC.Types.Name.Reader import GHC.Types.Name import GHC.Types.Basic -import Lexer +import GHC.Parser.Lexer import GHC.Utils.Lexeme ( isLexCon ) import GHC.Core.Type ( TyThing(..), funTyCon ) -import TysWiredIn ( cTupleTyConName, tupleTyCon, tupleDataCon, +import GHC.Builtin.Types( cTupleTyConName, tupleTyCon, tupleDataCon, nilDataConName, nilDataConKey, listTyConName, listTyConKey, eqTyCon_RDR, tupleTyConName, cTupleTyConNameArity_maybe ) import GHC.Types.ForeignCall -import PrelNames ( allNameStrings ) +import GHC.Builtin.Names ( allNameStrings ) import GHC.Types.SrcLoc import GHC.Types.Unique ( hasKey ) import OrdList ( OrdList, fromOL ) @@ -128,7 +129,7 @@ import Outputable import FastString import Maybes import Util -import ApiAnnotation +import GHC.Parser.Annotation import Data.List import GHC.Driver.Session ( WarningFlag(..), DynFlags ) import ErrUtils ( Messages ) @@ -489,7 +490,7 @@ getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1) getMonoBind bind binds = (bind, binds) has_args :: [LMatch GhcPs (LHsExpr GhcPs)] -> Bool -has_args [] = panic "RdrHsSyn:has_args" +has_args [] = panic "GHC.Parser.PostProcess.has_args" has_args (L _ (Match { m_pats = args }) : _) = not (null args) -- Don't group together FunBinds if they have -- no arguments. This is necessary now that variable bindings @@ -885,7 +886,7 @@ mkRuleTyVarBndrs = fmap (fmap cvt_one) tm_to_ty (Unqual occ) = Unqual (setOccNameSpace tvName occ) tm_to_ty _ = panic "mkRuleTyVarBndrs" --- See note [Parsing explicit foralls in Rules] in Parser.y +-- See note [Parsing explicit foralls in Rules] in GHC.Parser checkRuleTyVarBndrNames :: [LHsTyVarBndr GhcPs] -> P () checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName) where check (L loc (Unqual occ)) = do diff --git a/compiler/parser/HaddockUtils.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs similarity index 96% rename from compiler/parser/HaddockUtils.hs rename to compiler/GHC/Parser/PostProcess/Haddock.hs index 73429ec14aafd8032ffbfe317204d9683ba1802f..a3d5e101d7d34dd58792c36445da6dbc5f920fb5 100644 --- a/compiler/parser/HaddockUtils.hs +++ b/compiler/GHC/Parser/PostProcess/Haddock.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} -module HaddockUtils where +module GHC.Parser.PostProcess.Haddock where import GhcPrelude diff --git a/compiler/GHC/Plugins.hs b/compiler/GHC/Plugins.hs index ce9d019a70fe3587ae46a4e18e06de7ad90166f9..8ba1c5fb2d899cee8c0cec9d399253c2e8eeba12 100644 --- a/compiler/GHC/Plugins.hs +++ b/compiler/GHC/Plugins.hs @@ -31,7 +31,7 @@ module GHC.Plugins , module GHC.Core.Type , module GHC.Core.TyCon , module GHC.Core.Coercion - , module TysWiredIn + , module GHC.Builtin.Types , module GHC.Driver.Types , module GHC.Types.Basic , module GHC.Types.Var.Set @@ -90,7 +90,7 @@ import GHC.Core.Type hiding {- conflict with GHC.Core.Subst -} import GHC.Core.Coercion hiding {- conflict with GHC.Core.Subst -} ( substCo ) import GHC.Core.TyCon -import TysWiredIn +import GHC.Builtin.Types import GHC.Driver.Types import GHC.Types.Basic hiding ( Version {- conflicts with Packages.Version -} ) diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs index 1bd37047be0d86b361bd923a27a0ad69803efcc6..18d922d636b6f874e18b7621970b1080a802dfa2 100644 --- a/compiler/GHC/Rename/Env.hs +++ b/compiler/GHC/Rename/Env.hs @@ -53,8 +53,8 @@ import GHC.Types.Name.Reader import GHC.Driver.Types import GHC.Tc.Utils.Env import GHC.Tc.Utils.Monad -import RdrHsSyn ( filterCTuple, setRdrNameSpace ) -import TysWiredIn +import GHC.Parser.PostProcess ( filterCTuple, setRdrNameSpace ) +import GHC.Builtin.Types import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Env @@ -64,7 +64,7 @@ import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.TyCon import ErrUtils ( MsgDoc ) -import PrelNames ( rOOT_MAIN ) +import GHC.Builtin.Names( rOOT_MAIN ) import GHC.Types.Basic ( pprWarningTxtForMsg, TopLevelFlag(..), TupleSort(..) ) import GHC.Types.SrcLoc as SrcLoc import Outputable @@ -180,7 +180,7 @@ newTopSrcBinder (L loc rdr_name) -- -- We can get built-in syntax showing up here too, sadly. If you type -- data T = (,,,) - -- the constructor is parsed as a type, and then RdrHsSyn.tyConToDataCon + -- the constructor is parsed as a type, and then GHC.Parser.PostProcess.tyConToDataCon -- uses setRdrNameSpace to make it into a data constructors. At that point -- the nice Exact name for the TyCon gets swizzled to an Orig name. -- Hence the badOrigBinding error message. @@ -1633,7 +1633,7 @@ We store the relevant Name in the HsSyn tree, in * NegApp * NPlusKPat * HsDo -respectively. Initially, we just store the "standard" name (PrelNames.fromIntegralName, +respectively. Initially, we just store the "standard" name (GHC.Builtin.Names.fromIntegralName, fromRationalName etc), but the renamer changes this to the appropriate user name if Opt_NoImplicitPrelude is on. That is what lookupSyntax does. diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs index acb589d35e91bffd22e321a03621b4ab98b38705..6142718cebb6a6bd2b852d711c091e6626f0ff5e 100644 --- a/compiler/GHC/Rename/Expr.hs +++ b/compiler/GHC/Rename/Expr.hs @@ -45,7 +45,7 @@ import GHC.Rename.Splice ( rnBracket, rnSpliceExpr, checkThLocalName ) import GHC.Rename.HsType import GHC.Rename.Pat import GHC.Driver.Session -import PrelNames +import GHC.Builtin.Names import GHC.Types.Basic import GHC.Types.Name @@ -60,7 +60,7 @@ import Outputable import GHC.Types.SrcLoc import FastString import Control.Monad -import TysWiredIn ( nilDataConName ) +import GHC.Builtin.Types ( nilDataConName ) import qualified GHC.LanguageExtensions as LangExt import Data.Ord @@ -214,7 +214,7 @@ rnExpr (HsSpliceE _ splice) = rnSpliceExpr splice --------------------------------------------- -- Sections --- See Note [Parsing sections] in Parser.y +-- See Note [Parsing sections] in GHC.Parser rnExpr (HsPar x (L loc (section@(SectionL {})))) = do { (section', fvs) <- rnSection section ; return (HsPar x (L loc section'), fvs) } @@ -396,7 +396,7 @@ rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other) -- HsWrap ---------------------- --- See Note [Parsing sections] in Parser.y +-- See Note [Parsing sections] in GHC.Parser rnSection :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars) rnSection section@(SectionR x op expr) = do { (op', fvs_op) <- rnLExpr op diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs index 9def0b83e33cf7a82956c4b70455afb488a17e5b..a91a672dfbe6d6e3291990d2bf5204bd6111b131 100644 --- a/compiler/GHC/Rename/HsType.hs +++ b/compiler/GHC/Rename/HsType.hs @@ -47,8 +47,8 @@ import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn , lookupTyFixityRn ) import GHC.Tc.Utils.Monad import GHC.Types.Name.Reader -import PrelNames -import TysPrim ( funTyConName ) +import GHC.Builtin.Names +import GHC.Builtin.Types.Prim ( funTyConName ) import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Types.Name.Set diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index dd14b33275c2a9facf0a03a63dd722f19dd1d8c6..bc2c7d3d5d24525f779468db4469f317f0b4a83b 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/compiler/GHC/Rename/Module.hs @@ -44,7 +44,7 @@ import GHC.Tc.Utils.Monad import GHC.Types.ForeignCall ( CCallTarget(..) ) import GHC.Types.Module import GHC.Driver.Types ( Warnings(..), plusWarns ) -import PrelNames ( applicativeClassName, pureAName, thenAName +import GHC.Builtin.Names( applicativeClassName, pureAName, thenAName , monadClassName, returnMName, thenMName , semigroupClassName, sappendName , monoidClassName, mappendName @@ -2367,8 +2367,8 @@ add_kisig d (tycls@(TyClGroup { group_kisigs = kisigs }) : rest) add_bind :: LHsBind a -> HsValBinds a -> HsValBinds a add_bind b (ValBinds x bs sigs) = ValBinds x (bs `snocBag` b) sigs -add_bind _ (XValBindsLR {}) = panic "RdrHsSyn:add_bind" +add_bind _ (XValBindsLR {}) = panic "GHC.Rename.Module.add_bind" add_sig :: LSig (GhcPass a) -> HsValBinds (GhcPass a) -> HsValBinds (GhcPass a) add_sig s (ValBinds x bs sigs) = ValBinds x bs (s:sigs) -add_sig _ (XValBindsLR {}) = panic "RdrHsSyn:add_sig" +add_sig _ (XValBindsLR {}) = panic "GHC.Rename.Module.add_sig" diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs index bf2f15829e6a53f0ed5a4afc36a96b81a54a311b..ed080878999a31528d58542304d8f6b94f2d484b 100644 --- a/compiler/GHC/Rename/Names.hs +++ b/compiler/GHC/Rename/Names.hs @@ -43,7 +43,7 @@ import GHC.Rename.Fixity import GHC.Rename.Utils ( warnUnusedTopBinds, mkFieldEnv ) import GHC.Iface.Load ( loadSrcInterface ) import GHC.Tc.Utils.Monad -import PrelNames +import GHC.Builtin.Names import GHC.Types.Module import GHC.Types.Name import GHC.Types.Name.Env @@ -52,7 +52,7 @@ import GHC.Types.Avail import GHC.Types.FieldLabel import GHC.Driver.Types import GHC.Types.Name.Reader -import RdrHsSyn ( setRdrNameSpace ) +import GHC.Parser.PostProcess ( setRdrNameSpace ) import Outputable import Maybes import GHC.Types.SrcLoc as SrcLoc diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs index 166d46a05f1a1e2b4bae7c80d0269c90a5803a66..d8f55ccc1ff80e6dd723fc2a20d2de4a5a4576db 100644 --- a/compiler/GHC/Rename/Pat.hs +++ b/compiler/GHC/Rename/Pat.hs @@ -62,7 +62,7 @@ import GHC.Rename.Utils ( HsDocContext(..), newLocalBndrRn, bindLocalNames , checkDupNames, checkDupAndShadowedNames , checkTupSize , unknownSubordinateErr ) import GHC.Rename.HsType -import PrelNames +import GHC.Builtin.Names import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Reader @@ -72,7 +72,7 @@ import ListSetOps ( removeDups ) import Outputable import GHC.Types.SrcLoc import GHC.Types.Literal ( inCharRange ) -import TysWiredIn ( nilDataCon ) +import GHC.Builtin.Types ( nilDataCon ) import GHC.Core.DataCon import qualified GHC.LanguageExtensions as LangExt diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs index 560b908bbc4544e85406ac6c8805eabef06e7cd2..a0f0bb24194bbf32b24c5d17682e3e4744d9e94e 100644 --- a/compiler/GHC/Rename/Splice.hs +++ b/compiler/GHC/Rename/Splice.hs @@ -37,16 +37,16 @@ import Control.Monad ( unless, when ) import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr ) -import GHC.Tc.Utils.Env ( checkWellStaged ) -import THNames ( liftName ) +import GHC.Tc.Utils.Env ( checkWellStaged ) +import GHC.Builtin.Names.TH ( liftName ) import GHC.Driver.Session import FastString import ErrUtils ( dumpIfSet_dyn_printer, DumpFormat (..) ) import GHC.Tc.Utils.Env ( tcMetaTy ) import GHC.Driver.Hooks -import THNames ( quoteExpName, quotePatName, quoteDecName, quoteTypeName - , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, ) +import GHC.Builtin.Names.TH ( quoteExpName, quotePatName, quoteDecName, quoteTypeName + , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, ) import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcPolyExpr ) import {-# SOURCE #-} GHC.Tc.Gen.Splice diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs index 0de085eabfaf49757ff3ba88a6e0b968390d24df..aa4e05941fc124c9718bdb38b4207e37a6b0805f 100644 --- a/compiler/GHC/Rename/Unbound.hs +++ b/compiler/GHC/Rename/Unbound.hs @@ -26,7 +26,7 @@ import GHC.Types.Name import GHC.Types.Module import GHC.Types.SrcLoc as SrcLoc import Outputable -import PrelNames ( mkUnboundName, isUnboundName, getUnique) +import GHC.Builtin.Names ( mkUnboundName, isUnboundName, getUnique) import Util import Maybes import GHC.Driver.Session diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs index 2ed7c5db958591e4028f1afc935f45cf302be1ed..3c4f5d065f52c0073b12971f60c176f87bc82664 100644 --- a/compiler/GHC/Rename/Utils.hs +++ b/compiler/GHC/Rename/Utils.hs @@ -53,7 +53,7 @@ import GHC.Driver.Session import FastString import Control.Monad import Data.List -import Constants ( mAX_TUPLE_SIZE ) +import GHC.Settings.Constants ( mAX_TUPLE_SIZE ) import qualified Data.List.NonEmpty as NE import qualified GHC.LanguageExtensions as LangExt diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs index 7d3877749ab691b34f57b07a56ff0adb39fe2207..655e0ea5bc2e5600479c68aa11e40f1264760ae4 100644 --- a/compiler/GHC/Runtime/Eval.hs +++ b/compiler/GHC/Runtime/Eval.hs @@ -84,8 +84,8 @@ import GHC.Types.Unique import GHC.Types.Unique.Supply import MonadUtils import GHC.Types.Module -import PrelNames ( toDynName, pretendNameIsInScope ) -import TysWiredIn ( isCTupleTyConName ) +import GHC.Builtin.Names ( toDynName, pretendNameIsInScope ) +import GHC.Builtin.Types ( isCTupleTyConName ) import Panic import Maybes import ErrUtils @@ -95,8 +95,8 @@ import Outputable import FastString import Bag import Util -import qualified Lexer (P (..), ParseResult(..), unP, mkPState) -import qualified Parser (parseStmt, parseModule, parseDeclaration, parseImport) +import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, mkPState) +import qualified GHC.Parser as Parser (parseStmt, parseModule, parseDeclaration, parseImport) import System.Directory import Data.Dynamic diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs index d4dfa49ca14a6e354927d16b59162ea72b2e6769..3802baf4df5effd91d4e3bd1bedde685cd6a13a2 100644 --- a/compiler/GHC/Runtime/Heap/Inspect.hs +++ b/compiler/GHC/Runtime/Heap/Inspect.hs @@ -53,9 +53,9 @@ import GHC.Iface.Env import Util import GHC.Types.Var.Set import GHC.Types.Basic ( Boxity(..) ) -import TysPrim -import PrelNames -import TysWiredIn +import GHC.Builtin.Types.Prim +import GHC.Builtin.Names +import GHC.Builtin.Types import GHC.Driver.Session import Outputable as Ppr import GHC.Char diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs index 434f4dd29d02507b375bca1082ac1c32bcd4c769..5da9a916af921dac8904a1471dc3f3110c128332 100644 --- a/compiler/GHC/Runtime/Linker.hs +++ b/compiler/GHC/Runtime/Linker.hs @@ -60,8 +60,8 @@ import qualified Maybes import GHC.Types.Unique.DSet import FastString import GHC.Platform -import SysTools -import FileCleanup +import GHC.SysTools +import GHC.SysTools.FileCleanup -- Standard libraries import Control.Monad diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs index 5bad947b2afd908149b40435d9c394997be17ac1..be8395896c4776b6adc8174a8a1c3ce04de90fbc 100644 --- a/compiler/GHC/Runtime/Loader.hs +++ b/compiler/GHC/Runtime/Loader.hs @@ -36,7 +36,7 @@ import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) import GHC.Types.Name.Occurrence ( OccName, mkVarOcc ) import GHC.Rename.Names ( gresFromAvails ) import GHC.Driver.Plugins -import PrelNames ( pluginTyConName, frontendPluginTyConName ) +import GHC.Builtin.Names ( pluginTyConName, frontendPluginTyConName ) import GHC.Driver.Types import GHCi.RemoteTypes ( HValue ) diff --git a/compiler/main/Settings.hs b/compiler/GHC/Settings.hs similarity index 67% rename from compiler/main/Settings.hs rename to compiler/GHC/Settings.hs index a4e0f8e4a715901a6c88a8f4f65f847ed816a626..e0466a1cf22c34090f95dce6976652dad458f679 100644 --- a/compiler/main/Settings.hs +++ b/compiler/GHC/Settings.hs @@ -1,5 +1,16 @@ -module Settings +{-# LANGUAGE CPP #-} + +-- | Run-time settings +module GHC.Settings ( Settings (..) + , ToolSettings (..) + , FileSettings (..) + , GhcNameVersion (..) + , PlatformConstants (..) + , Platform (..) + , PlatformMisc (..) + , PlatformMini (..) + -- * Accessors , sProgramName , sProjectVersion , sGhcUsagePath @@ -62,11 +73,7 @@ import GhcPrelude import CliOption import Fingerprint -import FileSettings -import GhcNameVersion import GHC.Platform -import PlatformConstants -import ToolSettings data Settings = Settings { sGhcNameVersion :: {-# UNPACk #-} !GhcNameVersion @@ -81,6 +88,85 @@ data Settings = Settings , sRawSettings :: [(String, String)] } +-- | Settings for other executables GHC calls. +-- +-- Probably should further split down by phase, or split between +-- platform-specific and platform-agnostic. +data ToolSettings = ToolSettings + { toolSettings_ldSupportsCompactUnwind :: Bool + , toolSettings_ldSupportsBuildId :: Bool + , toolSettings_ldSupportsFilelist :: Bool + , toolSettings_ldIsGnuLd :: Bool + , toolSettings_ccSupportsNoPie :: Bool + + -- commands for particular phases + , toolSettings_pgm_L :: String + , toolSettings_pgm_P :: (String, [Option]) + , toolSettings_pgm_F :: String + , toolSettings_pgm_c :: String + , toolSettings_pgm_a :: (String, [Option]) + , toolSettings_pgm_l :: (String, [Option]) + , toolSettings_pgm_dll :: (String, [Option]) + , toolSettings_pgm_T :: String + , toolSettings_pgm_windres :: String + , toolSettings_pgm_libtool :: String + , toolSettings_pgm_ar :: String + , toolSettings_pgm_ranlib :: String + , -- | LLVM: opt llvm optimiser + toolSettings_pgm_lo :: (String, [Option]) + , -- | LLVM: llc static compiler + toolSettings_pgm_lc :: (String, [Option]) + , -- | LLVM: c compiler + toolSettings_pgm_lcc :: (String, [Option]) + , toolSettings_pgm_i :: String + + -- options for particular phases + , toolSettings_opt_L :: [String] + , toolSettings_opt_P :: [String] + , -- | cached Fingerprint of sOpt_P + -- See Note [Repeated -optP hashing] + toolSettings_opt_P_fingerprint :: Fingerprint + , toolSettings_opt_F :: [String] + , toolSettings_opt_c :: [String] + , toolSettings_opt_cxx :: [String] + , toolSettings_opt_a :: [String] + , toolSettings_opt_l :: [String] + , toolSettings_opt_windres :: [String] + , -- | LLVM: llvm optimiser + toolSettings_opt_lo :: [String] + , -- | LLVM: llc static compiler + toolSettings_opt_lc :: [String] + , -- | LLVM: c compiler + toolSettings_opt_lcc :: [String] + , -- | iserv options + toolSettings_opt_i :: [String] + + , toolSettings_extraGccViaCFlags :: [String] + } + + +-- | Paths to various files and directories used by GHC, including those that +-- provide more settings. +data FileSettings = FileSettings + { fileSettings_ghcUsagePath :: FilePath -- ditto + , fileSettings_ghciUsagePath :: FilePath -- ditto + , fileSettings_toolDir :: Maybe FilePath -- ditto + , fileSettings_topDir :: FilePath -- ditto + , fileSettings_tmpDir :: String -- no trailing '/' + , fileSettings_globalPackageDatabase :: FilePath + } + + +-- | Settings for what GHC this is. +data GhcNameVersion = GhcNameVersion + { ghcNameVersion_programName :: String + , ghcNameVersion_projectVersion :: String + } + +-- Produced by deriveConstants +-- Provides PlatformConstants datatype +#include "GHCConstantsHaskellType.hs" + ----------------------------------------------------------------------------- -- Accessessors from 'Settings' diff --git a/compiler/main/Constants.hs b/compiler/GHC/Settings/Constants.hs similarity index 85% rename from compiler/main/Constants.hs rename to compiler/GHC/Settings/Constants.hs index 9935b03583c91d6e2f03c217f10d88b4c42d9ac6..92a917e4303c503603323f5caaba1c64896564f5 100644 --- a/compiler/main/Constants.hs +++ b/compiler/GHC/Settings/Constants.hs @@ -1,10 +1,5 @@ -{- -(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 - -\section[Constants]{Info about this compilation} --} - -module Constants (module Constants) where +-- | Compile-time settings +module GHC.Settings.Constants where import GhcPrelude diff --git a/compiler/main/SysTools/Settings.hs b/compiler/GHC/Settings/IO.hs similarity index 98% rename from compiler/main/SysTools/Settings.hs rename to compiler/GHC/Settings/IO.hs index 42763f239acaffb077e1e8b429d15f7da3a6508f..bc15564543bab4fd5479ddbfdab66e6d164516df 100644 --- a/compiler/main/SysTools/Settings.hs +++ b/compiler/GHC/Settings/IO.hs @@ -2,7 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} -module SysTools.Settings +module GHC.Settings.IO ( SettingsError (..) , initSettings ) where @@ -11,18 +11,16 @@ module SysTools.Settings import GhcPrelude -import GHC.Settings +import GHC.Settings.Platform +import GHC.Settings.Utils import Config import CliOption -import FileSettings import Fingerprint import GHC.Platform -import GhcNameVersion import Outputable -import Settings -import SysTools.BaseDir -import ToolSettings +import GHC.Settings +import GHC.SysTools.BaseDir import Control.Monad.Trans.Except import Control.Monad.IO.Class diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs index e31327c06c0cff147d58e12bcbfff879647d2e63..7ee13baef8520ae52d50f97608ea7b886fcfb841 100644 --- a/compiler/GHC/Stg/Syntax.hs +++ b/compiler/GHC/Stg/Syntax.hs @@ -79,7 +79,7 @@ import Outputable import GHC.Driver.Packages ( isDynLinkName ) import GHC.Platform import GHC.Core.Ppr( {- instances -} ) -import PrimOp ( PrimOp, PrimCall ) +import GHC.Builtin.PrimOps ( PrimOp, PrimCall ) import GHC.Core.TyCon ( PrimRep(..), TyCon ) import GHC.Core.Type ( Type ) import GHC.Types.RepType ( typePrimRep1 ) diff --git a/compiler/GHC/Stg/Unarise.hs b/compiler/GHC/Stg/Unarise.hs index 6e163ab3e92642bc50feacdc39949ecb2e352422..de74b0b0ab12f67c4ee5e87944487affa60fa453 100644 --- a/compiler/GHC/Stg/Unarise.hs +++ b/compiler/GHC/Stg/Unarise.hs @@ -215,8 +215,8 @@ import Outputable import GHC.Types.RepType import GHC.Stg.Syntax import GHC.Core.Type -import TysPrim (intPrimTy,wordPrimTy,word64PrimTy) -import TysWiredIn +import GHC.Builtin.Types.Prim (intPrimTy,wordPrimTy,word64PrimTy) +import GHC.Builtin.Types import GHC.Types.Unique.Supply import Util import GHC.Types.Var.Env diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs index d7c5aab01cb0dc3b83c1105910430ae5aad6655e..231144965ed5f082927a1ec3da30c3b82aa0a0bc 100644 --- a/compiler/GHC/StgToCmm.hs +++ b/compiler/GHC/StgToCmm.hs @@ -46,7 +46,7 @@ import Outputable import Stream import GHC.Types.Basic import GHC.Types.Var.Set ( isEmptyDVarSet ) -import FileCleanup +import GHC.SysTools.FileCleanup import OrdList import GHC.Cmm.Graph diff --git a/compiler/GHC/StgToCmm/ArgRep.hs b/compiler/GHC/StgToCmm/ArgRep.hs index a36aa4c268ad1ee310f241159f3bc7e4cbf9ea09..a3df5a881fe9e4271a895f11236618caf68eb96f 100644 --- a/compiler/GHC/StgToCmm/ArgRep.hs +++ b/compiler/GHC/StgToCmm/ArgRep.hs @@ -25,7 +25,7 @@ import GHC.Runtime.Heap.Layout ( WordOff ) import GHC.Types.Id ( Id ) import GHC.Core.TyCon ( PrimRep(..), primElemRepSizeB ) import GHC.Types.Basic ( RepArity ) -import Constants ( wORD64_SIZE, dOUBLE_SIZE ) +import GHC.Settings.Constants ( wORD64_SIZE, dOUBLE_SIZE ) import Outputable import FastString diff --git a/compiler/GHC/StgToCmm/DataCon.hs b/compiler/GHC/StgToCmm/DataCon.hs index 789dc8df57c0cccfe8c65fdba3948b91856dcf95..a0645305faaab45dbf1834f5ce8da66f67dd7fbb 100644 --- a/compiler/GHC/StgToCmm/DataCon.hs +++ b/compiler/GHC/StgToCmm/DataCon.hs @@ -44,7 +44,7 @@ import GHC.Types.Id.Info( CafInfo( NoCafRefs ) ) import GHC.Types.Name (isInternalName) import GHC.Types.RepType (countConRepArgs) import GHC.Types.Literal -import PrelInfo +import GHC.Builtin.Utils import Outputable import GHC.Platform import Util diff --git a/compiler/GHC/StgToCmm/Env.hs b/compiler/GHC/StgToCmm/Env.hs index 047353b89a89e7430c0c8fc627932535029046a0..da2158c7e968b0c362190aca33de4b044eb11c0e 100644 --- a/compiler/GHC/StgToCmm/Env.hs +++ b/compiler/GHC/StgToCmm/Env.hs @@ -44,7 +44,7 @@ import GHC.Types.Name import Outputable import GHC.Stg.Syntax import GHC.Core.Type -import TysPrim +import GHC.Builtin.Types.Prim import GHC.Types.Unique.FM import Util import GHC.Types.Var.Env diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs index 05a5e7c69b0e4471b749a4a221cd4352bf9f71ea..94cd97ca239612bbd5027328cc6b52c045567369 100644 --- a/compiler/GHC/StgToCmm/Expr.hs +++ b/compiler/GHC/StgToCmm/Expr.hs @@ -41,7 +41,7 @@ import GHC.Core.DataCon import GHC.Driver.Session ( mAX_PTR_TAG ) import GHC.Types.ForeignCall import GHC.Types.Id -import PrimOp +import GHC.Builtin.PrimOps import GHC.Core.TyCon import GHC.Core.Type ( isUnliftedType ) import GHC.Types.RepType ( isVoidTy, countConRepArgs ) diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs index 2a0578327aae729894e75dfea8ad65d405d83804..51fee717c401650def53193826f6fb88986fa221 100644 --- a/compiler/GHC/StgToCmm/Foreign.hs +++ b/compiler/GHC/StgToCmm/Foreign.hs @@ -45,7 +45,7 @@ import GHC.Types.Unique.Supply import GHC.Types.Basic import GHC.Core.TyCo.Rep -import TysPrim +import GHC.Builtin.Types.Prim import Util (zipEqual) import Control.Monad diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs index 665fdeb21d328a3cdb0f4dcde6dc698d7473b4f0..b315c6a196ac23f85e267ef23228a572d9b81339 100644 --- a/compiler/GHC/StgToCmm/Prim.hs +++ b/compiler/GHC/StgToCmm/Prim.hs @@ -47,7 +47,7 @@ import GHC.Core.Type ( Type, tyConAppTyCon ) import GHC.Core.TyCon import GHC.Cmm.CLabel import GHC.Cmm.Utils -import PrimOp +import GHC.Builtin.PrimOps import GHC.Runtime.Heap.Layout import FastString import Outputable diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs index 19ff523fba0d99caa962e1b7dc85ee2b044967e6..179dc2d2d85a1c0c6dccd15687bd2b917ba0f3bf 100644 --- a/compiler/GHC/StgToCmm/Ticky.hs +++ b/compiler/GHC/StgToCmm/Ticky.hs @@ -131,7 +131,7 @@ import Util import GHC.Driver.Session -- Turgid imports for showTypeCategory -import PrelNames +import GHC.Builtin.Names import GHC.Tc.Utils.TcType import GHC.Core.TyCon import GHC.Core.Predicate diff --git a/compiler/main/SysTools.hs b/compiler/GHC/SysTools.hs similarity index 98% rename from compiler/main/SysTools.hs rename to compiler/GHC/SysTools.hs index ea6eb178ee73a394ebe35062247806a1781a87be..f3f1b4b1ca96fa383a6df5987094355e19139337 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/GHC/SysTools.hs @@ -10,14 +10,14 @@ {-# LANGUAGE CPP, MultiWayIf, ScopedTypeVariables #-} -module SysTools ( +module GHC.SysTools ( -- * Initialisation initSysTools, lazyInitLlvmConfig, -- * Interface to system tools - module SysTools.Tasks, - module SysTools.Info, + module GHC.SysTools.Tasks, + module GHC.SysTools.Info, linkDynLib, @@ -40,7 +40,7 @@ module SysTools ( import GhcPrelude -import GHC.Settings +import GHC.Settings.Utils import GHC.Types.Module import GHC.Driver.Packages @@ -54,18 +54,18 @@ import Control.Monad.Trans.Except (runExceptT) import System.FilePath import System.IO import System.IO.Unsafe (unsafeInterleaveIO) -import SysTools.ExtraObj -import SysTools.Info -import SysTools.Tasks -import SysTools.BaseDir -import SysTools.Settings +import GHC.SysTools.ExtraObj +import GHC.SysTools.Info +import GHC.SysTools.Tasks +import GHC.SysTools.BaseDir +import GHC.Settings.IO import qualified Data.Set as Set {- Note [How GHC finds toolchain utilities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -SysTools.initSysProgs figures out exactly where all the auxiliary programs +GHC.SysTools.initSysProgs figures out exactly where all the auxiliary programs are, and initialises mutable variables to make it easy to call them. To do this, it makes use of definitions in Config.hs, which is a Haskell file containing variables whose value is figured out by the build system. diff --git a/compiler/main/Ar.hs b/compiler/GHC/SysTools/Ar.hs similarity index 99% rename from compiler/main/Ar.hs rename to compiler/GHC/SysTools/Ar.hs index 1a1862a6fe95d7f900284633acf534da73f6697e..200b65204984f7b779e5bde3479aa919c5f654ef 100644 --- a/compiler/main/Ar.hs +++ b/compiler/GHC/SysTools/Ar.hs @@ -15,7 +15,7 @@ with Haskell directly and use ranlib on the final result to get the symbol index. This should allow us to work around with the differences/abailability of libtool across different platforms. -} -module Ar +module GHC.SysTools.Ar (ArchiveEntry(..) ,Archive(..) ,afilter diff --git a/compiler/main/SysTools/BaseDir.hs b/compiler/GHC/SysTools/BaseDir.hs similarity index 99% rename from compiler/main/SysTools/BaseDir.hs rename to compiler/GHC/SysTools/BaseDir.hs index c4fc71b502d9d1b26bac909f9c633f1e39756744..fe749b5cdc21f2d4100c93b8e6fcac024c31f6de 100644 --- a/compiler/main/SysTools/BaseDir.hs +++ b/compiler/GHC/SysTools/BaseDir.hs @@ -11,7 +11,7 @@ ----------------------------------------------------------------------------- -} -module SysTools.BaseDir +module GHC.SysTools.BaseDir ( expandTopDir, expandToolDir , findTopDir, findToolDir , tryFindTopDir diff --git a/compiler/main/Elf.hs b/compiler/GHC/SysTools/Elf.hs similarity index 99% rename from compiler/main/Elf.hs rename to compiler/GHC/SysTools/Elf.hs index 4d3b06e731905466af29f95a10fac9f186cef750..5d4d87af45145e5fa77757ecbc3541f568632c8b 100644 --- a/compiler/main/Elf.hs +++ b/compiler/GHC/SysTools/Elf.hs @@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -} -module Elf ( +module GHC.SysTools.Elf ( readElfSectionByName, readElfNoteAsString, makeElfNote diff --git a/compiler/main/SysTools/ExtraObj.hs b/compiler/GHC/SysTools/ExtraObj.hs similarity index 98% rename from compiler/main/SysTools/ExtraObj.hs rename to compiler/GHC/SysTools/ExtraObj.hs index 27cc4f7aae2a754ea676ed0eade0db4b936a253c..f20f8151077f47c16097423a95e716573b669dd1 100644 --- a/compiler/main/SysTools/ExtraObj.hs +++ b/compiler/GHC/SysTools/ExtraObj.hs @@ -6,7 +6,7 @@ -- ----------------------------------------------------------------------------- -module SysTools.ExtraObj ( +module GHC.SysTools.ExtraObj ( mkExtraObj, mkExtraObjToLinkIntoBinary, mkNoteObjsToLinkIntoBinary, checkLinkInfo, getLinkInfo, getCompilerInfo, ghcLinkInfoSectionName, ghcLinkInfoNoteName, platformSupportsSavingLinkOpts, @@ -21,7 +21,7 @@ import GHC.Platform import Outputable import GHC.Types.SrcLoc ( noSrcSpan ) import GHC.Types.Module -import Elf +import GHC.SysTools.Elf import Util import GhcPrelude @@ -30,9 +30,9 @@ import Data.Maybe import Control.Monad.IO.Class -import FileCleanup -import SysTools.Tasks -import SysTools.Info +import GHC.SysTools.FileCleanup +import GHC.SysTools.Tasks +import GHC.SysTools.Info mkExtraObj :: DynFlags -> Suffix -> String -> IO FilePath mkExtraObj dflags extn xs diff --git a/compiler/main/FileCleanup.hs b/compiler/GHC/SysTools/FileCleanup.hs similarity index 99% rename from compiler/main/FileCleanup.hs rename to compiler/GHC/SysTools/FileCleanup.hs index 81d0ce7a405c31ea964b0ca57c077379dfa71876..ef41185cdd7d04acbd26044558e8cf935b3845ee 100644 --- a/compiler/main/FileCleanup.hs +++ b/compiler/GHC/SysTools/FileCleanup.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -module FileCleanup +module GHC.SysTools.FileCleanup ( TempFileLifetime(..) , cleanTempDirs, cleanTempFiles, cleanCurrentModuleTempFiles , addFilesToClean, changeTempFilesLifetime diff --git a/compiler/main/SysTools/Info.hs b/compiler/GHC/SysTools/Info.hs similarity index 99% rename from compiler/main/SysTools/Info.hs rename to compiler/GHC/SysTools/Info.hs index b6b74406afa712a03d5671086e41fccb1cad2168..805157075534dd58c570505c0171aaacd7ba77be 100644 --- a/compiler/main/SysTools/Info.hs +++ b/compiler/GHC/SysTools/Info.hs @@ -6,7 +6,7 @@ -- (c) The GHC Team 2017 -- ----------------------------------------------------------------------------- -module SysTools.Info where +module GHC.SysTools.Info where import Exception import ErrUtils @@ -22,7 +22,7 @@ import System.IO import GHC.Platform import GhcPrelude -import SysTools.Process +import GHC.SysTools.Process {- Note [Run-time linker info] diff --git a/compiler/main/SysTools/Process.hs b/compiler/GHC/SysTools/Process.hs similarity index 99% rename from compiler/main/SysTools/Process.hs rename to compiler/GHC/SysTools/Process.hs index eda4b29bc022037e31b330dd172d5a2ca4a0c8fe..82f7a6d2f064d542fd7a4083e22d87474ce42ccf 100644 --- a/compiler/main/SysTools/Process.hs +++ b/compiler/GHC/SysTools/Process.hs @@ -6,7 +6,7 @@ -- (c) The GHC Team 2017 -- ----------------------------------------------------------------------------- -module SysTools.Process where +module GHC.SysTools.Process where #include "HsVersions.h" @@ -30,7 +30,7 @@ import System.IO import System.IO.Error as IO import System.Process -import FileCleanup +import GHC.SysTools.FileCleanup -- | Enable process jobs support on Windows if it can be expected to work (e.g. -- @process >= 1.6.8.0@). diff --git a/compiler/main/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs similarity index 99% rename from compiler/main/SysTools/Tasks.hs rename to compiler/GHC/SysTools/Tasks.hs index e4bbb32dc6c1e9d781cd43df3d96f46c495feafb..9d7b736feeb63fabbb21c3258a6cb60fd51b943c 100644 --- a/compiler/main/SysTools/Tasks.hs +++ b/compiler/GHC/SysTools/Tasks.hs @@ -6,7 +6,7 @@ -- (c) The GHC Team 2017 -- ----------------------------------------------------------------------------- -module SysTools.Tasks where +module GHC.SysTools.Tasks where import Exception import ErrUtils @@ -24,8 +24,8 @@ import GhcPrelude import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, parseLlvmVersion) -import SysTools.Process -import SysTools.Info +import GHC.SysTools.Process +import GHC.SysTools.Info {- ************************************************************************ diff --git a/compiler/main/SysTools/Terminal.hs b/compiler/GHC/SysTools/Terminal.hs similarity index 98% rename from compiler/main/SysTools/Terminal.hs rename to compiler/GHC/SysTools/Terminal.hs index 162dd320108b7e3d1f5c22cc87c23e94670745d0..69c605bc7349a4ccb6ce63fc190a2b5d1f26432e 100644 --- a/compiler/main/SysTools/Terminal.hs +++ b/compiler/GHC/SysTools/Terminal.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -module SysTools.Terminal (stderrSupportsAnsiColors) where +module GHC.SysTools.Terminal (stderrSupportsAnsiColors) where import GhcPrelude diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs index 5630bde86392354055552fcaf673c4d79908df16..6f5d72a51a6a4cbaa29d5a21cd670d4d7d227aaf 100644 --- a/compiler/GHC/Tc/Deriv.hs +++ b/compiler/GHC/Tc/Deriv.hs @@ -58,7 +58,7 @@ import GHC.Tc.Utils.TcType import GHC.Types.Var as Var import GHC.Types.Var.Env import GHC.Types.Var.Set -import PrelNames +import GHC.Builtin.Names import GHC.Types.SrcLoc import Util import Outputable diff --git a/compiler/GHC/Tc/Deriv/Functor.hs b/compiler/GHC/Tc/Deriv/Functor.hs index d727d7bb983a93af5da1650ea17e61b0a492e9f6..41aa86080de743d64a3530c35797996420181de4 100644 --- a/compiler/GHC/Tc/Deriv/Functor.hs +++ b/compiler/GHC/Tc/Deriv/Functor.hs @@ -31,7 +31,7 @@ import GHC.Core.DataCon import FastString import GHC.Hs import Outputable -import PrelNames +import GHC.Builtin.Names import GHC.Types.Name.Reader import GHC.Types.SrcLoc import State @@ -44,7 +44,7 @@ import Util import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Id.Make (coerceId) -import TysWiredIn (true_RDR, false_RDR) +import GHC.Builtin.Types (true_RDR, false_RDR) import Data.Maybe (catMaybes, isJust) diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs index d330d768270b020487b6af74c070adc14a936743..4f00de2427fa5c8ed4b75af848528bff06b21e6d 100644 --- a/compiler/GHC/Tc/Deriv/Generate.hs +++ b/compiler/GHC/Tc/Deriv/Generate.hs @@ -50,21 +50,21 @@ import Fingerprint import Encoding import GHC.Driver.Session -import PrelInfo +import GHC.Builtin.Utils import GHC.Tc.Instance.Family import GHC.Core.FamInstEnv -import PrelNames -import THNames +import GHC.Builtin.Names +import GHC.Builtin.Names.TH import GHC.Types.Id.Make ( coerceId ) -import PrimOp +import GHC.Builtin.PrimOps import GHC.Types.SrcLoc import GHC.Core.TyCon import GHC.Tc.Utils.Env import GHC.Tc.Utils.TcType import GHC.Tc.Validity ( checkValidCoAxBranch ) import GHC.Core.Coercion.Axiom ( coAxiomSingleBranch ) -import TysPrim -import TysWiredIn +import GHC.Builtin.Types.Prim +import GHC.Builtin.Types import GHC.Core.Type import GHC.Core.Class import GHC.Types.Var.Set diff --git a/compiler/GHC/Tc/Deriv/Generics.hs b/compiler/GHC/Tc/Deriv/Generics.hs index d40824e3ea3c3e07ce3ec691ea71c05404a8dbc0..d4af39d83c349c1d15051f309fb2c469a292a486 100644 --- a/compiler/GHC/Tc/Deriv/Generics.hs +++ b/compiler/GHC/Tc/Deriv/Generics.hs @@ -36,9 +36,9 @@ import GHC.Iface.Env ( newGlobalBinder ) import GHC.Types.Name hiding ( varName ) import GHC.Types.Name.Reader import GHC.Types.Basic -import TysPrim -import TysWiredIn -import PrelNames +import GHC.Builtin.Types.Prim +import GHC.Builtin.Types +import GHC.Builtin.Names import GHC.Tc.Utils.Env import GHC.Tc.Utils.Monad import GHC.Driver.Types diff --git a/compiler/GHC/Tc/Deriv/Infer.hs b/compiler/GHC/Tc/Deriv/Infer.hs index 47257d6b232ab297ddb6f9de3451855883133857..a5351fcf86d0796f46db79c05e145c6d1c372fde 100644 --- a/compiler/GHC/Tc/Deriv/Infer.hs +++ b/compiler/GHC/Tc/Deriv/Infer.hs @@ -26,7 +26,7 @@ import ErrUtils import GHC.Tc.Utils.Instantiate import Outputable import Pair -import PrelNames +import GHC.Builtin.Names import GHC.Tc.Deriv.Utils import GHC.Tc.Utils.Env import GHC.Tc.Deriv.Generate @@ -44,7 +44,7 @@ import GHC.Core.Type import GHC.Tc.Solver import GHC.Tc.Validity (validDerivPred) import GHC.Tc.Utils.Unify (buildImplicationFor, checkConstraints) -import TysWiredIn (typeToTypeKind) +import GHC.Builtin.Types (typeToTypeKind) import GHC.Core.Unify (tcUnifyTy) import Util import GHC.Types.Var diff --git a/compiler/GHC/Tc/Deriv/Utils.hs b/compiler/GHC/Tc/Deriv/Utils.hs index 5394a09e23a9bd0ad75c60996432883affff6c48..63c0e3002cd7e407e39878c06f6053ec683d42ce 100644 --- a/compiler/GHC/Tc/Deriv/Utils.hs +++ b/compiler/GHC/Tc/Deriv/Utils.hs @@ -38,7 +38,7 @@ import GHC.Iface.Load (loadInterfaceForName) import GHC.Types.Module (getModule) import GHC.Types.Name import Outputable -import PrelNames +import GHC.Builtin.Names import GHC.Types.SrcLoc import GHC.Tc.Deriv.Generate import GHC.Tc.Deriv.Functor @@ -46,7 +46,7 @@ import GHC.Tc.Deriv.Generics import GHC.Tc.Types.Origin import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcType -import THNames (liftClassKey) +import GHC.Builtin.Names.TH (liftClassKey) import GHC.Core.TyCon import GHC.Core.TyCo.Ppr (pprSourceTyCon) import GHC.Core.Type diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs index 333e442803281b5b1a38f24b090d4b3c39583b63..ae08f784435a491db1afaa8cc9d376f74de97b00 100644 --- a/compiler/GHC/Tc/Errors.hs +++ b/compiler/GHC/Tc/Errors.hs @@ -45,7 +45,7 @@ import GHC.Tc.Types.EvTerm import GHC.Hs.Binds ( PatSynBind(..) ) import GHC.Types.Name import GHC.Types.Name.Reader ( lookupGRE_Name, GlobalRdrEnv, mkRdrUnqual ) -import PrelNames ( typeableClassName ) +import GHC.Builtin.Names ( typeableClassName ) import GHC.Types.Id import GHC.Types.Var import GHC.Types.Var.Set diff --git a/compiler/GHC/Tc/Errors/Hole.hs b/compiler/GHC/Tc/Errors/Hole.hs index b361ca597d977660241af6c1e53a7b32ac6e8160..771765901ce1002b9a75cd7091ec97a6d3e1d63f 100644 --- a/compiler/GHC/Tc/Errors/Hole.hs +++ b/compiler/GHC/Tc/Errors/Hole.hs @@ -30,7 +30,7 @@ import GHC.Core.Type import GHC.Core.DataCon import GHC.Types.Name import GHC.Types.Name.Reader ( pprNameProvenance , GlobalRdrElt (..), globalRdrEnvElts ) -import PrelNames ( gHC_ERR ) +import GHC.Builtin.Names ( gHC_ERR ) import GHC.Types.Id import GHC.Types.Var.Set import GHC.Types.Var.Env @@ -59,7 +59,7 @@ import GHC.Hs.Doc ( unpackHDS, DeclDocMap(..) ) import GHC.Driver.Types ( ModIface_(..) ) import GHC.Iface.Load ( loadInterfaceForNameMaybe ) -import PrelInfo (knownKeyNames) +import GHC.Builtin.Utils (knownKeyNames) import GHC.Tc.Errors.Hole.FitTypes diff --git a/compiler/GHC/Tc/Gen/Arrow.hs b/compiler/GHC/Tc/Gen/Arrow.hs index 2cb54271194ea3c25d5b2145d306ab1238ea9349..58bbb40da27723382c8a9a21b518cd5c4ab95d62 100644 --- a/compiler/GHC/Tc/Gen/Arrow.hs +++ b/compiler/GHC/Tc/Gen/Arrow.hs @@ -30,9 +30,9 @@ import GHC.Tc.Types.Origin import GHC.Tc.Types.Evidence import GHC.Types.Id( mkLocalId ) import GHC.Tc.Utils.Instantiate -import TysWiredIn +import GHC.Builtin.Types import GHC.Types.Var.Set -import TysPrim +import GHC.Builtin.Types.Prim import GHC.Types.Basic( Arity ) import GHC.Types.SrcLoc import Outputable diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs index 8977ff3cd4d31f244480a226c9a43d7e95d23f58..0773e943c78416282b875c3affbe210bb95a7239 100644 --- a/compiler/GHC/Tc/Gen/Bind.hs +++ b/compiler/GHC/Tc/Gen/Bind.hs @@ -45,8 +45,8 @@ import GHC.Tc.Instance.Family( tcGetFamInstEnvs ) import GHC.Core.TyCon import GHC.Tc.Utils.TcType import GHC.Core.Type (mkStrLitTy, tidyOpenType, splitTyConApp_maybe, mkCastTy) -import TysPrim -import TysWiredIn( mkBoxedTupleTy ) +import GHC.Builtin.Types.Prim +import GHC.Builtin.Types( mkBoxedTupleTy ) import GHC.Types.Id import GHC.Types.Var as Var import GHC.Types.Var.Set @@ -63,7 +63,7 @@ import Maybes import Util import GHC.Types.Basic import Outputable -import PrelNames( ipClassName ) +import GHC.Builtin.Names( ipClassName ) import GHC.Tc.Validity (checkValidType) import GHC.Types.Unique.FM import GHC.Types.Unique.Set diff --git a/compiler/GHC/Tc/Gen/Default.hs b/compiler/GHC/Tc/Gen/Default.hs index 29fb7ee7e0eab2df7ef8c12f58080afc674c9aca..bf1132aa3e4ed998c2e4bef1a18975d8f765cbb4 100644 --- a/compiler/GHC/Tc/Gen/Default.hs +++ b/compiler/GHC/Tc/Gen/Default.hs @@ -19,7 +19,7 @@ import GHC.Tc.Utils.Zonk import GHC.Tc.Solver import GHC.Tc.Validity import GHC.Tc.Utils.TcType -import PrelNames +import GHC.Builtin.Names import GHC.Types.SrcLoc import Outputable import FastString diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs index 283bbce728f94eccb9ae3a3144f44bdcaddcfb66..b384b494e461871816432bdb7b912e80dc1e4eb5 100644 --- a/compiler/GHC/Tc/Gen/Export.hs +++ b/compiler/GHC/Tc/Gen/Export.hs @@ -10,7 +10,7 @@ module GHC.Tc.Gen.Export (tcRnExports, exports_from_avail) where import GhcPrelude import GHC.Hs -import PrelNames +import GHC.Builtin.Names import GHC.Types.Name.Reader import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Env @@ -40,9 +40,9 @@ import FastString (fsLit) import Control.Monad import GHC.Driver.Session -import GHC.Rename.Doc ( rnHsDoc ) -import RdrHsSyn ( setRdrNameSpace ) -import Data.Either ( partitionEithers ) +import GHC.Rename.Doc ( rnHsDoc ) +import GHC.Parser.PostProcess ( setRdrNameSpace ) +import Data.Either ( partitionEithers ) {- ************************************************************************ diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs index 3468a015e57911526b753baccc62bc551a6a1e8f..3048b78afaab7d04f1b0e70fecd42d24c336304f 100644 --- a/compiler/GHC/Tc/Gen/Expr.hs +++ b/compiler/GHC/Tc/Gen/Expr.hs @@ -36,7 +36,7 @@ where import GhcPrelude import {-# SOURCE #-} GHC.Tc.Gen.Splice( tcSpliceExpr, tcTypedBracket, tcUntypedBracket ) -import THNames( liftStringName, liftName ) +import GHC.Builtin.Names.TH( liftStringName, liftName ) import GHC.Hs import GHC.Tc.Types.Constraint ( HoleSort(..) ) @@ -77,10 +77,10 @@ import GHC.Core.TyCo.Subst (substTyWithInScope) import GHC.Core.Type import GHC.Tc.Types.Evidence import GHC.Types.Var.Set -import TysWiredIn -import TysPrim( intPrimTy ) -import PrimOp( tagToEnumKey ) -import PrelNames +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim( intPrimTy ) +import GHC.Builtin.PrimOps( tagToEnumKey ) +import GHC.Builtin.Names import GHC.Driver.Session import GHC.Types.SrcLoc import Util @@ -2013,14 +2013,14 @@ checkCrossStageLifting top_lvl id (Brack _ (TcPending ps_var lie_var q)) -- just going to flag an error for now ; lift <- if isStringTy id_ty then - do { sid <- tcLookupId THNames.liftStringName + do { sid <- tcLookupId GHC.Builtin.Names.TH.liftStringName -- See Note [Lifting strings] ; return (HsVar noExtField (noLoc sid)) } else setConstraintVar lie_var $ -- Put the 'lift' constraint into the right LIE newMethodFromName (OccurrenceOf id_name) - THNames.liftName + GHC.Builtin.Names.TH.liftName [getRuntimeRep id_ty, id_ty] -- Update the pending splices diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs index 050f3b5b89223dc7d272b7e9c84f552e53a76a0d..f1031d6e14359430bf08d4fa1d3f137655a76607 100644 --- a/compiler/GHC/Tc/Gen/Foreign.hs +++ b/compiler/GHC/Tc/Gen/Foreign.hs @@ -54,7 +54,7 @@ import GHC.Types.Name.Reader import GHC.Core.DataCon import GHC.Core.TyCon import GHC.Tc.Utils.TcType -import PrelNames +import GHC.Builtin.Names import GHC.Driver.Session import Outputable import GHC.Platform diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs index 094ed623acff6bbd534d82a1728c5295234a06a4..313ae9cf585fbfb5ccfe6d5e13de7b111fc37459 100644 --- a/compiler/GHC/Tc/Gen/HsType.hs +++ b/compiler/GHC/Tc/Gen/HsType.hs @@ -89,7 +89,7 @@ import GHC.Tc.Errors ( reportAllUnsolved ) import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Instantiate ( tcInstInvisibleTyBinders, tcInstInvisibleTyBinder ) import GHC.Core.Type -import TysPrim +import GHC.Builtin.Types.Prim import GHC.Types.Name.Reader( lookupLocalRdrOcc ) import GHC.Types.Var import GHC.Types.Var.Set @@ -100,10 +100,10 @@ import GHC.Core.Class import GHC.Types.Name -- import GHC.Types.Name.Set import GHC.Types.Var.Env -import TysWiredIn +import GHC.Builtin.Types import GHC.Types.Basic import GHC.Types.SrcLoc -import Constants ( mAX_CTUPLE_SIZE ) +import GHC.Settings.Constants ( mAX_CTUPLE_SIZE ) import ErrUtils( MsgDoc ) import GHC.Types.Unique import GHC.Types.Unique.Set @@ -111,7 +111,7 @@ import Util import GHC.Types.Unique.Supply import Outputable import FastString -import PrelNames hiding ( wildCardName ) +import GHC.Builtin.Names hiding ( wildCardName ) import GHC.Driver.Session import qualified GHC.LanguageExtensions as LangExt @@ -1014,7 +1014,7 @@ bigConstraintTuple arity Note [Ignore unary constraint tuples] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHC provides unary tuples and unboxed tuples (see Note [One-tuples] in -TysWiredIn) but does *not* provide unary constraint tuples. Why? First, +GHC.Builtin.Types) but does *not* provide unary constraint tuples. Why? First, recall the definition of a unary tuple data type: data Unit a = Unit a @@ -3311,7 +3311,7 @@ Consider An annoying difficulty happens if there are more than 62 inferred constraints. Then we need to fill in the TcTyVar with (say) a 70-tuple. Where do we find the TyCon? For good reasons we only have constraint -tuples up to 62 (see Note [How tuples work] in TysWiredIn). So how +tuples up to 62 (see Note [How tuples work] in GHC.Builtin.Types). So how can we make a 70-tuple? This was the root cause of #14217. It's incredibly tiresome, because we only need this type to fill diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs index 8fb7e7da7b51862859ff337340dfd5a3bb4b67b9..339093b47c3d78fac0abdd8c15ca926188796e3c 100644 --- a/compiler/GHC/Tc/Gen/Match.hs +++ b/compiler/GHC/Tc/Gen/Match.hs @@ -50,10 +50,10 @@ import GHC.Tc.Gen.Bind import GHC.Tc.Utils.Unify import GHC.Tc.Types.Origin import GHC.Types.Name -import TysWiredIn +import GHC.Builtin.Types import GHC.Types.Id import GHC.Core.TyCon -import TysPrim +import GHC.Builtin.Types.Prim import GHC.Tc.Types.Evidence import Outputable import Util diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs index f218b4e1be12f598970db4dd877cd2cf9126a124..9b3318a78f65db87ffc568aba2e7950f8d9b7e51 100644 --- a/compiler/GHC/Tc/Gen/Pat.hs +++ b/compiler/GHC/Tc/Gen/Pat.hs @@ -47,14 +47,14 @@ import GHC.Core.TyCo.Ppr ( pprTyVars ) import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Unify import GHC.Tc.Gen.HsType -import TysWiredIn +import GHC.Builtin.Types import GHC.Tc.Types.Evidence import GHC.Tc.Types.Origin import GHC.Core.TyCon import GHC.Core.DataCon import GHC.Core.PatSyn import GHC.Core.ConLike -import PrelNames +import GHC.Builtin.Names import GHC.Types.Basic hiding (SuccessFlag(..)) import GHC.Driver.Session import GHC.Types.SrcLoc diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs index cf7bd3c51d6f63a4cd0b8c322e557688ba49024a..83fab20ca52c67357179ea3b96685e6c534c0319 100644 --- a/compiler/GHC/Tc/Gen/Sig.hs +++ b/compiler/GHC/Tc/Gen/Sig.hs @@ -44,7 +44,7 @@ import GHC.Core.Type ( mkTyVarBinders ) import GHC.Driver.Session import GHC.Types.Var ( TyVar, tyVarKind ) import GHC.Types.Id ( Id, idName, idType, idInlinePragma, setInlinePragma, mkLocalId ) -import PrelNames( mkUnboundName ) +import GHC.Builtin.Names( mkUnboundName ) import GHC.Types.Basic import GHC.Types.Module( getModule ) import GHC.Types.Name diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index f60f6682d26efa3ebd21801f6060e294acf5c510..87b23a8b274ccf7a4a25e1fbbbeee5c882810a8a 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -46,12 +46,12 @@ import GHC.Tc.Utils.TcType import Outputable import GHC.Tc.Gen.Expr import GHC.Types.SrcLoc -import THNames +import GHC.Builtin.Names.TH import GHC.Tc.Utils.Unify import GHC.Tc.Utils.Env import GHC.Tc.Types.Origin import GHC.Core.Coercion( etaExpandCoAxBranch ) -import FileCleanup ( newTempName, TempFileLifetime(..) ) +import GHC.SysTools.FileCleanup ( newTempName, TempFileLifetime(..) ) import Control.Monad @@ -84,8 +84,8 @@ import GHC.Core.FamInstEnv import GHC.Core.InstEnv as InstEnv import GHC.Tc.Utils.Instantiate import GHC.Types.Name.Env -import PrelNames -import TysWiredIn +import GHC.Builtin.Names +import GHC.Builtin.Types import GHC.Types.Name.Occurrence as OccName import GHC.Driver.Hooks import GHC.Types.Var diff --git a/compiler/GHC/Tc/Instance/Class.hs b/compiler/GHC/Tc/Instance/Class.hs index 81ee5aec71fbff74e7a3c9c10e73a2590e5c2e76..53054de7f83ba76b0242844edbb886c84b9afebc 100644 --- a/compiler/GHC/Tc/Instance/Class.hs +++ b/compiler/GHC/Tc/Instance/Class.hs @@ -26,9 +26,9 @@ import GHC.Core.InstEnv import GHC.Tc.Utils.Instantiate( instDFunType ) import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcInstNewTyCon_maybe, tcLookupDataFamInst ) -import TysWiredIn -import TysPrim( eqPrimTyCon, eqReprPrimTyCon ) -import PrelNames +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim( eqPrimTyCon, eqReprPrimTyCon ) +import GHC.Builtin.Names import GHC.Types.Id import GHC.Core.Type @@ -569,7 +569,7 @@ if you'd written * * ***********************************************************************-} --- See also Note [The equality types story] in TysPrim +-- See also Note [The equality types story] in GHC.Builtin.Types.Prim matchHeteroEquality :: [Type] -> TcM ClsInstResult -- Solves (t1 ~~ t2) matchHeteroEquality args @@ -585,7 +585,7 @@ matchHomoEquality args@[k,t1,t2] , cir_what = BuiltinEqInstance }) matchHomoEquality args = pprPanic "matchHomoEquality" (ppr args) --- See also Note [The equality types story] in TysPrim +-- See also Note [The equality types story] in GHC.Builtin.Types.Prim matchCoercible :: [Type] -> TcM ClsInstResult matchCoercible args@[k, t1, t2] = return (OneInst { cir_new_theta = [ mkTyConApp eqReprPrimTyCon args' ] diff --git a/compiler/GHC/Tc/Instance/FunDeps.hs b/compiler/GHC/Tc/Instance/FunDeps.hs index 73a131769254030170a86517b9a4cc03d18350c7..40344af9ed7fe31df3884a9528257bed597db72a 100644 --- a/compiler/GHC/Tc/Instance/FunDeps.hs +++ b/compiler/GHC/Tc/Instance/FunDeps.hs @@ -516,7 +516,7 @@ Note [Equality superclasses] Suppose we have class (a ~ [b]) => C a b -Remember from Note [The equality types story] in TysPrim, that +Remember from Note [The equality types story] in GHC.Builtin.Types.Prim, that * (a ~~ b) is a superclass of (a ~ b) * (a ~# b) is a superclass of (a ~~ b) diff --git a/compiler/GHC/Tc/Instance/Typeable.hs b/compiler/GHC/Tc/Instance/Typeable.hs index 842157a3d42502cfa64c380eb6302888d7534e9c..c3e59b2f4ca73b7f497adf0339839d5c56ef6b0b 100644 --- a/compiler/GHC/Tc/Instance/Typeable.hs +++ b/compiler/GHC/Tc/Instance/Typeable.hs @@ -23,9 +23,10 @@ import GHC.Tc.Types.Evidence ( mkWpTyApps ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcType import GHC.Driver.Types ( lookupId ) -import PrelNames -import TysPrim ( primTyCons ) -import TysWiredIn ( tupleTyCon, sumTyCon, runtimeRepTyCon +import GHC.Builtin.Names +import GHC.Builtin.Types.Prim ( primTyCons ) +import GHC.Builtin.Types + ( tupleTyCon, sumTyCon, runtimeRepTyCon , vecCountTyCon, vecElemTyCon , nilDataCon, consDataCon ) import GHC.Types.Name @@ -39,7 +40,7 @@ import GHC.Driver.Session import Bag import GHC.Types.Var ( VarBndr(..) ) import GHC.Core.Map -import Constants +import GHC.Settings.Constants import Fingerprint(Fingerprint(..), fingerprintString, fingerprintFingerprints) import Outputable import FastString ( FastString, mkFastString, fsLit ) diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs index 091968ed21bced0438208c2ced9e40d9f45da696..17f2dd69d5a03e6e7bce09ff8949873ee344981a 100644 --- a/compiler/GHC/Tc/Module.hs +++ b/compiler/GHC/Tc/Module.hs @@ -62,15 +62,15 @@ import GHC.Rename.HsType import GHC.Rename.Expr import GHC.Rename.Utils ( HsDocContext(..) ) import GHC.Rename.Fixity ( lookupFixityRn ) -import TysWiredIn ( unitTy, mkListTy ) +import GHC.Builtin.Types ( unitTy, mkListTy ) import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Hs import GHC.Iface.Syntax ( ShowSub(..), showToHeader ) import GHC.Iface.Type ( ShowForAllFlag(..) ) import GHC.Core.PatSyn( pprPatSynType ) -import PrelNames -import PrelInfo +import GHC.Builtin.Names +import GHC.Builtin.Utils import GHC.Types.Name.Reader import GHC.Tc.Utils.Zonk import GHC.Tc.Gen.Expr @@ -90,7 +90,7 @@ import GHC.Core.FamInstEnv import GHC.Tc.Gen.Annotation import GHC.Tc.Gen.Bind import GHC.Iface.Make ( coAxiomToIfaceDecl ) -import HeaderInfo ( mkPrelImports ) +import GHC.Parser.Header ( mkPrelImports ) import GHC.Tc.Gen.Default import GHC.Tc.Utils.Env import GHC.Tc.Gen.Rule diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs index ad2c7816d2f0c045349a3273581525b5a97c1ed2..c060eac63869e8904bc2801be9f1800c2df28f5a 100644 --- a/compiler/GHC/Tc/Solver.hs +++ b/compiler/GHC/Tc/Solver.hs @@ -36,8 +36,8 @@ import GHC.Tc.Utils.Instantiate import ListSetOps import GHC.Types.Name import Outputable -import PrelInfo -import PrelNames +import GHC.Builtin.Utils +import GHC.Builtin.Names import GHC.Tc.Errors import GHC.Tc.Types.Evidence import GHC.Tc.Solver.Interact @@ -50,8 +50,8 @@ import GHC.Core.Predicate import GHC.Tc.Types.Origin import GHC.Tc.Utils.TcType import GHC.Core.Type -import TysWiredIn ( liftedRepTy ) -import GHC.Core.Unify ( tcMatchTyKi ) +import GHC.Builtin.Types ( liftedRepTy ) +import GHC.Core.Unify ( tcMatchTyKi ) import Util import GHC.Types.Var import GHC.Types.Var.Set @@ -665,7 +665,7 @@ tcNormalise given_ids ty Expand superclasses before starting, because (Int ~ Bool), has (Int ~~ Bool) as a superclass, which in turn has (Int ~N# Bool) as a superclass, and it's the latter that is insoluble. See -Note [The equality types story] in TysPrim. +Note [The equality types story] in GHC.Builtin.Types.Prim. If we fail to prove unsatisfiability we (arbitrarily) try just once to find superclasses, using try_harder. Reason: we might have a type diff --git a/compiler/GHC/Tc/Solver/Interact.hs b/compiler/GHC/Tc/Solver/Interact.hs index f9e0562c7ba2f4e103ff97f309793221c24fa791..acb9ca55430e5e029809eab15d82cd7882e1b08d 100644 --- a/compiler/GHC/Tc/Solver/Interact.hs +++ b/compiler/GHC/Tc/Solver/Interact.hs @@ -24,7 +24,7 @@ import GHC.Core.Coercion.Axiom ( sfInteractTop, sfInteractInert ) import GHC.Types.Var import GHC.Tc.Utils.TcType -import PrelNames ( coercibleTyConKey, +import GHC.Builtin.Names ( coercibleTyConKey, heqTyConKey, eqTyConKey, ipClassKey ) import GHC.Core.Coercion.Axiom ( TypeEqn, CoAxiom(..), CoAxBranch(..), fromBranches ) import GHC.Core.Class @@ -2489,7 +2489,7 @@ matchClassInst dflags inerts clas tys loc -- | If a class is "naturally coherent", then we needn't worry at all, in any -- way, about overlapping/incoherent instances. Just solve the thing! -- See Note [Naturally coherent classes] --- See also Note [The equality class story] in TysPrim. +-- See also Note [The equality class story] in GHC.Builtin.Types.Prim. naturallyCoherentClass :: Class -> Bool naturallyCoherentClass cls = isCTupleClass cls @@ -2590,7 +2590,7 @@ For example, consider (~~), which behaves as if it was defined like this: class a ~# b => a ~~ b instance a ~# b => a ~~ b -(See Note [The equality types story] in TysPrim.) +(See Note [The equality types story] in GHC.Builtin.Types.Prim.) Faced with [W] t1 ~~ t2, it's always OK to reduce it to [W] t1 ~# t2, without worrying about Note [Instance and Given overlap]. Why? Because diff --git a/compiler/GHC/Tc/Solver/Monad.hs b/compiler/GHC/Tc/Solver/Monad.hs index 0aea4743203a9ed199033dffdbf4dc1586943bd7..822ccb22482a6377332784e87d843d2e89fd3c0a 100644 --- a/compiler/GHC/Tc/Solver/Monad.hs +++ b/compiler/GHC/Tc/Solver/Monad.hs @@ -246,7 +246,7 @@ Note [Prioritise class equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We prioritise equalities in the solver (see selectWorkItem). But class constraints like (a ~ b) and (a ~~ b) are actually equalities too; -see Note [The equality types story] in TysPrim. +see Note [The equality types story] in GHC.Builtin.Types.Prim. Failing to prioritise these is inefficient (more kick-outs etc). But, worse, it can prevent us spotting a "recursive knot" among diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs index 612348c4f3b2cacbab1795e26687920c0e707e31..07d1453a5cbb5ecb3e7d32f8e3885a6867187476 100644 --- a/compiler/GHC/Tc/TyCl.hs +++ b/compiler/GHC/Tc/TyCl.hs @@ -42,7 +42,7 @@ import GHC.Tc.Utils.Unify ( checkTvConstraints ) import GHC.Tc.Gen.HsType import GHC.Tc.Instance.Class( AssocInstInfo(..) ) import GHC.Tc.Utils.TcMType -import TysWiredIn ( unitTy, makeRecoveryTyCon ) +import GHC.Builtin.Types ( unitTy, makeRecoveryTyCon ) import GHC.Tc.Utils.TcType import GHC.Rename.Env( lookupConstructorFields ) import GHC.Tc.Instance.Family diff --git a/compiler/GHC/Tc/TyCl/Build.hs b/compiler/GHC/Tc/TyCl/Build.hs index a118630fda3f43b217a103c4325c92d6ddc93d50..908f1398d778b8f06a33d9066dd8b8fdd69e0b5d 100644 --- a/compiler/GHC/Tc/TyCl/Build.hs +++ b/compiler/GHC/Tc/TyCl/Build.hs @@ -21,8 +21,8 @@ import GhcPrelude import GHC.Iface.Env import GHC.Core.FamInstEnv( FamInstEnvs, mkNewTypeCoAxiom ) -import TysWiredIn( isCTupleTyConName ) -import TysPrim ( voidPrimTy ) +import GHC.Builtin.Types( isCTupleTyConName ) +import GHC.Builtin.Types.Prim ( voidPrimTy ) import GHC.Core.DataCon import GHC.Core.PatSyn import GHC.Types.Var diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs index 6bee37fafd4da35a3751f08aa2a8698099d35f5f..0a719d90d2f063a558bd0eabd9e24cd726a9967f 100644 --- a/compiler/GHC/Tc/TyCl/PatSyn.hs +++ b/compiler/GHC/Tc/TyCl/PatSyn.hs @@ -30,7 +30,7 @@ import GHC.Tc.Gen.Sig( emptyPragEnv, completeSigFromId ) import GHC.Tc.Utils.Env import GHC.Tc.Utils.TcMType import GHC.Tc.Utils.Zonk -import TysPrim +import GHC.Builtin.Types.Prim import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Core.PatSyn @@ -47,7 +47,7 @@ import GHC.Types.Basic import GHC.Tc.Solver import GHC.Tc.Utils.Unify import GHC.Core.Predicate -import TysWiredIn +import GHC.Builtin.Types import GHC.Tc.Utils.TcType import GHC.Tc.Types.Evidence import GHC.Tc.Types.Origin diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs index 3101a96ac5f863eadd959acd2bce23da50dd3705..d12e7efce49372455dc863dd26ba25a16617da0f 100644 --- a/compiler/GHC/Tc/TyCl/Utils.hs +++ b/compiler/GHC/Tc/TyCl/Utils.hs @@ -38,7 +38,7 @@ import GHC.Tc.Gen.Bind( tcValBinds ) import GHC.Core.TyCo.Rep( Type(..), Coercion(..), MCoercion(..), UnivCoProvenance(..) ) import GHC.Tc.Utils.TcType import GHC.Core.Predicate -import TysWiredIn( unitTy ) +import GHC.Builtin.Types( unitTy ) import GHC.Core.Make( rEC_SEL_ERROR_ID ) import GHC.Hs import GHC.Core.Class diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs index dcf6fc94b6e526c1e16f1ffb062f0b1dd4d01065..e5f5fdbf50ef53aab6852d7c160bd5925934480c 100644 --- a/compiler/GHC/Tc/Types.hs +++ b/compiler/GHC/Tc/Types.hs @@ -120,7 +120,7 @@ import Outputable import ListSetOps import Fingerprint import Util -import PrelNames ( isUnboundName ) +import GHC.Builtin.Names ( isUnboundName ) import GHC.Types.CostCentre.State import Control.Monad (ap) diff --git a/compiler/GHC/Tc/Types/EvTerm.hs b/compiler/GHC/Tc/Types/EvTerm.hs index db5c6d1ce14260659c3946abf1bacaa8192200b1..09f016ca7198e7ae9410f9cd89dec8591b0e7953 100644 --- a/compiler/GHC/Tc/Types/EvTerm.hs +++ b/compiler/GHC/Tc/Types/EvTerm.hs @@ -17,7 +17,7 @@ import GHC.Driver.Session import GHC.Types.Name import GHC.Types.Module import GHC.Core.Utils -import PrelNames +import GHC.Builtin.Names import GHC.Types.SrcLoc -- Used with Opt_DeferTypeErrors diff --git a/compiler/GHC/Tc/Types/Evidence.hs b/compiler/GHC/Tc/Types/Evidence.hs index cf59896f9d6a3cbc5c5c9b21c3dc684e7a868723..922055ebf5470f678291c4b3380e48d9df74b326 100644 --- a/compiler/GHC/Tc/Types/Evidence.hs +++ b/compiler/GHC/Tc/Types/Evidence.hs @@ -64,7 +64,7 @@ import GHC.Core.Type import GHC.Core.TyCon import GHC.Core.DataCon( DataCon, dataConWrapId ) import GHC.Core.Class( Class ) -import PrelNames +import GHC.Builtin.Names import GHC.Types.Var.Env import GHC.Types.Var.Set import GHC.Core.Predicate diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs index 93cb63812cad9194f2d3b1445a6f4dc26c3b563d..fc134817be9e23157df8410da2cd2230fdd597e5 100644 --- a/compiler/GHC/Tc/Utils/Backpack.hs +++ b/compiler/GHC/Tc/Utils/Backpack.hs @@ -56,7 +56,7 @@ import Maybes import GHC.Tc.Utils.Env import GHC.Types.Var import GHC.Iface.Syntax -import PrelNames +import GHC.Builtin.Names import qualified Data.Map as Map import GHC.Driver.Finder diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs index 95722733be8e8572a3e586917315e867c0eadd06..cf55316b2265ed22129dd7e5e5fa124543bb2074 100644 --- a/compiler/GHC/Tc/Utils/Env.hs +++ b/compiler/GHC/Tc/Utils/Env.hs @@ -79,8 +79,8 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcMType import GHC.Tc.Utils.TcType import GHC.Iface.Load -import PrelNames -import TysWiredIn +import GHC.Builtin.Names +import GHC.Builtin.Types import GHC.Types.Id import GHC.Types.Var import GHC.Types.Name.Reader diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs index 563ddff69d69e437b7a81277914292bb3506a412..e896c7851ee6f8ee23f58fb90a2ee8fbe7aaaf07 100644 --- a/compiler/GHC/Tc/Utils/Instantiate.hs +++ b/compiler/GHC/Tc/Utils/Instantiate.hs @@ -50,7 +50,7 @@ import GHC.Tc.Types.Origin import GHC.Tc.Utils.Env import GHC.Tc.Types.Evidence import GHC.Core.InstEnv -import TysWiredIn ( heqDataCon, eqDataCon ) +import GHC.Builtin.Types ( heqDataCon, eqDataCon ) import GHC.Core ( isOrphan ) import GHC.Tc.Instance.FunDeps import GHC.Tc.Utils.TcMType @@ -67,7 +67,7 @@ import GHC.Types.Name import GHC.Types.Var ( EvVar, tyVarName, VarBndr(..) ) import GHC.Core.DataCon import GHC.Types.Var.Env -import PrelNames +import GHC.Builtin.Names import GHC.Types.SrcLoc as SrcLoc import GHC.Driver.Session import Util diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index bd52015c89ca44385b0ce39c8e59cf55eb2b9a2f..0b84f6909655d620319d4d93c1544738a5c1f12f 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -161,7 +161,7 @@ import GHC.Core.Type import GHC.Tc.Utils.TcType import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import PrelNames +import GHC.Builtin.Names import GHC.Types.Id import GHC.Types.Var.Set diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs index 14691708477fb2c723ee13895eef1092dade4fe0..53b93f51a3d91e93037e4870e4f173366bbf724d 100644 --- a/compiler/GHC/Tc/Utils/TcMType.hs +++ b/compiler/GHC/Tc/Utils/TcMType.hs @@ -114,11 +114,11 @@ import GHC.Tc.Types.Evidence import GHC.Types.Id as Id import GHC.Types.Name import GHC.Types.Var.Set -import TysWiredIn -import TysPrim +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim import GHC.Types.Var.Env import GHC.Types.Name.Env -import PrelNames +import GHC.Builtin.Names import Util import Outputable import FastString diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs index 1f076e2101cc68eed889b09b842e2d64f9ae4175..8e1cef1a865b734c337f0d59ef16e58093d8768e 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -213,9 +213,9 @@ import GHC.Types.Name as Name -- Perhaps there's a better way to do this? import GHC.Types.Name.Set import GHC.Types.Var.Env -import PrelNames -import TysWiredIn( coercibleClass, eqClass, heqClass, unitTyCon, unitTyConKey - , listTyCon, constraintKind ) +import GHC.Builtin.Names +import GHC.Builtin.Types ( coercibleClass, eqClass, heqClass, unitTyCon, unitTyConKey + , listTyCon, constraintKind ) import GHC.Types.Basic import Util import Maybes @@ -1115,7 +1115,7 @@ findDupTyVarTvs prs {- ************************************************************************ * * -\subsection{Tau, sigma and rho} + Tau, sigma and rho * * ************************************************************************ -} @@ -1176,7 +1176,7 @@ mkTcCastTy = mkCastTy -- Do we need a tc version of mkCastTy? {- ************************************************************************ * * -\subsection{Expanding and splitting} + Expanding and splitting * * ************************************************************************ @@ -2119,7 +2119,7 @@ isAlmostFunctionFree (CoercionTy {}) = True {- ************************************************************************ * * -\subsection{Misc} + Misc * * ************************************************************************ @@ -2171,7 +2171,7 @@ end of the compiler. {- ************************************************************************ * * -\subsection[TysWiredIn-ext-type]{External types} + External types * * ************************************************************************ diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs index f6d934af9a48be85aa3f4d21e48056070a9c9240..c6b0f8bae4561dd43619c456b3a5807f394ad34d 100644 --- a/compiler/GHC/Tc/Utils/Unify.hs +++ b/compiler/GHC/Tc/Utils/Unify.hs @@ -57,8 +57,8 @@ import GHC.Tc.Types.Origin import GHC.Types.Name( isSystemName ) import GHC.Tc.Utils.Instantiate import GHC.Core.TyCon -import TysWiredIn -import TysPrim( tYPE ) +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim( tYPE ) import GHC.Types.Var as Var import GHC.Types.Var.Set import GHC.Types.Var.Env diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs index 1cbb8415a363e16e088dcec8610242578d429935..4cf02d41e00b4dd726b73a193394a76d222a4a85 100644 --- a/compiler/GHC/Tc/Utils/Zonk.hs +++ b/compiler/GHC/Tc/Utils/Zonk.hs @@ -53,16 +53,16 @@ import GHC.Types.Id import GHC.Types.Id.Info import GHC.Core.Predicate import GHC.Tc.Utils.Monad -import PrelNames +import GHC.Builtin.Names import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo ) import GHC.Tc.Utils.TcType import GHC.Tc.Utils.TcMType import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) import GHC.Tc.Types.Evidence import GHC.Core.TyCo.Ppr ( pprTyVar ) -import TysPrim +import GHC.Builtin.Types.Prim import GHC.Core.TyCon -import TysWiredIn +import GHC.Builtin.Types import GHC.Core.Type import GHC.Core.Coercion import GHC.Core.ConLike diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs index 2fe9d165956e9ddfc05eb467109572d72efb59ff..6e44a6c39903cdbdab5c4ba1a7b0690de2e1c0cf 100644 --- a/compiler/GHC/Tc/Validity.hs +++ b/compiler/GHC/Tc/Validity.hs @@ -34,8 +34,8 @@ import GHC.Core.TyCo.FVs import GHC.Core.TyCo.Rep import GHC.Core.TyCo.Ppr import GHC.Tc.Utils.TcType hiding ( sizeType, sizeTypes ) -import TysWiredIn ( heqTyConName, eqTyConName, coercibleTyConName ) -import PrelNames +import GHC.Builtin.Types ( heqTyConName, eqTyConName, coercibleTyConName ) +import GHC.Builtin.Names import GHC.Core.Type import GHC.Core.Unify ( tcMatchTyX_BM, BindFlag(..) ) import GHC.Core.Coercion diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs index 920fb8ad0b30b87e2db820b4575c59ced98a7d93..7b5e4ce21951f0628096000a140ac427e3071ff1 100644 --- a/compiler/GHC/ThToHs.hs +++ b/compiler/GHC/ThToHs.hs @@ -27,16 +27,16 @@ where import GhcPrelude import GHC.Hs as Hs -import PrelNames +import GHC.Builtin.Names import GHC.Types.Name.Reader import qualified GHC.Types.Name as Name import GHC.Types.Module -import RdrHsSyn +import GHC.Parser.PostProcess import GHC.Types.Name.Occurrence as OccName import GHC.Types.SrcLoc import GHC.Core.Type import qualified GHC.Core.Coercion as Coercion ( Role(..) ) -import TysWiredIn +import GHC.Builtin.Types import GHC.Types.Basic as Hs import GHC.Types.ForeignCall import GHC.Types.Unique @@ -672,7 +672,7 @@ cvt_fundep (FunDep xs ys) = do { xs' <- mapM tNameL xs cvtForD :: Foreign -> CvtM (ForeignDecl GhcPs) cvtForD (ImportF callconv safety from nm ty) -- the prim and javascript calling conventions do not support headers - -- and are inserted verbatim, analogous to mkImport in RdrHsSyn + -- and are inserted verbatim, analogous to mkImport in GHC.Parser.PostProcess | callconv == TH.Prim || callconv == TH.JavaScript = mk_imp (CImport (noLoc (cvt_conv callconv)) (noLoc safety') Nothing (CFunction (StaticTarget (SourceText from) diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs index 03988d9028a0952ffb496e01ca1e88eb38ba3ec2..103b1940a08797db59cdefd13d8b9773e067cc6b 100644 --- a/compiler/GHC/Types/Basic.hs +++ b/compiler/GHC/Types/Basic.hs @@ -619,7 +619,7 @@ instance Outputable Origin where -- @'\{-\# INCOHERENT'@, -- 'ApiAnnotation.AnnClose' @`\#-\}`@, --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation data OverlapFlag = OverlapFlag { overlapMode :: OverlapMode , isSafeOverlap :: Bool @@ -1285,7 +1285,7 @@ data Activation = NeverActive data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma] | FunLike deriving( Eq, Data, Show ) - -- Show needed for Lexer.x + -- Show needed for GHC.Parser.Lexer data InlinePragma -- Note [InlinePragma] = InlinePragma @@ -1313,7 +1313,7 @@ data InlineSpec -- What the user's INLINE pragma looked like | NoUserInline -- User did not write any of INLINE/INLINABLE/NOINLINE -- e.g. in `defaultInlinePragma` or when created by CSE deriving( Eq, Data, Show ) - -- Show needed for Lexer.x + -- Show needed for GHC.Parser.Lexer {- Note [InlinePragma] ~~~~~~~~~~~~~~~~~~~~~~ @@ -1591,7 +1591,7 @@ data FractionalLit , fl_value :: Rational -- Numeric value of the literal } deriving (Data, Show) - -- The Show instance is required for the derived Lexer.x:Token instance when DEBUG is on + -- The Show instance is required for the derived GHC.Parser.Lexer.Token instance when DEBUG is on mkFractionalLit :: Real a => a -> FractionalLit mkFractionalLit r = FL { fl_text = SourceText (show (realToFrac r::Double)) diff --git a/compiler/GHC/Types/ForeignCall.hs b/compiler/GHC/Types/ForeignCall.hs index b745a6138fd7dc0c04123134a8939e42824462a9..46cdfd2af35d0697369afff7ee778b6c30c667b6 100644 --- a/compiler/GHC/Types/ForeignCall.hs +++ b/compiler/GHC/Types/ForeignCall.hs @@ -231,7 +231,7 @@ instance Outputable Header where -- 'ApiAnnotation.AnnHeader','ApiAnnotation.AnnVal', -- 'ApiAnnotation.AnnClose' @'\#-}'@, --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation data CType = CType SourceText -- Note [Pragma source text] in GHC.Types.Basic (Maybe Header) -- header to include for this type (SourceText,FastString) -- the type itself diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs index 000221234d3f9de1112a230e1bc3127a7dbcd885..fab72d23ded260608f16692903e9921f85ccd8fa 100644 --- a/compiler/GHC/Types/Id.hs +++ b/compiler/GHC/Types/Id.hs @@ -137,14 +137,14 @@ import qualified GHC.Types.Var as Var import GHC.Core.Type import GHC.Types.RepType -import TysPrim +import GHC.Builtin.Types.Prim import GHC.Core.DataCon import GHC.Types.Demand import GHC.Types.Cpr import GHC.Types.Name import GHC.Types.Module import GHC.Core.Class -import {-# SOURCE #-} PrimOp (PrimOp) +import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp) import GHC.Types.ForeignCall import Maybes import GHC.Types.SrcLoc @@ -519,7 +519,7 @@ hasNoBinding :: Id -> Bool -- they aren't any more. Instead, we inject a binding for -- them at the CorePrep stage. -- --- 'PrimOpId's also used to be of this kind. See Note [Primop wrappers] in PrimOp.hs. +-- 'PrimOpId's also used to be of this kind. See Note [Primop wrappers] in GHC.Builtin.PrimOps. -- for the history of this. -- -- Note that CorePrep currently eta expands things no-binding things and this @@ -528,7 +528,7 @@ hasNoBinding :: Id -> Bool -- -- EXCEPT: unboxed tuples, which definitely have no binding hasNoBinding id = case Var.idDetails id of - PrimOpId _ -> False -- See Note [Primop wrappers] in PrimOp.hs + PrimOpId _ -> False -- See Note [Primop wrappers] in GHC.Builtin.PrimOps FCallId _ -> True DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc _ -> isCompulsoryUnfolding (idUnfolding id) diff --git a/compiler/GHC/Types/Id/Info.hs b/compiler/GHC/Types/Id/Info.hs index af1ebb18cd6e683a1d038caf97e7ad3e78282588..a0a3b94ca988c85c68ca8aee5fa7d2df45a07b15 100644 --- a/compiler/GHC/Types/Id/Info.hs +++ b/compiler/GHC/Types/Id/Info.hs @@ -90,7 +90,7 @@ import GHC.Core hiding( hasCoreUnfolding ) import GHC.Core( hasCoreUnfolding ) import GHC.Core.Class -import {-# SOURCE #-} PrimOp (PrimOp) +import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp) import GHC.Types.Name import GHC.Types.Var.Set import GHC.Types.Basic diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs index e7e2c0cc8b015fad38ae652be79d1bc7c0045540..ce5012458a9527ebac27fcff580a19c407e20d26 100644 --- a/compiler/GHC/Types/Id/Make.hs +++ b/compiler/GHC/Types/Id/Make.hs @@ -42,8 +42,8 @@ module GHC.Types.Id.Make ( import GhcPrelude -import TysPrim -import TysWiredIn +import GHC.Builtin.Types.Prim +import GHC.Builtin.Types import GHC.Core.Opt.ConstantFold import GHC.Core.Type import GHC.Core.TyCo.Rep @@ -59,7 +59,7 @@ import GHC.Core.TyCon import GHC.Core.Class import GHC.Types.Name.Set import GHC.Types.Name -import PrimOp +import GHC.Builtin.PrimOps import GHC.Types.ForeignCall import GHC.Core.DataCon import GHC.Types.Id @@ -69,7 +69,7 @@ import GHC.Types.Cpr import GHC.Core import GHC.Types.Unique import GHC.Types.Unique.Supply -import PrelNames +import GHC.Builtin.Names import GHC.Types.Basic hiding ( SuccessFlag(..) ) import Util import GHC.Driver.Session diff --git a/compiler/GHC/Types/Id/Make.hs-boot b/compiler/GHC/Types/Id/Make.hs-boot index 25ae32207e4504a93688f46ab2dc813cb9366454..78c4b595832a5c9bccf50c1f4c8e627e1783fa83 100644 --- a/compiler/GHC/Types/Id/Make.hs-boot +++ b/compiler/GHC/Types/Id/Make.hs-boot @@ -3,7 +3,7 @@ import GHC.Types.Name( Name ) import GHC.Types.Var( Id ) import GHC.Core.Class( Class ) import {-# SOURCE #-} GHC.Core.DataCon( DataCon ) -import {-# SOURCE #-} PrimOp( PrimOp ) +import {-# SOURCE #-} GHC.Builtin.PrimOps( PrimOp ) data DataConBoxer diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs index 3191f006db6d3e132b31c736e0bd1fb32dc391d3..9c1d08822d97f08c66697ab8d00219c3edaf7c6d 100644 --- a/compiler/GHC/Types/Literal.hs +++ b/compiler/GHC/Types/Literal.hs @@ -52,15 +52,15 @@ module GHC.Types.Literal import GhcPrelude -import TysPrim -import PrelNames +import GHC.Builtin.Types.Prim +import GHC.Builtin.Names import GHC.Core.Type import GHC.Core.TyCon import Outputable import FastString import GHC.Types.Basic import Binary -import Constants +import GHC.Settings.Constants import GHC.Platform import GHC.Types.Unique.FM import Util diff --git a/compiler/GHC/Types/Module.hs b/compiler/GHC/Types/Module.hs index 3d73d7b57277ff73d6c8ba5486c7984433cb78c5..80ae18684f886142e3eba131b92062f8ffc96107 100644 --- a/compiler/GHC/Types/Module.hs +++ b/compiler/GHC/Types/Module.hs @@ -1101,7 +1101,7 @@ Make sure you change 'Packages.findWiredInPackages' if you add an entry here. For `integer-gmp`/`integer-simple` we also change the base name to `integer-wired-in`, but this is fundamentally no different. -See Note [The integer library] in PrelNames. +See Note [The integer library] in GHC.Builtin.Names. -} integerUnitId, primUnitId, @@ -1109,7 +1109,7 @@ integerUnitId, primUnitId, thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId primUnitId = fsToUnitId (fsLit "ghc-prim") integerUnitId = fsToUnitId (fsLit "integer-wired-in") - -- See Note [The integer library] in PrelNames + -- See Note [The integer library] in GHC.Builtin.Names baseUnitId = fsToUnitId (fsLit "base") rtsUnitId = fsToUnitId (fsLit "rts") thUnitId = fsToUnitId (fsLit "template-haskell") diff --git a/compiler/GHC/Types/Name/Cache.hs b/compiler/GHC/Types/Name/Cache.hs index abf7bc89b555018c3112008c29836d41c32fd8d9..9cac5eadf12eca067d971cc7ed2ebf88b4c12939 100644 --- a/compiler/GHC/Types/Name/Cache.hs +++ b/compiler/GHC/Types/Name/Cache.hs @@ -15,10 +15,10 @@ import GhcPrelude import GHC.Types.Module import GHC.Types.Name import GHC.Types.Unique.Supply -import TysWiredIn +import GHC.Builtin.Types import Util import Outputable -import PrelNames +import GHC.Builtin.Names #include "HsVersions.h" @@ -79,7 +79,7 @@ lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name lookupOrigNameCache nc mod occ | mod == gHC_TYPES || mod == gHC_PRIM || mod == gHC_TUPLE , Just name <- isBuiltInOcc_maybe occ - = -- See Note [Known-key names], 3(c) in PrelNames + = -- See Note [Known-key names], 3(c) in GHC.Builtin.Names -- Special case for tuples; there are too many -- of them to pre-populate the original-name cache Just name diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs index e2ef941723b531e999a4cc863ba3417dcf241eb0..29c427d5f949b4c5fa79dfef587f349bbe907682 100644 --- a/compiler/GHC/Types/Name/Reader.hs +++ b/compiler/GHC/Types/Name/Reader.hs @@ -117,7 +117,7 @@ import Data.List( sortBy ) -- 'ApiAnnotation.AnnVal' -- 'ApiAnnotation.AnnTilde', --- For details on above see note [Api annotations] in ApiAnnotation +-- For details on above see note [Api annotations] in GHC.Parser.Annotation data RdrName = Unqual OccName -- ^ Unqualified name diff --git a/compiler/GHC/Types/RepType.hs b/compiler/GHC/Types/RepType.hs index 645d2af7c871f07ea8971cc0a8c92a198abf44b8..c1bcb314d368f19011f705165ce28df147e75384 100644 --- a/compiler/GHC/Types/RepType.hs +++ b/compiler/GHC/Types/RepType.hs @@ -28,14 +28,14 @@ import GhcPrelude import GHC.Types.Basic (Arity, RepArity) import GHC.Core.DataCon import Outputable -import PrelNames +import GHC.Builtin.Names import GHC.Core.Coercion import GHC.Core.TyCon import GHC.Core.TyCo.Rep import GHC.Core.Type import Util -import TysPrim -import {-# SOURCE #-} TysWiredIn ( anyTypeOfKind ) +import GHC.Builtin.Types.Prim +import {-# SOURCE #-} GHC.Builtin.Types ( anyTypeOfKind ) import Data.List (sort) import qualified Data.IntSet as IS @@ -366,7 +366,7 @@ data RuntimeRep = VecRep VecCount VecElem -- ^ a SIMD vector type It's all in 1-1 correspondence with PrimRep except for TupleRep and SumRep, which describe unboxed products and sums respectively. RuntimeRep is defined in the library ghc-prim:GHC.Types. It is also "wired-in" to GHC: see -TysWiredIn.runtimeRepTyCon. The unarisation pass, in GHC.Stg.Unarise, transforms the +GHC.Builtin.Types.runtimeRepTyCon. The unarisation pass, in GHC.Stg.Unarise, transforms the program, so that that every variable has a type that has a PrimRep. For example, unarisation transforms our utup function above, to take two Int arguments instead of one (# Int, Int #) argument. @@ -425,13 +425,13 @@ runtimeRepPrimRep works by using tyConRuntimeRepInfo. That function should be passed the TyCon produced by promoting one of the constructors of RuntimeRep into type-level data. The RuntimeRep promoted datacons are associated with a RuntimeRepInfo (stored directly in the PromotedDataCon -constructor of TyCon). This pairing happens in TysWiredIn. A RuntimeRepInfo +constructor of TyCon). This pairing happens in GHC.Builtin.Types. A RuntimeRepInfo usually(*) contains a function from [Type] to [PrimRep]: the [Type] are the arguments to the promoted datacon. These arguments are necessary for the TupleRep and SumRep constructors, so that this process can recur, producing a flattened list of PrimReps. Calling this extracted function happens in runtimeRepPrimRep; the functions themselves are defined in -tupleRepDataCon and sumRepDataCon, both in TysWiredIn. +tupleRepDataCon and sumRepDataCon, both in GHC.Builtin.Types. The (*) above is to support vector representations. RuntimeRep refers to VecCount and VecElem, whose promoted datacons have nuggets of information @@ -454,9 +454,9 @@ runtimeRepPrimRep calls tyConRuntimeRepInfo on (PromotedDataCon "IntRep"), resp. (PromotedDataCon "TupleRep"), extracting a function that will produce the PrimReps. In example 1, this function is passed an empty list (the empty list of args to IntRep) and returns the PrimRep IntRep. (See the definition of runtimeRepSimpleDataCons in -TysWiredIn and its helper function mk_runtime_rep_dc.) Example 2 passes the promoted +GHC.Builtin.Types and its helper function mk_runtime_rep_dc.) Example 2 passes the promoted list as the one argument to the extracted function. The extracted function is defined -as prim_rep_fun within tupleRepDataCon in TysWiredIn. It takes one argument, decomposes +as prim_rep_fun within tupleRepDataCon in GHC.Builtin.Types. It takes one argument, decomposes the promoted list (with extractPromotedList), and then recurs back to runtimeRepPrimRep to process the LiftedRep and WordRep, concatentating the results. diff --git a/compiler/GHC/Types/SrcLoc.hs b/compiler/GHC/Types/SrcLoc.hs index 0488d4d8827240e72915fca7dbaecf3ffee6755c..9211104cb359b7a2f7991e90777d97f23f7ad10a 100644 --- a/compiler/GHC/Types/SrcLoc.hs +++ b/compiler/GHC/Types/SrcLoc.hs @@ -145,7 +145,7 @@ data RealSrcLoc -- -- Unlike 'RealSrcLoc', it is not affected by #line and {-# LINE ... #-} -- pragmas. In particular, notice how 'setSrcLoc' and 'resetAlrLastLoc' in --- Lexer.x update 'PsLoc' preserving 'BufPos'. +-- GHC.Parser.Lexer update 'PsLoc' preserving 'BufPos'. -- -- The parser guarantees that 'BufPos' are monotonic. See #17632. newtype BufPos = BufPos { bufPos :: Int } @@ -305,7 +305,7 @@ data SrcSpan = | UnhelpfulSpan !FastString -- Just a general indication -- also used to indicate an empty span - deriving (Eq, Show) -- Show is used by Lexer.x, because we + deriving (Eq, Show) -- Show is used by GHC.Parser.Lexer, because we -- derive Show for Token {- Note [Why Maybe BufPos] @@ -530,7 +530,7 @@ instance Show RealSrcLoc where show (SrcLoc filename row col) = "SrcLoc " ++ show filename ++ " " ++ show row ++ " " ++ show col --- Show is used by Lexer.x, because we derive Show for Token +-- Show is used by GHC.Parser.Lexer, because we derive Show for Token instance Show RealSrcSpan where show span@(RealSrcSpan' file sl sc el ec) | isPointRealSpan span diff --git a/compiler/GHC/Types/Unique.hs b/compiler/GHC/Types/Unique.hs index d031f70072488bd6a9741c220a823249b25b3aac..574d630ca1df2602eb36466fded9a63d8f9351f8 100644 --- a/compiler/GHC/Types/Unique.hs +++ b/compiler/GHC/Types/Unique.hs @@ -376,7 +376,7 @@ mkPreludeClassUnique :: Int -> Unique mkPreludeTyConUnique :: Int -> Unique mkPreludeDataConUnique :: Arity -> Unique mkPrimOpIdUnique :: Int -> Unique --- See Note [Primop wrappers] in PrimOp.hs. +-- See Note [Primop wrappers] in GHC.Builtin.PrimOps. mkPrimOpWrapperUnique :: Int -> Unique mkPreludeMiscIdUnique :: Int -> Unique mkCoVarUnique :: Int -> Unique diff --git a/compiler/GHC/Utils/Lexeme.hs b/compiler/GHC/Utils/Lexeme.hs index 2ea773a2f0251f9012329d5d2ef7ada02f2603d9..44bdbf0895b9476525b92abb070f3880c4c0422b 100644 --- a/compiler/GHC/Utils/Lexeme.hs +++ b/compiler/GHC/Utils/Lexeme.hs @@ -2,7 +2,7 @@ -- -- Functions to evaluate whether or not a string is a valid identifier. -- There is considerable overlap between the logic here and the logic --- in Lexer.x, but sadly there seems to be no way to merge them. +-- in GHC.Parser.Lexer, but sadly there seems to be no way to merge them. module GHC.Utils.Lexeme ( -- * Lexical characteristics of Haskell names @@ -208,7 +208,7 @@ okIdOcc str -- of course, `all` says "True" to an empty list -- | Is this character acceptable in an identifier (after the first letter)? --- See alexGetByte in Lexer.x +-- See alexGetByte in GHC.Parser.Lexer okIdChar :: Char -> Bool okIdChar c = case generalCategory c of UppercaseLetter -> True diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 5c828657e3a90bd5854462df67b323bc2135a3fa..c1c4b6dc24931a114f849006b3e6dfc3024d81e6 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -160,11 +160,7 @@ Library hs-source-dirs: . - iface main - parser - prelude - typecheck utils -- we use an explicit Prelude @@ -177,8 +173,8 @@ Library GHC.Iface.Ext.Binary GHC.Iface.Ext.Utils GHC.Iface.Ext.Ast - Ar - FileCleanup + GHC.SysTools.Ar + GHC.SysTools.FileCleanup GHC.Driver.Backpack GHC.Driver.Backpack.Syntax GHC.Types.Name.Shape @@ -258,8 +254,6 @@ Library GHC.Cmm.LayoutStack CliOption EnumSet - GhcNameVersion - FileSettings GHC.Cmm.Graph GHC.CmmToAsm.Ppr GHC.CmmToAsm.Config @@ -345,7 +339,7 @@ Library GHC.Hs.Utils GHC.Hs.Dump GHC.Iface.Binary - BinFingerprint + GHC.Iface.Recomp.Binary GHC.Tc.TyCl.Build GHC.Iface.Env GHC.Iface.Syntax @@ -355,12 +349,12 @@ Library GHC.Iface.Make GHC.Iface.Recomp GHC.IfaceToCore - FlagChecker + GHC.Iface.Recomp.Flags GHC.Types.Annotations GHC.Driver.CmdLine GHC.Driver.CodeOutput Config - Constants + GHC.Settings.Constants GHC.Driver.MakeFile GHC.Driver.Phases GHC.Driver.Pipeline.Monad @@ -372,7 +366,7 @@ Library GHC.Driver.Make GHC.Plugins GhcPrelude - HeaderInfo + GHC.Parser.Header GHC.Driver.Main HscStats GHC.Driver.Types @@ -381,38 +375,36 @@ Library GHC.Runtime.Loader UnitInfo GHC.Driver.Packages - PlatformConstants GHC.Driver.Plugins GHC.Tc.Plugin GHC.Core.Ppr.TyThing - Settings + GHC.Settings StaticPtrTable - SysTools - SysTools.BaseDir - SysTools.Terminal - SysTools.ExtraObj - SysTools.Info - SysTools.Process - SysTools.Tasks - SysTools.Settings - Elf + GHC.SysTools + GHC.SysTools.BaseDir + GHC.SysTools.Terminal + GHC.SysTools.ExtraObj + GHC.SysTools.Info + GHC.SysTools.Process + GHC.SysTools.Tasks + GHC.Settings.IO + GHC.SysTools.Elf GHC.Iface.Tidy - Ctype - HaddockUtils - Lexer + GHC.Parser.CharClass + GHC.Parser.Lexer GHC.Core.Coercion.Opt - Parser - RdrHsSyn - ApiAnnotation + GHC.Parser + GHC.Parser.PostProcess + GHC.Parser.PostProcess.Haddock + GHC.Parser.Annotation GHC.Types.ForeignCall - KnownUniques - PrelInfo - PrelNames + GHC.Builtin.Uniques + GHC.Builtin.Utils + GHC.Builtin.Names GHC.Core.Opt.ConstantFold - PrimOp - ToolSettings - TysPrim - TysWiredIn + GHC.Builtin.PrimOps + GHC.Builtin.Types.Prim + GHC.Builtin.Types GHC.Types.CostCentre GHC.Types.CostCentre.State GHC.Rename.Bind @@ -513,12 +505,12 @@ Library GHC.Tc.Solver.Canonical GHC.Tc.Solver.Flatten GHC.Tc.Solver.Monad - TcTypeNats + GHC.Builtin.Types.Literals GHC.Tc.Gen.Splice GHC.Core.Class GHC.Core.Coercion GHC.HsToCore.Quote - THNames + GHC.Builtin.Names.TH GHC.Core.FamInstEnv GHC.Tc.Instance.FunDeps GHC.Core.InstEnv diff --git a/compiler/ghc.mk b/compiler/ghc.mk index 5274d1a892662a11e3f0ed6edd9e8a5a4adf1bf6..561926af444911397c1c7a35f1b7ab815f02cba3 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -22,7 +22,7 @@ compiler_stage1_MKDEPENDC_OPTS = -DMAKING_GHC_BUILD_SYSTEM_DEPENDENCIES compiler_stage2_MKDEPENDC_OPTS = -DMAKING_GHC_BUILD_SYSTEM_DEPENDENCIES compiler_stage3_MKDEPENDC_OPTS = -DMAKING_GHC_BUILD_SYSTEM_DEPENDENCIES -compiler_stage1_C_FILES_NODEPS = compiler/parser/cutils.c +compiler_stage1_C_FILES_NODEPS = compiler/cbits/cutils.c # This package doesn't pass the Cabal checks because include-dirs # points outside the source directory. This isn't a real problem, so @@ -128,7 +128,7 @@ PRIMOP_BITS_STAGE3 = $(addprefix compiler/stage3/build/,$(PRIMOP_BITS_NAMES)) define preprocessCompilerFiles # $1 = compiler stage (build system stage + 1) compiler/stage$1/build/primops.txt: \ - compiler/prelude/primops.txt.pp \ + compiler/GHC/Builtin/primops.txt.pp \ $(includes_$(dec$1)_H_CONFIG) \ $(includes_$(dec$1)_H_PLATFORM) $$(HS_CPP) -P $$(compiler_CPP_OPTS) \ diff --git a/compiler/main/FileSettings.hs b/compiler/main/FileSettings.hs deleted file mode 100644 index 6179721cfd15372f00f6bd675ec75e4b4ca80472..0000000000000000000000000000000000000000 --- a/compiler/main/FileSettings.hs +++ /dev/null @@ -1,16 +0,0 @@ -module FileSettings - ( FileSettings (..) - ) where - -import GhcPrelude - --- | Paths to various files and directories used by GHC, including those that --- provide more settings. -data FileSettings = FileSettings - { fileSettings_ghcUsagePath :: FilePath -- ditto - , fileSettings_ghciUsagePath :: FilePath -- ditto - , fileSettings_toolDir :: Maybe FilePath -- ditto - , fileSettings_topDir :: FilePath -- ditto - , fileSettings_tmpDir :: String -- no trailing '/' - , fileSettings_globalPackageDatabase :: FilePath - } diff --git a/compiler/main/GhcNameVersion.hs b/compiler/main/GhcNameVersion.hs deleted file mode 100644 index 96e04186a7f29389fb2b36116c35b98e64fe32c0..0000000000000000000000000000000000000000 --- a/compiler/main/GhcNameVersion.hs +++ /dev/null @@ -1,11 +0,0 @@ -module GhcNameVersion - ( GhcNameVersion (..) - ) where - -import GhcPrelude - --- | Settings for what GHC this is. -data GhcNameVersion = GhcNameVersion - { ghcNameVersion_programName :: String - , ghcNameVersion_projectVersion :: String - } diff --git a/compiler/main/PlatformConstants.hs b/compiler/main/PlatformConstants.hs deleted file mode 100644 index 96b0f70e6de8f4b50a4c0d5dd887e2e696098096..0000000000000000000000000000000000000000 --- a/compiler/main/PlatformConstants.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE CPP #-} - -------------------------------------------------------------------------------- --- --- | Platform constants --- --- (c) The University of Glasgow 2013 --- -------------------------------------------------------------------------------- - -module PlatformConstants (PlatformConstants(..)) where - -import GhcPrelude - --- Produced by deriveConstants -#include "GHCConstantsHaskellType.hs" - diff --git a/compiler/main/StaticPtrTable.hs b/compiler/main/StaticPtrTable.hs index fd4b7344338dcbbaf4402e9f218eb71367634ae3..006b6f2b395300c173a27a3693b349ba4ed37daa 100644 --- a/compiler/main/StaticPtrTable.hs +++ b/compiler/main/StaticPtrTable.hs @@ -136,7 +136,7 @@ import GHC.Types.Module import GHC.Types.Name import Outputable import GHC.Platform -import PrelNames +import GHC.Builtin.Names import GHC.Tc.Utils.Env (lookupGlobal) import GHC.Core.Type diff --git a/compiler/main/ToolSettings.hs b/compiler/main/ToolSettings.hs deleted file mode 100644 index 82d125b5f60fb4a6e168f7c4db54da3c3a6e993f..0000000000000000000000000000000000000000 --- a/compiler/main/ToolSettings.hs +++ /dev/null @@ -1,64 +0,0 @@ -module ToolSettings - ( ToolSettings (..) - ) where - -import GhcPrelude - -import CliOption -import Fingerprint - --- | Settings for other executables GHC calls. --- --- Probably should further split down by phase, or split between --- platform-specific and platform-agnostic. -data ToolSettings = ToolSettings - { toolSettings_ldSupportsCompactUnwind :: Bool - , toolSettings_ldSupportsBuildId :: Bool - , toolSettings_ldSupportsFilelist :: Bool - , toolSettings_ldIsGnuLd :: Bool - , toolSettings_ccSupportsNoPie :: Bool - - -- commands for particular phases - , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) - , toolSettings_pgm_F :: String - , toolSettings_pgm_c :: String - , toolSettings_pgm_a :: (String, [Option]) - , toolSettings_pgm_l :: (String, [Option]) - , toolSettings_pgm_dll :: (String, [Option]) - , toolSettings_pgm_T :: String - , toolSettings_pgm_windres :: String - , toolSettings_pgm_libtool :: String - , toolSettings_pgm_ar :: String - , toolSettings_pgm_ranlib :: String - , -- | LLVM: opt llvm optimiser - toolSettings_pgm_lo :: (String, [Option]) - , -- | LLVM: llc static compiler - toolSettings_pgm_lc :: (String, [Option]) - , -- | LLVM: c compiler - toolSettings_pgm_lcc :: (String, [Option]) - , toolSettings_pgm_i :: String - - -- options for particular phases - , toolSettings_opt_L :: [String] - , toolSettings_opt_P :: [String] - , -- | cached Fingerprint of sOpt_P - -- See Note [Repeated -optP hashing] - toolSettings_opt_P_fingerprint :: Fingerprint - , toolSettings_opt_F :: [String] - , toolSettings_opt_c :: [String] - , toolSettings_opt_cxx :: [String] - , toolSettings_opt_a :: [String] - , toolSettings_opt_l :: [String] - , toolSettings_opt_windres :: [String] - , -- | LLVM: llvm optimiser - toolSettings_opt_lo :: [String] - , -- | LLVM: llc static compiler - toolSettings_opt_lc :: [String] - , -- | LLVM: c compiler - toolSettings_opt_lcc :: [String] - , -- | iserv options - toolSettings_opt_i :: [String] - - , toolSettings_extraGccViaCFlags :: [String] - } diff --git a/docs/core-spec/CoreSyn.ott b/docs/core-spec/CoreSyn.ott index 9ce8b5e16df75ec6b225b2b94ff1367b2912c209..c22eb5118321550789f94a17a46fee77144d33d9 100644 --- a/docs/core-spec/CoreSyn.ott +++ b/docs/core-spec/CoreSyn.ott @@ -215,7 +215,7 @@ T :: 'TyCon_' ::= {{ com Type constructors, \coderef{types/TyCon.hs}{TyCon} }} | ' K :: :: PromotedDataCon {{ com \ctor{PromotedDataCon}: Promoted data constructor }} | dataConTyCon K :: M :: dataConTyCon {{ com TyCon extracted from DataCon }} -H :: 'PrimTyCon_' ::= {{ com Primitive type constructors, \coderef{prelude/TysPrim.hs}{} }} +H :: 'PrimTyCon_' ::= {{ com Primitive type constructors, \coderef{GHC.Builtin.Types.Prim}{} }} | Int# :: :: intPrimTyCon {{ com Unboxed Int (\texttt{intPrimTyCon}) }} | ( ~# ) :: :: eqPrimTyCon {{ com Unboxed equality (\texttt{eqPrimTyCon}) }} | ( ~Rep# ) :: :: eqReprPrimTyCon {{ com Unboxed representational equality (\texttt{eqReprPrimTyCon}) }} diff --git a/docs/core-spec/core-spec.mng b/docs/core-spec/core-spec.mng index 86db02558680fd7b584eb0fbcef14e24e18071da..d5262743e72486fc1b24c6c489cc8dd6f8b56030 100644 --- a/docs/core-spec/core-spec.mng +++ b/docs/core-spec/core-spec.mng @@ -287,8 +287,8 @@ type arity $[[I]]$, a list of roles $[[role_list]]$ for its coercion parameters, and an output role $[[R']]$. The definition within GHC also includes a field named $[[coaxrProves]]$ which computes the output coercion from a list of types and a list of coercions. This is elided in this presentation, as we simply identify -axiom rules by their names $[[M]]$. See also \coderef{typecheck/TcTypeNats.hs}{mkBinAxiom} -and \coderef{typecheck/TcTypeNats.hs}{mkAxiom1}. +axiom rules by their names $[[M]]$. See also \coderef{GHC.Builtin.Types.Literals}{mkBinAxiom} +and \coderef{GHC.Builtin.Types.Literals}{mkAxiom1}. In \ottdrulename{Co\_UnivCo}, function $ \textsf{compatibleUnBoxedTys} $ stands for following checks: \begin{itemize} @@ -299,7 +299,7 @@ In \ottdrulename{Co\_UnivCo}, function $ \textsf{compatibleUnBoxedTys} $ stands \item unboxed tuples should have same length and each element should be coercible to appropriate element of the target tuple; \end{itemize} -For function implementation see \coderef{coreSyn/CoreLint.hs}{checkTypes}. +For function implementation see \coderef{GHC.Core.Lint}{checkTypes}. For further discussion see \url{https://gitlab.haskell.org/ghc/ghc/wikis/bad-unsafe-coercions}. \subsection{Type constructors} @@ -309,7 +309,8 @@ for this formalism: \gram{\ottT} -We include some representative primitive type constructors. There are many more in \ghcfile{prelude/TysPrim.hs}. +We include some representative primitive type constructors. There are many more +in \ghcfile{GHC.Builtin.Types.Prim}. \gram{\ottH} diff --git a/docs/users_guide/exts/primitives.rst b/docs/users_guide/exts/primitives.rst index 19956467135be0ea91135adec72e8e0378ce559d..f8580c968570324e197fbadedf2459db58ce1cd6 100644 --- a/docs/users_guide/exts/primitives.rst +++ b/docs/users_guide/exts/primitives.rst @@ -14,7 +14,7 @@ case. And if it isn't, we'd like to know about it. All these primitive data types and operations are exported by the library ``GHC.Prim``, for which there is :ghc-prim-ref:`detailed online documentation `. (This -documentation is generated from the file ``compiler/prelude/primops.txt.pp``.) +documentation is generated from the file ``compiler/GHC/Builtin/primops.txt.pp``.) If you want to mention any of the primitive data types or operations in your program, you must first import ``GHC.Prim`` to bring them into diff --git a/ghc.mk b/ghc.mk index af24c807b3529935df12e229ccbc91703298bf25..b93db3ba6ac914d5565b08a6fc8935e1abb30cb3 100644 --- a/ghc.mk +++ b/ghc.mk @@ -1219,8 +1219,8 @@ sdist-ghc-prep-tree : # These rules depend on sdist-ghc-prep-tree. $(eval $(call sdist-ghc-file,compiler,stage2,.,GHC/Cmm/Lexer,x)) $(eval $(call sdist-ghc-file,compiler,stage2,.,GHC/Cmm/Parser,y)) -$(eval $(call sdist-ghc-file,compiler,stage2,parser,Lexer,x)) -$(eval $(call sdist-ghc-file,compiler,stage2,parser,Parser,y)) +$(eval $(call sdist-ghc-file,compiler,stage2,.,GHC/Parser/Lexer,x)) +$(eval $(call sdist-ghc-file,compiler,stage2,.,GHC/Parser,y)) $(eval $(call sdist-ghc-file,utils/hpc,dist-install,,HpcParser,y)) $(eval $(call sdist-ghc-file,utils/genprimopcode,dist,,Lexer,x)) $(eval $(call sdist-ghc-file,utils/genprimopcode,dist,,Parser,y)) @@ -1316,7 +1316,7 @@ $(foreach n,0 1 2, \ $(eval CLEAN_FILES += $h))) CLEAN_FILES += $(includes_SETTINGS) CLEAN_FILES += utils/ghc-pkg/Version.hs -CLEAN_FILES += compiler/prelude/primops.txt +CLEAN_FILES += compiler/GHC/Builtin/primops.txt CLEAN_FILES += $(wildcard compiler/primop*incl) clean : clean_files clean_libraries diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 87b6f597cdf98b0e25e2597275d06c921cbc87d5..be3c75f556ff19b6870ff8db3daa009ed676c079 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -61,10 +61,10 @@ import GHC.Driver.Packages ( trusted, getPackageDetails, getInstalledPackageDeta listVisibleModuleNames, pprFlag ) import GHC.Iface.Syntax ( showToHeader ) import GHC.Core.Ppr.TyThing -import PrelNames +import GHC.Builtin.Names import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrName ) import GHC.Types.SrcLoc as SrcLoc -import qualified Lexer +import qualified GHC.Parser.Lexer as Lexer import StringBuffer import Outputable hiding ( printForUser, printForUserPartWay ) diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs index 94d5b8bf919999e23241426960d2726ef2a735bc..27e31b6cf62c967d7702e3854368f7f2fd4413b4 100644 --- a/ghc/GHCi/UI/Monad.hs +++ b/ghc/GHCi/UI/Monad.hs @@ -47,7 +47,7 @@ import GHC.Driver.Types import GHC.Types.SrcLoc import GHC.Types.Module import GHC.Types.Name.Reader as RdrName (mkOrig) -import PrelNames (gHC_GHCI_HELPERS) +import GHC.Builtin.Names (gHC_GHCI_HELPERS) import GHC.Runtime.Interpreter import GHCi.RemoteTypes import GHC.Hs (ImportDecl, GhcPs, GhciLStmt, LHsDecl) diff --git a/ghc/Main.hs b/ghc/Main.hs index 4ea0aebd31935c6353f0b58195f2286cfed6f2a7..7a356b920ae6ecc58e3a432135e14ffc0d0c1166 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -47,7 +47,7 @@ import GHC.HandleEncoding import GHC.Platform import GHC.Platform.Host import Config -import Constants +import GHC.Settings.Constants import GHC.Driver.Types import GHC.Driver.Packages ( pprPackages, pprPackagesSimple ) import GHC.Driver.Phases @@ -56,8 +56,8 @@ import GHC.Driver.Session hiding (WarnReason(..)) import ErrUtils import FastString import Outputable -import SysTools.BaseDir -import SysTools.Settings +import GHC.SysTools.BaseDir +import GHC.Settings.IO import GHC.Types.SrcLoc import Util import Panic @@ -69,7 +69,7 @@ import GHC.Iface.Load ( loadUserInterface ) import GHC.Driver.Finder ( findImportedModule, cannotFindModule ) import GHC.Tc.Utils.Monad ( initIfaceCheck ) import Binary ( openBinMem, put_ ) -import BinFingerprint ( fingerprintBinMem ) +import GHC.Iface.Recomp.Binary ( fingerprintBinMem ) -- Standard Haskell libraries import System.IO diff --git a/hadrian/src/Rules.hs b/hadrian/src/Rules.hs index f479ba679f713df2ac9df9a41e3024d23c4e5f9f..db3b16bddd82c8cab8de806d0964c737d5e1d892 100644 --- a/hadrian/src/Rules.hs +++ b/hadrian/src/Rules.hs @@ -52,8 +52,8 @@ toolArgsTarget = do root <- buildRoot let dir = buildDir (vanillaContext Stage0 compiler) need [ root -/- dir -/- "Config.hs" ] - need [ root -/- dir -/- "Parser.hs" ] - need [ root -/- dir -/- "Lexer.hs" ] + need [ root -/- dir -/- "GHC" -/- "Parser.hs" ] + need [ root -/- dir -/- "GHC" -/- "Parser" -/- "Lexer.hs" ] need [ root -/- dir -/- "GHC" -/- "Cmm" -/- "Parser.hs" ] need [ root -/- dir -/- "GHC" -/- "Cmm" -/- "Lexer.hs" ] diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs index 33322c8129e8ab293c020cff232575dc93566980..c943d971298dc760ee47f5798312140d569e3afb 100644 --- a/hadrian/src/Rules/Generate.hs +++ b/hadrian/src/Rules/Generate.hs @@ -26,7 +26,7 @@ trackGenerateHs :: Expr () trackGenerateHs = expr $ need [sourcePath -/- "Rules/Generate.hs"] primopsSource :: FilePath -primopsSource = "compiler/prelude/primops.txt.pp" +primopsSource = "compiler/GHC/Builtin/primops.txt.pp" primopsTxt :: Stage -> FilePath primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" diff --git a/hadrian/src/Rules/SourceDist.hs b/hadrian/src/Rules/SourceDist.hs index 6a01ab460293f1aa3ca98f7ebf04b0205a782798..78c1539b3d42c336ba025183840083b0fe04f5cc 100644 --- a/hadrian/src/Rules/SourceDist.hs +++ b/hadrian/src/Rules/SourceDist.hs @@ -138,11 +138,11 @@ prepareTree dest = do -- (stage, package, input file, output file) alexHappyFiles = - [ (Stage0, compiler, "GHC/Cmm/Parser.y", "GHC/Cmm/Parser.hs") - , (Stage0, compiler, "GHC/Cmm/Lexer.x", "GHC/Cmm/Lexer.hs") - , (Stage0, compiler, "parser/Parser.y", "Parser.hs") - , (Stage0, compiler, "parser/Lexer.x", "Lexer.hs") - , (Stage0, hpcBin, "HpcParser.y", "HpcParser.hs") - , (Stage0, genprimopcode, "Parser.y", "Parser.hs") - , (Stage0, genprimopcode, "Lexer.x", "Lexer.hs") + [ (Stage0, compiler, "GHC/Cmm/Parser.y", "GHC/Cmm/Parser.hs") + , (Stage0, compiler, "GHC/Cmm/Lexer.x", "GHC/Cmm/Lexer.hs") + , (Stage0, compiler, "GHC/Parser.y", "GHC/Parser.hs") + , (Stage0, compiler, "GHC/Parser/Lexer.x", "GHC/Parser/Lexer.hs") + , (Stage0, hpcBin, "HpcParser.y", "HpcParser.hs") + , (Stage0, genprimopcode, "Parser.y", "Parser.hs") + , (Stage0, genprimopcode, "Lexer.x", "Lexer.hs") ] diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs index e900546671cacfe86e3231615ded984d8c8c62c6..ab321ba0114b86c28cb4989d80ea69f92b8c5432 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -62,7 +62,7 @@ infix 4 :~:, :~~: -- in the body of the pattern-match, the compiler knows that @a ~ b@. -- -- @since 4.7.0.0 -data a :~: b where -- See Note [The equality types story] in TysPrim +data a :~: b where -- See Note [The equality types story] in GHC.Builtin.Types.Prim Refl :: a :~: a -- with credit to Conal Elliott for 'ty', Erik Hesselink & Martijn van diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs index ee293112a6a97e303fc58daaecaa11e33811e0ef..df79d2a9a07e1e3d1271f7cf1ff3c595a3d2d2b8 100644 --- a/libraries/base/GHC/IO.hs +++ b/libraries/base/GHC/IO.hs @@ -62,7 +62,7 @@ implement IO exceptions. NOTE: The IO representation is deeply wired in to various parts of the system. The following list may or may not be exhaustive: -Compiler - types of various primitives in PrimOp.hs +Compiler - types of various primitives in GHC.Builtin.PrimOps RTS - forceIO (StgStartup.cmm) - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast diff --git a/libraries/ghc-boot-th/GHC/Lexeme.hs b/libraries/ghc-boot-th/GHC/Lexeme.hs index 5093c98f1ecd9acf38ecdb23fc19762ddbdbe440..09d83917d354db087d9c65db8c60500953d75d8d 100644 --- a/libraries/ghc-boot-th/GHC/Lexeme.hs +++ b/libraries/ghc-boot-th/GHC/Lexeme.hs @@ -18,7 +18,7 @@ import Prelude -- See note [Why do we import Prelude here?] import Data.Char -- | Is this character acceptable in a symbol (after the first char)? --- See alexGetByte in Lexer.x +-- See alexGetByte in GHC.Parser.Lexer okSymChar :: Char -> Bool okSymChar c | c `elem` "(),;[]`{}_\"'" diff --git a/libraries/ghc-boot/GHC/Settings.hs b/libraries/ghc-boot/GHC/Settings/Platform.hs similarity index 90% rename from libraries/ghc-boot/GHC/Settings.hs rename to libraries/ghc-boot/GHC/Settings/Platform.hs index fd0a0ef3ad9fc264efa9005fe0fad12f668d99d7..f97fff6b6f7a8b11666f07c5c810642101037d9a 100644 --- a/libraries/ghc-boot/GHC/Settings.hs +++ b/libraries/ghc-boot/GHC/Settings/Platform.hs @@ -11,14 +11,14 @@ -- -- The "0" suffix is because the caller will partially apply it, and that will -- in turn be used a few more times. -module GHC.Settings where +module GHC.Settings.Platform where import Prelude -- See Note [Why do we import Prelude here?] import GHC.BaseDir import GHC.Platform +import GHC.Settings.Utils -import Data.Char (isSpace) import Data.Map (Map) import qualified Data.Map as Map @@ -93,16 +93,3 @@ readSetting0 settingsFile mySettings key = case Map.lookup key mySettings of Just v -> Right v Nothing -> Left $ "Failed to read " ++ show key ++ " value " ++ show xs Nothing -> Left $ "No entry for " ++ show key ++ " in " ++ show settingsFile - ------------------------------------------------------------------------------ --- read helpers - -maybeRead :: Read a => String -> Maybe a -maybeRead str = case reads str of - [(x, "")] -> Just x - _ -> Nothing - -maybeReadFuzzy :: Read a => String -> Maybe a -maybeReadFuzzy str = case reads str of - [(x, s)] | all isSpace s -> Just x - _ -> Nothing diff --git a/libraries/ghc-boot/GHC/Settings/Utils.hs b/libraries/ghc-boot/GHC/Settings/Utils.hs new file mode 100644 index 0000000000000000000000000000000000000000..1f1cd670301960211e28af6025ff4c18b5941e3e --- /dev/null +++ b/libraries/ghc-boot/GHC/Settings/Utils.hs @@ -0,0 +1,15 @@ +module GHC.Settings.Utils where + +import Prelude -- See Note [Why do we import Prelude here?] + +import Data.Char (isSpace) + +maybeRead :: Read a => String -> Maybe a +maybeRead str = case reads str of + [(x, "")] -> Just x + _ -> Nothing + +maybeReadFuzzy :: Read a => String -> Maybe a +maybeReadFuzzy str = case reads str of + [(x, s)] | all isSpace s -> Just x + _ -> Nothing diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in index d837fc98754fc15f8bc9ee6e2256e8ba04110747..c8ac491c59eaf04502caf5b5e67a0108686683ea 100644 --- a/libraries/ghc-boot/ghc-boot.cabal.in +++ b/libraries/ghc-boot/ghc-boot.cabal.in @@ -45,7 +45,8 @@ Library GHC.HandleEncoding GHC.Platform GHC.Platform.Host - GHC.Settings + GHC.Settings.Platform + GHC.Settings.Utils GHC.UniqueSubdir GHC.Version diff --git a/libraries/ghc-prim/GHC/Tuple.hs b/libraries/ghc-prim/GHC/Tuple.hs index 05d6fbfe53e8554c16f06c08d2a22c0237618647..51179167bc8a95df143558bbe10f25657b4cf414 100644 --- a/libraries/ghc-prim/GHC/Tuple.hs +++ b/libraries/ghc-prim/GHC/Tuple.hs @@ -28,7 +28,7 @@ data () = () -- The desugarer uses 1-tuples, -- but "()" is already used up for 0-tuples --- See Note [One-tuples] in TysWiredIn +-- See Note [One-tuples] in GHC.Builtin.Types data Unit a = Unit a data (a,b) = (a,b) diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index bdd0883a3719cd6922fdd33158184cc29b07ffdb..0a32454149fab981191b6c92c1346820ad1384ff 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -84,7 +84,7 @@ data Symbol -- to @x@. -- type family Any :: k where { } --- See Note [Any types] in TysWiredIn. Also, for a bit of history on Any see +-- See Note [Any types] in GHC.Builtin.Types. Also, for a bit of history on Any see -- #10886. Note that this must be a *closed* type family: we need to ensure -- that this can't reduce to a `data` type for the results discussed in -- Note [Any types]. @@ -214,7 +214,7 @@ for them, e.g. to compile the constructor's info table. Furthermore the type of MkCoercible cannot be written in Haskell (no syntax for ~#R). -So we define them as regular data types in GHC.Types, and do magic in TysWiredIn, +So we define them as regular data types in GHC.Types, and do magic in GHC.Builtin.Types, inside GHC, to change the kind and type. -} @@ -227,13 +227,13 @@ inside GHC, to change the kind and type. -- homogeneous equality @~@, this is printed as @~@ unless -- @-fprint-equality-relations@ is set. class a ~~ b - -- See also Note [The equality types story] in TysPrim + -- See also Note [The equality types story] in GHC.Builtin.Types.Prim -- | Lifted, homogeneous equality. By lifted, we mean that it -- can be bogus (deferred type error). By homogeneous, the two -- types @a@ and @b@ must have the same kinds. class a ~ b - -- See also Note [The equality types story] in TysPrim + -- See also Note [The equality types story] in GHC.Builtin.Types.Prim -- | @Coercible@ is a two-parameter class that has instances for types @a@ and @b@ if -- the compiler can infer that they have the same representation. This class @@ -283,7 +283,7 @@ class a ~ b -- -- @since 4.7.0.0 class Coercible (a :: k) (b :: k) - -- See also Note [The equality types story] in TysPrim + -- See also Note [The equality types story] in GHC.Builtin.Types.Prim {- ********************************************************************* * * @@ -409,7 +409,7 @@ data RuntimeRep = VecRep VecCount VecElem -- ^ a SIMD vector type -- RuntimeRep is intimately tied to TyCon.RuntimeRep (in GHC proper). See -- Note [RuntimeRep and PrimRep] in RepType. --- See also Note [Wiring in RuntimeRep] in TysWiredIn +-- See also Note [Wiring in RuntimeRep] in GHC.Builtin.Types -- | Length of a SIMD vector type data VecCount = Vec2 diff --git a/libraries/ghc-prim/cbits/atomic.c b/libraries/ghc-prim/cbits/atomic.c index 01037d70eedfab98911eb03c5787b75c48d0905f..d196ef23c767a3e0eebc80b95b0c0118167b0b47 100644 --- a/libraries/ghc-prim/cbits/atomic.c +++ b/libraries/ghc-prim/cbits/atomic.c @@ -319,7 +319,7 @@ hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new) #endif // AtomicReadByteArrayOp_Int -// Implies a full memory barrier (see compiler/prelude/primops.txt.pp) +// Implies a full memory barrier (see compiler/GHC/Builtin/primops.txt.pp) // __ATOMIC_SEQ_CST: Full barrier in both directions (hoisting and sinking // of code) and synchronizes with acquire loads and release stores in // all threads. @@ -375,7 +375,7 @@ hs_atomicread64(StgWord x) #endif // AtomicWriteByteArrayOp_Int -// Implies a full memory barrier (see compiler/prelude/primops.txt.pp) +// Implies a full memory barrier (see compiler/GHC/Builtin/primops.txt.pp) // __ATOMIC_SEQ_CST: Full barrier (see hs_atomicread8 above). extern void hs_atomicwrite8(StgWord x, StgWord val); diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 4c8aacf97f80444f692f0884714943aec23ff87f..c14bec1f65578a3bdbc3c05a39671436f6a9ec54 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -1598,7 +1598,7 @@ unboxedSumDataName alt arity prefix = "unboxedSumDataName: " debug_info = " (alt: " ++ show alt ++ ", arity: " ++ show arity ++ ")" - -- Synced with the definition of mkSumDataConOcc in TysWiredIn + -- Synced with the definition of mkSumDataConOcc in GHC.Builtin.Types sum_occ = '(' : '#' : bars nbars_before ++ '_' : bars nbars_after ++ "#)" bars i = replicate i '|' nbars_before = alt - 1 @@ -1614,7 +1614,7 @@ unboxedSumTypeName arity (NameG TcClsName (mkPkgName "ghc-prim") (mkModName "GHC.Prim")) where - -- Synced with the definition of mkSumTyConOcc in TysWiredIn + -- Synced with the definition of mkSumTyConOcc in GHC.Builtin.Types sum_occ = '(' : '#' : replicate (arity - 1) '|' ++ "#)" ----------------------------------------------------- diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 88354c4ebdae7f35e2d503a913f74668992da3b0..048cde8065b2c6c173857de212bab7cb3d22e67e 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -7,7 +7,7 @@ * * This file contains the implementations of all the primitive * operations ("primops") which are not expanded inline. See - * ghc/compiler/prelude/primops.txt.pp for a list of all the primops; + * ghc/compiler/GHC/Builtin/primops.txt.pp for a list of all the primops; * this file contains code for most of those with the attribute * out_of_line=True. * diff --git a/rts/Trace.h b/rts/Trace.h index ec25a09d7b14eac8b39ce053f86e9b348ea5da75..9c905af73765073de98f9abbab22a2b4fe5c5a27 100644 --- a/rts/Trace.h +++ b/rts/Trace.h @@ -374,7 +374,7 @@ void flushTrace(void); #endif /* TRACING */ // If DTRACE is enabled, but neither DEBUG nor TRACING, we need a C land -// wrapper for the user-msg probe (as we can't expand that in PrimOps.cmm) +// wrapper for the user-msg probe (as we can't expand that in GHC.Builtin.PrimOpss.cmm) // #if !defined(DEBUG) && !defined(TRACING) && defined(DTRACE) diff --git a/testsuite/tests/callarity/unittest/CallArity1.hs b/testsuite/tests/callarity/unittest/CallArity1.hs index fec7a1fe64bec59e6966c3a878a6abb5ef766924..5a3820fd34c7a51bcbb63c3379398376d33ef3c1 100644 --- a/testsuite/tests/callarity/unittest/CallArity1.hs +++ b/testsuite/tests/callarity/unittest/CallArity1.hs @@ -6,11 +6,11 @@ import GHC.Core.Type import GHC.Core.Make import GHC.Core.Opt.CallArity (callArityRHS) import GHC.Types.Id.Make -import SysTools +import GHC.SysTools import GHC.Driver.Session import ErrUtils import Outputable -import TysWiredIn +import GHC.Builtin.Types import GHC.Types.Literal import GHC import Control.Monad diff --git a/testsuite/tests/codeGen/should_fail/T13233.hs b/testsuite/tests/codeGen/should_fail/T13233.hs index a8d2343e655700bdf7374d2ec13c253ae8e2883b..82e08e207b774371328ab5cf1a291ccd97afab65 100644 --- a/testsuite/tests/codeGen/should_fail/T13233.hs +++ b/testsuite/tests/codeGen/should_fail/T13233.hs @@ -22,7 +22,7 @@ quux :: () quux = obscure (#,#) -- It used to be that primops has no binding. However, as described in --- Note [Primop wrappers] in PrimOp we now rewrite unsaturated primop +-- Note [Primop wrappers] in GHC.Builtin.PrimOps we now rewrite unsaturated primop -- applications to their wrapper, which allows safe use of levity polymorphism. primop :: forall (rep :: RuntimeRep) (a :: TYPE rep) b c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) diff --git a/testsuite/tests/codeGen/should_fail/T13233_elab.hs b/testsuite/tests/codeGen/should_fail/T13233_elab.hs index 87269769d9fe13892869fdaa4bc8d1b8fa19350b..8f62332af65742bbbdc0c6d8b3126214e594c612 100644 --- a/testsuite/tests/codeGen/should_fail/T13233_elab.hs +++ b/testsuite/tests/codeGen/should_fail/T13233_elab.hs @@ -25,7 +25,7 @@ quux :: () quux = obscure (#,#) -- It used to be that primops has no binding. However, as described in --- Note [Primop wrappers] in PrimOp we now rewrite unsaturated primop +-- Note [Primop wrappers] in GHC.Builtin.PrimOps we now rewrite unsaturated primop -- applications to their wrapper, which allows safe use of levity polymorphism. primop :: forall (rep :: RuntimeRep) (a :: TYPE rep) b c. a -> b -> (State# RealWorld -> (# State# RealWorld, c #)) diff --git a/testsuite/tests/driver/T15396.hs b/testsuite/tests/driver/T15396.hs index 9ab9f6e6e671b925b5466d95363e9f42fcbe1229..6fe44bcb1ac5d610a6df98a097fb4ce2e66a9a2b 100644 --- a/testsuite/tests/driver/T15396.hs +++ b/testsuite/tests/driver/T15396.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -import Ar +import GHC.SysTools.Ar -- obtained from echo -n \0 > x.o && ar -q b.a x.o && cat b.a archive = "!\nx.o/ 0 0 0 644 1 \ diff --git a/testsuite/tests/ghc-api/T10942.hs b/testsuite/tests/ghc-api/T10942.hs index 53528ad7180d1122d62e0748f1a892888cdbd4a2..359875167647c118a59188330fa6bf189ae66368 100644 --- a/testsuite/tests/ghc-api/T10942.hs +++ b/testsuite/tests/ghc-api/T10942.hs @@ -5,7 +5,7 @@ import GHC import Control.Monad.IO.Class (liftIO) import System.Environment -import HeaderInfo +import GHC.Parser.Header import Outputable import StringBuffer diff --git a/testsuite/tests/ghc-api/T11579.hs b/testsuite/tests/ghc-api/T11579.hs index 418057120cf04b7e21eb7f19eecebb2d3375b5cb..9e45410d2e5a1b65c8f25e8fecb906dd5170ed4d 100644 --- a/testsuite/tests/ghc-api/T11579.hs +++ b/testsuite/tests/ghc-api/T11579.hs @@ -3,7 +3,7 @@ import GHC.Driver.Session import FastString import GHC import StringBuffer -import Lexer +import GHC.Parser.Lexer import GHC.Types.SrcLoc main :: IO () diff --git a/testsuite/tests/ghc-api/T8628.hs b/testsuite/tests/ghc-api/T8628.hs index c3461b2eb7d453619103be9ca16878660bc065c7..a7cbdaa07c21e25e74b994313aad8a07f12993fe 100644 --- a/testsuite/tests/ghc-api/T8628.hs +++ b/testsuite/tests/ghc-api/T8628.hs @@ -11,7 +11,7 @@ import Outputable import Bag (filterBag,isEmptyBag) import System.Directory (removeFile) import System.Environment( getArgs ) -import PrelNames +import GHC.Builtin.Names main :: IO() main diff --git a/testsuite/tests/ghc-api/annotations/CheckUtils.hs b/testsuite/tests/ghc-api/annotations/CheckUtils.hs index 473ded85efe57d92bc7bc1a612a2c5e8a48bb306..275067ac8a4dcc33c10f97ebde399a0d5ca8ded6 100644 --- a/testsuite/tests/ghc-api/annotations/CheckUtils.hs +++ b/testsuite/tests/ghc-api/annotations/CheckUtils.hs @@ -12,7 +12,7 @@ import GHC.Types.Basic import GHC.Driver.Session import MonadUtils import Outputable -import ApiAnnotation +import GHC.Parser.Annotation import Bag (filterBag,isEmptyBag) import System.Directory (removeFile) import System.Environment( getArgs ) diff --git a/testsuite/tests/ghc-api/annotations/listcomps.hs b/testsuite/tests/ghc-api/annotations/listcomps.hs index 9f8fb4e6b447b94c60fbf3a7e2c4bad4f8b5ec4c..cd5eb86927c2eed0610da1d7b49f3decc179b9cf 100644 --- a/testsuite/tests/ghc-api/annotations/listcomps.hs +++ b/testsuite/tests/ghc-api/annotations/listcomps.hs @@ -13,7 +13,7 @@ import GHC.Types.Basic import GHC.Driver.Session import MonadUtils import Outputable -import ApiAnnotation +import GHC.Parser.Annotation import Bag (filterBag,isEmptyBag) import System.Directory (removeFile) import System.Environment( getArgs ) diff --git a/testsuite/tests/ghc-api/target-contents/TargetContents.hs b/testsuite/tests/ghc-api/target-contents/TargetContents.hs index 04d97c108a0771f87c280f13a4b73121f7636bfd..f71d1131e37291837a5474b08e40aee0e625cd33 100644 --- a/testsuite/tests/ghc-api/target-contents/TargetContents.hs +++ b/testsuite/tests/ghc-api/target-contents/TargetContents.hs @@ -12,7 +12,7 @@ import Data.Maybe import Data.Time.Calendar import Data.Time.Clock import Exception -import HeaderInfo +import GHC.Parser.Header import GHC.Driver.Types import Outputable import StringBuffer diff --git a/testsuite/tests/hiefile/should_run/PatTypes.hs b/testsuite/tests/hiefile/should_run/PatTypes.hs index c38cacab80a9448512e17b1436d192d2c1e2f4e3..25803d0e478b01e2c9a2d4cbdc44ee71bc2990b2 100644 --- a/testsuite/tests/hiefile/should_run/PatTypes.hs +++ b/testsuite/tests/hiefile/should_run/PatTypes.hs @@ -13,7 +13,7 @@ import GHC.Iface.Ext.Types import GHC.Iface.Ext.Utils import GHC.Driver.Session -import SysTools +import GHC.SysTools import qualified Data.Map as M import Data.Foldable diff --git a/testsuite/tests/layout/layout006.hs b/testsuite/tests/layout/layout006.hs index 70eacb42cf5aa1706ef40a4e998f0ea65da85216..84ad72760acb842746b36bd395dad69a1e7d0fc2 100644 --- a/testsuite/tests/layout/layout006.hs +++ b/testsuite/tests/layout/layout006.hs @@ -1,7 +1,7 @@ module M where --- GHC's RdrHsSyn.lhs had a piece of code like this +-- GHC's GHC.Parser.PostProcess had a piece of code like this f :: IO () f diff --git a/testsuite/tests/parser/should_run/CountParserDeps.hs b/testsuite/tests/parser/should_run/CountParserDeps.hs index 1872c93ba81eac837640b44506573a5cffa3ada3..03313fb66f0a0e2fb3e49b3f32afd04da9cb9a3c 100644 --- a/testsuite/tests/parser/should_run/CountParserDeps.hs +++ b/testsuite/tests/parser/should_run/CountParserDeps.hs @@ -40,7 +40,7 @@ parserDeps libdir = (df, _, _) <- parseDynamicFlags df [noLoc "-package=ghc"] setSessionDynFlags df env <- getSession - loop env emptyUniqSet [mkModuleName "Parser"] + loop env emptyUniqSet [mkModuleName "GHC.Parser"] where -- Source imports are only guaranteed to show up in the 'mi_deps' -- of modules that import them directly and don’t propagate diff --git a/testsuite/tests/unboxedsums/UbxSumLevPoly.hs b/testsuite/tests/unboxedsums/UbxSumLevPoly.hs index 3275eb7dfe5fb4cd4e960672d3879b2e5c93bea7..ba4e4e50e6aabe38880c669d9e7a95c2858c6f79 100644 --- a/testsuite/tests/unboxedsums/UbxSumLevPoly.hs +++ b/testsuite/tests/unboxedsums/UbxSumLevPoly.hs @@ -5,7 +5,7 @@ module UbxSumLevPoly where -- this failed thinking that (# Any | True #) :: TYPE (SumRep [LiftedRep, b]) -- But of course that b should be Lifted! --- It was due to silliness in TysWiredIn using the same uniques for different +-- It was due to silliness in GHC.Builtin.Types using the same uniques for different -- things in mk_sum. p = True diff --git a/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs b/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs index 579487555618be932f321d542aec20c2047b4527..8d5c7756d9354755652740a0012658ec9b484ed7 100644 --- a/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs +++ b/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs @@ -5,8 +5,8 @@ import GHC import GHC.Driver.Monad import Outputable import GHC.Types.RepType -import TysPrim -import TysWiredIn +import GHC.Builtin.Types.Prim +import GHC.Builtin.Types import GHC.Types.Unique.Set import GHC.Types.Unique diff --git a/utils/check-api-annotations/Main.hs b/utils/check-api-annotations/Main.hs index 3546e8693fed0e3a0813820e094e152ecf16f9ea..e0d62e6684a6ad0e68ea16401b5b3a82de80ce0d 100644 --- a/utils/check-api-annotations/Main.hs +++ b/utils/check-api-annotations/Main.hs @@ -5,7 +5,7 @@ import Data.List import GHC import GHC.Driver.Session import Outputable -import ApiAnnotation +import GHC.Parser.Annotation import GHC.Types.SrcLoc import System.Environment( getArgs ) import System.Exit diff --git a/utils/check-api-annotations/README b/utils/check-api-annotations/README index fcadc50ff673dabbe94d58abfb6eae21cb824608..5d852a30bf2a1cd99ac44be86af21bc2ebdf1927 100644 --- a/utils/check-api-annotations/README +++ b/utils/check-api-annotations/README @@ -1,5 +1,5 @@ -This programme is intended to be used by any GHC developers working on Parser.y -or RdrHsSyn.hs, and who want to check that their changes do not break the API +This programme is intended to be used by any GHC developers working on GHC.Parser +or GHC.Parser.PostProcess, and who want to check that their changes do not break the API Annotations. It does a basic test that all annotations do make it to the final AST, and dumps diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index bcbfe968c8251d7a7a5e41b0151272c037fb0222..5e34ee97c116191a425933c8467721a5cdacea46 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -859,7 +859,7 @@ ppType (TyApp (TyCon "ThreadId#") []) = "threadIdPrimTy" ppType (TyApp (TyCon "ForeignObj#") []) = "foreignObjPrimTy" ppType (TyApp (TyCon "BCO") []) = "bcoPrimTy" ppType (TyApp (TyCon "Compact#") []) = "compactPrimTy" -ppType (TyApp (TyCon "()") []) = "unitTy" -- unitTy is TysWiredIn's name for () +ppType (TyApp (TyCon "()") []) = "unitTy" -- unitTy is GHC.Builtin.Types's name for () ppType (TyVar "a") = "alphaTy" ppType (TyVar "b") = "betaTy" diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index c29e4cfd137e53676aa8e92939353671c2ff103e..ed68b3ff0461da0c6114ad9654c03ae5cd93d320 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -34,7 +34,8 @@ import qualified GHC.PackageDb as GhcPkg import GHC.PackageDb (BinaryStringRep(..)) import GHC.HandleEncoding import GHC.BaseDir (getBaseDir) -import GHC.Settings (getTargetPlatform, maybeReadFuzzy) +import GHC.Settings.Platform (getTargetPlatform) +import GHC.Settings.Utils (maybeReadFuzzy) import GHC.Platform (platformMini) import GHC.Platform.Host (cHostPlatformMini) import GHC.UniqueSubdir (uniqueSubdir) diff --git a/utils/haddock b/utils/haddock index 5ec817a3e41b7eaa50c74701ab2d7642df86464c..20bf93490b37c0410d85a0ad4d38f9ddc2253589 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit 5ec817a3e41b7eaa50c74701ab2d7642df86464c +Subproject commit 20bf93490b37c0410d85a0ad4d38f9ddc2253589