[Git][ghc/ghc][wip/wire-in-constraint-tuples] 2 commits: Hadrian: don't needlessly quote test_env for perf metrics

Ryan Scott gitlab at gitlab.haskell.org
Fri Sep 4 15:10:56 UTC 2020



Ryan Scott pushed to branch wip/wire-in-constraint-tuples at Glasgow Haskell Compiler / GHC


Commits:
43e70b34 by Ryan Scott at 2020-09-04T11:09:18-04:00
Hadrian: don't needlessly quote test_env for perf metrics

- - - - -
ede82d8e by Ryan Scott at 2020-09-04T11:09:18-04:00
Wire in constraint tuples

This wires in the definitions of the constraint tuple classes. The
key changes are in:

* `GHC.Builtin.Types`, where the `mk_ctuple` function is used to
  define constraint tuple type constructors, data constructors, and
  superclass selector functions, and
* `GHC.Builtin.Uniques`. In addition to wiring in the `Unique`s for
  constraint tuple type and data constructors, we now must wire in
  the superclass selector functions. Luckily, this proves to be not
  that challenging. See the newly added comments.

Historical note: constraint tuples used to be wired-in until about
five years ago, when commit 130e93aab220bdf14d08028771f83df210da340b
turned them into known-key names. This was done as part of a larger
refactor to reduce the number of special cases for constraint tuples,
but the commit message notes that the main reason that constraint
tuples were made known-key (as opposed to boxed/unboxed tuples, which
are wired in) is because it was awkward to wire in the superclass
selectors. This commit solves the problem of wiring in superclass
selectors.

Fixes #18635.

-------------------------
Metric Decrease:
    T10421
    T12150
    T12227
    T12234
    T12425
    T13056
    T13253-spj
    T18282
    T18304
    T5321FD
    T5321Fun
    T5837
    T9961
Metric Decrease (test_env='x86_64-linux-deb9-unreg-hadrian'):
    T12707
Metric Decrease (test_env='x86_64-darwin'):
    T4029
-------------------------

- - - - -


6 changed files:

- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Builtin/Types.hs-boot
- compiler/GHC/Builtin/Uniques.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Tc/Gen/HsType.hs
- hadrian/src/Settings/Builders/RunTest.hs


Changes:

=====================================
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
 
 {- *********************************************************************
 *                                                                      *


=====================================
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


=====================================
compiler/GHC/Builtin/Uniques.hs
=====================================
@@ -22,6 +22,7 @@ module GHC.Builtin.Uniques
       -- *** Constraint
     , mkCTupleTyConUnique
     , mkCTupleDataConUnique
+    , mkCTupleSelIdUnique
 
       -- ** Making built-in uniques
     , mkAlphaTyVarUnique
@@ -79,8 +80,9 @@ 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
@@ -158,6 +160,21 @@ getUnboxedSumName n
 
 --------------------------------------------------
 -- Constraint tuples
+--
+-- 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]). In addition, the
+-- superclass selectors for each constraint tuple have wired-in Uniques. A
+-- constraint tuple of arity n has n different selectors (e.g., the binary
+-- constraint tuple has selectors $p1(%,%) and $p2(%,%)).
+--
+-- The encoding of these selectors' Uniques takes somewhat resembles the
+-- encoding for unboxed sums (see above). 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
 
 mkCTupleTyConUnique :: Arity -> Unique
 mkCTupleTyConUnique a = mkUnique 'k' (2*a)
@@ -165,6 +182,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` 8 + sc_pos)
+
 getCTupleTyConName :: Int -> Name
 getCTupleTyConName n =
     case n `divMod` 2 of
@@ -172,14 +196,20 @@ 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` 8
+    sc_pos = n .&. 0xff
+
 --------------------------------------------------
 -- Normal tuples
 
@@ -230,6 +260,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


=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -1203,10 +1203,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


=====================================
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


=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -142,7 +142,7 @@ runTestBuilderArgs = builder RunTest ? do
             , case perfBaseline of
                 Just commit | not (null commit) -> arg ("--perf-baseline=" ++ show commit)
                 _ -> mempty
-            , emitWhenSet testEnv $ \env -> arg ("--test-env=" ++ show env)
+            , emitWhenSet testEnv $ \env -> arg ("--test-env=" ++ env)
             , emitWhenSet testMetricsFile $ \file -> arg ("--metrics-file=" ++ file)
             , getTestArgs -- User-provided arguments from command line.
             ]



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dcdf784827c632b61c3ec0e551578b7d90f17df6...ede82d8e6cbea05acf7a06a1845c30efc8a14c2d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dcdf784827c632b61c3ec0e551578b7d90f17df6...ede82d8e6cbea05acf7a06a1845c30efc8a14c2d
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/20200904/a017d0a8/attachment-0001.html>


More information about the ghc-commits mailing list