Reduce special-casing for nullary unboxed tuple
authorSimon Peyton Jones <simonpj@microsoft.com>
Thu, 26 May 2016 14:24:53 +0000 (15:24 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Thu, 26 May 2016 14:24:53 +0000 (15:24 +0100)
When we built the kind of a nullary unboxed tuple, we said, in
TysWiredIn.mk_tuple:

    res_rep | arity == 0 = voidRepDataConTy
                  -- See Note [Nullary unboxed tuple] in Type
            | otherwise  = unboxedTupleRepDataConTy

But this is bogus.  The Note deals with what the 'unarise' transformation
does, and up to that point it's simpler and more uniform to treat
nullary unboxed tuples the same as all the others.

Nicer now.  And it fixes the Lint error in Trac #12115

compiler/prelude/TysWiredIn.hs
compiler/typecheck/TcHsType.hs
compiler/types/TyCoRep.hs
compiler/types/Type.hs
testsuite/tests/codeGen/should_compile/T12115.hs [new file with mode: 0644]
testsuite/tests/codeGen/should_compile/all.T

index 6fbb821..5613d86 100644 (file)
@@ -73,7 +73,7 @@ module TysWiredIn (
         -- * Kinds
         typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind,
         isLiftedTypeKindTyConName, liftedTypeKind, constraintKind,
-        starKindTyCon, starKindTyConName,
+        starKindTyCon, starKindTyConName, unboxedTupleKind,
         unicodeStarKindTyCon, unicodeStarKindTyConName,
         liftedTypeKindTyCon, constraintKindTyCon,
 
@@ -546,10 +546,10 @@ constraintKindTyCon :: TyCon
 constraintKindTyCon = pcTyCon False NonRecursive constraintKindTyConName
                               Nothing [] []
 
-liftedTypeKind, constraintKind :: Kind
+liftedTypeKind, constraintKind, unboxedTupleKind :: Kind
 liftedTypeKind   = tYPE ptrRepLiftedTy
 constraintKind   = mkTyConApp constraintKindTyCon []
-
+unboxedTupleKind = tYPE unboxedTupleRepDataConTy
 
 {-
 ************************************************************************
@@ -755,15 +755,12 @@ mk_tuple boxity arity = (tycon, tuple_con)
                    -- NB: This must be one call to mkTemplateTyVars, to make
                    -- sure that all the uniques are different
                 (rr_tvs, open_tvs) = splitAt arity all_tvs
-                res_rep | arity == 0 = voidRepDataConTy
-                              -- See Note [Nullary unboxed tuple] in Type
-                        | otherwise  = unboxedTupleRepDataConTy
             in
             ( UnboxedTuple
             , gHC_PRIM
             , mkNamedBinders Specified rr_tvs ++
               map (mkAnonBinder . tyVarKind) open_tvs
-            , tYPE res_rep
+            , unboxedTupleKind
             , arity * 2
             , all_tvs
             , mkTyVarTys open_tvs
index 555070c..f09bde5 100644 (file)
@@ -700,7 +700,7 @@ finish_tuple tup_sort tau_tys tau_kinds exp_kind
   where
     arity = length tau_tys
     res_kind = case tup_sort of
-                 UnboxedTuple    -> tYPE unboxedTupleRepDataConTy
+                 UnboxedTuple    -> unboxedTupleKind
                  BoxedTuple      -> liftedTypeKind
                  ConstraintTuple -> constraintKind
 
index 7b88519..053101c 100644 (file)
@@ -264,6 +264,13 @@ Nor can we abstract over a type variable with any of these kinds.
 
 So a type variable can only be abstracted kk.
 
+Note [AppTy rep]
+~~~~~~~~~~~~~~~~
+Types of the form 'f a' must be of kind *, not #, so we are guaranteed
+that they are represented by pointers.  The reason is that f must have
+kind (kk -> kk) and kk cannot be unlifted; see Note [The kind invariant]
+in TyCoRep.
+
 Note [Arguments to type constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Because of kind polymorphism, in addition to type application we now
index ecf1f36..913664e 100644 (file)
@@ -1165,129 +1165,6 @@ The reason is that we then get better (shorter) type signatures in
 interfaces.  Notably this plays a role in tcTySigs in TcBinds.hs.
 
 
-                Representation types
-                ~~~~~~~~~~~~~~~~~~~~
-
-Note [Nullary unboxed tuple]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We represent the nullary unboxed tuple as the unary (but void) type
-Void#.  The reason for this is that the ReprArity is never
-less than the Arity (as it would otherwise be for a function type like
-(# #) -> Int).
-
-As a result, ReprArity is always strictly positive if Arity is. This
-is important because it allows us to distinguish at runtime between a
-thunk and a function takes a nullary unboxed tuple as an argument!
--}
-
-type UnaryType = Type
-
-data RepType = UbxTupleRep [UnaryType] -- INVARIANT: never an empty list (see Note [Nullary unboxed tuple])
-             | UnaryRep UnaryType
-
-instance Outputable RepType where
-  ppr (UbxTupleRep tys) = text "UbxTupleRep" <+> ppr tys
-  ppr (UnaryRep ty)     = text "UnaryRep"    <+> ppr ty
-
-flattenRepType :: RepType -> [UnaryType]
-flattenRepType (UbxTupleRep tys) = tys
-flattenRepType (UnaryRep ty)     = [ty]
-
--- | Looks through:
---
---      1. For-alls
---      2. Synonyms
---      3. Predicates
---      4. All newtypes, including recursive ones, but not newtype families
---      5. Casts
---
--- It's useful in the back end of the compiler.
-repType :: Type -> RepType
-repType ty
-  = go initRecTc ty
-  where
-    go :: RecTcChecker -> Type -> RepType
-    go rec_nts ty                       -- Expand predicates and synonyms
-      | Just ty' <- coreView ty
-      = go rec_nts ty'
-
-    go rec_nts (ForAllTy (Named {}) ty2)  -- Drop type foralls
-      = go rec_nts ty2
-
-    go rec_nts (TyConApp tc tys)        -- Expand newtypes
-      | isNewTyCon tc
-      , tys `lengthAtLeast` tyConArity tc
-      , Just rec_nts' <- checkRecTc rec_nts tc   -- See Note [Expanding newtypes] in TyCon
-      = go rec_nts' (newTyConInstRhs tc tys)
-
-      | isUnboxedTupleTyCon tc
-      = if null tys
-         then UnaryRep voidPrimTy -- See Note [Nullary unboxed tuple]
-         else UbxTupleRep (concatMap (flattenRepType . go rec_nts) non_rr_tys)
-      where
-          -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
-        non_rr_tys = dropRuntimeRepArgs tys
-
-    go rec_nts (CastTy ty _)
-      = go rec_nts ty
-
-    go _ ty@(CoercionTy _)
-      = pprPanic "repType" (ppr ty)
-
-    go _ ty = UnaryRep ty
-
--- ToDo: this could be moved to the code generator, using splitTyConApp instead
--- of inspecting the type directly.
-
--- | Discovers the primitive representation of a more abstract 'UnaryType'
-typePrimRep :: UnaryType -> PrimRep
-typePrimRep ty = kindPrimRep (typeKind ty)
-
--- | Find the primitive representation of a 'TyCon'. Defined here to
--- avoid module loops. Call this only on unlifted tycons.
-tyConPrimRep :: TyCon -> PrimRep
-tyConPrimRep tc = kindPrimRep res_kind
-  where
-    res_kind = tyConResKind tc
-
--- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep' of values
--- of types of this kind.
-kindPrimRep :: Kind -> PrimRep
-kindPrimRep ki | Just ki' <- coreViewOneStarKind ki = kindPrimRep ki'
-kindPrimRep (TyConApp typ [runtime_rep])
-  = ASSERT( typ `hasKey` tYPETyConKey )
-    go runtime_rep
-  where
-    go rr | Just rr' <- coreView rr = go rr'
-    go (TyConApp rr_dc args)
-      | RuntimeRep fun <- tyConRuntimeRepInfo rr_dc
-      = fun args
-    go rr = pprPanic "kindPrimRep.go" (ppr rr)
-kindPrimRep ki = WARN( True
-                     , text "kindPrimRep defaulting to PtrRep on" <+> ppr ki )
-                 PtrRep  -- this can happen legitimately for, e.g., Any
-
-typeRepArity :: Arity -> Type -> RepArity
-typeRepArity 0 _ = 0
-typeRepArity n ty = case repType ty of
-  UnaryRep (ForAllTy bndr ty) -> length (flattenRepType (repType (binderType bndr))) + typeRepArity (n - 1) ty
-  _                           -> pprPanic "typeRepArity: arity greater than type can handle" (ppr (n, ty, repType ty))
-
-isVoidTy :: Type -> Bool
--- True if the type has zero width
-isVoidTy ty = case repType ty of
-                UnaryRep (TyConApp tc _) -> isUnliftedTyCon tc &&
-                                            isVoidRep (tyConPrimRep tc)
-                _                        -> False
-
-{-
-Note [AppTy rep]
-~~~~~~~~~~~~~~~~
-Types of the form 'f a' must be of kind *, not #, so we are guaranteed
-that they are represented by pointers.  The reason is that f must have
-kind (kk -> kk) and kk cannot be unlifted; see Note [The kind invariant]
-in TyCoRep.
-
 ---------------------------------------------------------------------
                                 ForAllTy
                                 ~~~~~~~~
@@ -1830,6 +1707,137 @@ typeSize (TyConApp _ ts)  = 1 + sum (map typeSize ts)
 typeSize (CastTy ty co)   = typeSize ty + coercionSize co
 typeSize (CoercionTy co)  = coercionSize co
 
+
+{- **********************************************************************
+*                                                                       *
+                Representation types
+*                                                                       *
+********************************************************************** -}
+
+{- Note [Nullary unboxed tuple]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+At runtime we represent the nullary unboxed tuple as the type Void#.
+To see why, consider
+    f2 :: (# Int, Int #) -> Int
+    f1 :: (# Int #) -> Int
+    f0 :: (# #) -> Int
+
+When we "unarise" to eliminate unboxed tuples (this is done at the STG level),
+we'll transform to
+    f2 :: Int -> Int -> Int
+    f1 :: Int -> Int
+    f0 :: ??
+
+We do not want to give f0 zero arguments, otherwise a lambda will
+turn into a thunk! So we want to get
+    f0 :: Void# -> Int
+-}
+
+type UnaryType = Type
+
+data RepType
+  = UbxTupleRep [UnaryType] -- Represented by multiple values
+                            -- INVARIANT: never an empty list
+                            -- (see Note [Nullary unboxed tuple])
+  | UnaryRep UnaryType      -- Represented by a single value
+
+instance Outputable RepType where
+  ppr (UbxTupleRep tys) = text "UbxTupleRep" <+> ppr tys
+  ppr (UnaryRep ty)     = text "UnaryRep"    <+> ppr ty
+
+flattenRepType :: RepType -> [UnaryType]
+flattenRepType (UbxTupleRep tys) = tys
+flattenRepType (UnaryRep ty)     = [ty]
+
+-- | 'repType' figure out how a type will be represented
+--   at runtime.  It looks through
+--
+--      1. For-alls
+--      2. Synonyms
+--      3. Predicates
+--      4. All newtypes, including recursive ones, but not newtype families
+--      5. Casts
+--
+repType :: Type -> RepType
+repType ty
+  = go initRecTc ty
+  where
+    go :: RecTcChecker -> Type -> RepType
+    go rec_nts ty                       -- Expand predicates and synonyms
+      | Just ty' <- coreView ty
+      = go rec_nts ty'
+
+    go rec_nts (ForAllTy (Named {}) ty2)  -- Drop type foralls
+      = go rec_nts ty2
+
+    go rec_nts (TyConApp tc tys)        -- Expand newtypes
+      | isNewTyCon tc
+      , tys `lengthAtLeast` tyConArity tc
+      , Just rec_nts' <- checkRecTc rec_nts tc   -- See Note [Expanding newtypes] in TyCon
+      = go rec_nts' (newTyConInstRhs tc tys)
+
+      | isUnboxedTupleTyCon tc
+      = if null tys
+         then UnaryRep voidPrimTy -- See Note [Nullary unboxed tuple]
+         else UbxTupleRep (concatMap (flattenRepType . go rec_nts) non_rr_tys)
+      where
+          -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
+        non_rr_tys = dropRuntimeRepArgs tys
+
+    go rec_nts (CastTy ty _)
+      = go rec_nts ty
+
+    go _ ty@(CoercionTy _)
+      = pprPanic "repType" (ppr ty)
+
+    go _ ty = UnaryRep ty
+
+-- ToDo: this could be moved to the code generator, using splitTyConApp instead
+-- of inspecting the type directly.
+
+-- | Discovers the primitive representation of a more abstract 'UnaryType'
+typePrimRep :: UnaryType -> PrimRep
+typePrimRep ty = kindPrimRep (typeKind ty)
+
+-- | Find the primitive representation of a 'TyCon'. Defined here to
+-- avoid module loops. Call this only on unlifted tycons.
+tyConPrimRep :: TyCon -> PrimRep
+tyConPrimRep tc = kindPrimRep res_kind
+  where
+    res_kind = tyConResKind tc
+
+-- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep' of values
+-- of types of this kind.
+kindPrimRep :: Kind -> PrimRep
+kindPrimRep ki | Just ki' <- coreViewOneStarKind ki = kindPrimRep ki'
+kindPrimRep (TyConApp typ [runtime_rep])
+  = ASSERT( typ `hasKey` tYPETyConKey )
+    go runtime_rep
+  where
+    go rr | Just rr' <- coreView rr = go rr'
+    go (TyConApp rr_dc args)
+      | RuntimeRep fun <- tyConRuntimeRepInfo rr_dc
+      = fun args
+    go rr = pprPanic "kindPrimRep.go" (ppr rr)
+kindPrimRep ki = WARN( True
+                     , text "kindPrimRep defaulting to PtrRep on" <+> ppr ki )
+                 PtrRep  -- this can happen legitimately for, e.g., Any
+
+typeRepArity :: Arity -> Type -> RepArity
+typeRepArity 0 _ = 0
+typeRepArity n ty = case repType ty of
+  UnaryRep (ForAllTy bndr ty) -> length (flattenRepType (repType (binderType bndr)))
+                                 + typeRepArity (n - 1) ty
+  _ -> pprPanic "typeRepArity: arity greater than type can handle" (ppr (n, ty, repType ty))
+
+isVoidTy :: Type -> Bool
+-- True if the type has zero width
+isVoidTy ty = case repType ty of
+                UnaryRep (TyConApp tc _) -> isUnliftedTyCon tc &&
+                                            isVoidRep (tyConPrimRep tc)
+                _                        -> False
+
+
 {-
 %************************************************************************
 %*                                                                      *
diff --git a/testsuite/tests/codeGen/should_compile/T12115.hs b/testsuite/tests/codeGen/should_compile/T12115.hs
new file mode 100644 (file)
index 0000000..9cbb1b6
--- /dev/null
@@ -0,0 +1,9 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+module T12115 where
+
+import GHC.Prim
+import GHC.Types
+
+f :: (# Void#, (# #) #) -> String
+f = f
index 1d99fbb..9402b7d 100644 (file)
@@ -34,3 +34,4 @@ test('T9964', normal, compile, ['-O'])
 test('T10518', [cmm_src], compile, [''])
 test('T10667', [ when(arch('powerpc64'), expect_broken(11261)) ],
      compile, ['-g'])
+test('T12115', normal, compile, [''])
\ No newline at end of file