diff options
Diffstat (limited to 'compiler/prelude/TysWiredIn.hs')
| -rw-r--r-- | compiler/prelude/TysWiredIn.hs | 269 |
1 files changed, 108 insertions, 161 deletions
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 34c1838997..6c2ffb7417 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -43,22 +43,21 @@ module TysWiredIn ( wordTyCon, wordDataCon, wordTyConName, wordTy, -- * List - listTyCon, listTyCon_RDR, listTyConName, listTyConKey, - nilDataCon, nilDataConName, nilDataConKey, - consDataCon_RDR, consDataCon, consDataConName, - + listTyCon, nilDataCon, nilDataConName, consDataCon, consDataConName, + listTyCon_RDR, consDataCon_RDR, listTyConName, mkListTy, mkPromotedListTy, -- * Tuples mkTupleTy, mkBoxedTupleTy, - tupleTyCon, tupleDataCon, tupleTyConName, + tupleTyCon, tupleCon, promotedTupleTyCon, promotedTupleDataCon, - unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey, - pairTyCon, + unitTyCon, unitDataCon, unitDataConId, pairTyCon, unboxedUnitTyCon, unboxedUnitDataCon, unboxedSingletonTyCon, unboxedSingletonDataCon, unboxedPairTyCon, unboxedPairDataCon, - cTupleTyConName, cTupleTyConNames, isCTupleTyConName, + + -- * Unit + unitTy, -- * Kinds typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind, @@ -85,7 +84,7 @@ import PrelNames import TysPrim -- others: -import Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE ) +import Constants ( mAX_TUPLE_SIZE ) import Module ( Module ) import Type ( mkTyConApp ) import DataCon @@ -96,14 +95,11 @@ import Class ( Class, mkClass ) import TypeRep import RdrName import Name -import NameSet ( NameSet, mkNameSet, elemNameSet ) -import BasicTypes ( Arity, RecFlag(..), Boxity(..), - TupleSort(..) ) +import BasicTypes ( TupleSort(..), tupleSortBoxity, + Arity, RecFlag(..), Boxity(..) ) import ForeignCall -import Unique ( incrUnique, - mkTupleTyConUnique, mkTupleDataConUnique, - mkCTupleTyConUnique, mkPArrDataConUnique ) -import SrcLoc ( noSrcSpan ) +import Unique ( incrUnique, mkTupleTyConUnique, + mkTupleDataConUnique, mkPArrDataConUnique ) import Data.Array import FastString import Outputable @@ -323,39 +319,14 @@ typeSymbolKind = TyConApp (promoteTyCon typeSymbolKindCon) [] Note [How tuples work] See also Note [Known-key names] in PrelNames ~~~~~~~~~~~~~~~~~~~~~~ * There are three families of tuple TyCons and corresponding - DataCons, expressed by the type BasicTypes.TupleSort: - data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple - -* All three families are AlgTyCons, whose AlgTyConRhs is TupleTyCon - -* BoxedTuples - - A wired-in type - - Data type declarations in GHC.Tuple - - The data constructors really have an info table - -* UnboxedTuples - - A wired-in type - - Have a pretend DataCon, defined in GHC.Prim, - but no actual declaration and no info table - -* ConstraintTuples - - Are known-key rather than wired-in. Reason: it's awkward to - have all the superclass selectors wired-in. - - Declared as classes in GHC.Classes, e.g. - class (c1,c2) => (c1,c2) - - Given constraints: the superclasses automatically become available - - Wanted constraints: there is a built-in instance - instance (c1,c2) => (c1,c2) - - Currently just go up to 16; beyond that - you have to use manual nesting - - Their OccNames look like (%,,,%), so they can easily be - distinguished from term tuples. But (following Haskell) we - pretty-print saturated constraint tuples with round parens; see - BasicTypes.tupleParens. - -* In quite a lot of places things are restrcted just to - BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish - E.g. tupleTyCon has a Boxity argument + DataCons, (boxed, unboxed, and constraint tuples), expressed by the + type BasicTypes.TupleSort. + +* DataCons (and workers etc) for BoxedTuple and ConstraintTuple have + - distinct Uniques + - the same OccName + Using the same OccName means (hack!) that a single copy of the + runtime library code (info tables etc) works for both. * When looking up an OccName in the original-name cache (IfaceEnv.lookupOrigNameCache), we spot the tuple OccName to make sure @@ -369,164 +340,140 @@ isBuiltInOcc_maybe :: OccName -> Maybe Name -- map to wired-in Names with BuiltInSyntax isBuiltInOcc_maybe occ = case occNameString occ of - "[]" -> choose_ns listTyConName nilDataConName + "[]" -> choose_ns listTyCon nilDataCon ":" -> Just consDataConName "[::]" -> Just parrTyConName - "()" -> tup_name Boxed 0 - "(##)" -> tup_name Unboxed 0 - '(':',':rest -> parse_tuple Boxed 2 rest - '(':'#':',':rest -> parse_tuple Unboxed 2 rest + "(##)" -> choose_ns unboxedUnitTyCon unboxedUnitDataCon + "()" -> choose_ns unitTyCon unitDataCon + '(':'#':',':rest -> parse_tuple UnboxedTuple 2 rest + '(':',':rest -> parse_tuple BoxedTuple 2 rest _other -> Nothing where ns = occNameSpace occ parse_tuple sort n rest | (',' : rest2) <- rest = parse_tuple sort (n+1) rest2 - | tail_matches sort rest = tup_name sort n + | tail_matches sort rest = choose_ns (tupleTyCon sort n) + (tupleCon sort n) | otherwise = Nothing - tail_matches Boxed ")" = True - tail_matches Unboxed "#)" = True - tail_matches _ _ = False - - tup_name boxity arity - = choose_ns (getName (tupleTyCon boxity arity)) - (getName (tupleDataCon boxity arity)) + tail_matches BoxedTuple ")" = True + tail_matches UnboxedTuple "#)" = True + tail_matches _ _ = False choose_ns tc dc - | isTcClsNameSpace ns = Just tc - | isDataConNameSpace ns = Just dc - | otherwise = pprPanic "tup_name" (ppr occ) + | isTcClsNameSpace ns = Just (getName tc) + | isDataConNameSpace ns = Just (getName dc) + | otherwise = Just (getName (dataConWorkId dc)) -mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName +mkTupleOcc :: NameSpace -> TupleSort -> Arity -> OccName mkTupleOcc ns sort ar = mkOccName ns str where -- No need to cache these, the caching is done in mk_tuple str = case sort of - Unboxed -> '(' : '#' : commas ++ "#)" - Boxed -> '(' : commas ++ ")" - - commas = take (ar-1) (repeat ',') + UnboxedTuple -> '(' : '#' : commas ++ "#)" + BoxedTuple -> '(' : commas ++ ")" + ConstraintTuple -> '(' : commas ++ ")" -mkCTupleOcc :: NameSpace -> Arity -> OccName -mkCTupleOcc ns ar = mkOccName ns str - where - str = "(%" ++ commas ++ "%)" commas = take (ar-1) (repeat ',') -cTupleTyConName :: Arity -> Name -cTupleTyConName arity - = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES - (mkCTupleOcc tcName arity) noSrcSpan - -- The corresponding DataCon does not have a known-key name - -cTupleTyConNames :: [Name] -cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE]) - -cTupleTyConNameSet :: NameSet -cTupleTyConNameSet = mkNameSet cTupleTyConNames - -isCTupleTyConName :: Name -> Bool -isCTupleTyConName n - = ASSERT2( isExternalName n, ppr n ) - nameModule n == gHC_CLASSES - && n `elemNameSet` cTupleTyConNameSet - -tupleTyCon :: Boxity -> Arity -> TyCon + -- Cute hack: we reuse the standard tuple OccNames (and hence code) + -- for fact tuples, but give them different Uniques so they are not equal. + -- + -- You might think that this will go wrong because isBuiltInOcc_maybe won't + -- be able to tell the difference between boxed tuples and constraint tuples. BUT: + -- 1. Constraint tuples never occur directly in user code, so it doesn't matter + -- that we can't detect them in Orig OccNames originating from the user + -- programs (or those built by setRdrNameSpace used on an Exact tuple Name) + -- 2. Interface files have a special representation for tuple *occurrences* + -- in IfaceTyCons, their workers (in IfaceSyn) and their DataCons (in case + -- alternatives). Thus we don't rely on the OccName to figure out what kind + -- of tuple an occurrence was trying to use in these situations. + -- 3. We *don't* represent tuple data type declarations specially, so those + -- are still turned into wired-in names via isBuiltInOcc_maybe. But that's OK + -- because we don't actually need to declare constraint tuples thanks to this hack. + -- + -- So basically any OccName like (,,) flowing to isBuiltInOcc_maybe will always + -- refer to the standard boxed tuple. Cool :-) + + +tupleTyCon :: TupleSort -> Arity -> TyCon tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i) -- Build one specially -tupleTyCon Boxed i = fst (boxedTupleArr ! i) -tupleTyCon Unboxed i = fst (unboxedTupleArr ! i) - -tupleTyConName :: TupleSort -> Arity -> Name -tupleTyConName ConstraintTuple a = cTupleTyConName a -tupleTyConName BoxedTuple a = tyConName (tupleTyCon Boxed a) -tupleTyConName UnboxedTuple a = tyConName (tupleTyCon Unboxed a) +tupleTyCon BoxedTuple i = fst (boxedTupleArr ! i) +tupleTyCon UnboxedTuple i = fst (unboxedTupleArr ! i) +tupleTyCon ConstraintTuple i = fst (factTupleArr ! i) -promotedTupleTyCon :: Boxity -> Arity -> TyCon -promotedTupleTyCon boxity i = promoteTyCon (tupleTyCon boxity i) +promotedTupleTyCon :: TupleSort -> Arity -> TyCon +promotedTupleTyCon sort i = promoteTyCon (tupleTyCon sort i) -promotedTupleDataCon :: Boxity -> Arity -> TyCon -promotedTupleDataCon boxity i = promoteDataCon (tupleDataCon boxity i) +promotedTupleDataCon :: TupleSort -> Arity -> TyCon +promotedTupleDataCon sort i = promoteDataCon (tupleCon sort i) -tupleDataCon :: Boxity -> Arity -> DataCon -tupleDataCon sort i | i > mAX_TUPLE_SIZE = snd (mk_tuple sort i) -- Build one specially -tupleDataCon Boxed i = snd (boxedTupleArr ! i) -tupleDataCon Unboxed i = snd (unboxedTupleArr ! i) +tupleCon :: TupleSort -> Arity -> DataCon +tupleCon sort i | i > mAX_TUPLE_SIZE = snd (mk_tuple sort i) -- Build one specially +tupleCon BoxedTuple i = snd (boxedTupleArr ! i) +tupleCon UnboxedTuple i = snd (unboxedTupleArr ! i) +tupleCon ConstraintTuple i = snd (factTupleArr ! i) -boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon) -boxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed i | i <- [0..mAX_TUPLE_SIZE]] -unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]] +boxedTupleArr, unboxedTupleArr, factTupleArr :: Array Int (TyCon,DataCon) +boxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple BoxedTuple i | i <- [0..mAX_TUPLE_SIZE]] +unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple UnboxedTuple i | i <- [0..mAX_TUPLE_SIZE]] +factTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple ConstraintTuple i | i <- [0..mAX_TUPLE_SIZE]] -mk_tuple :: Boxity -> Int -> (TyCon,DataCon) -mk_tuple boxity arity = (tycon, tuple_con) +mk_tuple :: TupleSort -> Int -> (TyCon,DataCon) +mk_tuple sort arity = (tycon, tuple_con) where - tycon = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con - tup_sort - prom_tc NoParentTyCon - - tup_sort = case boxity of - Boxed -> BoxedTuple - Unboxed -> UnboxedTuple - - prom_tc = case boxity of - Boxed -> Just (mkPromotedTyCon tycon (promoteKind tc_kind)) - Unboxed -> Nothing - - modu = case boxity of - Boxed -> gHC_TUPLE - Unboxed -> gHC_PRIM - - tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq + tycon = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con sort prom_tc + prom_tc = case sort of + BoxedTuple -> Just (mkPromotedTyCon tycon (promoteKind tc_kind)) + UnboxedTuple -> Nothing + ConstraintTuple -> Nothing + + modu = mkTupleModule sort + tc_name = mkWiredInName modu (mkTupleOcc tcName sort arity) tc_uniq (ATyCon tycon) BuiltInSyntax tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind + res_kind = case sort of + BoxedTuple -> liftedTypeKind + UnboxedTuple -> unliftedTypeKind + ConstraintTuple -> constraintKind - res_kind = case boxity of - Boxed -> liftedTypeKind - Unboxed -> unliftedTypeKind - - tyvars = take arity $ case boxity of - Boxed -> alphaTyVars - Unboxed -> openAlphaTyVars + tyvars = take arity $ case sort of + BoxedTuple -> alphaTyVars + UnboxedTuple -> openAlphaTyVars + ConstraintTuple -> tyVarList constraintKind tuple_con = pcDataCon dc_name tyvars tyvar_tys tycon tyvar_tys = mkTyVarTys tyvars - dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq + dc_name = mkWiredInName modu (mkTupleOcc dataName sort arity) dc_uniq (AConLike (RealDataCon tuple_con)) BuiltInSyntax - tc_uniq = mkTupleTyConUnique boxity arity - dc_uniq = mkTupleDataConUnique boxity arity + tc_uniq = mkTupleTyConUnique sort arity + dc_uniq = mkTupleDataConUnique sort arity unitTyCon :: TyCon -unitTyCon = tupleTyCon Boxed 0 - -unitTyConKey :: Unique -unitTyConKey = getUnique unitTyCon - +unitTyCon = tupleTyCon BoxedTuple 0 unitDataCon :: DataCon unitDataCon = head (tyConDataCons unitTyCon) - unitDataConId :: Id unitDataConId = dataConWorkId unitDataCon pairTyCon :: TyCon -pairTyCon = tupleTyCon Boxed 2 +pairTyCon = tupleTyCon BoxedTuple 2 unboxedUnitTyCon :: TyCon -unboxedUnitTyCon = tupleTyCon Unboxed 0 - +unboxedUnitTyCon = tupleTyCon UnboxedTuple 0 unboxedUnitDataCon :: DataCon -unboxedUnitDataCon = tupleDataCon Unboxed 0 +unboxedUnitDataCon = tupleCon UnboxedTuple 0 unboxedSingletonTyCon :: TyCon -unboxedSingletonTyCon = tupleTyCon Unboxed 1 - +unboxedSingletonTyCon = tupleTyCon UnboxedTuple 1 unboxedSingletonDataCon :: DataCon -unboxedSingletonDataCon = tupleDataCon Unboxed 1 +unboxedSingletonDataCon = tupleCon UnboxedTuple 1 unboxedPairTyCon :: TyCon -unboxedPairTyCon = tupleTyCon Unboxed 2 - +unboxedPairTyCon = tupleTyCon UnboxedTuple 2 unboxedPairDataCon :: DataCon -unboxedPairDataCon = tupleDataCon Unboxed 2 +unboxedPairDataCon = tupleCon UnboxedTuple 2 {- ************************************************************************ @@ -807,17 +754,17 @@ done by enumeration\srcloc{lib/prelude/InTup?.hs}. \end{itemize} -} -mkTupleTy :: Boxity -> [Type] -> Type +mkTupleTy :: TupleSort -> [Type] -> Type -- Special case for *boxed* 1-tuples, which are represented by the type itself -mkTupleTy Boxed [ty] = ty -mkTupleTy boxity tys = mkTyConApp (tupleTyCon boxity (length tys)) tys +mkTupleTy sort [ty] | Boxed <- tupleSortBoxity sort = ty +mkTupleTy sort tys = mkTyConApp (tupleTyCon sort (length tys)) tys -- | Build the type of a small tuple that holds the specified type of thing mkBoxedTupleTy :: [Type] -> Type -mkBoxedTupleTy tys = mkTupleTy Boxed tys +mkBoxedTupleTy tys = mkTupleTy BoxedTuple tys unitTy :: Type -unitTy = mkTupleTy Boxed [] +unitTy = mkTupleTy BoxedTuple [] {- ************************************************************************ |