diff options
| -rw-r--r-- | compiler/GHC/Builtin/Types.hs | 131 | ||||
| -rw-r--r-- | compiler/GHC/Builtin/Types.hs-boot | 2 | ||||
| -rw-r--r-- | compiler/GHC/Builtin/Uniques.hs | 136 | ||||
| -rw-r--r-- | compiler/GHC/IfaceToCore.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Gen/HsType.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Types/Basic.hs | 2 |
6 files changed, 228 insertions, 54 deletions
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs index d9cf158ef6..e211434e60 100644 --- a/compiler/GHC/Builtin/Types.hs +++ b/compiler/GHC/Builtin/Types.hs @@ -80,9 +80,10 @@ module GHC.Builtin.Types ( unboxedTupleKind, unboxedSumKind, -- ** Constraint tuples - cTupleTyConName, cTupleTyConNames, isCTupleTyConName, + cTupleTyCon, cTupleTyConName, cTupleTyConNames, isCTupleTyConName, cTupleTyConNameArity_maybe, - cTupleDataConName, cTupleDataConNames, + cTupleDataCon, cTupleDataConName, cTupleDataConNames, + cTupleSelId, cTupleSelIdName, -- * Any anyTyCon, anyTy, anyTypeOfKind, @@ -174,10 +175,9 @@ import GHC.Core.Class ( Class, mkClass ) import GHC.Types.Name.Reader import GHC.Types.Name as Name import GHC.Types.Name.Env ( NameEnv, mkNameEnv, lookupNameEnv, lookupNameEnv_NF ) -import GHC.Types.Name.Set ( NameSet, mkNameSet, elemNameSet ) import GHC.Types.Basic import GHC.Types.ForeignCall -import GHC.Types.SrcLoc ( noSrcSpan ) +import GHC.Types.Unique.Set import Data.Array import GHC.Data.FastString import GHC.Data.BooleanFormula ( mkAnd ) @@ -723,20 +723,23 @@ Note [How tuples work] See also Note [Known-key names] in GHC.Builtin.Names 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. + - A wired-in type. - 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) - See GHC.Tc.Solver.Interact.matchCTuple + See GHC.Tc.Instance.Class.matchCTuple - Currently just go up to 62; 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. + - Unlike BoxedTuples and UnboxedTuples, which only wire + in type constructors and data constructors, ConstraintTuples also wire in + superclass selector functions. For instance, $p1(%,%) and $p2(%,%) are + the selectors for the binary constraint tuple. * In quite a lot of places things are restricted just to BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish @@ -914,26 +917,26 @@ mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)" commas :: Arity -> String commas ar = take (ar-1) (repeat ',') +cTupleTyCon :: Arity -> TyCon +cTupleTyCon i + | i > mAX_CTUPLE_SIZE = fstOf3 (mk_ctuple i) -- Build one specially + | otherwise = fstOf3 (cTupleArr ! i) + cTupleTyConName :: Arity -> Name -cTupleTyConName arity - = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES - (mkCTupleOcc tcName arity) noSrcSpan +cTupleTyConName a = tyConName (cTupleTyCon a) cTupleTyConNames :: [Name] cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE]) -cTupleTyConNameSet :: NameSet -cTupleTyConNameSet = mkNameSet cTupleTyConNames +cTupleTyConKeys :: UniqSet Unique +cTupleTyConKeys = mkUniqSet $ map getUnique cTupleTyConNames isCTupleTyConName :: Name -> Bool --- Use Type.isCTupleClass where possible isCTupleTyConName n = ASSERT2( isExternalName n, ppr n ) - nameModule n == gHC_CLASSES - && n `elemNameSet` cTupleTyConNameSet + getUnique n `elementOfUniqSet` cTupleTyConKeys -- | If the given name is that of a constraint tuple, return its arity. --- Note that this is inefficient. cTupleTyConNameArity_maybe :: Name -> Maybe Arity cTupleTyConNameArity_maybe n | not (isCTupleTyConName n) = Nothing @@ -943,14 +946,46 @@ cTupleTyConNameArity_maybe n -- case, we have to adjust accordingly our calculated arity. adjustArity a = if a > 0 then a + 1 else a +cTupleDataCon :: Arity -> DataCon +cTupleDataCon i + | i > mAX_CTUPLE_SIZE = sndOf3 (mk_ctuple i) -- Build one specially + | otherwise = sndOf3 (cTupleArr ! i) + cTupleDataConName :: Arity -> Name -cTupleDataConName arity - = mkExternalName (mkCTupleDataConUnique arity) gHC_CLASSES - (mkCTupleOcc dataName arity) noSrcSpan +cTupleDataConName i = dataConName (cTupleDataCon i) cTupleDataConNames :: [Name] cTupleDataConNames = map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE]) +cTupleSelId :: ConTag -- Superclass position + -> Arity -- Arity + -> Id +cTupleSelId sc_pos arity + | sc_pos > arity + = panic ("cTupleSelId: index out of bounds: superclass position: " + ++ show sc_pos ++ " > arity " ++ show arity) + + | sc_pos <= 0 + = panic ("cTupleSelId: Superclass positions start from 1. " + ++ "(superclass position: " ++ show sc_pos + ++ ", arity: " ++ show arity ++ ")") + + | arity < 2 + = panic ("cTupleSelId: Arity starts from 2. " + ++ "(superclass position: " ++ show sc_pos + ++ ", arity: " ++ show arity ++ ")") + + | arity > mAX_CTUPLE_SIZE + = thdOf3 (mk_ctuple arity) ! (sc_pos - 1) -- Build one specially + + | otherwise + = thdOf3 (cTupleArr ! arity) ! (sc_pos - 1) + +cTupleSelIdName :: ConTag -- Superclass position + -> Arity -- Arity + -> Name +cTupleSelIdName sc_pos arity = idName (cTupleSelId sc_pos arity) + tupleTyCon :: Boxity -> Arity -> TyCon tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i) -- Build one specially tupleTyCon Boxed i = fst (boxedTupleArr ! i) @@ -976,6 +1011,20 @@ 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]] +-- | Cached type constructors, data constructors, and superclass selectors for +-- constraint tuples. The outer array is indexed by the arity of the constraint +-- tuple and the inner array is indexed by the superclass position. +cTupleArr :: Array Int (TyCon, DataCon, Array Int Id) +cTupleArr = listArray (0,mAX_CTUPLE_SIZE) [mk_ctuple i | i <- [0..mAX_CTUPLE_SIZE]] + -- Although GHC does not make use of unary constraint tuples + -- (see Note [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType), + -- this array creates one anyway. This is primarily motivated by the fact + -- that (1) the indices of an Array must be contiguous, and (2) we would like + -- the index of a constraint tuple in this Array to correspond to its Arity. + -- We could envision skipping over the unary constraint tuple and having index + -- 1 correspond to a 2-constraint tuple (and so on), but that's more + -- complicated than it's worth. + -- | Given the TupleRep/SumRep tycon and list of RuntimeReps of the unboxed -- tuple/sum arguments, produces the return kind of an unboxed tuple/sum type -- constructor. @unboxedTupleSumKind [IntRep, LiftedRep] --> TYPE (TupleRep/SumRep @@ -1040,6 +1089,45 @@ mk_tuple Unboxed arity = (tycon, tuple_con) tc_uniq = mkTupleTyConUnique boxity arity dc_uniq = mkTupleDataConUnique boxity arity +mk_ctuple :: Arity -> (TyCon, DataCon, Array ConTagZ Id) +mk_ctuple arity = (tycon, tuple_con, sc_sel_ids_arr) + where + tycon = mkClassTyCon tc_name binders roles + rhs klass + (mkPrelTyConRepName tc_name) + + klass = mk_ctuple_class tycon sc_theta sc_sel_ids + tuple_con = pcDataConW dc_name tvs (map unrestricted sc_theta) tycon + + binders = mkTemplateAnonTyConBinders (replicate arity constraintKind) + roles = replicate arity Nominal + rhs = TupleTyCon{data_con = tuple_con, tup_sort = ConstraintTuple} + + modu = gHC_CLASSES + tc_name = mkWiredInName modu (mkCTupleOcc tcName arity) tc_uniq + (ATyCon tycon) BuiltInSyntax + dc_name = mkWiredInName modu (mkCTupleOcc dataName arity) dc_uniq + (AConLike (RealDataCon tuple_con)) BuiltInSyntax + tc_uniq = mkCTupleTyConUnique arity + dc_uniq = mkCTupleDataConUnique arity + + tvs = binderVars binders + sc_theta = map mkTyVarTy tvs + sc_sel_ids = [mk_sc_sel_id sc_pos | sc_pos <- [0..arity-1]] + sc_sel_ids_arr = listArray (0,arity-1) sc_sel_ids + + mk_sc_sel_id sc_pos = + let sc_sel_id_uniq = mkCTupleSelIdUnique sc_pos arity + sc_sel_id_occ = mkCTupleOcc tcName arity + sc_sel_id_name = mkWiredInIdName + gHC_CLASSES + (occNameFS (mkSuperDictSelOcc sc_pos sc_sel_id_occ)) + sc_sel_id_uniq + sc_sel_id + sc_sel_id = mkDictSelId sc_sel_id_name klass + + in sc_sel_id + unitTyCon :: TyCon unitTyCon = tupleTyCon Boxed 0 @@ -1248,7 +1336,10 @@ mk_class tycon sc_pred sc_sel_id = mkClass (tyConName tycon) (tyConTyVars tycon) [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon - +mk_ctuple_class :: TyCon -> ThetaType -> [Id] -> Class +mk_ctuple_class tycon sc_theta sc_sel_ids + = mkClass (tyConName tycon) (tyConTyVars tycon) [] sc_theta sc_sel_ids + [] [] (mkAnd []) tycon {- ********************************************************************* * * diff --git a/compiler/GHC/Builtin/Types.hs-boot b/compiler/GHC/Builtin/Types.hs-boot index d792edb612..95bed63a40 100644 --- a/compiler/GHC/Builtin/Types.hs-boot +++ b/compiler/GHC/Builtin/Types.hs-boot @@ -64,8 +64,10 @@ promotedTupleDataCon :: Boxity -> Arity -> TyCon tupleDataCon :: Boxity -> Arity -> DataCon tupleTyCon :: Boxity -> Arity -> TyCon +cTupleDataCon :: Arity -> DataCon cTupleDataConName :: Arity -> Name cTupleTyConName :: Arity -> Name +cTupleSelIdName :: ConTag -> Arity -> Name sumDataCon :: ConTag -> Arity -> DataCon sumTyCon :: Arity -> TyCon diff --git a/compiler/GHC/Builtin/Uniques.hs b/compiler/GHC/Builtin/Uniques.hs index 50be54d955..038647acc9 100644 --- a/compiler/GHC/Builtin/Uniques.hs +++ b/compiler/GHC/Builtin/Uniques.hs @@ -22,6 +22,7 @@ module GHC.Builtin.Uniques -- *** Constraint , mkCTupleTyConUnique , mkCTupleDataConUnique + , mkCTupleSelIdUnique -- ** Making built-in uniques , mkAlphaTyVarUnique @@ -79,34 +80,37 @@ knownUniqueName u = '5' -> Just $ getTupleTyConName Unboxed n '7' -> Just $ getTupleDataConName Boxed n '8' -> Just $ getTupleDataConName Unboxed n + 'j' -> Just $ getCTupleSelIdName n 'k' -> Just $ getCTupleTyConName n - 'm' -> Just $ getCTupleDataConUnique n + 'm' -> Just $ getCTupleDataConName n _ -> Nothing where (tag, n) = unpkUnique u --------------------------------------------------- --- Anonymous sums --- --- Sum arities start from 2. The encoding is a bit funny: we break up the --- integral part into bitfields for the arity, an alternative index (which is --- taken to be 0xff in the case of the TyCon), and, in the case of a datacon, a --- tag (used to identify the sum's TypeRep binding). --- --- This layout is chosen to remain compatible with the usual unique allocation --- for wired-in data constructors described in GHC.Types.Unique --- --- TyCon for sum of arity k: --- 00000000 kkkkkkkk 11111100 +{- +Note [Unique layout for unboxed sums] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- TypeRep of TyCon for sum of arity k: --- 00000000 kkkkkkkk 11111101 --- --- DataCon for sum of arity k and alternative n (zero-based): --- 00000000 kkkkkkkk nnnnnn00 --- --- TypeRep for sum DataCon of arity k and alternative n (zero-based): --- 00000000 kkkkkkkk nnnnnn10 +Sum arities start from 2. The encoding is a bit funny: we break up the +integral part into bitfields for the arity, an alternative index (which is +taken to be 0xfc in the case of the TyCon), and, in the case of a datacon, a +tag (used to identify the sum's TypeRep binding). + +This layout is chosen to remain compatible with the usual unique allocation +for wired-in data constructors described in GHC.Types.Unique + +TyCon for sum of arity k: + 00000000 kkkkkkkk 11111100 + +TypeRep of TyCon for sum of arity k: + 00000000 kkkkkkkk 11111101 + +DataCon for sum of arity k and alternative n (zero-based): + 00000000 kkkkkkkk nnnnnn00 + +TypeRep for sum DataCon of arity k and alternative n (zero-based): + 00000000 kkkkkkkk nnnnnn10 +-} mkSumTyConUnique :: Arity -> Unique mkSumTyConUnique arity = @@ -156,8 +160,56 @@ getUnboxedSumName n -- * u+1: its worker Id -- * u+2: the TyConRepName of the promoted TyCon --------------------------------------------------- --- Constraint tuples +{- +Note [Unique layout for constraint tuple selectors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Constraint tuples, like boxed and unboxed tuples, have their type and data +constructor Uniques wired in (see +Note [Uniques for tuple type and data constructors]). Constraint tuples are +somewhat more involved, however. For a boxed or unboxed n-tuple, we need: + +* A Unique for the type constructor, and +* A Unique for the data constructor + +With a constraint n-tuple, however, we need: + +* A Unique for the type constructor, +* A Unique for the data constructor, and +* A Unique for each of the n superclass selectors + +To pick a concrete example (n = 2), the binary constraint tuple has a type +constructor and data constructor (%,%) along with superclass selectors +$p1(%,%) and $p2(%,%). + +Just as we wire in the Uniques for constraint tuple type constructors and data +constructors, we wish to wire in the Uniques for the superclass selectors as +well. Not only does this make everything consistent, it also avoids a +compile-time performance penalty whenever GHC.Classes is loaded from an +interface file. This is because GHC.Classes defines constraint tuples as class +definitions, and if these classes weren't wired in, then loading GHC.Classes +would also load every single constraint tuple type constructor, data +constructor, and superclass selector. See #18635. + +We encode the Uniques for constraint tuple superclass selectors as follows. The +integral part of the Unique is broken up into bitfields for the arity and the +position of the superclass. Given a selector for a constraint tuple with +arity n (zero-based) and position k (where 1 <= k <= n), its Unique will look +like: + + 00000000 nnnnnnnn kkkkkkkk + +We can use bit-twiddling tricks to access the arity and position with +cTupleSelIdArityBits and cTupleSelIdPosBitmask, respectively. + +This pattern bears a certain resemblance to the way that the Uniques for +unboxed sums are encoded. This is because for a unboxed sum of arity n, there +are n corresponding data constructors, each with an alternative position k. +Similarly, for a constraint tuple of arity n, there are n corresponding +superclass selectors. Reading Note [Unique layout for unboxed sums] will +instill an appreciation for how the encoding for constraint tuple superclass +selector Uniques takes inspiration from the encoding for unboxed sum Uniques. +-} mkCTupleTyConUnique :: Arity -> Unique mkCTupleTyConUnique a = mkUnique 'k' (2*a) @@ -165,6 +217,13 @@ mkCTupleTyConUnique a = mkUnique 'k' (2*a) mkCTupleDataConUnique :: Arity -> Unique mkCTupleDataConUnique a = mkUnique 'm' (3*a) +mkCTupleSelIdUnique :: ConTagZ -> Arity -> Unique +mkCTupleSelIdUnique sc_pos arity + | sc_pos >= arity + = panic ("mkCTupleSelIdUnique: " ++ show sc_pos ++ " >= " ++ show arity) + | otherwise + = mkUnique 'j' (arity `shiftL` cTupleSelIdArityBits + sc_pos) + getCTupleTyConName :: Int -> Name getCTupleTyConName n = case n `divMod` 2 of @@ -172,14 +231,36 @@ getCTupleTyConName n = (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity _ -> panic "getCTupleTyConName: impossible" -getCTupleDataConUnique :: Int -> Name -getCTupleDataConUnique n = +getCTupleDataConName :: Int -> Name +getCTupleDataConName n = case n `divMod` 3 of (arity, 0) -> cTupleDataConName arity - (_arity, 1) -> panic "getCTupleDataConName: no worker" + (arity, 1) -> getName $ dataConWrapId $ cTupleDataCon arity (arity, 2) -> mkPrelTyConRepName $ cTupleDataConName arity _ -> panic "getCTupleDataConName: impossible" +getCTupleSelIdName :: Int -> Name +getCTupleSelIdName n = cTupleSelIdName (sc_pos + 1) arity + where + arity = n `shiftR` cTupleSelIdArityBits + sc_pos = n .&. cTupleSelIdPosBitmask + +-- Given the arity of a constraint tuple, this is the number of bits by which +-- one must shift it to the left in order to encode the arity in the Unique +-- of a superclass selector for that constraint tuple. Alternatively, given the +-- Unique for a constraint tuple superclass selector, this is the number of +-- bits by which one must shift it to the right to retrieve the arity of the +-- constraint tuple. See Note [Unique layout for constraint tuple selectors]. +cTupleSelIdArityBits :: Int +cTupleSelIdArityBits = 8 + +-- Given the Unique for a constraint tuple superclass selector, one can +-- retrieve the position of the selector by ANDing this mask, which will +-- clear all but the eight least significant bits. +-- See Note [Unique layout for constraint tuple selectors]. +cTupleSelIdPosBitmask :: Int +cTupleSelIdPosBitmask = 0xff + -------------------------------------------------- -- Normal tuples @@ -230,6 +311,7 @@ Allocation of unique supply characters: d desugarer f AbsC flattener g SimplStg + j constraint tuple superclass selectors k constraint tuple tycons m constraint tuple datacons n Native codegen diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs index 21749ea6aa..ed8c3efb65 100644 --- a/compiler/GHC/IfaceToCore.hs +++ b/compiler/GHC/IfaceToCore.hs @@ -1207,10 +1207,9 @@ tcTupleTyCon :: Bool -- True <=> typechecking a *type* (vs. an expr) -> IfL TyCon tcTupleTyCon in_type sort arity = case sort of - ConstraintTuple -> do { thing <- tcIfaceGlobal (cTupleTyConName arity) - ; return (tyThingTyCon thing) } - BoxedTuple -> return (tupleTyCon Boxed arity) - UnboxedTuple -> return (tupleTyCon Unboxed arity') + ConstraintTuple -> return (cTupleTyCon arity) + BoxedTuple -> return (tupleTyCon Boxed arity) + UnboxedTuple -> return (tupleTyCon Unboxed arity') where arity' | in_type = arity `div` 2 | otherwise = arity -- in expressions, we only have term args diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs index 3a1ab09c9b..8d4dbdb7fc 100644 --- a/compiler/GHC/Tc/Gen/HsType.hs +++ b/compiler/GHC/Tc/Gen/HsType.hs @@ -1269,8 +1269,8 @@ finish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind = do | arity > mAX_CTUPLE_SIZE -> failWith (bigConstraintTuple arity) | otherwise - -> do tycon <- tcLookupTyCon (cTupleTyConName arity) - check_expected_kind (mkTyConApp tycon tau_tys) constraintKind + -> let tycon = cTupleTyCon arity in + check_expected_kind (mkTyConApp tycon tau_tys) constraintKind BoxedTuple -> do let tycon = tupleTyCon Boxed arity checkWiredInTyCon tycon diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs index e89196c1a6..5c71d7a4f7 100644 --- a/compiler/GHC/Types/Basic.hs +++ b/compiler/GHC/Types/Basic.hs @@ -179,7 +179,7 @@ type JoinArity = Int ************************************************************************ -} --- | Constructor Tag +-- | A *one-index* constructor tag -- -- Type of the tags associated with each constructor possibility or superclass -- selector |