[Git][ghc/ghc][wip/romes/no-this-unit-id-aggressive] 3 commits: working this out
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Tue Mar 7 11:27:50 UTC 2023
Rodrigo Mesquita pushed to branch wip/romes/no-this-unit-id-aggressive at Glasgow Haskell Compiler / GHC
Commits:
d8f005d3 by romes at 2023-03-07T09:55:03+00:00
working this out
- - - - -
183f975e by romes at 2023-03-07T10:25:43+00:00
Delete wires and unwires map
- - - - -
ea020879 by romes at 2023-03-07T11:27:10+00:00
Wired in names have type WiredIn Name
- - - - -
15 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Builtin/Utils.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Ext/Binary.hs
- compiler/GHC/Iface/Ext/Debug.hs
- compiler/GHC/Iface/Ext/Types.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Unit/Types.hs
- + del-this-unit-id.sh
- hadrian/src/Hadrian/Haskell/Cabal.hs
- hadrian/src/Rules/ToolArgs.hs
Changes:
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -198,317 +198,319 @@ names with uniques. These ones are the *non* wired-in ones. The
wired in ones are defined in GHC.Builtin.Types etc.
-}
-basicKnownKeyNames :: [Name] -- See Note [Known-key names]
+basicKnownKeyNames :: IO [Name] -- See Note [Known-key names]
basicKnownKeyNames
- = genericTyConNames
- ++ [ -- Classes. *Must* include:
- -- classes that are grabbed by key (e.g., eqClassKey)
- -- classes in "Class.standardClassKeys" (quite a few)
- eqClassName, -- mentioned, derivable
- ordClassName, -- derivable
- boundedClassName, -- derivable
- numClassName, -- mentioned, numeric
- enumClassName, -- derivable
- monadClassName,
- functorClassName,
- realClassName, -- numeric
- integralClassName, -- numeric
- fractionalClassName, -- numeric
- floatingClassName, -- numeric
- realFracClassName, -- numeric
- realFloatClassName, -- numeric
- dataClassName,
- isStringClassName,
- applicativeClassName,
- alternativeClassName,
- foldableClassName,
- traversableClassName,
- semigroupClassName, sappendName,
- monoidClassName, memptyName, mappendName, mconcatName,
-
- -- The IO type
- ioTyConName, ioDataConName,
- runMainIOName,
- runRWName,
-
- -- Type representation types
- trModuleTyConName, trModuleDataConName,
- trNameTyConName, trNameSDataConName, trNameDDataConName,
- trTyConTyConName, trTyConDataConName,
-
- -- Typeable
- typeableClassName,
- typeRepTyConName,
- someTypeRepTyConName,
- someTypeRepDataConName,
- kindRepTyConName,
- kindRepTyConAppDataConName,
- kindRepVarDataConName,
- kindRepAppDataConName,
- kindRepFunDataConName,
- kindRepTYPEDataConName,
- kindRepTypeLitSDataConName,
- kindRepTypeLitDDataConName,
- typeLitSortTyConName,
- typeLitSymbolDataConName,
- typeLitNatDataConName,
- typeLitCharDataConName,
- typeRepIdName,
- mkTrTypeName,
- mkTrConName,
- mkTrAppName,
- mkTrFunName,
- typeSymbolTypeRepName, typeNatTypeRepName, typeCharTypeRepName,
- trGhcPrimModuleName,
-
- -- KindReps for common cases
- starKindRepName,
- starArrStarKindRepName,
- starArrStarArrStarKindRepName,
- constraintKindRepName,
-
- -- WithDict
- withDictClassName,
-
- -- Dynamic
- toDynName,
-
- -- Numeric stuff
- negateName, minusName, geName, eqName,
- mkRationalBase2Name, mkRationalBase10Name,
-
- -- Conversion functions
- rationalTyConName,
- ratioTyConName, ratioDataConName,
- fromRationalName, fromIntegerName,
- toIntegerName, toRationalName,
- fromIntegralName, realToFracName,
-
- -- Int# stuff
- divIntName, modIntName,
-
- -- String stuff
- fromStringName,
-
- -- Enum stuff
- enumFromName, enumFromThenName,
- enumFromThenToName, enumFromToName,
-
- -- Applicative stuff
- pureAName, apAName, thenAName,
-
- -- Functor stuff
- fmapName,
-
- -- Monad stuff
- thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName,
- returnMName, joinMName,
-
- -- MonadFail
- monadFailClassName, failMName,
-
- -- MonadFix
- monadFixClassName, mfixName,
-
- -- Arrow stuff
- arrAName, composeAName, firstAName,
- appAName, choiceAName, loopAName,
-
- -- Ix stuff
- ixClassName,
-
- -- Show stuff
- showClassName,
-
- -- Read stuff
- readClassName,
-
- -- Stable pointers
- newStablePtrName,
-
- -- GHC Extensions
- considerAccessibleName,
-
- -- Strings and lists
- unpackCStringName, unpackCStringUtf8Name,
- unpackCStringAppendName, unpackCStringAppendUtf8Name,
- unpackCStringFoldrName, unpackCStringFoldrUtf8Name,
- cstringLengthName,
-
- -- Overloaded lists
- isListClassName,
- fromListName,
- fromListNName,
- toListName,
-
- -- Non-empty lists
- nonEmptyTyConName,
-
- -- Overloaded record dot, record update
- getFieldName, setFieldName,
-
- -- List operations
- concatName, filterName, mapName,
- zipName, foldrName, buildName, augmentName, appendName,
-
- -- FFI primitive types that are not wired-in.
- stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName,
- int8TyConName, int16TyConName, int32TyConName, int64TyConName,
- word8TyConName, word16TyConName, word32TyConName, word64TyConName,
-
- -- Others
- otherwiseIdName, inlineIdName,
- eqStringName, assertName,
- assertErrorName, traceName,
- printName,
- dollarName,
-
- -- ghc-bignum
- integerFromNaturalName,
- integerToNaturalClampName,
- integerToNaturalThrowName,
- integerToNaturalName,
- integerToWordName,
- integerToIntName,
- integerToWord64Name,
- integerToInt64Name,
- integerFromWordName,
- integerFromWord64Name,
- integerFromInt64Name,
- integerAddName,
- integerMulName,
- integerSubName,
- integerNegateName,
- integerAbsName,
- integerPopCountName,
- integerQuotName,
- integerRemName,
- integerDivName,
- integerModName,
- integerDivModName,
- integerQuotRemName,
- integerEncodeFloatName,
- integerEncodeDoubleName,
- integerGcdName,
- integerLcmName,
- integerAndName,
- integerOrName,
- integerXorName,
- integerComplementName,
- integerBitName,
- integerTestBitName,
- integerShiftLName,
- integerShiftRName,
-
- naturalToWordName,
- naturalPopCountName,
- naturalShiftRName,
- naturalShiftLName,
- naturalAddName,
- naturalSubName,
- naturalSubThrowName,
- naturalSubUnsafeName,
- naturalMulName,
- naturalQuotRemName,
- naturalQuotName,
- naturalRemName,
- naturalAndName,
- naturalAndNotName,
- naturalOrName,
- naturalXorName,
- naturalTestBitName,
- naturalBitName,
- naturalGcdName,
- naturalLcmName,
- naturalLog2Name,
- naturalLogBaseWordName,
- naturalLogBaseName,
- naturalPowModName,
- naturalSizeInBaseName,
-
- bignatFromWordListName,
- bignatEqName,
-
- -- Float/Double
- integerToFloatName,
- integerToDoubleName,
- naturalToFloatName,
- naturalToDoubleName,
- rationalToFloatName,
- rationalToDoubleName,
-
- -- Other classes
- monadPlusClassName,
-
- -- Type-level naturals
- knownNatClassName, knownSymbolClassName, knownCharClassName,
-
- -- Overloaded labels
- fromLabelClassOpName,
-
- -- Implicit Parameters
- ipClassName,
-
- -- Overloaded record fields
- hasFieldClassName,
-
- -- Call Stacks
- callStackTyConName,
- emptyCallStackName, pushCallStackName,
-
- -- Source Locations
- srcLocDataConName,
-
- -- Annotation type checking
- toAnnotationWrapperName
-
- -- The SPEC type for SpecConstr
- , specTyConName
-
- -- The Either type
- , eitherTyConName, leftDataConName, rightDataConName
-
- -- The Void type
- , voidTyConName
-
+ = sequence [
-- Plugins
- , pluginTyConName
+ pluginTyConName
, frontendPluginTyConName
-
- -- Generics
- , genClassName, gen1ClassName
- , datatypeClassName, constructorClassName, selectorClassName
-
- -- Monad comprehensions
- , guardMName
- , liftMName
- , mzipName
-
- -- GHCi Sandbox
- , ghciIoClassName, ghciStepIoMName
-
- -- StaticPtr
- , makeStaticName
- , staticPtrTyConName
- , staticPtrDataConName, staticPtrInfoDataConName
- , fromStaticPtrName
-
- -- Fingerprint
- , fingerprintDataConName
-
- -- Custom type errors
- , errorMessageTypeErrorFamName
- , typeErrorTextDataConName
- , typeErrorAppendDataConName
- , typeErrorVAppendDataConName
- , typeErrorShowTypeDataConName
-
- -- Unsafe coercion proofs
- , unsafeEqualityProofName
- , unsafeEqualityTyConName
- , unsafeReflDataConName
- , unsafeCoercePrimName
- ]
+ ] >>= \ioknownnames ->
+ pure (ioknownnames ++
+ genericTyConNames
+ ++ [ -- Classes. *Must* include:
+ -- classes that are grabbed by key (e.g., eqClassKey)
+ -- classes in "Class.standardClassKeys" (quite a few)
+ eqClassName, -- mentioned, derivable
+ ordClassName, -- derivable
+ boundedClassName, -- derivable
+ numClassName, -- mentioned, numeric
+ enumClassName, -- derivable
+ monadClassName,
+ functorClassName,
+ realClassName, -- numeric
+ integralClassName, -- numeric
+ fractionalClassName, -- numeric
+ floatingClassName, -- numeric
+ realFracClassName, -- numeric
+ realFloatClassName, -- numeric
+ dataClassName,
+ isStringClassName,
+ applicativeClassName,
+ alternativeClassName,
+ foldableClassName,
+ traversableClassName,
+ semigroupClassName, sappendName,
+ monoidClassName, memptyName, mappendName, mconcatName,
+
+ -- The IO type
+ ioTyConName, ioDataConName,
+ runMainIOName,
+ runRWName,
+
+ -- Type representation types
+ trModuleTyConName, trModuleDataConName,
+ trNameTyConName, trNameSDataConName, trNameDDataConName,
+ trTyConTyConName, trTyConDataConName,
+
+ -- Typeable
+ typeableClassName,
+ typeRepTyConName,
+ someTypeRepTyConName,
+ someTypeRepDataConName,
+ kindRepTyConName,
+ kindRepTyConAppDataConName,
+ kindRepVarDataConName,
+ kindRepAppDataConName,
+ kindRepFunDataConName,
+ kindRepTYPEDataConName,
+ kindRepTypeLitSDataConName,
+ kindRepTypeLitDDataConName,
+ typeLitSortTyConName,
+ typeLitSymbolDataConName,
+ typeLitNatDataConName,
+ typeLitCharDataConName,
+ typeRepIdName,
+ mkTrTypeName,
+ mkTrConName,
+ mkTrAppName,
+ mkTrFunName,
+ typeSymbolTypeRepName, typeNatTypeRepName, typeCharTypeRepName,
+ trGhcPrimModuleName,
+
+ -- KindReps for common cases
+ starKindRepName,
+ starArrStarKindRepName,
+ starArrStarArrStarKindRepName,
+ constraintKindRepName,
+
+ -- WithDict
+ withDictClassName,
+
+ -- Dynamic
+ toDynName,
+
+ -- Numeric stuff
+ negateName, minusName, geName, eqName,
+ mkRationalBase2Name, mkRationalBase10Name,
+
+ -- Conversion functions
+ rationalTyConName,
+ ratioTyConName, ratioDataConName,
+ fromRationalName, fromIntegerName,
+ toIntegerName, toRationalName,
+ fromIntegralName, realToFracName,
+
+ -- Int# stuff
+ divIntName, modIntName,
+
+ -- String stuff
+ fromStringName,
+
+ -- Enum stuff
+ enumFromName, enumFromThenName,
+ enumFromThenToName, enumFromToName,
+
+ -- Applicative stuff
+ pureAName, apAName, thenAName,
+
+ -- Functor stuff
+ fmapName,
+
+ -- Monad stuff
+ thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName,
+ returnMName, joinMName,
+
+ -- MonadFail
+ monadFailClassName, failMName,
+
+ -- MonadFix
+ monadFixClassName, mfixName,
+
+ -- Arrow stuff
+ arrAName, composeAName, firstAName,
+ appAName, choiceAName, loopAName,
+
+ -- Ix stuff
+ ixClassName,
+
+ -- Show stuff
+ showClassName,
+
+ -- Read stuff
+ readClassName,
+
+ -- Stable pointers
+ newStablePtrName,
+
+ -- GHC Extensions
+ considerAccessibleName,
+
+ -- Strings and lists
+ unpackCStringName, unpackCStringUtf8Name,
+ unpackCStringAppendName, unpackCStringAppendUtf8Name,
+ unpackCStringFoldrName, unpackCStringFoldrUtf8Name,
+ cstringLengthName,
+
+ -- Overloaded lists
+ isListClassName,
+ fromListName,
+ fromListNName,
+ toListName,
+
+ -- Non-empty lists
+ nonEmptyTyConName,
+
+ -- Overloaded record dot, record update
+ getFieldName, setFieldName,
+
+ -- List operations
+ concatName, filterName, mapName,
+ zipName, foldrName, buildName, augmentName, appendName,
+
+ -- FFI primitive types that are not wired-in.
+ stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName,
+ int8TyConName, int16TyConName, int32TyConName, int64TyConName,
+ word8TyConName, word16TyConName, word32TyConName, word64TyConName,
+
+ -- Others
+ otherwiseIdName, inlineIdName,
+ eqStringName, assertName,
+ assertErrorName, traceName,
+ printName,
+ dollarName,
+
+ -- ghc-bignum
+ integerFromNaturalName,
+ integerToNaturalClampName,
+ integerToNaturalThrowName,
+ integerToNaturalName,
+ integerToWordName,
+ integerToIntName,
+ integerToWord64Name,
+ integerToInt64Name,
+ integerFromWordName,
+ integerFromWord64Name,
+ integerFromInt64Name,
+ integerAddName,
+ integerMulName,
+ integerSubName,
+ integerNegateName,
+ integerAbsName,
+ integerPopCountName,
+ integerQuotName,
+ integerRemName,
+ integerDivName,
+ integerModName,
+ integerDivModName,
+ integerQuotRemName,
+ integerEncodeFloatName,
+ integerEncodeDoubleName,
+ integerGcdName,
+ integerLcmName,
+ integerAndName,
+ integerOrName,
+ integerXorName,
+ integerComplementName,
+ integerBitName,
+ integerTestBitName,
+ integerShiftLName,
+ integerShiftRName,
+
+ naturalToWordName,
+ naturalPopCountName,
+ naturalShiftRName,
+ naturalShiftLName,
+ naturalAddName,
+ naturalSubName,
+ naturalSubThrowName,
+ naturalSubUnsafeName,
+ naturalMulName,
+ naturalQuotRemName,
+ naturalQuotName,
+ naturalRemName,
+ naturalAndName,
+ naturalAndNotName,
+ naturalOrName,
+ naturalXorName,
+ naturalTestBitName,
+ naturalBitName,
+ naturalGcdName,
+ naturalLcmName,
+ naturalLog2Name,
+ naturalLogBaseWordName,
+ naturalLogBaseName,
+ naturalPowModName,
+ naturalSizeInBaseName,
+
+ bignatFromWordListName,
+ bignatEqName,
+
+ -- Float/Double
+ integerToFloatName,
+ integerToDoubleName,
+ naturalToFloatName,
+ naturalToDoubleName,
+ rationalToFloatName,
+ rationalToDoubleName,
+
+ -- Other classes
+ monadPlusClassName,
+
+ -- Type-level naturals
+ knownNatClassName, knownSymbolClassName, knownCharClassName,
+
+ -- Overloaded labels
+ fromLabelClassOpName,
+
+ -- Implicit Parameters
+ ipClassName,
+
+ -- Overloaded record fields
+ hasFieldClassName,
+
+ -- Call Stacks
+ callStackTyConName,
+ emptyCallStackName, pushCallStackName,
+
+ -- Source Locations
+ srcLocDataConName,
+
+ -- Annotation type checking
+ toAnnotationWrapperName
+
+ -- The SPEC type for SpecConstr
+ , specTyConName
+
+ -- The Either type
+ , eitherTyConName, leftDataConName, rightDataConName
+
+ -- The Void type
+ , voidTyConName
+
+ -- Generics
+ , genClassName, gen1ClassName
+ , datatypeClassName, constructorClassName, selectorClassName
+
+ -- Monad comprehensions
+ , guardMName
+ , liftMName
+ , mzipName
+
+ -- GHCi Sandbox
+ , ghciIoClassName, ghciStepIoMName
+
+ -- StaticPtr
+ , makeStaticName
+ , staticPtrTyConName
+ , staticPtrDataConName, staticPtrInfoDataConName
+ , fromStaticPtrName
+
+ -- Fingerprint
+ , fingerprintDataConName
+
+ -- Custom type errors
+ , errorMessageTypeErrorFamName
+ , typeErrorTextDataConName
+ , typeErrorAppendDataConName
+ , typeErrorVAppendDataConName
+ , typeErrorShowTypeDataConName
+
+ -- Unsafe coercion proofs
+ , unsafeEqualityProofName
+ , unsafeEqualityTyConName
+ , unsafeReflDataConName
+ , unsafeCoercePrimName
+ ])
genericTyConNames :: [Name]
genericTyConNames = [
@@ -540,7 +542,7 @@ genericTyConNames = [
--MetaHaskell Extension Add a new module here
-}
-pRELUDE :: Module
+pRELUDE :: WiredIn Module
pRELUDE = mkBaseModule_ pRELUDE_NAME
gHC_PRIM, gHC_PRIM_PANIC,
@@ -559,7 +561,7 @@ gHC_PRIM, gHC_PRIM_PANIC,
aRROW, gHC_DESUGAR, rANDOM, gHC_EXTS, gHC_IS_LIST,
cONTROL_EXCEPTION_BASE, gHC_TYPEERROR, gHC_TYPELITS, gHC_TYPELITS_INTERNAL,
gHC_TYPENATS, gHC_TYPENATS_INTERNAL,
- dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE, fOREIGN_C_CONSTPTR :: Module
+ dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE, fOREIGN_C_CONSTPTR :: WiredIn Module
gHC_PRIM = mkPrimModule (fsLit "GHC.Prim") -- Primitive types and values
gHC_PRIM_PANIC = mkPrimModule (fsLit "GHC.Prim.Panic")
@@ -630,26 +632,26 @@ dEBUG_TRACE = mkBaseModule (fsLit "Debug.Trace")
uNSAFE_COERCE = mkBaseModule (fsLit "Unsafe.Coerce")
fOREIGN_C_CONSTPTR = mkBaseModule (fsLit "Foreign.C.ConstPtr")
-gHC_SRCLOC :: Module
+gHC_SRCLOC :: WiredIn Module
gHC_SRCLOC = mkBaseModule (fsLit "GHC.SrcLoc")
-gHC_STACK, gHC_STACK_TYPES :: Module
+gHC_STACK, gHC_STACK_TYPES :: WiredIn Module
gHC_STACK = mkBaseModule (fsLit "GHC.Stack")
gHC_STACK_TYPES = mkBaseModule (fsLit "GHC.Stack.Types")
-gHC_STATICPTR :: Module
+gHC_STATICPTR :: WiredIn Module
gHC_STATICPTR = mkBaseModule (fsLit "GHC.StaticPtr")
-gHC_STATICPTR_INTERNAL :: Module
+gHC_STATICPTR_INTERNAL :: WiredIn Module
gHC_STATICPTR_INTERNAL = mkBaseModule (fsLit "GHC.StaticPtr.Internal")
-gHC_FINGERPRINT_TYPE :: Module
+gHC_FINGERPRINT_TYPE :: WiredIn Module
gHC_FINGERPRINT_TYPE = mkBaseModule (fsLit "GHC.Fingerprint.Type")
-gHC_OVER_LABELS :: Module
+gHC_OVER_LABELS :: WiredIn Module
gHC_OVER_LABELS = mkBaseModule (fsLit "GHC.OverloadedLabels")
-gHC_RECORDS :: Module
+gHC_RECORDS :: WiredIn Module
gHC_RECORDS = mkBaseModule (fsLit "GHC.Records")
rOOT_MAIN :: Module
@@ -663,23 +665,23 @@ pRELUDE_NAME, mAIN_NAME :: ModuleName
pRELUDE_NAME = mkModuleNameFS (fsLit "Prelude")
mAIN_NAME = mkModuleNameFS (fsLit "Main")
-mkPrimModule :: FastString -> Module
-mkPrimModule m = mkModule primUnit (mkModuleNameFS m)
+mkPrimModule :: FastString -> WiredIn Module
+mkPrimModule m = mkModule <$> primUnit <*> pure (mkModuleNameFS m)
-mkBignumModule :: FastString -> Module
-mkBignumModule m = mkModule bignumUnit (mkModuleNameFS m)
+mkBignumModule :: FastString -> WiredIn Module
+mkBignumModule m = mkModule <$> bignumUnit <*> pure (mkModuleNameFS m)
-mkBaseModule :: FastString -> Module
+mkBaseModule :: FastString -> WiredIn Module
mkBaseModule m = mkBaseModule_ (mkModuleNameFS m)
-mkBaseModule_ :: ModuleName -> Module
-mkBaseModule_ m = mkModule baseUnit m
+mkBaseModule_ :: ModuleName -> WiredIn Module
+mkBaseModule_ m = mkModule <$> baseUnit <*> pure m
-mkThisGhcModule :: FastString -> Module
+mkThisGhcModule :: FastString -> WiredIn Module
mkThisGhcModule m = mkThisGhcModule_ (mkModuleNameFS m)
-mkThisGhcModule_ :: ModuleName -> Module
-mkThisGhcModule_ m = mkModule thisGhcUnit m
+mkThisGhcModule_ :: ModuleName -> WiredIn Module
+mkThisGhcModule_ m = mkModule <$> thisGhcUnit <*> pure m
mkMainModule :: FastString -> Module
mkMainModule m = mkModule mainUnit (mkModuleNameFS m)
@@ -700,14 +702,14 @@ main_RDR_Unqual = mkUnqual varName (fsLit "main")
-- We definitely don't want an Orig RdrName, because
-- main might, in principle, be imported into module Main
-eq_RDR, ge_RDR, le_RDR, lt_RDR, gt_RDR, compare_RDR,
- ltTag_RDR, eqTag_RDR, gtTag_RDR :: RdrName
+le_RDR, lt_RDR, gt_RDR, compare_RDR :: WiredIn RdrName
+le_RDR = varQual_RDR <$> gHC_CLASSES <*> pure (fsLit "<=")
+lt_RDR = varQual_RDR <$> gHC_CLASSES <*> pure (fsLit "<")
+gt_RDR = varQual_RDR <$> gHC_CLASSES <*> pure (fsLit ">")
+compare_RDR = varQual_RDR <$> gHC_CLASSES <*> pure (fsLit "compare")
+eq_RDR, ge_RDR, ltTag_RDR, eqTag_RDR, gtTag_RDR :: RdrName
eq_RDR = nameRdrName eqName
ge_RDR = nameRdrName geName
-le_RDR = varQual_RDR gHC_CLASSES (fsLit "<=")
-lt_RDR = varQual_RDR gHC_CLASSES (fsLit "<")
-gt_RDR = varQual_RDR gHC_CLASSES (fsLit ">")
-compare_RDR = varQual_RDR gHC_CLASSES (fsLit "compare")
ltTag_RDR = nameRdrName ordLTDataConName
eqTag_RDR = nameRdrName ordEQDataConName
gtTag_RDR = nameRdrName ordGTDataConName
@@ -736,9 +738,9 @@ left_RDR, right_RDR :: RdrName
left_RDR = nameRdrName leftDataConName
right_RDR = nameRdrName rightDataConName
-fromEnum_RDR, toEnum_RDR :: RdrName
-fromEnum_RDR = varQual_RDR gHC_ENUM (fsLit "fromEnum")
-toEnum_RDR = varQual_RDR gHC_ENUM (fsLit "toEnum")
+fromEnum_RDR, toEnum_RDR :: WiredIn RdrName
+fromEnum_RDR = varQual_RDR <$> gHC_ENUM <*> pure (fsLit "fromEnum")
+toEnum_RDR = varQual_RDR <$> gHC_ENUM <*> pure (fsLit "toEnum")
enumFrom_RDR, enumFromTo_RDR, enumFromThen_RDR, enumFromThenTo_RDR :: RdrName
enumFrom_RDR = nameRdrName enumFromName
@@ -761,12 +763,13 @@ bindIO_RDR, returnIO_RDR :: RdrName
bindIO_RDR = nameRdrName bindIOName
returnIO_RDR = nameRdrName returnIOName
-fromInteger_RDR, fromRational_RDR, minus_RDR, times_RDR, plus_RDR :: RdrName
+fromInteger_RDR, fromRational_RDR, minus_RDR :: RdrName
fromInteger_RDR = nameRdrName fromIntegerName
fromRational_RDR = nameRdrName fromRationalName
minus_RDR = nameRdrName minusName
-times_RDR = varQual_RDR gHC_NUM (fsLit "*")
-plus_RDR = varQual_RDR gHC_NUM (fsLit "+")
+times_RDR, plus_RDR :: WiredIn RdrName
+times_RDR = varQual_RDR <$> gHC_NUM <*> pure (fsLit "*")
+plus_RDR = varQual_RDR <$> gHC_NUM <*> pure (fsLit "+")
toInteger_RDR, toRational_RDR, fromIntegral_RDR :: RdrName
toInteger_RDR = nameRdrName toIntegerName
@@ -781,65 +784,65 @@ fromList_RDR = nameRdrName fromListName
fromListN_RDR = nameRdrName fromListNName
toList_RDR = nameRdrName toListName
-compose_RDR :: RdrName
-compose_RDR = varQual_RDR gHC_BASE (fsLit ".")
+compose_RDR :: WiredIn RdrName
+compose_RDR = varQual_RDR <$> gHC_BASE <*> pure (fsLit ".")
not_RDR, dataToTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR,
and_RDR, range_RDR, inRange_RDR, index_RDR,
- unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName
-and_RDR = varQual_RDR gHC_CLASSES (fsLit "&&")
-not_RDR = varQual_RDR gHC_CLASSES (fsLit "not")
-dataToTag_RDR = varQual_RDR gHC_PRIM (fsLit "dataToTag#")
-succ_RDR = varQual_RDR gHC_ENUM (fsLit "succ")
-pred_RDR = varQual_RDR gHC_ENUM (fsLit "pred")
-minBound_RDR = varQual_RDR gHC_ENUM (fsLit "minBound")
-maxBound_RDR = varQual_RDR gHC_ENUM (fsLit "maxBound")
-range_RDR = varQual_RDR gHC_IX (fsLit "range")
-inRange_RDR = varQual_RDR gHC_IX (fsLit "inRange")
-index_RDR = varQual_RDR gHC_IX (fsLit "index")
-unsafeIndex_RDR = varQual_RDR gHC_IX (fsLit "unsafeIndex")
-unsafeRangeSize_RDR = varQual_RDR gHC_IX (fsLit "unsafeRangeSize")
+ unsafeIndex_RDR, unsafeRangeSize_RDR :: WiredIn RdrName
+and_RDR = varQual_RDR <$> gHC_CLASSES <*> pure (fsLit "&&")
+not_RDR = varQual_RDR <$> gHC_CLASSES <*> pure (fsLit "not")
+dataToTag_RDR = varQual_RDR <$> gHC_PRIM <*> pure (fsLit "dataToTag#")
+succ_RDR = varQual_RDR <$> gHC_ENUM <*> pure (fsLit "succ")
+pred_RDR = varQual_RDR <$> gHC_ENUM <*> pure (fsLit "pred")
+minBound_RDR = varQual_RDR <$> gHC_ENUM <*> pure (fsLit "minBound")
+maxBound_RDR = varQual_RDR <$> gHC_ENUM <*> pure (fsLit "maxBound")
+range_RDR = varQual_RDR <$> gHC_IX <*> pure (fsLit "range")
+inRange_RDR = varQual_RDR <$> gHC_IX <*> pure (fsLit "inRange")
+index_RDR = varQual_RDR <$> gHC_IX <*> pure (fsLit "index")
+unsafeIndex_RDR = varQual_RDR <$> gHC_IX <*> pure (fsLit "unsafeIndex")
+unsafeRangeSize_RDR = varQual_RDR <$> gHC_IX <*> pure (fsLit "unsafeRangeSize")
readList_RDR, readListDefault_RDR, readListPrec_RDR, readListPrecDefault_RDR,
- readPrec_RDR, parens_RDR, choose_RDR, lexP_RDR, expectP_RDR :: RdrName
-readList_RDR = varQual_RDR gHC_READ (fsLit "readList")
-readListDefault_RDR = varQual_RDR gHC_READ (fsLit "readListDefault")
-readListPrec_RDR = varQual_RDR gHC_READ (fsLit "readListPrec")
-readListPrecDefault_RDR = varQual_RDR gHC_READ (fsLit "readListPrecDefault")
-readPrec_RDR = varQual_RDR gHC_READ (fsLit "readPrec")
-parens_RDR = varQual_RDR gHC_READ (fsLit "parens")
-choose_RDR = varQual_RDR gHC_READ (fsLit "choose")
-lexP_RDR = varQual_RDR gHC_READ (fsLit "lexP")
-expectP_RDR = varQual_RDR gHC_READ (fsLit "expectP")
-
-readField_RDR, readFieldHash_RDR, readSymField_RDR :: RdrName
-readField_RDR = varQual_RDR gHC_READ (fsLit "readField")
-readFieldHash_RDR = varQual_RDR gHC_READ (fsLit "readFieldHash")
-readSymField_RDR = varQual_RDR gHC_READ (fsLit "readSymField")
-
-punc_RDR, ident_RDR, symbol_RDR :: RdrName
-punc_RDR = dataQual_RDR lEX (fsLit "Punc")
-ident_RDR = dataQual_RDR lEX (fsLit "Ident")
-symbol_RDR = dataQual_RDR lEX (fsLit "Symbol")
-
-step_RDR, alt_RDR, reset_RDR, prec_RDR, pfail_RDR :: RdrName
-step_RDR = varQual_RDR rEAD_PREC (fsLit "step")
-alt_RDR = varQual_RDR rEAD_PREC (fsLit "+++")
-reset_RDR = varQual_RDR rEAD_PREC (fsLit "reset")
-prec_RDR = varQual_RDR rEAD_PREC (fsLit "prec")
-pfail_RDR = varQual_RDR rEAD_PREC (fsLit "pfail")
+ readPrec_RDR, parens_RDR, choose_RDR, lexP_RDR, expectP_RDR :: WiredIn RdrName
+readList_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readList")
+readListDefault_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readListDefault")
+readListPrec_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readListPrec")
+readListPrecDefault_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readListPrecDefault")
+readPrec_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readPrec")
+parens_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "parens")
+choose_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "choose")
+lexP_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "lexP")
+expectP_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "expectP")
+
+readField_RDR, readFieldHash_RDR, readSymField_RDR :: WiredIn RdrName
+readField_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readField")
+readFieldHash_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readFieldHash")
+readSymField_RDR = varQual_RDR <$> gHC_READ <*> pure (fsLit "readSymField")
+
+punc_RDR, ident_RDR, symbol_RDR :: WiredIn RdrName
+punc_RDR = dataQual_RDR <$> lEX <*> pure (fsLit "Punc")
+ident_RDR = dataQual_RDR <$> lEX <*> pure (fsLit "Ident")
+symbol_RDR = dataQual_RDR <$> lEX <*> pure (fsLit "Symbol")
+
+step_RDR, alt_RDR, reset_RDR, prec_RDR, pfail_RDR :: WiredIn RdrName
+step_RDR = varQual_RDR <$> rEAD_PREC <*> pure (fsLit "step")
+alt_RDR = varQual_RDR <$> rEAD_PREC <*> pure (fsLit "+++")
+reset_RDR = varQual_RDR <$> rEAD_PREC <*> pure (fsLit "reset")
+prec_RDR = varQual_RDR <$> rEAD_PREC <*> pure (fsLit "prec")
+pfail_RDR = varQual_RDR <$> rEAD_PREC <*> pure (fsLit "pfail")
showsPrec_RDR, shows_RDR, showString_RDR,
- showSpace_RDR, showCommaSpace_RDR, showParen_RDR :: RdrName
-showsPrec_RDR = varQual_RDR gHC_SHOW (fsLit "showsPrec")
-shows_RDR = varQual_RDR gHC_SHOW (fsLit "shows")
-showString_RDR = varQual_RDR gHC_SHOW (fsLit "showString")
-showSpace_RDR = varQual_RDR gHC_SHOW (fsLit "showSpace")
-showCommaSpace_RDR = varQual_RDR gHC_SHOW (fsLit "showCommaSpace")
-showParen_RDR = varQual_RDR gHC_SHOW (fsLit "showParen")
+ showSpace_RDR, showCommaSpace_RDR, showParen_RDR :: WiredIn RdrName
+showsPrec_RDR = varQual_RDR <$> gHC_SHOW <*> pure (fsLit "showsPrec")
+shows_RDR = varQual_RDR <$> gHC_SHOW <*> pure (fsLit "shows")
+showString_RDR = varQual_RDR <$> gHC_SHOW <*> pure (fsLit "showString")
+showSpace_RDR = varQual_RDR <$> gHC_SHOW <*> pure (fsLit "showSpace")
+showCommaSpace_RDR = varQual_RDR <$> gHC_SHOW <*> pure (fsLit "showCommaSpace")
+showParen_RDR = varQual_RDR <$> gHC_SHOW <*> pure (fsLit "showParen")
-error_RDR :: RdrName
-error_RDR = varQual_RDR gHC_ERR (fsLit "error")
+error_RDR :: WiredIn RdrName
+error_RDR = varQual_RDR <$> gHC_ERR <*> pure (fsLit "error")
-- Generics (constructors and functions)
u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR,
@@ -854,72 +857,72 @@ u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR,
uAddrDataCon_RDR, uCharDataCon_RDR, uDoubleDataCon_RDR,
uFloatDataCon_RDR, uIntDataCon_RDR, uWordDataCon_RDR,
uAddrHash_RDR, uCharHash_RDR, uDoubleHash_RDR,
- uFloatHash_RDR, uIntHash_RDR, uWordHash_RDR :: RdrName
-
-u1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "U1")
-par1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Par1")
-rec1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Rec1")
-k1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "K1")
-m1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "M1")
-
-l1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "L1")
-r1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "R1")
-
-prodDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit ":*:")
-comp1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Comp1")
-
-unPar1_RDR = varQual_RDR gHC_GENERICS (fsLit "unPar1")
-unRec1_RDR = varQual_RDR gHC_GENERICS (fsLit "unRec1")
-unK1_RDR = varQual_RDR gHC_GENERICS (fsLit "unK1")
-unComp1_RDR = varQual_RDR gHC_GENERICS (fsLit "unComp1")
-
-from_RDR = varQual_RDR gHC_GENERICS (fsLit "from")
-from1_RDR = varQual_RDR gHC_GENERICS (fsLit "from1")
-to_RDR = varQual_RDR gHC_GENERICS (fsLit "to")
-to1_RDR = varQual_RDR gHC_GENERICS (fsLit "to1")
-
-datatypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "datatypeName")
-moduleName_RDR = varQual_RDR gHC_GENERICS (fsLit "moduleName")
-packageName_RDR = varQual_RDR gHC_GENERICS (fsLit "packageName")
-isNewtypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "isNewtype")
-selName_RDR = varQual_RDR gHC_GENERICS (fsLit "selName")
-conName_RDR = varQual_RDR gHC_GENERICS (fsLit "conName")
-conFixity_RDR = varQual_RDR gHC_GENERICS (fsLit "conFixity")
-conIsRecord_RDR = varQual_RDR gHC_GENERICS (fsLit "conIsRecord")
-
-prefixDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Prefix")
-infixDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Infix")
+ uFloatHash_RDR, uIntHash_RDR, uWordHash_RDR :: WiredIn RdrName
+
+u1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "U1")
+par1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "Par1")
+rec1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "Rec1")
+k1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "K1")
+m1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "M1")
+
+l1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "L1")
+r1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "R1")
+
+prodDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit ":*:")
+comp1DataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "Comp1")
+
+unPar1_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "unPar1")
+unRec1_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "unRec1")
+unK1_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "unK1")
+unComp1_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "unComp1")
+
+from_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "from")
+from1_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "from1")
+to_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "to")
+to1_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "to1")
+
+datatypeName_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "datatypeName")
+moduleName_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "moduleName")
+packageName_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "packageName")
+isNewtypeName_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "isNewtype")
+selName_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "selName")
+conName_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "conName")
+conFixity_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "conFixity")
+conIsRecord_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "conIsRecord")
+
+prefixDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "Prefix")
+infixDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "Infix")
leftAssocDataCon_RDR = nameRdrName leftAssociativeDataConName
rightAssocDataCon_RDR = nameRdrName rightAssociativeDataConName
notAssocDataCon_RDR = nameRdrName notAssociativeDataConName
-uAddrDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UAddr")
-uCharDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UChar")
-uDoubleDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UDouble")
-uFloatDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UFloat")
-uIntDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UInt")
-uWordDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UWord")
+uAddrDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "UAddr")
+uCharDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "UChar")
+uDoubleDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "UDouble")
+uFloatDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "UFloat")
+uIntDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "UInt")
+uWordDataCon_RDR = dataQual_RDR <$> gHC_GENERICS <*> pure (fsLit "UWord")
-uAddrHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uAddr#")
-uCharHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uChar#")
-uDoubleHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uDouble#")
-uFloatHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uFloat#")
-uIntHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uInt#")
-uWordHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uWord#")
+uAddrHash_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "uAddr#")
+uCharHash_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "uChar#")
+uDoubleHash_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "uDouble#")
+uFloatHash_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "uFloat#")
+uIntHash_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "uInt#")
+uWordHash_RDR = varQual_RDR <$> gHC_GENERICS <*> pure (fsLit "uWord#")
fmap_RDR, replace_RDR, pure_RDR, ap_RDR, liftA2_RDR, foldable_foldr_RDR,
foldMap_RDR, null_RDR, all_RDR, traverse_RDR, mempty_RDR,
- mappend_RDR :: RdrName
+ mappend_RDR :: WiredIn RdrName
fmap_RDR = nameRdrName fmapName
-replace_RDR = varQual_RDR gHC_BASE (fsLit "<$")
+replace_RDR = varQual_RDR <$> gHC_BASE <*> pure (fsLit "<$")
pure_RDR = nameRdrName pureAName
ap_RDR = nameRdrName apAName
-liftA2_RDR = varQual_RDR gHC_BASE (fsLit "liftA2")
-foldable_foldr_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldr")
-foldMap_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldMap")
-null_RDR = varQual_RDR dATA_FOLDABLE (fsLit "null")
-all_RDR = varQual_RDR dATA_FOLDABLE (fsLit "all")
-traverse_RDR = varQual_RDR dATA_TRAVERSABLE (fsLit "traverse")
+liftA2_RDR = varQual_RDR <$> gHC_BASE <*> pure (fsLit "liftA2")
+foldable_foldr_RDR = varQual_RDR <$> dATA_FOLDABLE <*> pure (fsLit "foldr")
+foldMap_RDR = varQual_RDR <$> dATA_FOLDABLE <*> pure (fsLit "foldMap")
+null_RDR = varQual_RDR <$> dATA_FOLDABLE <*> pure (fsLit "null")
+all_RDR = varQual_RDR <$> dATA_FOLDABLE <*> pure (fsLit "all")
+traverse_RDR = varQual_RDR <$> dATA_TRAVERSABLE <*> pure (fsLit "traverse")
mempty_RDR = nameRdrName memptyName
mappend_RDR = nameRdrName mappendName
@@ -946,26 +949,26 @@ and it's convenient to write them all down in one place.
wildCardName :: Name
wildCardName = mkSystemVarName wildCardKey (fsLit "wild")
-runMainIOName, runRWName :: Name
-runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey
-runRWName = varQual gHC_MAGIC (fsLit "runRW#") runRWKey
+runMainIOName, runRWName :: WiredIn Name
+runMainIOName = varQual <$> gHC_TOP_HANDLER <*> pure (fsLit "runMainIO") runMainKey
+runRWName = varQual <$> gHC_MAGIC <*> pure (fsLit "runRW#") runRWKey
-orderingTyConName, ordLTDataConName, ordEQDataConName, ordGTDataConName :: Name
-orderingTyConName = tcQual gHC_TYPES (fsLit "Ordering") orderingTyConKey
-ordLTDataConName = dcQual gHC_TYPES (fsLit "LT") ordLTDataConKey
-ordEQDataConName = dcQual gHC_TYPES (fsLit "EQ") ordEQDataConKey
-ordGTDataConName = dcQual gHC_TYPES (fsLit "GT") ordGTDataConKey
+orderingTyConName, ordLTDataConName, ordEQDataConName, ordGTDataConName :: WiredIn Name
+orderingTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "Ordering") <*> pure orderingTyConKey
+ordLTDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "LT") <*> pure ordLTDataConKey
+ordEQDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "EQ") <*> pure ordEQDataConKey
+ordGTDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "GT") <*> pure ordGTDataConKey
-specTyConName :: Name
-specTyConName = tcQual gHC_TYPES (fsLit "SPEC") specTyConKey
+specTyConName :: WiredIn Name
+specTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "SPEC") <*> pure specTyConKey
-eitherTyConName, leftDataConName, rightDataConName :: Name
-eitherTyConName = tcQual dATA_EITHER (fsLit "Either") eitherTyConKey
-leftDataConName = dcQual dATA_EITHER (fsLit "Left") leftDataConKey
-rightDataConName = dcQual dATA_EITHER (fsLit "Right") rightDataConKey
+eitherTyConName, leftDataConName, rightDataConName :: WiredIn Name
+eitherTyConName = tcQual <$> dATA_EITHER <*> pure (fsLit "Either") <*> pure eitherTyConKey
+leftDataConName = dcQual <$> dATA_EITHER <*> pure (fsLit "Left") <*> pure leftDataConKey
+rightDataConName = dcQual <$> dATA_EITHER <*> pure (fsLit "Right") <*> pure rightDataConKey
-voidTyConName :: Name
-voidTyConName = tcQual gHC_BASE (fsLit "Void") voidTyConKey
+voidTyConName :: WiredIn Name
+voidTyConName = tcQual <$> gHC_BASE <*> pure (fsLit "Void") <*> pure voidTyConKey
-- Generics (types)
v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
@@ -982,136 +985,136 @@ v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
noSourceUnpackednessDataConName, sourceLazyDataConName,
sourceStrictDataConName, noSourceStrictnessDataConName,
decidedLazyDataConName, decidedStrictDataConName, decidedUnpackDataConName,
- metaDataDataConName, metaConsDataConName, metaSelDataConName :: Name
-
-v1TyConName = tcQual gHC_GENERICS (fsLit "V1") v1TyConKey
-u1TyConName = tcQual gHC_GENERICS (fsLit "U1") u1TyConKey
-par1TyConName = tcQual gHC_GENERICS (fsLit "Par1") par1TyConKey
-rec1TyConName = tcQual gHC_GENERICS (fsLit "Rec1") rec1TyConKey
-k1TyConName = tcQual gHC_GENERICS (fsLit "K1") k1TyConKey
-m1TyConName = tcQual gHC_GENERICS (fsLit "M1") m1TyConKey
-
-sumTyConName = tcQual gHC_GENERICS (fsLit ":+:") sumTyConKey
-prodTyConName = tcQual gHC_GENERICS (fsLit ":*:") prodTyConKey
-compTyConName = tcQual gHC_GENERICS (fsLit ":.:") compTyConKey
-
-rTyConName = tcQual gHC_GENERICS (fsLit "R") rTyConKey
-dTyConName = tcQual gHC_GENERICS (fsLit "D") dTyConKey
-cTyConName = tcQual gHC_GENERICS (fsLit "C") cTyConKey
-sTyConName = tcQual gHC_GENERICS (fsLit "S") sTyConKey
-
-rec0TyConName = tcQual gHC_GENERICS (fsLit "Rec0") rec0TyConKey
-d1TyConName = tcQual gHC_GENERICS (fsLit "D1") d1TyConKey
-c1TyConName = tcQual gHC_GENERICS (fsLit "C1") c1TyConKey
-s1TyConName = tcQual gHC_GENERICS (fsLit "S1") s1TyConKey
-
-repTyConName = tcQual gHC_GENERICS (fsLit "Rep") repTyConKey
-rep1TyConName = tcQual gHC_GENERICS (fsLit "Rep1") rep1TyConKey
-
-uRecTyConName = tcQual gHC_GENERICS (fsLit "URec") uRecTyConKey
-uAddrTyConName = tcQual gHC_GENERICS (fsLit "UAddr") uAddrTyConKey
-uCharTyConName = tcQual gHC_GENERICS (fsLit "UChar") uCharTyConKey
-uDoubleTyConName = tcQual gHC_GENERICS (fsLit "UDouble") uDoubleTyConKey
-uFloatTyConName = tcQual gHC_GENERICS (fsLit "UFloat") uFloatTyConKey
-uIntTyConName = tcQual gHC_GENERICS (fsLit "UInt") uIntTyConKey
-uWordTyConName = tcQual gHC_GENERICS (fsLit "UWord") uWordTyConKey
-
-prefixIDataConName = dcQual gHC_GENERICS (fsLit "PrefixI") prefixIDataConKey
-infixIDataConName = dcQual gHC_GENERICS (fsLit "InfixI") infixIDataConKey
-leftAssociativeDataConName = dcQual gHC_GENERICS (fsLit "LeftAssociative") leftAssociativeDataConKey
-rightAssociativeDataConName = dcQual gHC_GENERICS (fsLit "RightAssociative") rightAssociativeDataConKey
-notAssociativeDataConName = dcQual gHC_GENERICS (fsLit "NotAssociative") notAssociativeDataConKey
-
-sourceUnpackDataConName = dcQual gHC_GENERICS (fsLit "SourceUnpack") sourceUnpackDataConKey
-sourceNoUnpackDataConName = dcQual gHC_GENERICS (fsLit "SourceNoUnpack") sourceNoUnpackDataConKey
-noSourceUnpackednessDataConName = dcQual gHC_GENERICS (fsLit "NoSourceUnpackedness") noSourceUnpackednessDataConKey
-sourceLazyDataConName = dcQual gHC_GENERICS (fsLit "SourceLazy") sourceLazyDataConKey
-sourceStrictDataConName = dcQual gHC_GENERICS (fsLit "SourceStrict") sourceStrictDataConKey
-noSourceStrictnessDataConName = dcQual gHC_GENERICS (fsLit "NoSourceStrictness") noSourceStrictnessDataConKey
-decidedLazyDataConName = dcQual gHC_GENERICS (fsLit "DecidedLazy") decidedLazyDataConKey
-decidedStrictDataConName = dcQual gHC_GENERICS (fsLit "DecidedStrict") decidedStrictDataConKey
-decidedUnpackDataConName = dcQual gHC_GENERICS (fsLit "DecidedUnpack") decidedUnpackDataConKey
-
-metaDataDataConName = dcQual gHC_GENERICS (fsLit "MetaData") metaDataDataConKey
-metaConsDataConName = dcQual gHC_GENERICS (fsLit "MetaCons") metaConsDataConKey
-metaSelDataConName = dcQual gHC_GENERICS (fsLit "MetaSel") metaSelDataConKey
+ metaDataDataConName, metaConsDataConName, metaSelDataConName :: WiredIn Name
+
+v1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "V1") <*> pure v1TyConKey
+u1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "U1") <*> pure u1TyConKey
+par1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "Par1") <*> pure par1TyConKey
+rec1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "Rec1") <*> pure rec1TyConKey
+k1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "K1") <*> pure k1TyConKey
+m1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "M1") <*> pure m1TyConKey
+
+sumTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit ":+:") <*> pure sumTyConKey
+prodTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit ":*:") <*> pure prodTyConKey
+compTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit ":.:") <*> pure compTyConKey
+
+rTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "R") <*> pure rTyConKey
+dTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "D") <*> pure dTyConKey
+cTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "C") <*> pure cTyConKey
+sTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "S") <*> pure sTyConKey
+
+rec0TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "Rec0") <*> pure rec0TyConKey
+d1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "D1") <*> pure d1TyConKey
+c1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "C1") <*> pure c1TyConKey
+s1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "S1") <*> pure s1TyConKey
+
+repTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "Rep") <*> pure repTyConKey
+rep1TyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "Rep1") <*> pure rep1TyConKey
+
+uRecTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "URec") <*> pure uRecTyConKey
+uAddrTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "UAddr") <*> pure uAddrTyConKey
+uCharTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "UChar") <*> pure uCharTyConKey
+uDoubleTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "UDouble") <*> pure uDoubleTyConKey
+uFloatTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "UFloat") <*> pure uFloatTyConKey
+uIntTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "UInt") <*> pure uIntTyConKey
+uWordTyConName = tcQual <$> gHC_GENERICS <*> pure (fsLit "UWord") <*> pure uWordTyConKey
+
+prefixIDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "PrefixI") <*> pure prefixIDataConKey
+infixIDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "InfixI") <*> pure infixIDataConKey
+leftAssociativeDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "LeftAssociative") <*> pure leftAssociativeDataConKey
+rightAssociativeDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "RightAssociative") <*> pure rightAssociativeDataConKey
+notAssociativeDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "NotAssociative") <*> pure notAssociativeDataConKey
+
+sourceUnpackDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "SourceUnpack") <*> pure sourceUnpackDataConKey
+sourceNoUnpackDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "SourceNoUnpack") <*> pure sourceNoUnpackDataConKey
+noSourceUnpackednessDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "NoSourceUnpackedness") <*> pure noSourceUnpackednessDataConKey
+sourceLazyDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "SourceLazy") <*> pure sourceLazyDataConKey
+sourceStrictDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "SourceStrict") <*> pure sourceStrictDataConKey
+noSourceStrictnessDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "NoSourceStrictness") <*> pure noSourceStrictnessDataConKey
+decidedLazyDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "DecidedLazy") <*> pure decidedLazyDataConKey
+decidedStrictDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "DecidedStrict") <*> pure decidedStrictDataConKey
+decidedUnpackDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "DecidedUnpack") <*> pure decidedUnpackDataConKey
+
+metaDataDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "MetaData") <*> pure metaDataDataConKey
+metaConsDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "MetaCons") <*> pure metaConsDataConKey
+metaSelDataConName = dcQual <$> gHC_GENERICS <*> pure (fsLit "MetaSel") <*> pure metaSelDataConKey
-- Primitive Int
-divIntName, modIntName :: Name
-divIntName = varQual gHC_CLASSES (fsLit "divInt#") divIntIdKey
-modIntName = varQual gHC_CLASSES (fsLit "modInt#") modIntIdKey
+divIntName, modIntName :: WiredIn Name
+divIntName = varQual <$> gHC_CLASSES <*> pure (fsLit "divInt#") <*> pure divIntIdKey
+modIntName = varQual <$> gHC_CLASSES <*> pure (fsLit "modInt#") <*> pure modIntIdKey
-- Base strings Strings
unpackCStringName, unpackCStringFoldrName,
unpackCStringUtf8Name, unpackCStringFoldrUtf8Name,
unpackCStringAppendName, unpackCStringAppendUtf8Name,
- eqStringName, cstringLengthName :: Name
-cstringLengthName = varQual gHC_CSTRING (fsLit "cstringLength#") cstringLengthIdKey
-eqStringName = varQual gHC_BASE (fsLit "eqString") eqStringIdKey
+ eqStringName, cstringLengthName :: WiredIn Name
+cstringLengthName = varQual <$> gHC_CSTRING <*> pure (fsLit "cstringLength#") <*> pure cstringLengthIdKey
+eqStringName = varQual <$> gHC_BASE <*> pure (fsLit "eqString") <*> pure eqStringIdKey
-unpackCStringName = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey
-unpackCStringAppendName = varQual gHC_CSTRING (fsLit "unpackAppendCString#") unpackCStringAppendIdKey
-unpackCStringFoldrName = varQual gHC_CSTRING (fsLit "unpackFoldrCString#") unpackCStringFoldrIdKey
+unpackCStringName = varQual <$> gHC_CSTRING <*> pure (fsLit "unpackCString#") <*> pure unpackCStringIdKey
+unpackCStringAppendName = varQual <$> gHC_CSTRING <*> pure (fsLit "unpackAppendCString#") <*> pure unpackCStringAppendIdKey
+unpackCStringFoldrName = varQual <$> gHC_CSTRING <*> pure (fsLit "unpackFoldrCString#") <*> pure unpackCStringFoldrIdKey
-unpackCStringUtf8Name = varQual gHC_CSTRING (fsLit "unpackCStringUtf8#") unpackCStringUtf8IdKey
-unpackCStringAppendUtf8Name = varQual gHC_CSTRING (fsLit "unpackAppendCStringUtf8#") unpackCStringAppendUtf8IdKey
-unpackCStringFoldrUtf8Name = varQual gHC_CSTRING (fsLit "unpackFoldrCStringUtf8#") unpackCStringFoldrUtf8IdKey
+unpackCStringUtf8Name = varQual <$> gHC_CSTRING <*> pure (fsLit "unpackCStringUtf8#") <*> pure unpackCStringUtf8IdKey
+unpackCStringAppendUtf8Name = varQual <$> gHC_CSTRING <*> pure (fsLit "unpackAppendCStringUtf8#") <*> pure unpackCStringAppendUtf8IdKey
+unpackCStringFoldrUtf8Name = varQual <$> gHC_CSTRING <*> pure (fsLit "unpackFoldrCStringUtf8#") <*> pure unpackCStringFoldrUtf8IdKey
-- The 'inline' function
-inlineIdName :: Name
-inlineIdName = varQual gHC_MAGIC (fsLit "inline") inlineIdKey
+inlineIdName :: WiredIn Name
+inlineIdName = varQual <$> gHC_MAGIC <*> pure (fsLit "inline") <*> pure inlineIdKey
-- Base classes (Eq, Ord, Functor)
-fmapName, eqClassName, eqName, ordClassName, geName, functorClassName :: Name
-eqClassName = clsQual gHC_CLASSES (fsLit "Eq") eqClassKey
-eqName = varQual gHC_CLASSES (fsLit "==") eqClassOpKey
-ordClassName = clsQual gHC_CLASSES (fsLit "Ord") ordClassKey
-geName = varQual gHC_CLASSES (fsLit ">=") geClassOpKey
-functorClassName = clsQual gHC_BASE (fsLit "Functor") functorClassKey
-fmapName = varQual gHC_BASE (fsLit "fmap") fmapClassOpKey
+fmapName, eqClassName, eqName, ordClassName, geName, functorClassName :: WiredIn Name
+eqClassName = clsQual <$> gHC_CLASSES <*> pure (fsLit "Eq") <*> pure eqClassKey
+eqName = varQual <$> gHC_CLASSES <*> pure (fsLit "==") <*> pure eqClassOpKey
+ordClassName = clsQual <$> gHC_CLASSES <*> pure (fsLit "Ord") <*> pure ordClassKey
+geName = varQual <$> gHC_CLASSES <*> pure (fsLit ">=") <*> pure geClassOpKey
+functorClassName = clsQual <$> gHC_BASE <*> pure (fsLit "Functor") <*> pure functorClassKey
+fmapName = varQual <$> gHC_BASE <*> pure (fsLit "fmap") <*> pure fmapClassOpKey
-- Class Monad
-monadClassName, thenMName, bindMName, returnMName :: Name
-monadClassName = clsQual gHC_BASE (fsLit "Monad") monadClassKey
-thenMName = varQual gHC_BASE (fsLit ">>") thenMClassOpKey
-bindMName = varQual gHC_BASE (fsLit ">>=") bindMClassOpKey
-returnMName = varQual gHC_BASE (fsLit "return") returnMClassOpKey
+monadClassName, thenMName, bindMName, returnMName :: WiredIn Name
+monadClassName = clsQual <$> gHC_BASE <*> pure (fsLit "Monad") <*> pure monadClassKey
+thenMName = varQual <$> gHC_BASE <*> pure (fsLit ">>") <*> pure thenMClassOpKey
+bindMName = varQual <$> gHC_BASE <*> pure (fsLit ">>=") <*> pure bindMClassOpKey
+returnMName = varQual <$> gHC_BASE <*> pure (fsLit "return") <*> pure returnMClassOpKey
-- Class MonadFail
-monadFailClassName, failMName :: Name
-monadFailClassName = clsQual mONAD_FAIL (fsLit "MonadFail") monadFailClassKey
-failMName = varQual mONAD_FAIL (fsLit "fail") failMClassOpKey
+monadFailClassName, failMName :: WiredIn Name
+monadFailClassName = clsQual <$> mONAD_FAIL <*> pure (fsLit "MonadFail") <*> pure monadFailClassKey
+failMName = varQual <$> mONAD_FAIL <*> pure (fsLit "fail") <*> pure failMClassOpKey
-- Class Applicative
-applicativeClassName, pureAName, apAName, thenAName :: Name
-applicativeClassName = clsQual gHC_BASE (fsLit "Applicative") applicativeClassKey
-apAName = varQual gHC_BASE (fsLit "<*>") apAClassOpKey
-pureAName = varQual gHC_BASE (fsLit "pure") pureAClassOpKey
-thenAName = varQual gHC_BASE (fsLit "*>") thenAClassOpKey
+applicativeClassName, pureAName, apAName, thenAName :: WiredIn Name
+applicativeClassName = clsQual <$> gHC_BASE <*> pure (fsLit "Applicative") <*> pure applicativeClassKey
+apAName = varQual <$> gHC_BASE <*> pure (fsLit "<*>") <*> pure apAClassOpKey
+pureAName = varQual <$> gHC_BASE <*> pure (fsLit "pure") <*> pure pureAClassOpKey
+thenAName = varQual <$> gHC_BASE <*> pure (fsLit "*>") <*> pure thenAClassOpKey
-- Classes (Foldable, Traversable)
-foldableClassName, traversableClassName :: Name
-foldableClassName = clsQual dATA_FOLDABLE (fsLit "Foldable") foldableClassKey
-traversableClassName = clsQual dATA_TRAVERSABLE (fsLit "Traversable") traversableClassKey
+foldableClassName, traversableClassName :: WiredIn Name
+foldableClassName = clsQual <$> dATA_FOLDABLE <*> pure (fsLit "Foldable") <*> pure foldableClassKey
+traversableClassName = clsQual <$> dATA_TRAVERSABLE <*> pure (fsLit "Traversable") <*> pure traversableClassKey
-- Classes (Semigroup, Monoid)
-semigroupClassName, sappendName :: Name
-semigroupClassName = clsQual gHC_BASE (fsLit "Semigroup") semigroupClassKey
-sappendName = varQual gHC_BASE (fsLit "<>") sappendClassOpKey
-monoidClassName, memptyName, mappendName, mconcatName :: Name
-monoidClassName = clsQual gHC_BASE (fsLit "Monoid") monoidClassKey
-memptyName = varQual gHC_BASE (fsLit "mempty") memptyClassOpKey
-mappendName = varQual gHC_BASE (fsLit "mappend") mappendClassOpKey
-mconcatName = varQual gHC_BASE (fsLit "mconcat") mconcatClassOpKey
+semigroupClassName, sappendName :: WiredIn Name
+semigroupClassName = clsQual <$> gHC_BASE <*> pure (fsLit "Semigroup") <*> pure semigroupClassKey
+sappendName = varQual <$> gHC_BASE <*> pure (fsLit "<>") <*> pure sappendClassOpKey
+monoidClassName, memptyName, mappendName, mconcatName :: WiredIn Name
+monoidClassName = clsQual <$> gHC_BASE <*> pure (fsLit "Monoid") <*> pure monoidClassKey
+memptyName = varQual <$> gHC_BASE <*> pure (fsLit "mempty") <*> pure memptyClassOpKey
+mappendName = varQual <$> gHC_BASE <*> pure (fsLit "mappend") <*> pure mappendClassOpKey
+mconcatName = varQual <$> gHC_BASE <*> pure (fsLit "mconcat") <*> pure mconcatClassOpKey
-- AMP additions
-joinMName, alternativeClassName :: Name
-joinMName = varQual gHC_BASE (fsLit "join") joinMIdKey
-alternativeClassName = clsQual mONAD (fsLit "Alternative") alternativeClassKey
+joinMName, alternativeClassName :: WiredIn Name
+joinMName = varQual <$> gHC_BASE <*> pure (fsLit "join") <*> pure joinMIdKey
+alternativeClassName = clsQual <$> mONAD <*> pure (fsLit "Alternative") <*> pure alternativeClassKey
--
joinMIdKey, apAClassOpKey, pureAClassOpKey, thenAClassOpKey,
@@ -1124,29 +1127,29 @@ alternativeClassKey = mkPreludeMiscIdUnique 754
-- Functions for GHC extensions
-considerAccessibleName :: Name
-considerAccessibleName = varQual gHC_EXTS (fsLit "considerAccessible") considerAccessibleIdKey
+considerAccessibleName :: WiredIn Name
+considerAccessibleName = varQual <$> gHC_EXTS <*> pure (fsLit "considerAccessible") <*> pure considerAccessibleIdKey
-- Random GHC.Base functions
fromStringName, otherwiseIdName, foldrName, buildName, augmentName,
mapName, appendName, assertName,
- dollarName :: Name
-dollarName = varQual gHC_BASE (fsLit "$") dollarIdKey
-otherwiseIdName = varQual gHC_BASE (fsLit "otherwise") otherwiseIdKey
-foldrName = varQual gHC_BASE (fsLit "foldr") foldrIdKey
-buildName = varQual gHC_BASE (fsLit "build") buildIdKey
-augmentName = varQual gHC_BASE (fsLit "augment") augmentIdKey
-mapName = varQual gHC_BASE (fsLit "map") mapIdKey
-appendName = varQual gHC_BASE (fsLit "++") appendIdKey
-assertName = varQual gHC_BASE (fsLit "assert") assertIdKey
-fromStringName = varQual dATA_STRING (fsLit "fromString") fromStringClassOpKey
+ dollarName :: WiredIn Name
+dollarName = varQual <$> gHC_BASE <*> pure (fsLit "$") <*> pure dollarIdKey
+otherwiseIdName = varQual <$> gHC_BASE <*> pure (fsLit "otherwise") <*> pure otherwiseIdKey
+foldrName = varQual <$> gHC_BASE <*> pure (fsLit "foldr") <*> pure foldrIdKey
+buildName = varQual <$> gHC_BASE <*> pure (fsLit "build") <*> pure buildIdKey
+augmentName = varQual <$> gHC_BASE <*> pure (fsLit "augment") <*> pure augmentIdKey
+mapName = varQual <$> gHC_BASE <*> pure (fsLit "map") <*> pure mapIdKey
+appendName = varQual <$> gHC_BASE <*> pure (fsLit "++") <*> pure appendIdKey
+assertName = varQual <$> gHC_BASE <*> pure (fsLit "assert") <*> pure assertIdKey
+fromStringName = varQual <$> dATA_STRING <*> pure (fsLit "fromString") <*> pure fromStringClassOpKey
-- Module GHC.Num
-numClassName, fromIntegerName, minusName, negateName :: Name
-numClassName = clsQual gHC_NUM (fsLit "Num") numClassKey
-fromIntegerName = varQual gHC_NUM (fsLit "fromInteger") fromIntegerClassOpKey
-minusName = varQual gHC_NUM (fsLit "-") minusClassOpKey
-negateName = varQual gHC_NUM (fsLit "negate") negateClassOpKey
+numClassName, fromIntegerName, minusName, negateName :: WiredIn Name
+numClassName = clsQual <$> gHC_NUM <*> pure (fsLit "Num") <*> pure numClassKey
+fromIntegerName = varQual <$> gHC_NUM <*> pure (fsLit "fromInteger") <*> pure fromIntegerClassOpKey
+minusName = varQual <$> gHC_NUM <*> pure (fsLit "-") <*> pure minusClassOpKey
+negateName = varQual <$> gHC_NUM <*> pure (fsLit "negate") <*> pure negateClassOpKey
---------------------------------
-- ghc-bignum
@@ -1215,12 +1218,12 @@ integerFromNaturalName
, bignatEqName
, bignatCompareName
, bignatCompareWordName
- :: Name
+ :: WiredIn Name
-bnbVarQual, bnnVarQual, bniVarQual :: String -> Unique -> Name
-bnbVarQual str key = varQual gHC_NUM_BIGNAT (fsLit str) key
-bnnVarQual str key = varQual gHC_NUM_NATURAL (fsLit str) key
-bniVarQual str key = varQual gHC_NUM_INTEGER (fsLit str) key
+bnbVarQual, bnnVarQual, bniVarQual :: String -> Unique -> WiredIn Name
+bnbVarQual str key = varQual <$> gHC_NUM_BIGNAT <*> pure (fsLit str) key
+bnnVarQual str key = varQual <$> gHC_NUM_NATURAL <*> pure (fsLit str) <*> pure key
+bniVarQual str key = varQual <$> gHC_NUM_INTEGER <*> pure (fsLit str) <*> pure key
-- Types and DataCons
bignatFromWordListName = bnbVarQual "bigNatFromWordList#" bignatFromWordListIdKey
@@ -1300,40 +1303,40 @@ integerShiftRName = bniVarQual "integerShiftR#" integerShiftR
rationalTyConName, ratioTyConName, ratioDataConName, realClassName,
integralClassName, realFracClassName, fractionalClassName,
fromRationalName, toIntegerName, toRationalName, fromIntegralName,
- realToFracName, mkRationalBase2Name, mkRationalBase10Name :: Name
-rationalTyConName = tcQual gHC_REAL (fsLit "Rational") rationalTyConKey
-ratioTyConName = tcQual gHC_REAL (fsLit "Ratio") ratioTyConKey
-ratioDataConName = dcQual gHC_REAL (fsLit ":%") ratioDataConKey
-realClassName = clsQual gHC_REAL (fsLit "Real") realClassKey
-integralClassName = clsQual gHC_REAL (fsLit "Integral") integralClassKey
-realFracClassName = clsQual gHC_REAL (fsLit "RealFrac") realFracClassKey
-fractionalClassName = clsQual gHC_REAL (fsLit "Fractional") fractionalClassKey
-fromRationalName = varQual gHC_REAL (fsLit "fromRational") fromRationalClassOpKey
-toIntegerName = varQual gHC_REAL (fsLit "toInteger") toIntegerClassOpKey
-toRationalName = varQual gHC_REAL (fsLit "toRational") toRationalClassOpKey
-fromIntegralName = varQual gHC_REAL (fsLit "fromIntegral")fromIntegralIdKey
-realToFracName = varQual gHC_REAL (fsLit "realToFrac") realToFracIdKey
-mkRationalBase2Name = varQual gHC_REAL (fsLit "mkRationalBase2") mkRationalBase2IdKey
-mkRationalBase10Name = varQual gHC_REAL (fsLit "mkRationalBase10") mkRationalBase10IdKey
+ realToFracName, mkRationalBase2Name, mkRationalBase10Name :: WiredIn Name
+rationalTyConName = tcQual <$> gHC_REAL <*> pure (fsLit "Rational") <*> pure rationalTyConKey
+ratioTyConName = tcQual <$> gHC_REAL <*> pure (fsLit "Ratio") <*> pure ratioTyConKey
+ratioDataConName = dcQual <$> gHC_REAL <*> pure (fsLit ":%") <*> pure ratioDataConKey
+realClassName = clsQual <$> gHC_REAL <*> pure (fsLit "Real") <*> pure realClassKey
+integralClassName = clsQual <$> gHC_REAL <*> pure (fsLit "Integral") <*> pure integralClassKey
+realFracClassName = clsQual <$> gHC_REAL <*> pure (fsLit "RealFrac") <*> pure realFracClassKey
+fractionalClassName = clsQual <$> gHC_REAL <*> pure (fsLit "Fractional") <*> pure fractionalClassKey
+fromRationalName = varQual <$> gHC_REAL <*> pure (fsLit "fromRational") <*> pure fromRationalClassOpKey
+toIntegerName = varQual <$> gHC_REAL <*> pure (fsLit "toInteger") <*> pure toIntegerClassOpKey
+toRationalName = varQual <$> gHC_REAL <*> pure (fsLit "toRational") <*> pure toRationalClassOpKey
+fromIntegralName = varQual <$> gHC_REAL <*> pure (fsLit "fromIntegral") <*> pure fromIntegralIdKey
+realToFracName = varQual <$> gHC_REAL <*> pure (fsLit "realToFrac") <*> pure realToFracIdKey
+mkRationalBase2Name = varQual <$> gHC_REAL <*> pure (fsLit "mkRationalBase2") <*> pure mkRationalBase2IdKey
+mkRationalBase10Name = varQual <$> gHC_REAL <*> pure (fsLit "mkRationalBase10") <*> pure mkRationalBase10IdKey
-- GHC.Float classes
-floatingClassName, realFloatClassName :: Name
-floatingClassName = clsQual gHC_FLOAT (fsLit "Floating") floatingClassKey
-realFloatClassName = clsQual gHC_FLOAT (fsLit "RealFloat") realFloatClassKey
+floatingClassName, realFloatClassName :: WiredIn Name
+floatingClassName = clsQual <$> gHC_FLOAT <*> pure (fsLit "Floating") <*> pure floatingClassKey
+realFloatClassName = clsQual <$> gHC_FLOAT <*> pure (fsLit "RealFloat") <*> pure realFloatClassKey
-- other GHC.Float functions
integerToFloatName, integerToDoubleName,
naturalToFloatName, naturalToDoubleName,
- rationalToFloatName, rationalToDoubleName :: Name
-integerToFloatName = varQual gHC_FLOAT (fsLit "integerToFloat#") integerToFloatIdKey
-integerToDoubleName = varQual gHC_FLOAT (fsLit "integerToDouble#") integerToDoubleIdKey
-naturalToFloatName = varQual gHC_FLOAT (fsLit "naturalToFloat#") naturalToFloatIdKey
-naturalToDoubleName = varQual gHC_FLOAT (fsLit "naturalToDouble#") naturalToDoubleIdKey
-rationalToFloatName = varQual gHC_FLOAT (fsLit "rationalToFloat") rationalToFloatIdKey
-rationalToDoubleName = varQual gHC_FLOAT (fsLit "rationalToDouble") rationalToDoubleIdKey
+ rationalToFloatName, rationalToDoubleName :: WiredIn Name
+integerToFloatName = varQual <$> gHC_FLOAT <*> pure (fsLit "integerToFloat#") <*> pure integerToFloatIdKey
+integerToDoubleName = varQual <$> gHC_FLOAT <*> pure (fsLit "integerToDouble#") <*> pure integerToDoubleIdKey
+naturalToFloatName = varQual <$> gHC_FLOAT <*> pure (fsLit "naturalToFloat#") <*> pure naturalToFloatIdKey
+naturalToDoubleName = varQual <$> gHC_FLOAT <*> pure (fsLit "naturalToDouble#") <*> pure naturalToDoubleIdKey
+rationalToFloatName = varQual <$> gHC_FLOAT <*> pure (fsLit "rationalToFloat") <*> pure rationalToFloatIdKey
+rationalToDoubleName = varQual <$> gHC_FLOAT <*> pure (fsLit "rationalToDouble") <*> pure rationalToDoubleIdKey
-- Class Ix
-ixClassName :: Name
-ixClassName = clsQual gHC_IX (fsLit "Ix") ixClassKey
+ixClassName :: WiredIn Name
+ixClassName = clsQual <$> gHC_IX <*> pure (fsLit "Ix") <*> pure ixClassKey
-- Typeable representation types
trModuleTyConName
@@ -1343,14 +1346,14 @@ trModuleTyConName
, trNameDDataConName
, trTyConTyConName
, trTyConDataConName
- :: Name
-trModuleTyConName = tcQual gHC_TYPES (fsLit "Module") trModuleTyConKey
-trModuleDataConName = dcQual gHC_TYPES (fsLit "Module") trModuleDataConKey
-trNameTyConName = tcQual gHC_TYPES (fsLit "TrName") trNameTyConKey
-trNameSDataConName = dcQual gHC_TYPES (fsLit "TrNameS") trNameSDataConKey
-trNameDDataConName = dcQual gHC_TYPES (fsLit "TrNameD") trNameDDataConKey
-trTyConTyConName = tcQual gHC_TYPES (fsLit "TyCon") trTyConTyConKey
-trTyConDataConName = dcQual gHC_TYPES (fsLit "TyCon") trTyConDataConKey
+ :: WiredIn Name
+trModuleTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "Module") <*> pure trModuleTyConKey
+trModuleDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "Module") <*> pure trModuleDataConKey
+trNameTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "TrName") <*> pure trNameTyConKey
+trNameSDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "TrNameS") <*> pure trNameSDataConKey
+trNameDDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "TrNameD") <*> pure trNameDDataConKey
+trTyConTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "TyCon") <*> pure trTyConTyConKey
+trTyConDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "TyCon") <*> pure trTyConDataConKey
kindRepTyConName
, kindRepTyConAppDataConName
@@ -1360,25 +1363,25 @@ kindRepTyConName
, kindRepTYPEDataConName
, kindRepTypeLitSDataConName
, kindRepTypeLitDDataConName
- :: Name
-kindRepTyConName = tcQual gHC_TYPES (fsLit "KindRep") kindRepTyConKey
-kindRepTyConAppDataConName = dcQual gHC_TYPES (fsLit "KindRepTyConApp") kindRepTyConAppDataConKey
-kindRepVarDataConName = dcQual gHC_TYPES (fsLit "KindRepVar") kindRepVarDataConKey
-kindRepAppDataConName = dcQual gHC_TYPES (fsLit "KindRepApp") kindRepAppDataConKey
-kindRepFunDataConName = dcQual gHC_TYPES (fsLit "KindRepFun") kindRepFunDataConKey
-kindRepTYPEDataConName = dcQual gHC_TYPES (fsLit "KindRepTYPE") kindRepTYPEDataConKey
-kindRepTypeLitSDataConName = dcQual gHC_TYPES (fsLit "KindRepTypeLitS") kindRepTypeLitSDataConKey
-kindRepTypeLitDDataConName = dcQual gHC_TYPES (fsLit "KindRepTypeLitD") kindRepTypeLitDDataConKey
+ :: WiredIn Name
+kindRepTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "KindRep") <*> pure kindRepTyConKey
+kindRepTyConAppDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepTyConApp") <*> pure kindRepTyConAppDataConKey
+kindRepVarDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepVar") <*> pure kindRepVarDataConKey
+kindRepAppDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepApp") <*> pure kindRepAppDataConKey
+kindRepFunDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepFun") <*> pure kindRepFunDataConKey
+kindRepTYPEDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepTYPE") <*> pure kindRepTYPEDataConKey
+kindRepTypeLitSDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepTypeLitS") <*> pure kindRepTypeLitSDataConKey
+kindRepTypeLitDDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "KindRepTypeLitD") <*> pure kindRepTypeLitDDataConKey
typeLitSortTyConName
, typeLitSymbolDataConName
, typeLitNatDataConName
, typeLitCharDataConName
- :: Name
-typeLitSortTyConName = tcQual gHC_TYPES (fsLit "TypeLitSort") typeLitSortTyConKey
-typeLitSymbolDataConName = dcQual gHC_TYPES (fsLit "TypeLitSymbol") typeLitSymbolDataConKey
-typeLitNatDataConName = dcQual gHC_TYPES (fsLit "TypeLitNat") typeLitNatDataConKey
-typeLitCharDataConName = dcQual gHC_TYPES (fsLit "TypeLitChar") typeLitCharDataConKey
+ :: WiredIn Name
+typeLitSortTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "TypeLitSort") <*> pure typeLitSortTyConKey
+typeLitSymbolDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "TypeLitSymbol") <*> pure typeLitSymbolDataConKey
+typeLitNatDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "TypeLitNat") <*> pure typeLitNatDataConKey
+typeLitCharDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "TypeLitChar") <*> pure typeLitCharDataConKey
-- Class Typeable, and functions for constructing `Typeable` dictionaries
typeableClassName
@@ -1394,37 +1397,37 @@ typeableClassName
, typeSymbolTypeRepName
, typeCharTypeRepName
, trGhcPrimModuleName
- :: Name
-typeableClassName = clsQual tYPEABLE_INTERNAL (fsLit "Typeable") typeableClassKey
-typeRepTyConName = tcQual tYPEABLE_INTERNAL (fsLit "TypeRep") typeRepTyConKey
-someTypeRepTyConName = tcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepTyConKey
-someTypeRepDataConName = dcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepDataConKey
-typeRepIdName = varQual tYPEABLE_INTERNAL (fsLit "typeRep#") typeRepIdKey
-mkTrTypeName = varQual tYPEABLE_INTERNAL (fsLit "mkTrType") mkTrTypeKey
-mkTrConName = varQual tYPEABLE_INTERNAL (fsLit "mkTrCon") mkTrConKey
-mkTrAppName = varQual tYPEABLE_INTERNAL (fsLit "mkTrApp") mkTrAppKey
-mkTrFunName = varQual tYPEABLE_INTERNAL (fsLit "mkTrFun") mkTrFunKey
-typeNatTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey
-typeSymbolTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey
-typeCharTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeCharTypeRep") typeCharTypeRepKey
+ :: WiredIn Name
+typeableClassName = clsQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "Typeable") <*> pure typeableClassKey
+typeRepTyConName = tcQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "TypeRep") <*> pure typeRepTyConKey
+someTypeRepTyConName = tcQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "SomeTypeRep") <*> pure someTypeRepTyConKey
+someTypeRepDataConName = dcQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "SomeTypeRep") <*> pure someTypeRepDataConKey
+typeRepIdName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "typeRep#") <*> pure typeRepIdKey
+mkTrTypeName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "mkTrType") <*> pure mkTrTypeKey
+mkTrConName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "mkTrCon") <*> pure mkTrConKey
+mkTrAppName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "mkTrApp") <*> pure mkTrAppKey
+mkTrFunName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "mkTrFun") <*> pure mkTrFunKey
+typeNatTypeRepName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "typeNatTypeRep") <*> pure typeNatTypeRepKey
+typeSymbolTypeRepName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "typeSymbolTypeRep") <*> pure typeSymbolTypeRepKey
+typeCharTypeRepName = varQual <$> tYPEABLE_INTERNAL <*> pure (fsLit "typeCharTypeRep") <*> pure typeCharTypeRepKey
-- this is the Typeable 'Module' for GHC.Prim (which has no code, so we place in GHC.Types)
-- See Note [Grand plan for Typeable] in GHC.Tc.Instance.Typeable.
-trGhcPrimModuleName = varQual gHC_TYPES (fsLit "tr$ModuleGHCPrim") trGhcPrimModuleKey
+trGhcPrimModuleName = varQual <$> gHC_TYPES <*> pure (fsLit "tr$ModuleGHCPrim") <*> pure trGhcPrimModuleKey
-- Typeable KindReps for some common cases
starKindRepName, starArrStarKindRepName,
- starArrStarArrStarKindRepName, constraintKindRepName :: Name
-starKindRepName = varQual gHC_TYPES (fsLit "krep$*") starKindRepKey
-starArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*Arr*") starArrStarKindRepKey
-starArrStarArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*->*->*") starArrStarArrStarKindRepKey
-constraintKindRepName = varQual gHC_TYPES (fsLit "krep$Constraint") constraintKindRepKey
+ starArrStarArrStarKindRepName, constraintKindRepName :: WiredIn Name
+starKindRepName = varQual <$> gHC_TYPES <*> pure (fsLit "krep$*") <*> pure starKindRepKey
+starArrStarKindRepName = varQual <$> gHC_TYPES <*> pure (fsLit "krep$*Arr*") <*> pure starArrStarKindRepKey
+starArrStarArrStarKindRepName = varQual <$> gHC_TYPES <*> pure (fsLit "krep$*->*->*") <*> pure starArrStarArrStarKindRepKey
+constraintKindRepName = varQual <$> gHC_TYPES <*> pure (fsLit "krep$Constraint") <*> pure constraintKindRepKey
-- WithDict
-withDictClassName :: Name
-withDictClassName = clsQual gHC_MAGIC_DICT (fsLit "WithDict") withDictClassKey
+withDictClassName :: WiredIn Name
+withDictClassName = clsQual <$> gHC_MAGIC_DICT <*> pure (fsLit "WithDict") <*> pure withDictClassKey
-nonEmptyTyConName :: Name
-nonEmptyTyConName = tcQual gHC_BASE (fsLit "NonEmpty") nonEmptyTyConKey
+nonEmptyTyConName :: WiredIn Name
+nonEmptyTyConName = tcQual <$> gHC_BASE <*> pure (fsLit "NonEmpty") <*> pure nonEmptyTyConKey
-- Custom type errors
errorMessageTypeErrorFamName
@@ -1432,244 +1435,244 @@ errorMessageTypeErrorFamName
, typeErrorAppendDataConName
, typeErrorVAppendDataConName
, typeErrorShowTypeDataConName
- :: Name
+ :: WiredIn Name
errorMessageTypeErrorFamName =
- tcQual gHC_TYPEERROR (fsLit "TypeError") errorMessageTypeErrorFamKey
+ tcQual <$> gHC_TYPEERROR <*> pure (fsLit "TypeError") <*> pure errorMessageTypeErrorFamKey
typeErrorTextDataConName =
- dcQual gHC_TYPEERROR (fsLit "Text") typeErrorTextDataConKey
+ dcQual <$> gHC_TYPEERROR <*> pure (fsLit "Text") <*> pure typeErrorTextDataConKey
typeErrorAppendDataConName =
- dcQual gHC_TYPEERROR (fsLit ":<>:") typeErrorAppendDataConKey
+ dcQual <$> gHC_TYPEERROR <*> pure (fsLit ":<>:") <*> pure typeErrorAppendDataConKey
typeErrorVAppendDataConName =
- dcQual gHC_TYPEERROR (fsLit ":$$:") typeErrorVAppendDataConKey
+ dcQual <$> gHC_TYPEERROR <*> pure (fsLit ":$$:") <*> pure typeErrorVAppendDataConKey
typeErrorShowTypeDataConName =
- dcQual gHC_TYPEERROR (fsLit "ShowType") typeErrorShowTypeDataConKey
+ dcQual <$> gHC_TYPEERROR <*> pure (fsLit "ShowType") <*> pure typeErrorShowTypeDataConKey
-- Unsafe coercion proofs
unsafeEqualityProofName, unsafeEqualityTyConName, unsafeCoercePrimName,
- unsafeReflDataConName :: Name
-unsafeEqualityProofName = varQual uNSAFE_COERCE (fsLit "unsafeEqualityProof") unsafeEqualityProofIdKey
-unsafeEqualityTyConName = tcQual uNSAFE_COERCE (fsLit "UnsafeEquality") unsafeEqualityTyConKey
-unsafeReflDataConName = dcQual uNSAFE_COERCE (fsLit "UnsafeRefl") unsafeReflDataConKey
-unsafeCoercePrimName = varQual uNSAFE_COERCE (fsLit "unsafeCoerce#") unsafeCoercePrimIdKey
+ unsafeReflDataConName :: WiredIn Name
+unsafeEqualityProofName = varQual <$> uNSAFE_COERCE <*> pure (fsLit "unsafeEqualityProof") <*> pure unsafeEqualityProofIdKey
+unsafeEqualityTyConName = tcQual <$> uNSAFE_COERCE <*> pure (fsLit "UnsafeEquality") <*> pure unsafeEqualityTyConKey
+unsafeReflDataConName = dcQual <$> uNSAFE_COERCE <*> pure (fsLit "UnsafeRefl") <*> pure unsafeReflDataConKey
+unsafeCoercePrimName = varQual <$> uNSAFE_COERCE <*> pure (fsLit "unsafeCoerce#") <*> pure unsafeCoercePrimIdKey
-- Dynamic
-toDynName :: Name
-toDynName = varQual dYNAMIC (fsLit "toDyn") toDynIdKey
+toDynName :: WiredIn Name
+toDynName = varQual <$> dYNAMIC <*> pure (fsLit "toDyn") <*> pure toDynIdKey
-- Class Data
-dataClassName :: Name
-dataClassName = clsQual gENERICS (fsLit "Data") dataClassKey
+dataClassName :: WiredIn Name
+dataClassName = clsQual <$> gENERICS <*> pure (fsLit "Data") <*> pure dataClassKey
-- Error module
-assertErrorName :: Name
-assertErrorName = varQual gHC_IO_Exception (fsLit "assertError") assertErrorIdKey
+assertErrorName :: WiredIn Name
+assertErrorName = varQual <$> gHC_IO_Exception <*> pure (fsLit "assertError") <*> pure assertErrorIdKey
-- Debug.Trace
-traceName :: Name
-traceName = varQual dEBUG_TRACE (fsLit "trace") traceKey
+traceName :: WiredIn Name
+traceName = varQual <$> dEBUG_TRACE <*> pure (fsLit "trace") <*> pure traceKey
-- Enum module (Enum, Bounded)
enumClassName, enumFromName, enumFromToName, enumFromThenName,
- enumFromThenToName, boundedClassName :: Name
-enumClassName = clsQual gHC_ENUM (fsLit "Enum") enumClassKey
-enumFromName = varQual gHC_ENUM (fsLit "enumFrom") enumFromClassOpKey
-enumFromToName = varQual gHC_ENUM (fsLit "enumFromTo") enumFromToClassOpKey
-enumFromThenName = varQual gHC_ENUM (fsLit "enumFromThen") enumFromThenClassOpKey
-enumFromThenToName = varQual gHC_ENUM (fsLit "enumFromThenTo") enumFromThenToClassOpKey
-boundedClassName = clsQual gHC_ENUM (fsLit "Bounded") boundedClassKey
+ enumFromThenToName, boundedClassName :: WiredIn Name
+enumClassName = clsQual <$> gHC_ENUM <*> pure (fsLit "Enum") <*> pure enumClassKey
+enumFromName = varQual <$> gHC_ENUM <*> pure (fsLit "enumFrom") <*> pure enumFromClassOpKey
+enumFromToName = varQual <$> gHC_ENUM <*> pure (fsLit "enumFromTo") <*> pure enumFromToClassOpKey
+enumFromThenName = varQual <$> gHC_ENUM <*> pure (fsLit "enumFromThen") <*> pure enumFromThenClassOpKey
+enumFromThenToName = varQual <$> gHC_ENUM <*> pure (fsLit "enumFromThenTo") <*> pure enumFromThenToClassOpKey
+boundedClassName = clsQual <$> gHC_ENUM <*> pure (fsLit "Bounded") <*> pure boundedClassKey
-- List functions
-concatName, filterName, zipName :: Name
-concatName = varQual gHC_LIST (fsLit "concat") concatIdKey
-filterName = varQual gHC_LIST (fsLit "filter") filterIdKey
-zipName = varQual gHC_LIST (fsLit "zip") zipIdKey
+concatName, filterName, zipName :: WiredIn Name
+concatName = varQual <$> gHC_LIST <*> pure (fsLit "concat") <*> pure concatIdKey
+filterName = varQual <$> gHC_LIST <*> pure (fsLit "filter") <*> pure filterIdKey
+zipName = varQual <$> gHC_LIST <*> pure (fsLit "zip") <*> pure zipIdKey
-- Overloaded lists
-isListClassName, fromListName, fromListNName, toListName :: Name
-isListClassName = clsQual gHC_IS_LIST (fsLit "IsList") isListClassKey
-fromListName = varQual gHC_IS_LIST (fsLit "fromList") fromListClassOpKey
-fromListNName = varQual gHC_IS_LIST (fsLit "fromListN") fromListNClassOpKey
-toListName = varQual gHC_IS_LIST (fsLit "toList") toListClassOpKey
+isListClassName, fromListName, fromListNName, toListName :: WiredIn Name
+isListClassName = clsQual <$> gHC_IS_LIST <*> pure (fsLit "IsList") <*> pure isListClassKey
+fromListName = varQual <$> gHC_IS_LIST <*> pure (fsLit "fromList") <*> pure fromListClassOpKey
+fromListNName = varQual <$> gHC_IS_LIST <*> pure (fsLit "fromListN") <*> pure fromListNClassOpKey
+toListName = varQual <$> gHC_IS_LIST <*> pure (fsLit "toList") <*> pure toListClassOpKey
-- HasField class ops
-getFieldName, setFieldName :: Name
-getFieldName = varQual gHC_RECORDS (fsLit "getField") getFieldClassOpKey
-setFieldName = varQual gHC_RECORDS (fsLit "setField") setFieldClassOpKey
+getFieldName, setFieldName :: WiredIn Name
+getFieldName = varQual <$> gHC_RECORDS <*> pure (fsLit "getField") <*> pure getFieldClassOpKey
+setFieldName = varQual <$> gHC_RECORDS <*> pure (fsLit "setField") <*> pure setFieldClassOpKey
-- Class Show
-showClassName :: Name
-showClassName = clsQual gHC_SHOW (fsLit "Show") showClassKey
+showClassName :: WiredIn Name
+showClassName = clsQual <$> gHC_SHOW <*> pure (fsLit "Show") <*> pure showClassKey
-- Class Read
-readClassName :: Name
-readClassName = clsQual gHC_READ (fsLit "Read") readClassKey
+readClassName :: WiredIn Name
+readClassName = clsQual <$> gHC_READ <*> pure (fsLit "Read") <*> pure readClassKey
-- Classes Generic and Generic1, Datatype, Constructor and Selector
genClassName, gen1ClassName, datatypeClassName, constructorClassName,
- selectorClassName :: Name
-genClassName = clsQual gHC_GENERICS (fsLit "Generic") genClassKey
-gen1ClassName = clsQual gHC_GENERICS (fsLit "Generic1") gen1ClassKey
+ selectorClassName :: WiredIn Name
+genClassName = clsQual <$> gHC_GENERICS <*> pure (fsLit "Generic") <*> pure genClassKey
+gen1ClassName = clsQual <$> gHC_GENERICS <*> pure (fsLit "Generic1") <*> pure gen1ClassKey
-datatypeClassName = clsQual gHC_GENERICS (fsLit "Datatype") datatypeClassKey
-constructorClassName = clsQual gHC_GENERICS (fsLit "Constructor") constructorClassKey
-selectorClassName = clsQual gHC_GENERICS (fsLit "Selector") selectorClassKey
+datatypeClassName = clsQual <$> gHC_GENERICS <*> pure (fsLit "Datatype") <*> pure datatypeClassKey
+constructorClassName = clsQual <$> gHC_GENERICS <*> pure (fsLit "Constructor") <*> pure constructorClassKey
+selectorClassName = clsQual <$> gHC_GENERICS <*> pure (fsLit "Selector") <*> pure selectorClassKey
-genericClassNames :: [Name]
+genericClassNames :: [WiredIn Name]
genericClassNames = [genClassName, gen1ClassName]
-- GHCi things
-ghciIoClassName, ghciStepIoMName :: Name
-ghciIoClassName = clsQual gHC_GHCI (fsLit "GHCiSandboxIO") ghciIoClassKey
-ghciStepIoMName = varQual gHC_GHCI (fsLit "ghciStepIO") ghciStepIoMClassOpKey
+ghciIoClassName, ghciStepIoMName :: WiredIn Name
+ghciIoClassName = clsQual <$> gHC_GHCI <*> pure (fsLit "GHCiSandboxIO") <*> pure ghciIoClassKey
+ghciStepIoMName = varQual <$> gHC_GHCI <*> pure (fsLit "ghciStepIO") <*> pure ghciStepIoMClassOpKey
-- IO things
ioTyConName, ioDataConName,
- thenIOName, bindIOName, returnIOName, failIOName :: Name
-ioTyConName = tcQual gHC_TYPES (fsLit "IO") ioTyConKey
-ioDataConName = dcQual gHC_TYPES (fsLit "IO") ioDataConKey
-thenIOName = varQual gHC_BASE (fsLit "thenIO") thenIOIdKey
-bindIOName = varQual gHC_BASE (fsLit "bindIO") bindIOIdKey
-returnIOName = varQual gHC_BASE (fsLit "returnIO") returnIOIdKey
-failIOName = varQual gHC_IO (fsLit "failIO") failIOIdKey
+ thenIOName, bindIOName, returnIOName, failIOName :: WiredIn Name
+ioTyConName = tcQual <$> gHC_TYPES <*> pure (fsLit "IO") <*> pure ioTyConKey
+ioDataConName = dcQual <$> gHC_TYPES <*> pure (fsLit "IO") <*> pure ioDataConKey
+thenIOName = varQual <$> gHC_BASE <*> pure (fsLit "thenIO") <*> pure thenIOIdKey
+bindIOName = varQual <$> gHC_BASE <*> pure (fsLit "bindIO") <*> pure bindIOIdKey
+returnIOName = varQual <$> gHC_BASE <*> pure (fsLit "returnIO") <*> pure returnIOIdKey
+failIOName = varQual <$> gHC_IO <*> pure (fsLit "failIO") <*> pure failIOIdKey
-- IO things
-printName :: Name
-printName = varQual sYSTEM_IO (fsLit "print") printIdKey
+printName :: WiredIn Name
+printName = varQual <$> sYSTEM_IO <*> pure (fsLit "print") <*> pure printIdKey
-- Int, Word, and Addr things
-int8TyConName, int16TyConName, int32TyConName, int64TyConName :: Name
-int8TyConName = tcQual gHC_INT (fsLit "Int8") int8TyConKey
-int16TyConName = tcQual gHC_INT (fsLit "Int16") int16TyConKey
-int32TyConName = tcQual gHC_INT (fsLit "Int32") int32TyConKey
-int64TyConName = tcQual gHC_INT (fsLit "Int64") int64TyConKey
+int8TyConName, int16TyConName, int32TyConName, int64TyConName :: WiredIn Name
+int8TyConName = tcQual <$> gHC_INT <*> pure (fsLit "Int8") <*> pure int8TyConKey
+int16TyConName = tcQual <$> gHC_INT <*> pure (fsLit "Int16") <*> pure int16TyConKey
+int32TyConName = tcQual <$> gHC_INT <*> pure (fsLit "Int32") <*> pure int32TyConKey
+int64TyConName = tcQual <$> gHC_INT <*> pure (fsLit "Int64") <*> pure int64TyConKey
-- Word module
-word8TyConName, word16TyConName, word32TyConName, word64TyConName :: Name
-word8TyConName = tcQual gHC_WORD (fsLit "Word8") word8TyConKey
-word16TyConName = tcQual gHC_WORD (fsLit "Word16") word16TyConKey
-word32TyConName = tcQual gHC_WORD (fsLit "Word32") word32TyConKey
-word64TyConName = tcQual gHC_WORD (fsLit "Word64") word64TyConKey
+word8TyConName, word16TyConName, word32TyConName, word64TyConName :: WiredIn Name
+word8TyConName = tcQual <$> gHC_WORD <*> pure (fsLit "Word8") <*> pure word8TyConKey
+word16TyConName = tcQual <$> gHC_WORD <*> pure (fsLit "Word16") <*> pure word16TyConKey
+word32TyConName = tcQual <$> gHC_WORD <*> pure (fsLit "Word32") <*> pure word32TyConKey
+word64TyConName = tcQual <$> gHC_WORD <*> pure (fsLit "Word64") <*> pure word64TyConKey
-- PrelPtr module
-ptrTyConName, funPtrTyConName :: Name
-ptrTyConName = tcQual gHC_PTR (fsLit "Ptr") ptrTyConKey
-funPtrTyConName = tcQual gHC_PTR (fsLit "FunPtr") funPtrTyConKey
+ptrTyConName, funPtrTyConName :: WiredIn Name
+ptrTyConName = tcQual <$> gHC_PTR <*> pure (fsLit "Ptr") <*> pure ptrTyConKey
+funPtrTyConName = tcQual <$> gHC_PTR <*> pure (fsLit "FunPtr") <*> pure funPtrTyConKey
-- Foreign objects and weak pointers
-stablePtrTyConName, newStablePtrName :: Name
-stablePtrTyConName = tcQual gHC_STABLE (fsLit "StablePtr") stablePtrTyConKey
-newStablePtrName = varQual gHC_STABLE (fsLit "newStablePtr") newStablePtrIdKey
+stablePtrTyConName, newStablePtrName :: WiredIn Name
+stablePtrTyConName = tcQual <$> gHC_STABLE <*> pure (fsLit "StablePtr") <*> pure stablePtrTyConKey
+newStablePtrName = varQual <$> gHC_STABLE <*> pure (fsLit "newStablePtr") <*> pure newStablePtrIdKey
-- Recursive-do notation
-monadFixClassName, mfixName :: Name
-monadFixClassName = clsQual mONAD_FIX (fsLit "MonadFix") monadFixClassKey
-mfixName = varQual mONAD_FIX (fsLit "mfix") mfixIdKey
+monadFixClassName, mfixName :: WiredIn Name
+monadFixClassName = clsQual <$> mONAD_FIX <*> pure (fsLit "MonadFix") <*> pure monadFixClassKey
+mfixName = varQual <$> mONAD_FIX <*> pure (fsLit "mfix") <*> pure mfixIdKey
-- Arrow notation
-arrAName, composeAName, firstAName, appAName, choiceAName, loopAName :: Name
-arrAName = varQual aRROW (fsLit "arr") arrAIdKey
-composeAName = varQual gHC_DESUGAR (fsLit ">>>") composeAIdKey
-firstAName = varQual aRROW (fsLit "first") firstAIdKey
-appAName = varQual aRROW (fsLit "app") appAIdKey
-choiceAName = varQual aRROW (fsLit "|||") choiceAIdKey
-loopAName = varQual aRROW (fsLit "loop") loopAIdKey
+arrAName, composeAName, firstAName, appAName, choiceAName, loopAName :: WiredIn Name
+arrAName = varQual <$> aRROW <*> pure (fsLit "arr") <*> pure arrAIdKey
+composeAName = varQual <$> gHC_DESUGAR <*> pure (fsLit ">>>") <*> pure composeAIdKey
+firstAName = varQual <$> aRROW <*> pure (fsLit "first") <*> pure firstAIdKey
+appAName = varQual <$> aRROW <*> pure (fsLit "app") <*> pure appAIdKey
+choiceAName = varQual <$> aRROW <*> pure (fsLit "|||") <*> pure choiceAIdKey
+loopAName = varQual <$> aRROW <*> pure (fsLit "loop") <*> pure loopAIdKey
-- Monad comprehensions
-guardMName, liftMName, mzipName :: Name
-guardMName = varQual mONAD (fsLit "guard") guardMIdKey
-liftMName = varQual mONAD (fsLit "liftM") liftMIdKey
-mzipName = varQual mONAD_ZIP (fsLit "mzip") mzipIdKey
+guardMName, liftMName, mzipName :: WiredIn Name
+guardMName = varQual <$> mONAD <*> pure (fsLit "guard") <*> pure guardMIdKey
+liftMName = varQual <$> mONAD <*> pure (fsLit "liftM") <*> pure liftMIdKey
+mzipName = varQual <$> mONAD_ZIP <*> pure (fsLit "mzip") <*> pure mzipIdKey
-- Annotation type checking
-toAnnotationWrapperName :: Name
-toAnnotationWrapperName = varQual gHC_DESUGAR (fsLit "toAnnotationWrapper") toAnnotationWrapperIdKey
+toAnnotationWrapperName :: WiredIn Name
+toAnnotationWrapperName = varQual <$> gHC_DESUGAR <*> pure (fsLit "toAnnotationWrapper") <*> pure toAnnotationWrapperIdKey
-- Other classes, needed for type defaulting
-monadPlusClassName, isStringClassName :: Name
-monadPlusClassName = clsQual mONAD (fsLit "MonadPlus") monadPlusClassKey
-isStringClassName = clsQual dATA_STRING (fsLit "IsString") isStringClassKey
+monadPlusClassName, isStringClassName :: WiredIn Name
+monadPlusClassName = clsQual <$> mONAD <*> pure (fsLit "MonadPlus") <*> pure monadPlusClassKey
+isStringClassName = clsQual <$> dATA_STRING <*> pure (fsLit "IsString") <*> pure isStringClassKey
-- Type-level naturals
-knownNatClassName :: Name
-knownNatClassName = clsQual gHC_TYPENATS (fsLit "KnownNat") knownNatClassNameKey
-knownSymbolClassName :: Name
-knownSymbolClassName = clsQual gHC_TYPELITS (fsLit "KnownSymbol") knownSymbolClassNameKey
-knownCharClassName :: Name
-knownCharClassName = clsQual gHC_TYPELITS (fsLit "KnownChar") knownCharClassNameKey
+knownNatClassName :: WiredIn Name
+knownNatClassName = clsQual <$> gHC_TYPENATS <*> pure (fsLit "KnownNat") <*> pure knownNatClassNameKey
+knownSymbolClassName :: WiredIn Name
+knownSymbolClassName = clsQual <$> gHC_TYPELITS <*> pure (fsLit "KnownSymbol") <*> pure knownSymbolClassNameKey
+knownCharClassName :: WiredIn Name
+knownCharClassName = clsQual <$> gHC_TYPELITS <*> pure (fsLit "KnownChar") <*> pure knownCharClassNameKey
-- Overloaded labels
-fromLabelClassOpName :: Name
+fromLabelClassOpName :: WiredIn Name
fromLabelClassOpName
- = varQual gHC_OVER_LABELS (fsLit "fromLabel") fromLabelClassOpKey
+ = varQual <$> gHC_OVER_LABELS <*> pure (fsLit "fromLabel") <*> pure fromLabelClassOpKey
-- Implicit Parameters
-ipClassName :: Name
+ipClassName :: WiredIn Name
ipClassName
- = clsQual gHC_CLASSES (fsLit "IP") ipClassKey
+ = clsQual <$> gHC_CLASSES <*> pure (fsLit "IP") <*> pure ipClassKey
-- Overloaded record fields
-hasFieldClassName :: Name
+hasFieldClassName :: WiredIn Name
hasFieldClassName
- = clsQual gHC_RECORDS (fsLit "HasField") hasFieldClassNameKey
+ = clsQual <$> gHC_RECORDS <*> pure (fsLit "HasField") <*> pure hasFieldClassNameKey
-- Source Locations
callStackTyConName, emptyCallStackName, pushCallStackName,
- srcLocDataConName :: Name
+ srcLocDataConName :: WiredIn Name
callStackTyConName
- = tcQual gHC_STACK_TYPES (fsLit "CallStack") callStackTyConKey
+ = tcQual <$> gHC_STACK_TYPES <*> pure (fsLit "CallStack") <*> pure callStackTyConKey
emptyCallStackName
- = varQual gHC_STACK_TYPES (fsLit "emptyCallStack") emptyCallStackKey
+ = varQual <$> gHC_STACK_TYPES <*> pure (fsLit "emptyCallStack") <*> pure emptyCallStackKey
pushCallStackName
- = varQual gHC_STACK_TYPES (fsLit "pushCallStack") pushCallStackKey
+ = varQual <$> gHC_STACK_TYPES <*> pure (fsLit "pushCallStack") <*> pure pushCallStackKey
srcLocDataConName
- = dcQual gHC_STACK_TYPES (fsLit "SrcLoc") srcLocDataConKey
+ = dcQual <$> gHC_STACK_TYPES <*> pure (fsLit "SrcLoc") <*> pure srcLocDataConKey
-- plugins
-pLUGINS :: Module
-pLUGINS = mkThisGhcModule (fsLit "GHC.Driver.Plugins")
-pluginTyConName :: Name
-pluginTyConName = tcQual pLUGINS (fsLit "Plugin") pluginTyConKey
-frontendPluginTyConName :: Name
-frontendPluginTyConName = tcQual pLUGINS (fsLit "FrontendPlugin") frontendPluginTyConKey
+pLUGINS :: IO (WiredIn Module)
+pLUGINS = pure $ mkThisGhcModule (fsLit "GHC.Driver.Plugins")
+pluginTyConName :: IO (WiredIn Name)
+pluginTyConName = pLUGINS >>= \plugin_mod -> pure (tcQual <$> plugin_mod <*> pure (fsLit "Plugin") <*> pure pluginTyConKey)
+frontendPluginTyConName :: IO Name
+frontendPluginTyConName = pLUGINS >>= \plugin_mod -> pure (tcQual <$> plugin_mod <*> pure (fsLit "FrontendPlugin") <*> pure frontendPluginTyConKey)
-- Static pointers
-makeStaticName :: Name
+makeStaticName :: WiredIn Name
makeStaticName =
- varQual gHC_STATICPTR_INTERNAL (fsLit "makeStatic") makeStaticKey
+ varQual <$> gHC_STATICPTR_INTERNAL <*> pure (fsLit "makeStatic") <*> pure makeStaticKey
-staticPtrInfoTyConName :: Name
+staticPtrInfoTyConName :: WiredIn Name
staticPtrInfoTyConName =
- tcQual gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoTyConKey
+ tcQual <$> gHC_STATICPTR <*> pure (fsLit "StaticPtrInfo") <*> pure staticPtrInfoTyConKey
-staticPtrInfoDataConName :: Name
+staticPtrInfoDataConName :: WiredIn Name
staticPtrInfoDataConName =
- dcQual gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoDataConKey
+ dcQual <$> gHC_STATICPTR <*> pure (fsLit "StaticPtrInfo") <*> pure staticPtrInfoDataConKey
-staticPtrTyConName :: Name
+staticPtrTyConName :: WiredIn Name
staticPtrTyConName =
- tcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrTyConKey
+ tcQual <$> gHC_STATICPTR <*> pure (fsLit "StaticPtr") <*> pure staticPtrTyConKey
-staticPtrDataConName :: Name
+staticPtrDataConName :: WiredIn Name
staticPtrDataConName =
- dcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrDataConKey
+ dcQual <$> gHC_STATICPTR <*> pure (fsLit "StaticPtr") <*> pure staticPtrDataConKey
-fromStaticPtrName :: Name
+fromStaticPtrName :: WiredIn Name
fromStaticPtrName =
- varQual gHC_STATICPTR (fsLit "fromStaticPtr") fromStaticPtrClassOpKey
+ varQual <$> gHC_STATICPTR <*> pure (fsLit "fromStaticPtr") <*> pure fromStaticPtrClassOpKey
-fingerprintDataConName :: Name
+fingerprintDataConName :: WiredIn Name
fingerprintDataConName =
- dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey
+ dcQual <$> gHC_FINGERPRINT_TYPE <*> pure (fsLit "Fingerprint") <*> pure fingerprintDataConKey
-constPtrConName :: Name
+constPtrConName :: WiredIn Name
constPtrConName =
- tcQual fOREIGN_C_CONSTPTR (fsLit "ConstPtr") constPtrTyConKey
+ tcQual <$> fOREIGN_C_CONSTPTR <*> pure (fsLit "ConstPtr") <*> pure constPtrTyConKey
{-
************************************************************************
=====================================
compiler/GHC/Builtin/Utils.hs
=====================================
@@ -113,7 +113,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 "GHC.Builtin.Names")
-knownKeyNames :: [Name]
+knownKeyNames :: IO [Name]
knownKeyNames
| debugIsOn
, Just badNamesStr <- knownKeyNamesOkay all_names
@@ -123,7 +123,7 @@ knownKeyNames
-- "<<details unavailable>>" error. (This seems to happen only in the
-- stage 2 compiler, for reasons I [Richard] have no clue of.)
| otherwise
- = all_names
+ = (++) all_names <$> basicKnownKeyNames
where
all_names =
concat [ concatMap wired_tycon_kk_names primTyCons
@@ -132,7 +132,6 @@ knownKeyNames
, map idName wiredInIds
, map idName allThePrimOpIds
, map (idName . primOpWrapperId) allThePrimOps
- , basicKnownKeyNames
, templateHaskellNames
]
-- All of the names associated with a wired-in TyCon.
@@ -189,22 +188,22 @@ knownKeyNamesOkay all_names
-- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a
-- known-key thing.
-lookupKnownKeyName :: Unique -> Maybe Name
+lookupKnownKeyName :: Unique -> IO (Maybe Name)
lookupKnownKeyName u =
- knownUniqueName u <|> lookupUFM_Directly knownKeysMap u
+ (knownUniqueName u <|>) . flip lookupUFM_Directly u <$> knownKeysMap
-- | Is a 'Name' known-key?
-isKnownKeyName :: Name -> Bool
+isKnownKeyName :: Name -> IO Bool
isKnownKeyName n =
- isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap
+ (isJust (knownUniqueName $ nameUnique n) ||) . elemUFM n <$> knownKeysMap
-- | Maps 'Unique's to known-key names.
--
-- The type is @UniqFM Name Name@ to denote that the 'Unique's used
-- in the domain are 'Unique's associated with 'Name's (as opposed
-- to some other namespace of 'Unique's).
-knownKeysMap :: UniqFM Name Name
-knownKeysMap = listToIdentityUFM knownKeyNames
+knownKeysMap :: IO (UniqFM Name Name)
+knownKeysMap = listToIdentityUFM <$> knownKeyNames
-- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by
-- GHCi's ':info' command.
=====================================
compiler/GHC/Driver/Backpack.hs
=====================================
@@ -235,8 +235,7 @@ withBkpSession cid insts deps session_type do_this = do
, importPaths = []
-- Synthesize the flags
, packageFlags = packageFlags dflags ++ map (\(uid0, rn) ->
- let uid = unwireUnit unit_state
- $ improveUnit unit_state
+ let uid = improveUnit unit_state
$ renameHoleUnit unit_state (listToUFM insts) uid0
in ExposePackage
(showSDoc dflags
@@ -372,7 +371,7 @@ buildUnit session cid insts lunit = do
-- really used for anything, so we leave it
-- blank for now.
TcSession -> []
- _ -> map (toUnitId . unwireUnit state)
+ _ -> map toUnitId
$ deps ++ [ moduleUnit mod
| (_, mod) <- insts
, not (isHoleModule mod) ],
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -305,7 +305,8 @@ newHscEnv top_dir dflags = newHscEnvWithHUG top_dir dflags (homeUnitId_ dflags)
newHscEnvWithHUG :: FilePath -> DynFlags -> UnitId -> HomeUnitGraph -> IO HscEnv
newHscEnvWithHUG top_dir top_dynflags cur_unit home_unit_graph = do
- nc_var <- initNameCache 'r' knownKeyNames
+ knownKeyNames' <- knownKeyNames
+ nc_var <- initNameCache 'r' knownKeyNames'
fc_var <- initFinderCache
logger <- initLogger
tmpfs <- initTmpFs
=====================================
compiler/GHC/Iface/Binary.hs
=====================================
@@ -1,4 +1,4 @@
-{-# LANGUAGE BinaryLiterals, ScopedTypeVariables #-}
+{-# LANGUAGE BinaryLiterals, ScopedTypeVariables, LambdaCase #-}
--
-- (c) The University of Glasgow 2002-2006
@@ -336,18 +336,17 @@ putName _dict BinSymbolTable{
bin_symtab_map = symtab_map_ref,
bin_symtab_next = symtab_next }
bh name
- | isKnownKeyName name
- , let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits
= -- assert (u < 2^(22 :: Int))
- put_ bh (0x80000000
- .|. (fromIntegral (ord c) `shiftL` 22)
- .|. (fromIntegral u :: Word32))
-
- | otherwise
- = do symtab_map <- readIORef symtab_map_ref
- case lookupUFM symtab_map name of
- Just (off,_) -> put_ bh (fromIntegral off :: Word32)
- Nothing -> do
+ isKnownKeyName name >>= \case
+ True -> let (c, u) = unpkUnique (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits
+ in put_ bh (0x80000000
+ .|. (fromIntegral (ord c) `shiftL` 22)
+ .|. (fromIntegral u :: Word32))
+ False -> do
+ symtab_map <- readIORef symtab_map_ref
+ case lookupUFM symtab_map name of
+ Just (off,_) -> put_ bh (fromIntegral off :: Word32)
+ Nothing -> do
off <- readFastMutInt symtab_next
-- massert (off < 2^(30 :: Int))
writeFastMutInt symtab_next (off+1)
@@ -370,10 +369,10 @@ getSymtabName _name_cache _dict symtab bh = do
ix = fromIntegral i .&. 0x003FFFFF
u = mkUnique tag ix
in
- return $! case lookupKnownKeyName u of
- Nothing -> pprPanic "getSymtabName:unknown known-key unique"
- (ppr i $$ ppr u $$ char tag $$ ppr ix)
- Just n -> n
+ lookupKnownKeyName u >>= \case
+ Nothing -> pprPanic "getSymtabName:unknown known-key unique"
+ (ppr i $$ ppr u $$ char tag $$ ppr ix)
+ Just n -> return $! n
_ -> pprPanic "getSymtabName:unknown name tag" (ppr i)
=====================================
compiler/GHC/Iface/Ext/Binary.hs
=====================================
@@ -3,6 +3,7 @@ Binary serialization for .hie files.
-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
module GHC.Iface.Ext.Binary
( readHieFile
@@ -291,15 +292,18 @@ putName (HieSymbolTable next ref) bh name = do
let hieName = ExternalName mod occ (nameSrcSpan name)
writeIORef ref $! addToUFM symmap name (off, hieName)
put_ bh (fromIntegral off :: Word32)
- Just (off, LocalName _occ span)
- | notLocal (toHieName name) || nameSrcSpan name /= span -> do
- writeIORef ref $! addToUFM symmap name (off, toHieName name)
- put_ bh (fromIntegral off :: Word32)
+ Just (off, LocalName _occ span) -> do
+ hieName <- toHieName name
+ if notLocal (hieName) || nameSrcSpan name /= span then do
+ writeIORef ref $! addToUFM symmap name (off, hieName)
+ put_ bh (fromIntegral off :: Word32)
+ else put_ bh (fromIntegral off :: Word32) -- ROMES:TODO can we not duplicate this here as below?
Just (off, _) -> put_ bh (fromIntegral off :: Word32)
Nothing -> do
+ hieName <- toHieName name
off <- readFastMutInt next
writeFastMutInt next (off+1)
- writeIORef ref $! addToUFM symmap name (off, toHieName name)
+ writeIORef ref $! addToUFM symmap name (off, hieName)
put_ bh (fromIntegral off :: Word32)
where
@@ -328,7 +332,7 @@ fromHieName nc hie_name = do
-- don't update the NameCache for local names
pure $ mkInternalName uniq occ span
- KnownKeyName u -> case lookupKnownKeyName u of
+ KnownKeyName u -> lookupKnownKeyName u >>= \case
Nothing -> pprPanic "fromHieName:unknown known-key unique"
(ppr u)
Just n -> pure n
=====================================
compiler/GHC/Iface/Ext/Debug.hs
=====================================
@@ -22,6 +22,8 @@ import qualified Data.Set as S
import Data.Function ( on )
import Data.List ( sortOn )
+import System.IO.Unsafe ( unsafePerformIO )
+
type Diff a = a -> a -> [SDoc]
diffFile :: Diff HieFile
@@ -64,10 +66,10 @@ diffAst diffType (Node info1 span1 xs1) (Node info2 span2 xs2) =
type DiffIdent = Either ModuleName HieName
normalizeIdents :: Ord a => NodeIdentifiers a -> [(DiffIdent,IdentifierDetails a)]
-normalizeIdents = sortOn go . map (first toHieName) . M.toList
+normalizeIdents = sortOn go . map (first (unsafePerformIO . toHieName)) . M.toList
where
first f (a,b) = (fmap f a, b)
- go (a,b) = (hieNameOcc <$> a,identInfo b,identType b)
+ go (a,b) = (unsafePerformIO . hieNameOcc <$> a,identInfo b,identType b)
diffList :: Diff a -> Diff [a]
diffList f xs ys
=====================================
compiler/GHC/Iface/Ext/Types.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -42,6 +43,8 @@ import Data.Coerce ( coerce )
import Data.Function ( on )
import qualified Data.Semigroup as S
+import System.IO.Unsafe ( unsafePerformIO )
+
type Span = RealSrcSpan
-- | Current version of @.hie@ files
@@ -581,10 +584,10 @@ newtype EvBindDeps = EvBindDeps { getEvBindDeps :: [Name] }
deriving Outputable
instance Eq EvBindDeps where
- (==) = coerce ((==) `on` map toHieName)
+ (==) = coerce ((==) `on` map (unsafePerformIO . toHieName))
instance Ord EvBindDeps where
- compare = coerce (compare `on` map toHieName)
+ compare = coerce (compare `on` map (unsafePerformIO . toHieName))
instance Binary EvBindDeps where
put_ bh (EvBindDeps xs) = put_ bh xs
@@ -767,19 +770,25 @@ instance Outputable HieName where
ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp
ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u
-hieNameOcc :: HieName -> OccName
-hieNameOcc (ExternalName _ occ _) = occ
-hieNameOcc (LocalName occ _) = occ
+-- Why do we need IO? See Note [Looking up known key names]
+hieNameOcc :: HieName -> IO OccName
+hieNameOcc (ExternalName _ occ _) = pure occ
+hieNameOcc (LocalName occ _) = pure occ
hieNameOcc (KnownKeyName u) =
- case lookupKnownKeyName u of
- Just n -> nameOccName n
+ lookupKnownKeyName u >>= \case
+ Just n -> pure (nameOccName n)
Nothing -> pprPanic "hieNameOcc:unknown known-key unique"
(ppr u)
-toHieName :: Name -> HieName
-toHieName name
- | isKnownKeyName name = KnownKeyName (nameUnique name)
- | isExternalName name = ExternalName (nameModule name)
- (nameOccName name)
- (removeBufSpan $ nameSrcSpan name)
- | otherwise = LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name)
+-- Why do we need IO? See Note [Looking up known key names]
+toHieName :: Name -> IO HieName
+toHieName name =
+ isKnownKeyName name >>= \case
+ True -> pure (KnownKeyName (nameUnique name))
+ False
+ | isExternalName name ->
+ pure $ ExternalName (nameModule name)
+ (nameOccName name)
+ (removeBufSpan $ nameSrcSpan name)
+ | otherwise ->
+ pure $ LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name)
=====================================
compiler/GHC/Runtime/Loader.hs
=====================================
@@ -138,15 +138,17 @@ loadPlugins hsc_env
where
options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags
, opt_mod_nm == mod_nm ]
- loadPlugin = loadPlugin' (mkVarOccFS (fsLit "plugin")) pluginTyConName hsc_env
+ loadPlugin p = pluginTyConName >>= \pluginTyConName' -> loadPlugin' (mkVarOccFS (fsLit "plugin")) pluginTyConName' hsc_env p
loadFrontendPlugin :: HscEnv -> ModuleName -> IO (FrontendPlugin, [Linkable], PkgsLoaded)
loadFrontendPlugin hsc_env mod_name = do
checkExternalInterpreter hsc_env
(plugin, _iface, links, pkgs)
- <- loadPlugin' (mkVarOccFS (fsLit "frontendPlugin")) frontendPluginTyConName
- hsc_env mod_name
+ <- frontendPluginTyConName >>=
+ \frontendPluginTCN ->
+ loadPlugin' (mkVarOccFS (fsLit "frontendPlugin")) frontendPluginTCN
+ hsc_env mod_name
return (plugin, links, pkgs)
-- #14335
@@ -168,7 +170,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name
[ text "The module", ppr mod_name
, text "did not export the plugin name"
, ppr plugin_rdr_name ]) ;
- Just (name, mod_iface) ->
+ Just (name, mod_iface) -> pprTrace "ROMES: Current unit" (ppr . ue_current_unit . hsc_unit_env $ hsc_env) $
do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name
; eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon)
=====================================
compiler/GHC/Tc/Errors/Hole.hs
=====================================
@@ -597,6 +597,7 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
; traceTc "hole_lvl is:" $ ppr hole_lvl
; traceTc "simples are: " $ ppr simples
; traceTc "locals are: " $ ppr lclBinds
+ ; builtIns' <- liftIO builtIns
; let (lcl, gbl) = partition gre_lcl (globalRdrEnvElts rdr_env)
-- We remove binding shadowings here, but only for the local level.
-- this is so we e.g. suggest the global fmap from the Functor class
@@ -605,7 +606,7 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
locals = removeBindingShadowing $
map IdHFCand lclBinds ++ map GreHFCand lcl
globals = map GreHFCand gbl
- syntax = map NameHFCand builtIns
+ syntax = map NameHFCand builtIns'
-- If the hole is a rigid type-variable, then we only check the
-- locals, since only they can match the type (in a meaningful way).
only_locals = any isImmutableTyVar $ getTyVar_maybe hole_ty
@@ -663,8 +664,8 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
hole_lvl = ctLocLevel ct_loc
-- BuiltInSyntax names like (:) and []
- builtIns :: [Name]
- builtIns = filter isBuiltInSyntax knownKeyNames
+ builtIns :: IO [Name]
+ builtIns = filter isBuiltInSyntax <$> knownKeyNames
-- We make a refinement type by adding a new type variable in front
-- of the type of t h hole, going from e.g. [Integer] -> Integer
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -69,7 +69,6 @@ module GHC.Unit.State (
pprWithUnitState,
-- * Utils
- unwireUnit,
implicitPackageDeps)
where
@@ -108,6 +107,7 @@ import GHC.Utils.Exception
import System.Directory
import System.FilePath as FilePath
import Control.Monad
+import Data.IORef
import Data.Graph (stronglyConnComp, SCC(..))
import Data.Char ( toUpper )
import Data.List ( intersperse, partition, sortBy, isSuffixOf )
@@ -410,7 +410,7 @@ type ModuleNameProvidersMap =
Map ModuleName (Map Module ModuleOrigin)
data UnitState = UnitState {
- -- | A mapping of 'Unit' to 'UnitInfo'. This list is adjusted
+ -- | A mapping of 'UnitId' to 'UnitInfo'. This list is adjusted
-- so that only valid units are here. 'UnitInfo' reflects
-- what was stored *on disk*, except for the 'trusted' flag, which
-- is adjusted at runtime. (In particular, some units in this map
@@ -430,12 +430,6 @@ data UnitState = UnitState {
-- And also to resolve package qualifiers with the PackageImports extension.
packageNameMap :: UniqFM PackageName UnitId,
- -- | A mapping from database unit keys to wired in unit ids.
- wireMap :: Map UnitId UnitId,
-
- -- | A mapping from wired in unit ids to unit keys from the database.
- unwireMap :: Map UnitId UnitId,
-
-- | The units we're going to link in eagerly. This list
-- should be in reverse dependency order; that is, a unit
-- is always mentioned before the units it depends on.
@@ -478,8 +472,6 @@ emptyUnitState = UnitState {
unitInfoMap = Map.empty,
preloadClosure = emptyUniqSet,
packageNameMap = emptyUFM,
- wireMap = Map.empty,
- unwireMap = Map.empty,
preloadUnits = [],
explicitUnits = [],
homeUnitDepends = [],
@@ -649,7 +641,7 @@ initUnits logger dflags cached_dbs home_units = do
-- Try to find platform constants
--
-- See Note [Platform constants] in GHC.Platform
- mconstants <- if homeUnitId_ dflags == rtsUnitId
+ mconstants <- pprTrace "initUnits" (ppr (homeUnitId_ dflags, rtsUnitId)) $ if homeUnitId_ dflags == rtsUnitId
then do
-- we're building the RTS! Lookup DerivedConstants.h in the include paths
lookupPlatformConstants (includePathsGlobal (includePaths dflags))
@@ -671,13 +663,8 @@ mkHomeUnit
-> Maybe UnitId -- ^ Home unit instance of
-> [(ModuleName, Module)] -- ^ Home unit instantiations
-> HomeUnit
-mkHomeUnit unit_state hu_id hu_instanceof hu_instantiations_ =
- let
- -- Some wired units can be used to instantiate the home unit. We need to
- -- replace their unit keys with their wired unit ids.
- wmap = wireMap unit_state
- hu_instantiations = map (fmap (upd_wired_in_mod wmap)) hu_instantiations_
- in case (hu_instanceof, hu_instantiations) of
+mkHomeUnit unit_state hu_id hu_instanceof hu_instantiations =
+ case (hu_instanceof, hu_instantiations) of
(Nothing,[]) -> DefiniteHomeUnit hu_id Nothing
(Nothing, _) -> throwGhcException $ CmdLineError ("Use of -instantiated-with requires -this-component-id")
(Just _, []) -> throwGhcException $ CmdLineError ("Use of -this-component-id requires -instantiated-with")
@@ -1080,8 +1067,6 @@ pprTrustFlag flag = case flag of
--
-- See Note [Wired-in units] in GHC.Unit.Types
-type WiringMap = Map UnitId UnitId
-
findWiredInUnits
:: Logger
-> UnitPrecedenceMap
@@ -1096,8 +1081,9 @@ findWiredInUnits logger prec_map pkgs vis_map = do
-- their canonical names (eg. base-1.0 ==> base), as described
-- in Note [Wired-in units] in GHC.Unit.Types
let
- matches :: UnitInfo -> UnitId -> Bool
- pc `matches` pid = unitPackageName pc == PackageName (unitIdFS pid)
+ -- Match a package name against a UnitInfo
+ matches :: UnitInfo -> FastString -> Bool
+ pc `matches` pname = unitPackageName pc == PackageName pname
-- find which package corresponds to each wired-in package
-- delete any other packages with the same name
@@ -1116,10 +1102,10 @@ findWiredInUnits logger prec_map pkgs vis_map = do
-- this works even when there is no exposed wired in package
-- available.
--
- findWiredInUnit :: [UnitInfo] -> UnitId -> IO (Maybe (UnitId, UnitInfo))
- findWiredInUnit pkgs wired_pkg = firstJustsM [try all_exposed_ps, try all_ps, notfound]
+ findWiredInUnitByName :: [UnitInfo] -> WiredInPackageName -> IO (Maybe (FastString, UnitInfo))
+ findWiredInUnitByName pkgs (WiredInPackageName wired_pkg_name) = firstJustsM [try all_exposed_ps, try all_ps, notfound] -- ROMES:TODO: In fact, here we ?
where
- all_ps = [ p | p <- pkgs, p `matches` wired_pkg ]
+ all_ps = [ p | p <- pkgs, p `matches` wired_pkg_name ]
all_exposed_ps = [ p | p <- all_ps, Map.member (mkUnit p) vis_map ]
try ps = case sortByPreference prec_map ps of
@@ -1129,33 +1115,34 @@ findWiredInUnits logger prec_map pkgs vis_map = do
notfound = do
debugTraceMsg logger 2 $
text "wired-in package "
- <> ftext (unitIdFS wired_pkg)
+ <> ftext wired_pkg_name
<> text " not found."
return Nothing
- pick :: UnitInfo -> IO (UnitId, UnitInfo)
+
+ pick :: UnitInfo -> IO (FastString, UnitInfo)
pick pkg = do
debugTraceMsg logger 2 $
text "wired-in package "
- <> ftext (unitIdFS wired_pkg)
+ <> ftext wired_pkg_name
<> text " mapped to "
<> ppr (unitId pkg)
- return (wired_pkg, pkg)
+ return (wired_pkg_name, pkg)
- mb_wired_in_pkgs <- mapM (findWiredInUnit pkgs) wiredInUnitIds
+ mb_wired_in_pkgs <- mapM (findWiredInUnitByName pkgs) wiredInUnitNames
let
wired_in_pkgs = catMaybes mb_wired_in_pkgs
- wiredInMap :: Map UnitId UnitId
+ wiredInMap :: Map WiredInPackageName UnitId
wiredInMap = Map.fromList
- [ (unitId realUnitInfo, wiredInUnitId)
- | (wiredInUnitId, realUnitInfo) <- wired_in_pkgs
+ [ (WiredInPackageName wiredInUnitName, unitId realUnitInfo)
+ | (wiredInUnitName, realUnitInfo) <- wired_in_pkgs
, not (unitIsIndefinite realUnitInfo)
]
- updateWiredInDependencies pkgs = map (upd_deps . upd_pkg) pkgs
+ updateWiredInDependencies pkgs = map upd_pkg pkgs
where upd_pkg pkg
- | Just wiredInUnitId <- Map.lookup (unitId pkg) wiredInMap
+ | Just wiredInUnitId <- Map.lookup (WiredInPackageName $ unitIdFS $ unitId pkg) wiredInMap
= pkg { unitId = wiredInUnitId
, unitInstanceOf = wiredInUnitId
-- every non instantiated unit is an instance of
@@ -1165,12 +1152,11 @@ findWiredInUnits logger prec_map pkgs vis_map = do
}
| otherwise
= pkg
- upd_deps pkg = pkg {
- unitDepends = map (upd_wired_in wiredInMap) (unitDepends pkg),
- unitExposedModules
- = map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v))
- (unitExposedModules pkg)
- }
+ -- upd_deps pkg = pkg {
+ -- unitExposedModules
+ -- = map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v))
+ -- (unitExposedModules pkg)
+ -- }
return (updateWiredInDependencies pkgs, wiredInMap)
@@ -1182,30 +1168,26 @@ findWiredInUnits logger prec_map pkgs vis_map = do
-- For instance, base-4.9.0.0 will be rewritten to just base, to match
-- what appears in GHC.Builtin.Names.
-upd_wired_in_mod :: WiringMap -> Module -> Module
-upd_wired_in_mod wiredInMap (Module uid m) = Module (upd_wired_in_uid wiredInMap uid) m
-
-upd_wired_in_uid :: WiringMap -> Unit -> Unit
-upd_wired_in_uid wiredInMap u = case u of
- HoleUnit -> HoleUnit
- RealUnit (Definite uid) -> RealUnit (Definite (upd_wired_in wiredInMap uid))
- VirtUnit indef_uid ->
- VirtUnit $ mkInstantiatedUnit
- (instUnitInstanceOf indef_uid)
- (map (\(x,y) -> (x,upd_wired_in_mod wiredInMap y)) (instUnitInsts indef_uid))
-
-upd_wired_in :: WiringMap -> UnitId -> UnitId
-upd_wired_in wiredInMap key
- | Just key' <- Map.lookup key wiredInMap = key'
- | otherwise = key
-
-updateVisibilityMap :: WiringMap -> VisibilityMap -> VisibilityMap
-updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap)
- where f vm (from, to) = case Map.lookup (RealUnit (Definite from)) vis_map of
- Nothing -> vm
- Just r -> Map.insert (RealUnit (Definite to)) r
- (Map.delete (RealUnit (Definite from)) vm)
-
+-- upd_wired_in_mod :: WiringMap -> Module -> Module
+-- upd_wired_in_mod wiredInMap (Module uid m) = Module (upd_wired_in_uid wiredInMap uid) m
+--
+-- upd_wired_in_uid :: WiringMap -> Unit -> Unit
+-- upd_wired_in_uid wiredInMap u = case u of
+-- HoleUnit -> HoleUnit
+-- RealUnit (Definite uid) -> RealUnit (Definite uid)
+-- VirtUnit indef_uid ->
+-- VirtUnit $ mkInstantiatedUnit
+-- (instUnitInstanceOf indef_uid)
+-- (map (\(x,y) -> (x,upd_wired_in_mod wiredInMap y)) (instUnitInsts indef_uid))
+
+-- This function was updating the wired-in names in the visibility map to the
+-- actual wired-in names, no longer needed. It wasn't actually changing the visibility of anything
+-- updateVisibilityMap :: WiringMap -> VisibilityMap -> VisibilityMap
+-- updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap)
+-- where f vm (from, to) = case Map.lookup (RealUnit (Definite from)) vis_map of
+-- Nothing -> vm
+-- Just r -> Map.insert (RealUnit (Definite to)) r
+-- (Map.delete (RealUnit (Definite from)) vm)
-- ----------------------------------------------------------------------------
@@ -1597,7 +1579,7 @@ mkUnitState logger cfg = do
-- -hide-package). This needs to know about the unusable packages, since if a
-- user tries to enable an unusable package, we should let them know.
--
- vis_map2 <- mayThrowUnitErr
+ vis_map <- mayThrowUnitErr
$ foldM (applyPackageFlag prec_map prelim_pkg_db emptyUniqSet unusable
(unitConfigHideAll cfg) pkgs1)
vis_map1 other_flags
@@ -1607,13 +1589,11 @@ mkUnitState logger cfg = do
-- it modifies the unit ids of wired in packages, but when we process
-- package arguments we need to key against the old versions.
--
- (pkgs2, wired_map) <- findWiredInUnits logger prec_map pkgs1 vis_map2
- let pkg_db = mkUnitInfoMap pkgs2
+ (pkgs2, !wired_map) <- findWiredInUnits logger prec_map pkgs1 vis_map
- -- Update the visibility map, so we treat wired packages as visible.
- let vis_map = updateVisibilityMap wired_map vis_map2
+ let pkg_db = mkUnitInfoMap pkgs2
- let hide_plugin_pkgs = unitConfigHideAllPlugins cfg
+ hide_plugin_pkgs = unitConfigHideAllPlugins cfg
plugin_vis_map <-
case unitConfigFlagsPlugins cfg of
-- common case; try to share the old vis_map
@@ -1624,22 +1604,20 @@ mkUnitState logger cfg = do
-- Use the vis_map PRIOR to wired in,
-- because otherwise applyPackageFlag
-- won't work.
- | otherwise = vis_map2
- plugin_vis_map2
+ -- ROMES:TODO: update applyPackageFlag st it doesn't expected the previous wired-in names
+ | otherwise = vis_map
+ plugin_vis_map
<- mayThrowUnitErr
$ foldM (applyPackageFlag prec_map prelim_pkg_db emptyUniqSet unusable
hide_plugin_pkgs pkgs1)
plugin_vis_map1
(reverse (unitConfigFlagsPlugins cfg))
- -- Updating based on wired in packages is mostly
- -- good hygiene, because it won't matter: no wired in
- -- package has a compiler plugin.
-- TODO: If a wired in package had a compiler plugin,
-- and you tried to pick different wired in packages
-- with the plugin flags and the normal flags... what
-- would happen? I don't know! But this doesn't seem
-- likely to actually happen.
- return (updateVisibilityMap wired_map plugin_vis_map2)
+ return (plugin_vis_map)
let pkgname_map = listToUFM [ (unitPackageName p, unitInstanceOf p)
| p <- pkgs2
@@ -1691,11 +1669,11 @@ mkUnitState logger cfg = do
, moduleNameProvidersMap = mod_map
, pluginModuleNameProvidersMap = mkModuleNameProvidersMap logger cfg pkg_db emptyUniqSet plugin_vis_map
, packageNameMap = pkgname_map
- , wireMap = wired_map
- , unwireMap = Map.fromList [ (v,k) | (k,v) <- Map.toList wired_map ]
, requirementContext = req_ctx
, allowVirtualUnits = unitConfigAllowVirtual cfg
}
+
+ pprTrace "findWiredInUnits" (ppr wired_map) $ writeIORef workingThisOut wired_map
return (state, raw_dbs)
selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool
@@ -1710,14 +1688,6 @@ selectHomeUnits home_units flags = foldl' go Set.empty flags
-- MP: This does not yet support thinning/renaming
go cur _ = cur
-
--- | Given a wired-in 'Unit', "unwire" it into the 'Unit'
--- that it was recorded as in the package database.
-unwireUnit :: UnitState -> Unit -> Unit
-unwireUnit state uid@(RealUnit (Definite def_uid)) =
- maybe uid (RealUnit . Definite) (Map.lookup def_uid (unwireMap state))
-unwireUnit _ uid = uid
-
-- -----------------------------------------------------------------------------
-- | Makes the mapping from ModuleName to package info
=====================================
compiler/GHC/Unit/Types.hs
=====================================
@@ -5,6 +5,7 @@
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | Unit & Module types
@@ -35,6 +36,9 @@ module GHC.Unit.Types
, DefUnitId
, Instantiations
, GenInstantiations
+ , WiredIn
+ , WiringMap
+ , WiredInPackageName (..)
, mkInstantiatedUnit
, mkInstantiatedUnitHash
, mkVirtUnit
@@ -79,7 +83,7 @@ module GHC.Unit.Types
, interactiveUnit
, isInteractiveModule
- , wiredInUnitIds
+ , wiredInUnitNames
-- * Boot modules
, IsBootInterface (..)
@@ -101,10 +105,14 @@ import GHC.Utils.Fingerprint
import GHC.Utils.Misc
import Control.DeepSeq
+import Control.Monad.Trans.Reader
import Data.Data
import Data.List (sortBy )
import Data.Function
import Data.Bifunctor
+import Data.IORef
+import Data.Map (Map)
+import qualified Data.Map as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS.Char8
@@ -544,6 +552,11 @@ unitIdString = unpackFS . unitIdFS
stringToUnitId :: String -> UnitId
stringToUnitId = UnitId . mkFastString
+newtype WiredInPackageName = WiredInPackageName
+ { wiredInPackageNameFS :: FastString }
+ deriving (Data)
+ deriving (Binary, Eq, Ord, Uniquable, Outputable) via UnitId
+
---------------------------------------------------------------------
-- UTILS
---------------------------------------------------------------------
@@ -587,45 +600,75 @@ Make sure you change 'GHC.Unit.State.findWiredInUnits' if you add an entry here.
-}
+type WiringMap = Map WiredInPackageName UnitId
+type WiredIn = Reader WiringMap
+
+bignumUnitName, primUnitName, baseUnitName, rtsUnitName,
+ thUnitName, mainUnitName, thisGhcUnitName, interactiveUnitName :: WiredInPackageName
+
bignumUnitId, primUnitId, baseUnitId, rtsUnitId,
- thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId
+ thUnitId, thisGhcUnitId :: WiredIn UnitId
+mainUnitId, interactiveUnitId :: UnitId
bignumUnit, primUnit, baseUnit, rtsUnit,
- thUnit, mainUnit, thisGhcUnit, interactiveUnit :: Unit
-
-primUnitId = UnitId (fsLit "ghc-prim")
-bignumUnitId = UnitId (fsLit "ghc-bignum")
-baseUnitId = UnitId (fsLit "base")
-rtsUnitId = UnitId (fsLit "rts")
-thisGhcUnitId = UnitId (fsLit "ghc")
-interactiveUnitId = UnitId (fsLit "interactive")
-thUnitId = UnitId (fsLit "template-haskell")
-
-thUnit = RealUnit (Definite thUnitId)
-primUnit = RealUnit (Definite primUnitId)
-bignumUnit = RealUnit (Definite bignumUnitId)
-baseUnit = RealUnit (Definite baseUnitId)
-rtsUnit = RealUnit (Definite rtsUnitId)
-thisGhcUnit = RealUnit (Definite thisGhcUnitId)
+ thUnit, thisGhcUnit :: WiredIn Unit
+mainUnit, interactiveUnit :: Unit
+
+primUnitName = WiredInPackageName $ fsLit "ghc-prim"
+bignumUnitName = WiredInPackageName $ fsLit "ghc-bignum"
+baseUnitName = WiredInPackageName $ fsLit "base"
+rtsUnitName = WiredInPackageName $ fsLit "rts"
+thisGhcUnitName = WiredInPackageName $ fsLit "ghc"
+interactiveUnitName = WiredInPackageName $ fsLit "interactive"
+thUnitName = WiredInPackageName $ fsLit "template-haskell"
+
+primUnitId = mkWiredInUnitId primUnitName
+bignumUnitId = mkWiredInUnitId bignumUnitName
+baseUnitId = mkWiredInUnitId baseUnitName
+rtsUnitId = mkWiredInUnitId rtsUnitName
+thisGhcUnitId = mkWiredInUnitId thisGhcUnitName
+interactiveUnitId = UnitId $ wiredInPackageNameFS interactiveUnitName
+thUnitId = mkWiredInUnitId thUnitName
+
+thUnit = RealUnit . Definite <$> thUnitId
+primUnit = RealUnit . Definite <$> primUnitId
+bignumUnit = RealUnit . Definite <$> bignumUnitId
+baseUnit = RealUnit . Definite <$> baseUnitId
+rtsUnit = RealUnit . Definite <$> rtsUnitId
+thisGhcUnit = RealUnit . Definite <$> thisGhcUnitId
interactiveUnit = RealUnit (Definite interactiveUnitId)
-- | This is the package Id for the current program. It is the default
-- package Id if you don't specify a package name. We don't add this prefix
-- to symbol names, since there can be only one main package per program.
-mainUnitId = UnitId (fsLit "main")
+mainUnitName = WiredInPackageName $ fsLit "main"
+mainUnitId = UnitId $ wiredInPackageNameFS mainUnitName
mainUnit = RealUnit (Definite mainUnitId)
+-- Make the actual unit id the result of looking up the wired-in unit package name in the wire map
+mkWiredInUnitId :: WiredInPackageName -> WiredIn UnitId
+mkWiredInUnitId name = ask >>= \wiring_map -> case Map.lookup name wiring_map of
+ Nothing -> pure $ pprTrace "Romes:Couldn't find UnitId" (ppr (name,wiring_map)) $ UnitId $ wiredInPackageNameFS name
+ -- case x of
+ -- rtsUnitName -> (UnitId $ fsLit "rts")
+ -- primUnitName -> (UnitId $ fsLit "ghc-prim")
+ -- this is a fallback, in which situations do
+ -- we need a fallback? perhaps when booting
+ -- the compiler with the rts?
+ Just actual_name -> pure $ pprTrace "Romes:Found in wire map" (ppr name <+> text "->" <> ppr actual_name) actual_name
+
+
isInteractiveModule :: Module -> Bool
isInteractiveModule mod = moduleUnit mod == interactiveUnit
-wiredInUnitIds :: [UnitId]
-wiredInUnitIds =
- [ primUnitId
- , bignumUnitId
- , baseUnitId
- , rtsUnitId
- , thUnitId
- , thisGhcUnitId
+wiredInUnitNames :: [WiredInPackageName]
+wiredInUnitNames =
+ [ primUnitName
+ , bignumUnitName
+ , baseUnitName
+ , rtsUnitName
+ , thUnitName
+ , thisGhcUnitName
]
---------------------------------------------------------------------
=====================================
del-this-unit-id.sh
=====================================
@@ -0,0 +1 @@
+sed -i '' 's/ghc-options: -this-unit-id.*//i' compiler/ghc.cabal.in libraries/base/base.cabal libraries/ghc-bignum/ghc-bignum.cabal libraries/ghc-prim/ghc-prim.cabal rts/rts.cabal.in libraries/template-haskell/template-haskell.cabal.in
=====================================
hadrian/src/Hadrian/Haskell/Cabal.hs
=====================================
@@ -29,6 +29,7 @@ pkgVersion = fmap version . readPackageData
-- The Cabal file is tracked.
pkgIdentifier :: Package -> Action String
pkgIdentifier package = do
+ -- ROMES:TODO: besides the version, compute a simple hash
cabal <- readPackageData package
return $ if null (version cabal)
then name cabal
=====================================
hadrian/src/Rules/ToolArgs.hs
=====================================
@@ -85,25 +85,12 @@ multiSetup pkg_s = do
need (srcs ++ gens)
let rexp m = ["-reexported-module", m]
let hidir = root </> "interfaces" </> pkgPath p
- writeFile' (resp_file root p) (intercalate "\n" (th_hack arg_list
+ writeFile' (resp_file root p) (intercalate "\n" (arg_list
++ modules cd
++ concatMap rexp (reexportModules cd)
++ ["-outputdir", hidir]))
return (resp_file root p)
-
- -- The template-haskell package is compiled with -this-unit-id=template-haskell but
- -- everything which depends on it depends on `-package-id-template-haskell-2.17.0.0`
- -- and so the logic for detetecting which home-units depend on what is defeated.
- -- The workaround here is just to rewrite all the `-package-id` arguments to
- -- point to `template-haskell` instead which works for the multi-repl case.
- -- See #20887
- th_hack :: [String] -> [String]
- th_hack ((isPrefixOf "-package-id template-haskell" -> True) : xs) = "-package-id" : "template-haskell" : xs
- th_hack (x:xs) = x : th_hack xs
- th_hack [] = []
-
-
toolRuleBody :: FilePath -> Action ()
toolRuleBody fp = do
mm <- dirMap
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22036aa2f01cb01a24cb203744ad4233dcd0b947...ea020879c3c261a06231fa7f60d84b5caf082835
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22036aa2f01cb01a24cb203744ad4233dcd0b947...ea020879c3c261a06231fa7f60d84b5caf082835
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230307/71b59d39/attachment-0001.html>
More information about the ghc-commits
mailing list