diff options
Diffstat (limited to 'compiler/prelude')
| -rw-r--r-- | compiler/prelude/PrelInfo.hs | 111 | ||||
| -rw-r--r-- | compiler/prelude/PrelNames.hs | 88 | ||||
| -rw-r--r-- | compiler/prelude/THNames.hs | 105 | ||||
| -rw-r--r-- | compiler/prelude/TysPrim.hs | 38 | ||||
| -rw-r--r-- | compiler/prelude/TysWiredIn.hs | 55 |
5 files changed, 146 insertions, 251 deletions
diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs index f76b62ee00..f79b6b1e7f 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/prelude/PrelInfo.hs @@ -10,7 +10,7 @@ module PrelInfo ( primOpRules, builtinRules, ghcPrimExports, - knownKeyNames, + wiredInThings, knownKeyNames, primOpId, -- Random other things @@ -23,31 +23,56 @@ module PrelInfo ( #include "HsVersions.h" -import Constants ( mAX_TUPLE_SIZE ) -import BasicTypes ( Boxity(..) ) -import ConLike ( ConLike(..) ) import PrelNames import PrelRules import Avail import PrimOp import DataCon import Id -import Name import MkId +import Name( Name, getName ) import TysPrim import TysWiredIn import HscTypes import Class import TyCon +import Outputable +import UniqFM import Util import {-# SOURCE #-} TcTypeNats ( typeNatTyCons ) +#ifdef GHCI +import THNames +#endif + import Data.Array -{- -************************************************************************ + +{- ********************************************************************* +* * + Known key things +* * +********************************************************************* -} + +knownKeyNames :: [Name] +knownKeyNames = + ASSERT2( isNullUFM badNamesUFM, text "badknownKeyNames" <+> ppr badNamesUFM ) + names + where + badNamesUFM = filterUFM (\ns -> length ns > 1) namesUFM + namesUFM = foldl (\m n -> addToUFM_Acc (:) singleton m n n) emptyUFM names + names = concat + [ map getName wiredInThings + , cTupleTyConNames + , basicKnownKeyNames +#ifdef GHCI + , templateHaskellNames +#endif + ] + +{- ********************************************************************* * * -\subsection[builtinNameInfo]{Lookup built-in names} + Wired in things * * ************************************************************************ @@ -62,61 +87,33 @@ Notes about wired in things * The name cache is initialised with (the names of) all wired-in things -* The type environment itself contains no wired in things. The type - checker sees if the Name is wired in before looking up the name in - the type environment. +* The type checker sees if the Name is wired in before looking up + the name in the type environment. So the type envt itself contains + no wired in things. * MkIface prunes out wired-in things before putting them in an interface file. So interface files never contain wired-in things. -} - -knownKeyNames :: [Name] --- This list is used to ensure that when you say "Prelude.map" --- in your source code, or in an interface file, --- you get a Name with the correct known key --- (See Note [Known-key names] in PrelNames) -knownKeyNames - = concat [ tycon_kk_names funTyCon - , concatMap tycon_kk_names primTyCons - - , concatMap tycon_kk_names wiredInTyCons - -- Does not include tuples - - , concatMap tycon_kk_names typeNatTyCons - - , concatMap (rep_names . tupleTyCon Boxed) [2..mAX_TUPLE_SIZE] -- Yuk - - , cTupleTyConNames - -- Constraint tuples are known-key but not wired-in - -- They can't show up in source code, but can appear - -- in intreface files - - , map idName wiredInIds - , map (idName . primOpId) allThePrimOps - , basicKnownKeyNames ] +wiredInThings :: [TyThing] +-- This list is used only to initialise HscMain.knownKeyNames +-- to ensure that when you say "Prelude.map" in your source code, you +-- get a Name with the correct known key (See Note [Known-key names]) +wiredInThings + = concat + [ -- Wired in TyCons and their implicit Ids + tycon_things + , concatMap implicitTyThings tycon_things + + -- Wired in Ids + , map AnId wiredInIds + + -- PrimOps + , map (AnId . primOpId) allThePrimOps + ] where - -- "kk" short for "known-key" - tycon_kk_names :: TyCon -> [Name] - tycon_kk_names tc = tyConName tc : (rep_names tc ++ concatMap thing_kk_names (implicitTyConThings tc)) - - datacon_kk_names dc - | Promoted tc <- promoteDataCon_maybe dc = dataConName dc : rep_names tc - | otherwise = [dataConName dc] - - thing_kk_names :: TyThing -> [Name] - thing_kk_names (ATyCon tc) = tycon_kk_names tc - thing_kk_names (AConLike (RealDataCon dc)) = datacon_kk_names dc - thing_kk_names thing = [getName thing] - - -- The TyConRepName for a known-key TyCon has a known key, - -- but isn't itself an implicit thing. Yurgh. - -- NB: if any of the wired-in TyCons had record fields, the record - -- field names would be in a similar situation. Ditto class ops. - -- But it happens that there aren't any - rep_names tc = case tyConRepName_maybe tc of - Just n -> [n] - Nothing -> [] + tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons + ++ typeNatTyCons) {- We let a lot of "non-standard" values be visible, so that we can make diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index 05a38ffec9..30d11fef59 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -206,13 +206,11 @@ basicKnownKeyNames -- Typeable typeableClassName, typeRepTyConName, - trTyConDataConName, - trModuleDataConName, - trNameSDataConName, - typeRepIdName, + mkTyConName, mkPolyTyConAppName, mkAppTyName, - typeSymbolTypeRepName, typeNatTypeRepName, + typeNatTypeRepName, + typeSymbolTypeRepName, -- Dynamic toDynName, @@ -228,6 +226,7 @@ basicKnownKeyNames fromIntegralName, realToFracName, -- String stuff + stringTyConName, fromStringName, -- Enum stuff @@ -608,8 +607,7 @@ toInteger_RDR = nameRdrName toIntegerName toRational_RDR = nameRdrName toRationalName fromIntegral_RDR = nameRdrName fromIntegralName -stringTy_RDR, fromString_RDR :: RdrName -stringTy_RDR = tcQual_RDR gHC_BASE (fsLit "String") +fromString_RDR :: RdrName fromString_RDR = nameRdrName fromStringName fromList_RDR, fromListN_RDR, toList_RDR :: RdrName @@ -670,6 +668,11 @@ showString_RDR = varQual_RDR gHC_SHOW (fsLit "showString") showSpace_RDR = varQual_RDR gHC_SHOW (fsLit "showSpace") showParen_RDR = varQual_RDR gHC_SHOW (fsLit "showParen") +typeRep_RDR, mkTyCon_RDR, mkTyConApp_RDR :: RdrName +typeRep_RDR = varQual_RDR tYPEABLE_INTERNAL (fsLit "typeRep#") +mkTyCon_RDR = varQual_RDR tYPEABLE_INTERNAL (fsLit "mkTyCon") +mkTyConApp_RDR = varQual_RDR tYPEABLE_INTERNAL (fsLit "mkTyConApp") + undefined_RDR :: RdrName undefined_RDR = varQual_RDR gHC_ERR (fsLit "undefined") @@ -779,39 +782,6 @@ and it's convenient to write them all down in one place. -- guys as well (perhaps) e.g. see trueDataConName below -} --- | Build a 'Name' for the 'Typeable' representation of the given special 'TyCon'. --- Special 'TyCon's include @(->)@, @BOX@, @Constraint@, etc. See 'TysPrim'. -mkSpecialTyConRepName :: FastString -> Name -> Name --- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable. -mkSpecialTyConRepName fs tc_name - = mkExternalName (tyConRepNameUnique (nameUnique tc_name)) - tYPEABLE_INTERNAL - (mkVarOccFS fs) - wiredInSrcSpan - --- | Make a 'Name' for the 'Typeable' representation of the given wired-in type -mkPrelTyConRepName :: Name -> Name --- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable. -mkPrelTyConRepName tc_name -- Prelude tc_name is always External, - -- so nameModule will work - = mkExternalName rep_uniq rep_mod rep_occ (nameSrcSpan tc_name) - where - name_occ = nameOccName tc_name - name_mod = nameModule tc_name - name_uniq = nameUnique tc_name - rep_uniq | isTcOcc name_occ = tyConRepNameUnique name_uniq - | otherwise = dataConRepNameUnique name_uniq - (rep_mod, rep_occ) = tyConRepModOcc name_mod name_occ - --- | TODO --- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable. -tyConRepModOcc :: Module -> OccName -> (Module, OccName) -tyConRepModOcc tc_module tc_occ - | tc_module == gHC_TYPES - = (tYPEABLE_INTERNAL, mkTyConRepUserOcc tc_occ) - | otherwise - = (tc_module, mkTyConRepSysOcc tc_occ) - wildCardName :: Name wildCardName = mkSystemVarName wildCardKey (fsLit "wild") @@ -879,11 +849,12 @@ uWordTyConName = tcQual gHC_GENERICS (fsLit "UWord") uWordTyConKey -- Base strings Strings unpackCStringName, unpackCStringFoldrName, - unpackCStringUtf8Name, eqStringName :: Name + unpackCStringUtf8Name, eqStringName, stringTyConName :: Name unpackCStringName = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey unpackCStringFoldrName = varQual gHC_CSTRING (fsLit "unpackFoldrCString#") unpackCStringFoldrIdKey unpackCStringUtf8Name = varQual gHC_CSTRING (fsLit "unpackCStringUtf8#") unpackCStringUtf8IdKey eqStringName = varQual gHC_BASE (fsLit "eqString") eqStringIdKey +stringTyConName = tcQual gHC_BASE (fsLit "String") stringTyConKey -- The 'inline' function inlineIdName :: Name @@ -1082,21 +1053,15 @@ ixClassName = clsQual gHC_ARR (fsLit "Ix") ixClassKey -- Class Typeable, and functions for constructing `Typeable` dictionaries typeableClassName , typeRepTyConName - , trTyConDataConName - , trModuleDataConName - , trNameSDataConName + , mkTyConName , mkPolyTyConAppName , mkAppTyName - , typeRepIdName , typeNatTypeRepName , typeSymbolTypeRepName :: Name typeableClassName = clsQual tYPEABLE_INTERNAL (fsLit "Typeable") typeableClassKey typeRepTyConName = tcQual tYPEABLE_INTERNAL (fsLit "TypeRep") typeRepTyConKey -trTyConDataConName = dcQual gHC_TYPES (fsLit "TyCon") trTyConDataConKey -trModuleDataConName = dcQual gHC_TYPES (fsLit "Module") trModuleDataConKey -trNameSDataConName = dcQual gHC_TYPES (fsLit "TrNameS") trNameSDataConKey -typeRepIdName = varQual tYPEABLE_INTERNAL (fsLit "typeRep#") typeRepIdKey +mkTyConName = varQual tYPEABLE_INTERNAL (fsLit "mkTyCon") mkTyConKey mkPolyTyConAppName = varQual tYPEABLE_INTERNAL (fsLit "mkPolyTyConApp") mkPolyTyConAppKey mkAppTyName = varQual tYPEABLE_INTERNAL (fsLit "mkAppTy") mkAppTyKey typeNatTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey @@ -1377,7 +1342,7 @@ ghciIoClassKey :: Unique ghciIoClassKey = mkPreludeClassUnique 44 ---------------- Template Haskell ------------------- --- THNames.hs: USES ClassUniques 200-299 +-- USES ClassUniques 200-299 ----------------------------------------------------- {- @@ -1524,6 +1489,9 @@ unknown2TyConKey = mkPreludeTyConUnique 131 unknown3TyConKey = mkPreludeTyConUnique 132 opaqueTyConKey = mkPreludeTyConUnique 133 +stringTyConKey :: Unique +stringTyConKey = mkPreludeTyConUnique 134 + -- Generics (Unique keys) v1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey, k1TyConKey, m1TyConKey, sumTyConKey, prodTyConKey, @@ -1621,7 +1589,7 @@ ipCoNameKey = mkPreludeTyConUnique 185 ---------------- Template Haskell ------------------- --- THNames.hs: USES TyConUniques 200-299 +-- USES TyConUniques 200-299 ----------------------------------------------------- ----------------------- SIMD ------------------------ @@ -1700,16 +1668,6 @@ srcLocDataConKey = mkPreludeDataConUnique 37 ipDataConKey :: Unique ipDataConKey = mkPreludeDataConUnique 38 -trTyConDataConKey, trModuleDataConKey, trNameSDataConKey :: Unique -trTyConDataConKey = mkPreludeDataConUnique 40 -trModuleDataConKey = mkPreludeDataConUnique 41 -trNameSDataConKey = mkPreludeDataConUnique 42 - ----------------- Template Haskell ------------------- --- THNames.hs: USES DataUniques 100-150 ------------------------------------------------------ - - {- ************************************************************************ * * @@ -1964,7 +1922,7 @@ proxyHashKey :: Unique proxyHashKey = mkPreludeMiscIdUnique 502 ---------------- Template Haskell ------------------- --- THNames.hs: USES IdUniques 200-499 +-- USES IdUniques 200-499 ----------------------------------------------------- -- Used to make `Typeable` dictionaries @@ -1973,21 +1931,19 @@ mkTyConKey , mkAppTyKey , typeNatTypeRepKey , typeSymbolTypeRepKey - , typeRepIdKey :: Unique mkTyConKey = mkPreludeMiscIdUnique 503 mkPolyTyConAppKey = mkPreludeMiscIdUnique 504 mkAppTyKey = mkPreludeMiscIdUnique 505 typeNatTypeRepKey = mkPreludeMiscIdUnique 506 typeSymbolTypeRepKey = mkPreludeMiscIdUnique 507 -typeRepIdKey = mkPreludeMiscIdUnique 508 -- Dynamic toDynIdKey :: Unique -toDynIdKey = mkPreludeMiscIdUnique 509 +toDynIdKey = mkPreludeMiscIdUnique 508 bitIntegerIdKey :: Unique -bitIntegerIdKey = mkPreludeMiscIdUnique 510 +bitIntegerIdKey = mkPreludeMiscIdUnique 509 {- ************************************************************************ diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs index 571487a274..062f9577e7 100644 --- a/compiler/prelude/THNames.hs +++ b/compiler/prelude/THNames.hs @@ -448,6 +448,23 @@ unsafeName = libFun (fsLit "unsafe") unsafeIdKey safeName = libFun (fsLit "safe") safeIdKey interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey +-- data Inline = ... +noInlineDataConName, inlineDataConName, inlinableDataConName :: Name +noInlineDataConName = thCon (fsLit "NoInline") noInlineDataConKey +inlineDataConName = thCon (fsLit "Inline") inlineDataConKey +inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey + +-- data RuleMatch = ... +conLikeDataConName, funLikeDataConName :: Name +conLikeDataConName = thCon (fsLit "ConLike") conLikeDataConKey +funLikeDataConName = thCon (fsLit "FunLike") funLikeDataConKey + +-- data Phases = ... +allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: Name +allPhasesDataConName = thCon (fsLit "AllPhases") allPhasesDataConKey +fromPhaseDataConName = thCon (fsLit "FromPhase") fromPhaseDataConKey +beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey + -- newtype TExp a = ... tExpDataConName :: Name tExpDataConName = thCon (fsLit "TExp") tExpDataConKey @@ -506,42 +523,12 @@ quotePatName = qqFun (fsLit "quotePat") quotePatKey quoteDecName = qqFun (fsLit "quoteDec") quoteDecKey quoteTypeName = qqFun (fsLit "quoteType") quoteTypeKey --- data Inline = ... -noInlineDataConName, inlineDataConName, inlinableDataConName :: Name -noInlineDataConName = thCon (fsLit "NoInline") noInlineDataConKey -inlineDataConName = thCon (fsLit "Inline") inlineDataConKey -inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey - --- data RuleMatch = ... -conLikeDataConName, funLikeDataConName :: Name -conLikeDataConName = thCon (fsLit "ConLike") conLikeDataConKey -funLikeDataConName = thCon (fsLit "FunLike") funLikeDataConKey - --- data Phases = ... -allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: Name -allPhasesDataConName = thCon (fsLit "AllPhases") allPhasesDataConKey -fromPhaseDataConName = thCon (fsLit "FromPhase") fromPhaseDataConKey -beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey - - -{- ********************************************************************* -* * - Class keys -* * -********************************************************************* -} - -- ClassUniques available: 200-299 -- Check in PrelNames if you want to change this liftClassKey :: Unique liftClassKey = mkPreludeClassUnique 200 -{- ********************************************************************* -* * - TyCon keys -* * -********************************************************************* -} - -- TyConUniques available: 200-299 -- Check in PrelNames if you want to change this @@ -587,43 +574,6 @@ tExpTyConKey = mkPreludeTyConUnique 230 injAnnTyConKey = mkPreludeTyConUnique 231 kindTyConKey = mkPreludeTyConUnique 232 -{- ********************************************************************* -* * - DataCon keys -* * -********************************************************************* -} - --- DataConUniques available: 100-150 --- If you want to change this, make sure you check in PrelNames - --- data Inline = ... -noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique -noInlineDataConKey = mkPreludeDataConUnique 100 -inlineDataConKey = mkPreludeDataConUnique 101 -inlinableDataConKey = mkPreludeDataConUnique 102 - --- data RuleMatch = ... -conLikeDataConKey, funLikeDataConKey :: Unique -conLikeDataConKey = mkPreludeDataConUnique 103 -funLikeDataConKey = mkPreludeDataConUnique 104 - --- data Phases = ... -allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique -allPhasesDataConKey = mkPreludeDataConUnique 105 -fromPhaseDataConKey = mkPreludeDataConUnique 106 -beforePhaseDataConKey = mkPreludeDataConUnique 107 - --- newtype TExp a = ... -tExpDataConKey :: Unique -tExpDataConKey = mkPreludeDataConUnique 108 - - -{- ********************************************************************* -* * - Id keys -* * -********************************************************************* -} - -- IdUniques available: 200-499 -- If you want to change this, make sure you check in PrelNames @@ -893,6 +843,27 @@ unsafeIdKey = mkPreludeMiscIdUnique 430 safeIdKey = mkPreludeMiscIdUnique 431 interruptibleIdKey = mkPreludeMiscIdUnique 432 +-- data Inline = ... +noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique +noInlineDataConKey = mkPreludeDataConUnique 40 +inlineDataConKey = mkPreludeDataConUnique 41 +inlinableDataConKey = mkPreludeDataConUnique 42 + +-- data RuleMatch = ... +conLikeDataConKey, funLikeDataConKey :: Unique +conLikeDataConKey = mkPreludeDataConUnique 43 +funLikeDataConKey = mkPreludeDataConUnique 44 + +-- data Phases = ... +allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique +allPhasesDataConKey = mkPreludeDataConUnique 45 +fromPhaseDataConKey = mkPreludeDataConUnique 46 +beforePhaseDataConKey = mkPreludeDataConUnique 47 + +-- newtype TExp a = ... +tExpDataConKey :: Unique +tExpDataConKey = mkPreludeDataConUnique 48 + -- data FunDep = ... funDepIdKey :: Unique funDepIdKey = mkPreludeMiscIdUnique 440 diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs index 3a6dd0341e..d66b48e3b7 100644 --- a/compiler/prelude/TysPrim.hs +++ b/compiler/prelude/TysPrim.hs @@ -10,8 +10,6 @@ -- | This module defines TyCons that can't be expressed in Haskell. -- They are all, therefore, wired-in TyCons. C.f module TysWiredIn module TysPrim( - mkPrimTyConName, -- For implicit parameters in TysWiredIn only - mkTemplateTyVars, alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar, alphaTy, betaTy, gammaTy, deltaTy, @@ -83,11 +81,12 @@ module TysPrim( #include "HsVersions.h" import Var ( TyVar, KindVar, mkTyVar ) -import Name +import Name ( Name, BuiltInSyntax(..), mkInternalName, mkWiredInName ) +import OccName ( mkTyVarOccFS, mkTcOccFS ) import TyCon import TypeRep import SrcLoc -import Unique +import Unique ( mkAlphaTyVarUnique ) import PrelNames import FastString @@ -259,9 +258,8 @@ funTyConName :: Name funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon funTyCon :: TyCon -funTyCon = mkFunTyCon funTyConName kind tc_rep_nm - where - kind = mkArrowKinds [liftedTypeKind, liftedTypeKind] liftedTypeKind +funTyCon = mkFunTyCon funTyConName $ + mkArrowKinds [liftedTypeKind, liftedTypeKind] liftedTypeKind -- You might think that (->) should have type (?? -> ? -> *), and you'd be right -- But if we do that we get kind errors when saying -- instance Control.Arrow (->) @@ -271,8 +269,6 @@ funTyCon = mkFunTyCon funTyConName kind tc_rep_nm -- a prefix way, thus: (->) Int# Int#. And this is unusual. -- because they are never in scope in the source - tc_rep_nm = mkSpecialTyConRepName (fsLit "tcFun") funTyConName - -- One step to remove subkinding. -- (->) :: * -> * -> * -- but we should have (and want) the following typing rule for fully applied arrows @@ -322,21 +318,14 @@ superKindTyConName, anyKindTyConName, liftedTypeKindTyConName, constraintKindTyConName :: Name -mk_kind_tycon :: Name -- ^ Name of the kind constructor, e.g. @*@ - -> FastString -- ^ Name of the 'TyConRepName' function, - -- e.g. @tcLiftedKind :: TyCon@ - -> TyCon -- ^ The kind constructor -mk_kind_tycon tc_name rep_fs - = mkKindTyCon tc_name superKind (mkSpecialTyConRepName rep_fs tc_name) - -superKindTyCon = mk_kind_tycon superKindTyConName (fsLit "tcBOX") - -- See Note [SuperKind (BOX)] +superKindTyCon = mkKindTyCon superKindTyConName superKind + -- See Note [SuperKind (BOX)] -anyKindTyCon = mk_kind_tycon anyKindTyConName (fsLit "tcAnyK") -constraintKindTyCon = mk_kind_tycon constraintKindTyConName (fsLit "tcConstraint") -liftedTypeKindTyCon = mk_kind_tycon liftedTypeKindTyConName (fsLit "tcLiftedKind") -openTypeKindTyCon = mk_kind_tycon openTypeKindTyConName (fsLit "tcOpenKind") -unliftedTypeKindTyCon = mk_kind_tycon unliftedTypeKindTyConName (fsLit "tcUnliftedKind") +anyKindTyCon = mkKindTyCon anyKindTyConName superKind +liftedTypeKindTyCon = mkKindTyCon liftedTypeKindTyConName superKind +openTypeKindTyCon = mkKindTyCon openTypeKindTyConName superKind +unliftedTypeKindTyCon = mkKindTyCon unliftedTypeKindTyConName superKind +constraintKindTyCon = mkKindTyCon constraintKindTyConName superKind -------------------------- -- ... and now their names @@ -747,7 +736,6 @@ variables with no constraints on them. It appears in similar circumstances to Any, but at the kind level. For example: type family Length (l :: [k]) :: Nat - type instance Length [] = Zero f :: Proxy (Length []) -> Int f = .... @@ -788,7 +776,7 @@ anyTy = mkTyConTy anyTyCon anyTyCon :: TyCon anyTyCon = mkFamilyTyCon anyTyConName kind [kKiVar] Nothing (ClosedSynFamilyTyCon Nothing) - Nothing + NoParentTyCon NotInjective where kind = ForAllTy kKiVar (mkTyVarTy kKiVar) diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 067700f120..e8a06e7ad4 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -99,7 +99,6 @@ import TysPrim -- others: import CoAxiom import Coercion -import Id import Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE ) import Module ( Module ) import Type ( mkTyConApp ) @@ -290,7 +289,7 @@ pcTyCon is_enum is_rec is_prom name cType tyvars cons is_rec is_prom False -- Not in GADT syntax - (VanillaAlgTyCon (mkPrelTyConRepName name)) + NoParentTyCon pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon pcDataCon = pcDataConWithFixity False @@ -311,7 +310,7 @@ pcDataConWithFixity' :: Bool -> Name -> Unique -> [TyVar] -> [Type] -> TyCon -> pcDataConWithFixity' declared_infix dc_name wrk_key tyvars arg_tys tycon = data_con where - data_con = mkDataCon dc_name declared_infix prom_info + data_con = mkDataCon dc_name declared_infix (map (const no_bang) arg_tys) [] -- No labelled fields tyvars @@ -328,16 +327,10 @@ pcDataConWithFixity' declared_infix dc_name wrk_key tyvars arg_tys tycon modu = ASSERT( isExternalName dc_name ) nameModule dc_name - dc_occ = nameOccName dc_name - wrk_occ = mkDataConWorkerOcc dc_occ + wrk_occ = mkDataConWorkerOcc (nameOccName dc_name) wrk_name = mkWiredInName modu wrk_occ wrk_key (AnId (dataConWorkId data_con)) UserSyntax - prom_info | Promoted {} <- promotableTyCon_maybe tycon -- Knot-tied - = Promoted (mkPrelTyConRepName dc_name) - | otherwise - = NotPromoted - {- ************************************************************************ * * @@ -505,19 +498,15 @@ mk_tuple boxity arity = (tycon, tuple_con) where tycon = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con tup_sort - prom_tc flavour - - flavour = case boxity of - Boxed -> VanillaAlgTyCon (mkPrelTyConRepName tc_name) - Unboxed -> UnboxedAlgTyCon + prom_tc NoParentTyCon tup_sort = case boxity of Boxed -> BoxedTuple Unboxed -> UnboxedTuple prom_tc = case boxity of - Boxed -> Promoted (mkPromotedTyCon tycon (promoteKind tc_kind)) - Unboxed -> NotPromoted + Boxed -> Just (mkPromotedTyCon tycon (promoteKind tc_kind)) + Unboxed -> Nothing modu = case boxity of Boxed -> gHC_TUPLE @@ -743,11 +732,8 @@ mkListTy :: Type -> Type mkListTy ty = mkTyConApp listTyCon [ty] listTyCon :: TyCon -listTyCon = buildAlgTyCon listTyConName alpha_tyvar [Representational] - Nothing [] - (DataTyCon [nilDataCon, consDataCon] False ) - Recursive True False - (VanillaAlgTyCon (mkSpecialTyConRepName (fsLit "tcList") listTyConName)) +listTyCon = pcTyCon False Recursive True + listTyConName Nothing alpha_tyvar [nilDataCon, consDataCon] mkPromotedListTy :: Type -> Type mkPromotedListTy ty = mkTyConApp promotedListTyCon [ty] @@ -944,10 +930,10 @@ eqTyCon = mkAlgTyCon eqTyConName Nothing [] -- No stupid theta (DataTyCon [eqBoxDataCon] False) - (VanillaAlgTyCon (mkSpecialTyConRepName (fsLit "tcEq") eqTyConName)) + NoParentTyCon NonRecursive False - NotPromoted + Nothing -- No parent for constraint-kinded types where kv = kKiVar k = mkTyVarTy kv @@ -963,17 +949,15 @@ eqBoxDataCon = pcDataCon eqBoxDataConName args [TyConApp eqPrimTyCon (map mkTyVa coercibleTyCon :: TyCon -coercibleTyCon = mkClassTyCon coercibleTyConName kind tvs - [Nominal, Representational, Representational] - rhs coercibleClass NonRecursive - (mkPrelTyConRepName coercibleTyConName) - where - kind = (ForAllTy kv $ mkArrowKinds [k, k] constraintKind) - kv = kKiVar - k = mkTyVarTy kv - [a,b] = mkTemplateTyVars [k,k] - tvs = [kv, a, b] - rhs = DataTyCon [coercibleDataCon] False +coercibleTyCon = mkClassTyCon + coercibleTyConName kind tvs [Nominal, Representational, Representational] + rhs coercibleClass NonRecursive + where kind = (ForAllTy kv $ mkArrowKinds [k, k] constraintKind) + kv = kKiVar + k = mkTyVarTy kv + [a,b] = mkTemplateTyVars [k,k] + tvs = [kv, a, b] + rhs = DataTyCon [coercibleDataCon] False coercibleDataCon :: DataCon coercibleDataCon = pcDataCon coercibleDataConName args [TyConApp eqReprPrimTyCon (map mkTyVarTy args)] coercibleTyCon @@ -1010,7 +994,6 @@ ipCoName = mkWiredInCoAxiomName BuiltInSyntax gHC_CLASSES (fsLit "NTCo:IP") -- See Note [The Implicit Parameter class] ipTyCon :: TyCon ipTyCon = mkClassTyCon ipTyConName kind [ip,a] [] rhs ipClass NonRecursive - (mkPrelTyConRepName ipTyConName) where kind = mkArrowKinds [typeSymbolKind, liftedTypeKind] constraintKind [ip,a] = mkTemplateTyVars [typeSymbolKind, liftedTypeKind] |