diff options
Diffstat (limited to 'compiler')
36 files changed, 276 insertions, 171 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs index 2130448e89..61c6680700 100644 --- a/compiler/GHC/Builtin/Names.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -171,6 +171,7 @@ import GHC.Unit.Module.Name import GHC.Types.Name.Occurrence import GHC.Types.Name.Reader import GHC.Types.Unique +import GHC.Builtin.Uniques import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Data.FastString diff --git a/compiler/GHC/Builtin/Names/TH.hs b/compiler/GHC/Builtin/Names/TH.hs index 1903a7d108..dc237b6963 100644 --- a/compiler/GHC/Builtin/Names/TH.hs +++ b/compiler/GHC/Builtin/Names/TH.hs @@ -14,6 +14,7 @@ import GHC.Types.Name( Name ) import GHC.Types.Name.Occurrence( tcName, clsName, dataName, varName ) import GHC.Types.Name.Reader( RdrName, nameRdrName ) import GHC.Types.Unique +import GHC.Builtin.Uniques import GHC.Data.FastString -- To add a name, do three things diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs index 77dc9ca1c0..c172493193 100644 --- a/compiler/GHC/Builtin/PrimOps.hs +++ b/compiler/GHC/Builtin/PrimOps.hs @@ -43,7 +43,8 @@ import GHC.Types.Basic ( Arity, Fixity(..), FixityDirection(..), Boxity(..), SourceText(..) ) import GHC.Types.SrcLoc ( wiredInSrcSpan ) import GHC.Types.ForeignCall ( CLabelString ) -import GHC.Types.Unique ( Unique, mkPrimOpIdUnique, mkPrimOpWrapperUnique ) +import GHC.Types.Unique ( Unique) +import GHC.Builtin.Uniques (mkPrimOpIdUnique, mkPrimOpWrapperUnique ) import GHC.Unit ( Unit ) import GHC.Utils.Outputable import GHC.Data.FastString diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs index 44a61dc2cb..d9cf158ef6 100644 --- a/compiler/GHC/Builtin/Types.hs +++ b/compiler/GHC/Builtin/Types.hs @@ -157,7 +157,7 @@ import {-# SOURCE #-} GHC.Types.Id.Make ( mkDataConWorkId, mkDictSelId ) -- friends: import GHC.Builtin.Names import GHC.Builtin.Types.Prim -import {-# SOURCE #-} GHC.Builtin.Uniques +import GHC.Builtin.Uniques -- others: import GHC.Core.Coercion.Axiom @@ -178,7 +178,6 @@ import GHC.Types.Name.Set ( NameSet, mkNameSet, elemNameSet ) import GHC.Types.Basic import GHC.Types.ForeignCall import GHC.Types.SrcLoc ( noSrcSpan ) -import GHC.Types.Unique import Data.Array import GHC.Data.FastString import GHC.Data.BooleanFormula ( mkAnd ) diff --git a/compiler/GHC/Builtin/Types.hs-boot b/compiler/GHC/Builtin/Types.hs-boot index 792faf939f..d792edb612 100644 --- a/compiler/GHC/Builtin/Types.hs-boot +++ b/compiler/GHC/Builtin/Types.hs-boot @@ -2,9 +2,10 @@ module GHC.Builtin.Types where import {-# SOURCE #-} GHC.Core.TyCon ( TyCon ) import {-# SOURCE #-} GHC.Core.TyCo.Rep (Type, Kind) +import {-# SOURCE #-} GHC.Core.DataCon ( DataCon ) -import GHC.Types.Basic (Arity, TupleSort) -import GHC.Types.Name (Name) +import GHC.Types.Basic (Arity, TupleSort, Boxity, ConTag) +import {-# SOURCE #-} GHC.Types.Name (Name) listTyCon :: TyCon typeNatKind, typeSymbolKind :: Type @@ -55,4 +56,16 @@ multMulTyCon :: TyCon tupleTyConName :: TupleSort -> Arity -> Name + integerTy, naturalTy :: Type + +promotedTupleDataCon :: Boxity -> Arity -> TyCon + +tupleDataCon :: Boxity -> Arity -> DataCon +tupleTyCon :: Boxity -> Arity -> TyCon + +cTupleDataConName :: Arity -> Name +cTupleTyConName :: Arity -> Name + +sumDataCon :: ConTag -> Arity -> DataCon +sumTyCon :: Arity -> TyCon diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs index 20c0ab634d..e631e04baa 100644 --- a/compiler/GHC/Builtin/Types/Prim.hs +++ b/compiler/GHC/Builtin/Types/Prim.hs @@ -118,6 +118,7 @@ import GHC.Types.Name import GHC.Core.TyCon import GHC.Types.SrcLoc import GHC.Types.Unique +import GHC.Builtin.Uniques import GHC.Builtin.Names import GHC.Data.FastString import GHC.Utils.Outputable diff --git a/compiler/GHC/Builtin/Uniques.hs b/compiler/GHC/Builtin/Uniques.hs index 326467566f..50be54d955 100644 --- a/compiler/GHC/Builtin/Uniques.hs +++ b/compiler/GHC/Builtin/Uniques.hs @@ -22,19 +22,46 @@ module GHC.Builtin.Uniques -- *** Constraint , mkCTupleTyConUnique , mkCTupleDataConUnique + + -- ** Making built-in uniques + , mkAlphaTyVarUnique + , mkPrimOpIdUnique, mkPrimOpWrapperUnique + , mkPreludeMiscIdUnique, mkPreludeDataConUnique + , mkPreludeTyConUnique, mkPreludeClassUnique + , mkCoVarUnique + + , mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique + , mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique + , mkCostCentreUnique + + , mkBuiltinUnique + , mkPseudoUniqueD + , mkPseudoUniqueE + , mkPseudoUniqueH + + -- ** Deriving uniquesc + -- *** From TyCon name uniques + , tyConRepNameUnique + -- *** From DataCon name uniques + , dataConWorkerUnique, dataConTyRepNameUnique + + , initTyVarUnique + , initExitJoinUnique + ) where #include "HsVersions.h" import GHC.Prelude -import GHC.Builtin.Types -import GHC.Core.TyCon -import GHC.Core.DataCon -import GHC.Types.Id +import {-# SOURCE #-} GHC.Builtin.Types +import {-# SOURCE #-} GHC.Core.TyCon +import {-# SOURCE #-} GHC.Core.DataCon +import {-# SOURCE #-} GHC.Types.Id +import {-# SOURCE #-} GHC.Types.Name import GHC.Types.Basic import GHC.Types.Unique -import GHC.Types.Name +import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Misc @@ -180,3 +207,110 @@ getTupleDataConName boxity n = (arity, 2) -> fromMaybe (panic "getTupleDataCon") $ tyConRepName_maybe $ promotedTupleDataCon boxity arity _ -> panic "getTupleDataConName: impossible" + +{- +************************************************************************ +* * +\subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things} +* * +************************************************************************ + +Allocation of unique supply characters: + v,t,u : for renumbering value-, type- and usage- vars. + B: builtin + C-E: pseudo uniques (used in native-code generator) + X: uniques from mkLocalUnique + _: unifiable tyvars (above) + 0-9: prelude things below + (no numbers left any more..) + :: (prelude) parallel array data constructors + + other a-z: lower case chars for unique supplies. Used so far: + + d desugarer + f AbsC flattener + g SimplStg + k constraint tuple tycons + m constraint tuple datacons + n Native codegen + r Hsc name cache + s simplifier + z anonymous sums +-} + +mkAlphaTyVarUnique :: Int -> Unique +mkPreludeClassUnique :: Int -> Unique +mkPrimOpIdUnique :: Int -> Unique +-- See Note [Primop wrappers] in GHC.Builtin.PrimOps. +mkPrimOpWrapperUnique :: Int -> Unique +mkPreludeMiscIdUnique :: Int -> Unique +mkCoVarUnique :: Int -> Unique + +mkAlphaTyVarUnique i = mkUnique '1' i +mkCoVarUnique i = mkUnique 'g' i +mkPreludeClassUnique i = mkUnique '2' i + +-------------------------------------------------- +mkPrimOpIdUnique op = mkUnique '9' (2*op) +mkPrimOpWrapperUnique op = mkUnique '9' (2*op+1) +mkPreludeMiscIdUnique i = mkUnique '0' i + +-- The "tyvar uniques" print specially nicely: a, b, c, etc. +-- See pprUnique for details + +initTyVarUnique :: Unique +initTyVarUnique = mkUnique 't' 0 + +mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH, + mkBuiltinUnique :: Int -> Unique + +mkBuiltinUnique i = mkUnique 'B' i +mkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs +mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs +mkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs + +mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique +mkRegSingleUnique = mkUnique 'R' +mkRegSubUnique = mkUnique 'S' +mkRegPairUnique = mkUnique 'P' +mkRegClassUnique = mkUnique 'L' + +mkCostCentreUnique :: Int -> Unique +mkCostCentreUnique = mkUnique 'C' + +mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique +-- See Note [The Unique of an OccName] in GHC.Types.Name.Occurrence +mkVarOccUnique fs = mkUnique 'i' (uniqueOfFS fs) +mkDataOccUnique fs = mkUnique 'd' (uniqueOfFS fs) +mkTvOccUnique fs = mkUnique 'v' (uniqueOfFS fs) +mkTcOccUnique fs = mkUnique 'c' (uniqueOfFS fs) + +initExitJoinUnique :: Unique +initExitJoinUnique = mkUnique 's' 0 + + +-------------------------------------------------- +-- Wired-in type constructor keys occupy *two* slots: +-- * u: the TyCon itself +-- * u+1: the TyConRepName of the TyCon + +mkPreludeTyConUnique :: Int -> Unique +mkPreludeTyConUnique i = mkUnique '3' (2*i) + +tyConRepNameUnique :: Unique -> Unique +tyConRepNameUnique u = incrUnique u + +-------------------------------------------------- +-- Wired-in data constructor keys occupy *three* slots: +-- * u: the DataCon itself +-- * u+1: its worker Id +-- * u+2: the TyConRepName of the promoted TyCon +-- Prelude data constructors are too simple to need wrappers. + +mkPreludeDataConUnique :: Arity -> Unique +mkPreludeDataConUnique i = mkUnique '6' (3*i) -- Must be alphabetic + +-------------------------------------------------- +dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique +dataConWorkerUnique u = incrUnique u +dataConTyRepNameUnique u = stepUnique u 2 diff --git a/compiler/GHC/Builtin/Uniques.hs-boot b/compiler/GHC/Builtin/Uniques.hs-boot index 3e24cd5a55..f239d13688 100644 --- a/compiler/GHC/Builtin/Uniques.hs-boot +++ b/compiler/GHC/Builtin/Uniques.hs-boot @@ -2,8 +2,9 @@ module GHC.Builtin.Uniques where import GHC.Prelude import GHC.Types.Unique -import GHC.Types.Name +import {-# SOURCE #-} GHC.Types.Name import GHC.Types.Basic +import GHC.Data.FastString -- Needed by GHC.Builtin.Types knownUniqueName :: Unique -> Maybe Name @@ -16,3 +17,24 @@ mkCTupleDataConUnique :: Arity -> Unique mkTupleTyConUnique :: Boxity -> Arity -> Unique mkTupleDataConUnique :: Boxity -> Arity -> Unique + +mkAlphaTyVarUnique :: Int -> Unique +mkPreludeClassUnique :: Int -> Unique +mkPrimOpIdUnique :: Int -> Unique +mkPrimOpWrapperUnique :: Int -> Unique +mkPreludeMiscIdUnique :: Int -> Unique +mkCoVarUnique :: Int -> Unique + +mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH, + mkBuiltinUnique :: Int -> Unique + +mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique +mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique + +initExitJoinUnique, initTyVarUnique :: Unique + +mkPreludeTyConUnique :: Int -> Unique +tyConRepNameUnique :: Unique -> Unique + +mkPreludeDataConUnique :: Arity -> Unique +dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Base.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Base.hs index 86c25c5a24..a06934c837 100644 --- a/compiler/GHC/CmmToAsm/Reg/Graph/Base.hs +++ b/compiler/GHC/CmmToAsm/Reg/Graph/Base.hs @@ -27,6 +27,7 @@ import GHC.Prelude import GHC.Types.Unique.Set import GHC.Types.Unique.FM import GHC.Types.Unique +import GHC.Builtin.Uniques import GHC.Utils.Monad (concatMapM) diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs b/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs index af0e8d970f..42421bfb08 100644 --- a/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs +++ b/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs @@ -44,6 +44,7 @@ import GHC.Cmm import GHC.Types.Unique.Set import GHC.Types.Unique.FM import GHC.Types.Unique +import GHC.Builtin.Uniques import GHC.Utils.Monad.State import GHC.Utils.Outputable import GHC.Utils.Panic diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs index 6eb9723fe7..59152b5447 100644 --- a/compiler/GHC/Core/DataCon.hs +++ b/compiler/GHC/Core/DataCon.hs @@ -83,7 +83,7 @@ import GHC.Data.FastString import GHC.Unit import GHC.Utils.Binary import GHC.Types.Unique.Set -import GHC.Types.Unique( mkAlphaTyVarUnique ) +import GHC.Builtin.Uniques( mkAlphaTyVarUnique ) import GHC.Utils.Outputable import GHC.Utils.Misc diff --git a/compiler/GHC/Core/DataCon.hs-boot b/compiler/GHC/Core/DataCon.hs-boot index 831392e9ba..6df12da9db 100644 --- a/compiler/GHC/Core/DataCon.hs-boot +++ b/compiler/GHC/Core/DataCon.hs-boot @@ -1,8 +1,8 @@ module GHC.Core.DataCon where import GHC.Prelude -import GHC.Types.Var( TyVar, TyCoVar, InvisTVBinder ) -import GHC.Types.Name( Name, NamedThing ) +import {-# SOURCE #-} GHC.Types.Var( Id, TyVar, TyCoVar, InvisTVBinder ) +import {-# SOURCE #-} GHC.Types.Name( Name, NamedThing ) import {-# SOURCE #-} GHC.Core.TyCon( TyCon ) import GHC.Types.FieldLabel ( FieldLabel ) import GHC.Types.Unique ( Uniquable ) @@ -15,6 +15,7 @@ data DataConRep data EqSpec dataConName :: DataCon -> Name +dataConWorkId :: DataCon -> Id dataConTyCon :: DataCon -> TyCon dataConExTyCoVars :: DataCon -> [TyCoVar] dataConUserTyVars :: DataCon -> [TyVar] @@ -32,3 +33,6 @@ instance Uniquable DataCon instance NamedThing DataCon instance Outputable DataCon instance OutputableBndr DataCon + +dataConWrapId :: DataCon -> Id +promoteDataCon :: DataCon -> TyCon diff --git a/compiler/GHC/Core/Opt/Arity.hs b/compiler/GHC/Core/Opt/Arity.hs index 4cfb3bacf0..b55d91767e 100644 --- a/compiler/GHC/Core/Opt/Arity.hs +++ b/compiler/GHC/Core/Opt/Arity.hs @@ -43,7 +43,7 @@ import GHC.Core.Coercion as Coercion import GHC.Core.Multiplicity import GHC.Types.Var.Set import GHC.Types.Basic -import GHC.Types.Unique +import GHC.Builtin.Uniques import GHC.Driver.Session ( DynFlags, GeneralFlag(..), gopt ) import GHC.Utils.Outputable import GHC.Utils.Panic diff --git a/compiler/GHC/Core/Opt/Exitify.hs b/compiler/GHC/Core/Opt/Exitify.hs index 7372b79ebc..e489cf298f 100644 --- a/compiler/GHC/Core/Opt/Exitify.hs +++ b/compiler/GHC/Core/Opt/Exitify.hs @@ -44,7 +44,7 @@ import GHC.Types.Id.Info import GHC.Core import GHC.Core.Utils import GHC.Utils.Monad.State -import GHC.Types.Unique +import GHC.Builtin.Uniques import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Core.FVs diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs index 400cb00c83..54487652f0 100644 --- a/compiler/GHC/Core/Opt/Monad.hs +++ b/compiler/GHC/Core/Opt/Monad.hs @@ -63,6 +63,7 @@ import GHC.Types.Var import GHC.Utils.Outputable as Outputable import GHC.Data.FastString import GHC.Utils.Error( Severity(..), DumpFormat (..), dumpOptionsFromFlag ) +import GHC.Types.Unique (uniqFromMask) import GHC.Types.Unique.Supply import GHC.Utils.Monad import GHC.Types.Name.Env diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs index 2c7cd2d5de..e1b85969e3 100644 --- a/compiler/GHC/Core/TyCon.hs +++ b/compiler/GHC/Core/TyCon.hs @@ -149,6 +149,9 @@ import {-# SOURCE #-} GHC.Core.DataCon ( DataCon, dataConExTyCoVars, dataConFieldLabels , dataConTyCon, dataConFullSig , isUnboxedSumCon ) +import GHC.Builtin.Uniques + ( tyConRepNameUnique + , dataConTyRepNameUnique ) import GHC.Utils.Binary import GHC.Types.Var @@ -167,7 +170,6 @@ import GHC.Data.FastString.Env import GHC.Types.FieldLabel import GHC.Settings.Constants import GHC.Utils.Misc -import GHC.Types.Unique( tyConRepNameUnique, dataConTyRepNameUnique ) import GHC.Types.Unique.Set import GHC.Unit.Module diff --git a/compiler/GHC/Core/TyCon.hs-boot b/compiler/GHC/Core/TyCon.hs-boot index c561da08f9..21a54508b3 100644 --- a/compiler/GHC/Core/TyCon.hs-boot +++ b/compiler/GHC/Core/TyCon.hs-boot @@ -2,11 +2,20 @@ module GHC.Core.TyCon where import GHC.Prelude import GHC.Types.Unique ( Uniquable ) +import {-# SOURCE #-} GHC.Types.Name +import GHC.Utils.Outputable data TyCon instance Uniquable TyCon +instance Outputable TyCon + +type TyConRepName = Name isTupleTyCon :: TyCon -> Bool isUnboxedTupleTyCon :: TyCon -> Bool isFunTyCon :: TyCon -> Bool + +tyConRepName_maybe :: TyCon -> Maybe TyConRepName +mkPrelTyConRepName :: Name -> TyConRepName +tyConName :: TyCon -> Name diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs index 8ba378521d..239152c059 100644 --- a/compiler/GHC/CoreToByteCode.hs +++ b/compiler/GHC/CoreToByteCode.hs @@ -50,6 +50,7 @@ import GHC.Builtin.Types.Prim import GHC.Core.TyCo.Ppr ( pprType ) import GHC.Utils.Error import GHC.Types.Unique +import GHC.Builtin.Uniques import GHC.Data.FastString import GHC.Utils.Panic import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, nonVoidIds ) diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs index 5f3e1b808f..452e649f5d 100644 --- a/compiler/GHC/Iface/Ext/Ast.hs +++ b/compiler/GHC/Iface/Ext/Ast.hs @@ -54,7 +54,7 @@ import GHC.Tc.Types import GHC.Tc.Types.Evidence import GHC.Types.Var ( Id, Var, EvId, setVarName, varName, varType, varUnique ) import GHC.Types.Var.Env -import GHC.Types.Unique +import GHC.Builtin.Uniques import GHC.Iface.Make ( mkIfaceExports ) import GHC.Utils.Panic import GHC.Data.Maybe diff --git a/compiler/GHC/Platform/Reg.hs b/compiler/GHC/Platform/Reg.hs index 1ecca9fe47..c011a59eb0 100644 --- a/compiler/GHC/Platform/Reg.hs +++ b/compiler/GHC/Platform/Reg.hs @@ -32,6 +32,7 @@ import GHC.Prelude import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.Unique +import GHC.Builtin.Uniques import GHC.Platform.Reg.Class import Data.List (intersect) diff --git a/compiler/GHC/Platform/Reg/Class.hs b/compiler/GHC/Platform/Reg/Class.hs index 3b967c5c55..981305ed94 100644 --- a/compiler/GHC/Platform/Reg/Class.hs +++ b/compiler/GHC/Platform/Reg/Class.hs @@ -8,6 +8,7 @@ import GHC.Prelude import GHC.Utils.Outputable as Outputable import GHC.Types.Unique +import GHC.Builtin.Uniques -- | The class of a register. diff --git a/compiler/GHC/Stg/Pipeline.hs b/compiler/GHC/Stg/Pipeline.hs index ea758e58db..a407737cf1 100644 --- a/compiler/GHC/Stg/Pipeline.hs +++ b/compiler/GHC/Stg/Pipeline.hs @@ -27,6 +27,7 @@ import GHC.Unit.Module ( Module ) import GHC.Driver.Session import GHC.Utils.Error +import GHC.Types.Unique (uniqFromMask) import GHC.Types.Unique.Supply import GHC.Utils.Outputable import GHC.Utils.Panic diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs index 699e601777..e7b067e946 100644 --- a/compiler/GHC/Tc/TyCl/Utils.hs +++ b/compiler/GHC/Tc/TyCl/Utils.hs @@ -59,7 +59,7 @@ import GHC.Types.Var.Set import GHC.Core.Coercion ( ltRole ) import GHC.Types.Basic import GHC.Types.SrcLoc -import GHC.Types.Unique ( mkBuiltinUnique ) +import GHC.Builtin.Uniques ( mkBuiltinUnique ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index abdd670483..9f7d0b2ec1 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -180,6 +180,7 @@ import GHC.Types.Name.Env import GHC.Types.Name.Set import GHC.Data.Bag import GHC.Utils.Outputable as Outputable +import GHC.Types.Unique (uniqFromMask) import GHC.Types.Unique.Supply import GHC.Driver.Session import GHC.Data.FastString diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs index b7a9876144..678f2c6fc8 100644 --- a/compiler/GHC/Tc/Validity.hs +++ b/compiler/GHC/Tc/Validity.hs @@ -67,7 +67,7 @@ import GHC.Data.List.SetOps import GHC.Types.SrcLoc import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic -import GHC.Types.Unique ( mkAlphaTyVarUnique ) +import GHC.Builtin.Uniques ( mkAlphaTyVarUnique ) import GHC.Data.Bag ( emptyBag ) import qualified GHC.LanguageExtensions as LangExt diff --git a/compiler/GHC/Types/FieldLabel.hs b/compiler/GHC/Types/FieldLabel.hs index a392af845e..7636545963 100644 --- a/compiler/GHC/Types/FieldLabel.hs +++ b/compiler/GHC/Types/FieldLabel.hs @@ -73,8 +73,8 @@ where import GHC.Prelude -import GHC.Types.Name.Occurrence -import GHC.Types.Name +import {-# SOURCE #-} GHC.Types.Name.Occurrence +import {-# SOURCE #-} GHC.Types.Name import GHC.Data.FastString import GHC.Data.FastString.Env diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs index cbf566a5fe..5b6c54cc00 100644 --- a/compiler/GHC/Types/Id.hs +++ b/compiler/GHC/Types/Id.hs @@ -153,6 +153,7 @@ import GHC.Types.ForeignCall import GHC.Data.Maybe import GHC.Types.SrcLoc import GHC.Types.Unique +import GHC.Builtin.Uniques (mkBuiltinUnique) import GHC.Types.Unique.Supply import GHC.Data.FastString import GHC.Core.Multiplicity diff --git a/compiler/GHC/Types/Id.hs-boot b/compiler/GHC/Types/Id.hs-boot new file mode 100644 index 0000000000..7e4894f22c --- /dev/null +++ b/compiler/GHC/Types/Id.hs-boot @@ -0,0 +1,7 @@ +module GHC.Types.Id where + +import GHC.Prelude () +import {-# SOURCE #-} GHC.Types.Name +import {-# SOURCE #-} GHC.Types.Var + +idName :: Id -> Name diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs index bd25be0ce0..90a3368dea 100644 --- a/compiler/GHC/Types/Id/Make.hs +++ b/compiler/GHC/Types/Id/Make.hs @@ -69,6 +69,7 @@ import GHC.Types.Demand import GHC.Types.Cpr import GHC.Core import GHC.Types.Unique +import GHC.Builtin.Uniques import GHC.Types.Unique.Supply import GHC.Builtin.Names import GHC.Types.Basic hiding ( SuccessFlag(..) ) diff --git a/compiler/GHC/Types/Name.hs-boot b/compiler/GHC/Types/Name.hs-boot index 331dbda5ed..8799f6dbb3 100644 --- a/compiler/GHC/Types/Name.hs-boot +++ b/compiler/GHC/Types/Name.hs-boot @@ -1,5 +1,24 @@ -module GHC.Types.Name where +module GHC.Types.Name ( + module GHC.Types.Name, + module GHC.Types.Name.Occurrence +) where import GHC.Prelude () +import {-# SOURCE #-} GHC.Types.Name.Occurrence +import GHC.Types.Unique +import GHC.Utils.Outputable data Name + +instance Uniquable Name +instance Outputable Name + +class NamedThing a where + getOccName :: a -> OccName + getName :: a -> Name + + getOccName n = nameOccName (getName n) + +nameUnique :: Name -> Unique +setNameUnique :: Name -> Unique -> Name +nameOccName :: Name -> OccName diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs index ad6042a8f0..9756900ad8 100644 --- a/compiler/GHC/Types/Name/Occurrence.hs +++ b/compiler/GHC/Types/Name/Occurrence.hs @@ -105,6 +105,7 @@ import GHC.Prelude import GHC.Utils.Misc import GHC.Types.Unique +import GHC.Builtin.Uniques import GHC.Types.Unique.FM import GHC.Types.Unique.Set import GHC.Data.FastString diff --git a/compiler/GHC/Types/Name/Occurrence.hs-boot b/compiler/GHC/Types/Name/Occurrence.hs-boot index ef23bb13fb..1c27d943a7 100644 --- a/compiler/GHC/Types/Name/Occurrence.hs-boot +++ b/compiler/GHC/Types/Name/Occurrence.hs-boot @@ -1,5 +1,13 @@ module GHC.Types.Name.Occurrence where -import GHC.Prelude () +import GHC.Prelude (String) +import GHC.Data.FastString data OccName + +class HasOccName name where + occName :: name -> OccName + +occNameString :: OccName -> String +mkRecFldSelOcc :: String -> OccName +mkVarOccFS :: FastString -> OccName diff --git a/compiler/GHC/Types/Unique.hs b/compiler/GHC/Types/Unique.hs index c97f7a9553..29fd5c6cd6 100644 --- a/compiler/GHC/Types/Unique.hs +++ b/compiler/GHC/Types/Unique.hs @@ -31,45 +31,18 @@ module GHC.Types.Unique ( mkUniqueGrimily, getKey, - mkUnique, unpkUnique, + mkUnique, unpkUnique, uniqFromMask, eqUnique, ltUnique, - incrUnique, + incrUnique, stepUnique, newTagUnique, - initTyVarUnique, - initExitJoinUnique, nonDetCmpUnique, isValidKnownKeyUnique, - -- ** Making built-in uniques - - -- now all the built-in GHC.Types.Uniques (and functions to make them) - -- [the Oh-So-Wonderful Haskell module system wins again...] - mkAlphaTyVarUnique, - mkPrimOpIdUnique, mkPrimOpWrapperUnique, - mkPreludeMiscIdUnique, mkPreludeDataConUnique, - mkPreludeTyConUnique, mkPreludeClassUnique, - mkCoVarUnique, - - mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique, - mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique, - mkCostCentreUnique, - - mkBuiltinUnique, - mkPseudoUniqueD, - mkPseudoUniqueE, - mkPseudoUniqueH, - - -- ** Deriving uniques - -- *** From TyCon name uniques - tyConRepNameUnique, - -- *** From DataCon name uniques - dataConWorkerUnique, dataConTyRepNameUnique, - -- ** Local uniques -- | These are exposed exclusively for use by 'GHC.Types.Var.Env.uniqAway', which -- has rather peculiar needs. See Note [Local uniques]. - mkLocalUnique, minLocalUnique, maxLocalUnique + mkLocalUnique, minLocalUnique, maxLocalUnique, ) where #include "HsVersions.h" @@ -77,7 +50,6 @@ module GHC.Types.Unique ( import GHC.Prelude -import GHC.Types.Basic import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Misc @@ -159,8 +131,7 @@ uniqueMask = (1 `shiftL` uNIQUE_BITS) - 1 -- and as long as the Char fits in 8 bits, which we assume anyway! mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces --- NOT EXPORTED, so that we can see all the Chars that --- are used in this one module +-- EXPORTED and used only in GHC.Builtin.Uniques mkUnique c i = MkUnique (tag .|. bits) where @@ -176,6 +147,13 @@ unpkUnique (MkUnique u) in (tag, i) +foreign import ccall unsafe "genSym" genSym :: IO Int + +uniqFromMask :: Char -> IO Unique +uniqFromMask mask + = do { uqNum <- genSym + ; return $! mkUnique mask uqNum } + -- | The interface file symbol-table encoding assumes that known-key uniques fit -- in 30-bits; verify this. -- @@ -341,109 +319,3 @@ iToBase62 n_ {-# INLINE chooseChar62 #-} chooseChar62 (I# n) = C# (indexCharOffAddr# chars62 n) chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"# - -{- -************************************************************************ -* * -\subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things} -* * -************************************************************************ - -Allocation of unique supply characters: - v,t,u : for renumbering value-, type- and usage- vars. - B: builtin - C-E: pseudo uniques (used in native-code generator) - X: uniques from mkLocalUnique - _: unifiable tyvars (above) - 0-9: prelude things below - (no numbers left any more..) - :: (prelude) parallel array data constructors - - other a-z: lower case chars for unique supplies. Used so far: - - d desugarer - f AbsC flattener - g SimplStg - k constraint tuple tycons - m constraint tuple datacons - n Native codegen - r Hsc name cache - s simplifier - z anonymous sums --} - -mkAlphaTyVarUnique :: Int -> Unique -mkPreludeClassUnique :: Int -> Unique -mkPreludeTyConUnique :: Int -> Unique -mkPreludeDataConUnique :: Arity -> Unique -mkPrimOpIdUnique :: Int -> Unique --- See Note [Primop wrappers] in GHC.Builtin.PrimOps. -mkPrimOpWrapperUnique :: Int -> Unique -mkPreludeMiscIdUnique :: Int -> Unique -mkCoVarUnique :: Int -> Unique - -mkAlphaTyVarUnique i = mkUnique '1' i -mkCoVarUnique i = mkUnique 'g' i -mkPreludeClassUnique i = mkUnique '2' i - --------------------------------------------------- --- Wired-in type constructor keys occupy *two* slots: --- * u: the TyCon itself --- * u+1: the TyConRepName of the TyCon -mkPreludeTyConUnique i = mkUnique '3' (2*i) - -tyConRepNameUnique :: Unique -> Unique -tyConRepNameUnique u = incrUnique u - --------------------------------------------------- --- Wired-in data constructor keys occupy *three* slots: --- * u: the DataCon itself --- * u+1: its worker Id --- * u+2: the TyConRepName of the promoted TyCon --- Prelude data constructors are too simple to need wrappers. - -mkPreludeDataConUnique i = mkUnique '6' (3*i) -- Must be alphabetic - --------------------------------------------------- -dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique -dataConWorkerUnique u = incrUnique u -dataConTyRepNameUnique u = stepUnique u 2 - --------------------------------------------------- -mkPrimOpIdUnique op = mkUnique '9' (2*op) -mkPrimOpWrapperUnique op = mkUnique '9' (2*op+1) -mkPreludeMiscIdUnique i = mkUnique '0' i - --- The "tyvar uniques" print specially nicely: a, b, c, etc. --- See pprUnique for details - -initTyVarUnique :: Unique -initTyVarUnique = mkUnique 't' 0 - -mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH, - mkBuiltinUnique :: Int -> Unique - -mkBuiltinUnique i = mkUnique 'B' i -mkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs -mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs -mkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs - -mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique -mkRegSingleUnique = mkUnique 'R' -mkRegSubUnique = mkUnique 'S' -mkRegPairUnique = mkUnique 'P' -mkRegClassUnique = mkUnique 'L' - -mkCostCentreUnique :: Int -> Unique -mkCostCentreUnique = mkUnique 'C' - -mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique --- See Note [The Unique of an OccName] in GHC.Types.Name.Occurrence -mkVarOccUnique fs = mkUnique 'i' (uniqueOfFS fs) -mkDataOccUnique fs = mkUnique 'd' (uniqueOfFS fs) -mkTvOccUnique fs = mkUnique 'v' (uniqueOfFS fs) -mkTcOccUnique fs = mkUnique 'c' (uniqueOfFS fs) - -initExitJoinUnique :: Unique -initExitJoinUnique = mkUnique 's' 0 - diff --git a/compiler/GHC/Types/Unique/Supply.hs b/compiler/GHC/Types/Unique/Supply.hs index 1ccb3c0fd1..a401946732 100644 --- a/compiler/GHC/Types/Unique/Supply.hs +++ b/compiler/GHC/Types/Unique/Supply.hs @@ -22,7 +22,7 @@ module GHC.Types.Unique.Supply ( -- ** Operations on supplies uniqFromSupply, uniqsFromSupply, -- basic ops - takeUniqFromSupply, uniqFromMask, + takeUniqFromSupply, mkSplitUniqSupply, splitUniqSupply, listSplitUniqSupply, @@ -250,12 +250,6 @@ uniqFromSupply (MkSplitUniqSupply n _ _) = mkUniqueGrimily n uniqsFromSupply (MkSplitUniqSupply n _ s2) = mkUniqueGrimily n : uniqsFromSupply s2 takeUniqFromSupply (MkSplitUniqSupply n s1 _) = (mkUniqueGrimily n, s1) -uniqFromMask :: Char -> IO Unique -uniqFromMask mask - = do { uqNum <- genSym - ; return $! mkUnique mask uqNum } - - {- ************************************************************************ * * diff --git a/compiler/GHC/Types/Var.hs b/compiler/GHC/Types/Var.hs index b5892a70da..edee58e53d 100644 --- a/compiler/GHC/Types/Var.hs +++ b/compiler/GHC/Types/Var.hs @@ -103,7 +103,7 @@ import {-# SOURCE #-} GHC.Tc.Utils.TcType( TcTyVarDetails, pprTcTyVarDetails, import {-# SOURCE #-} GHC.Types.Id.Info( IdDetails, IdInfo, coVarDetails, isCoVarDetails, vanillaIdInfo, pprIdDetails ) import {-# SOURCE #-} GHC.Builtin.Types ( manyDataConTy ) -import GHC.Types.Name hiding (varName) +import {-# SOURCE #-} GHC.Types.Name import GHC.Types.Unique ( Uniquable, Unique, getKey, getUnique , mkUniqueGrimily, nonDetCmpUnique ) import GHC.Utils.Misc diff --git a/compiler/GHC/Types/Var.hs-boot b/compiler/GHC/Types/Var.hs-boot index 78c748f7ec..664aabfa2f 100644 --- a/compiler/GHC/Types/Var.hs-boot +++ b/compiler/GHC/Types/Var.hs-boot @@ -1,6 +1,7 @@ module GHC.Types.Var where import GHC.Prelude () +import {-# SOURCE #-} GHC.Types.Name -- We compile this GHC with -XNoImplicitPrelude, so if there are no imports -- it does not seem to depend on anything. But it does! We must, for -- example, compile GHC.Types in the ghc-prim library first. So this @@ -10,4 +11,10 @@ import GHC.Prelude () data ArgFlag data AnonArgFlag data Var +instance NamedThing Var +data VarBndr var argf +data Specificity type TyVar = Var +type Id = Var +type TyCoVar = Id +type InvisTVBinder = VarBndr TyVar Specificity |