[commit: ghc] master: More fixes for unboxed tuples (b43a793)

git at git.haskell.org git at git.haskell.org
Fri May 27 13:35:16 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/b43a7936ebf77bce744d50a131d686c83f63e60b/ghc

>---------------------------------------------------------------

commit b43a7936ebf77bce744d50a131d686c83f63e60b
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri May 27 14:34:45 2016 +0100

    More fixes for unboxed tuples
    
    This is a continuation of
       commit e9e61f18a548b70693f4ccd245bc56335c94b498
       Date:   Thu May 26 15:24:53 2016 +0100
       Reduce special-casing for nullary unboxed tuple
    
    which related to Trac #12115.  But typecheck/should_run/tcrun051
    revealed that my patch was incomplete.
    
    This fixes it, by removing another special case in Type.repType.
    I had also missed a case in UnariseStg.unariseIdBinder.
    
    I took the opportunity to add explanatory notes
      Note [Unarisation]
      Note [Unarisation and nullary tuples]
    in UnariseStg


>---------------------------------------------------------------

b43a7936ebf77bce744d50a131d686c83f63e60b
 compiler/simplStg/UnariseStg.hs | 87 +++++++++++++++++++++++++++++++++--------
 compiler/types/Type.hs          | 10 ++---
 2 files changed, 76 insertions(+), 21 deletions(-)

diff --git a/compiler/simplStg/UnariseStg.hs b/compiler/simplStg/UnariseStg.hs
index 4c8a665..9eca768 100644
--- a/compiler/simplStg/UnariseStg.hs
+++ b/compiler/simplStg/UnariseStg.hs
@@ -4,8 +4,8 @@
 
 Note [Unarisation]
 ~~~~~~~~~~~~~~~~~~
-
-The idea of this pass is to translate away *all* unboxed-tuple binders. So for example:
+The idea of this pass is to translate away *all* unboxed-tuple binders.
+So for example:
 
 f (x :: (# Int, Bool #)) = f x + f (# 1, True #)
  ==>
@@ -18,10 +18,55 @@ this example the type of 'f' changes, for example.
 STG fed to the code generators *must* be unarised because the code generators do
 not support unboxed tuple binders natively.
 
+In more detail:
+
+Suppose that a variable x : (# t1, t2 #).
+
+  * At the binding site for x, make up fresh vars  x1:t1, x2:t2
+
+  * Extend the UniariseEnv   x :-> [x1,x2]
+
+  * Replace the binding with a curried binding for x1,x2
+       Lambda:   \x.e                ==>   \x1 x2. e
+       Case alt: MkT a b x c d -> e  ==>   MkT a b x1 x2 c d -> e
+
+  * Replace argument occurrences with a sequence of args
+    via a lookup in UnariseEnv
+       f a b x c d   ==>   f a b x1 x2 c d
+
+  * Replace tail-call occurrences with an unboxed tuple
+    via a lookup in UnariseEnv
+       x  ==>  (# x1, x2 #)
+    So, for example
+       f x = x    ==>   f x1 x2 = (# x1, x2 #)
+
+    This applies to case scrutinees too
+       case x of (# a,b #) -> e   ==>   case (# x1,x2 #) of (# a,b #) -> e
+    I think we rely on the code generator to short-circuit this
+    case without generating any actual code.
+
+Of course all this applies recursively, so that we flattn out nested tuples.
+
+Note [Unarisation and nullary tuples]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The above scheme has a special cases for nullary unboxed tuples, x :: (# #)
+
+  * Extend the UnariseEnv with   x :-> [voidPrimId]
+
+  * Replace bindings with a binding for void:Void#
+       \x. e  =>  \void. e
+    and similarly case alternatives
+
+  * If we find (# #) as an argument all by itself
+       f ...(# #)...
+    it looks like an Id, so we look up in UnariseEnv. We want to replace it
+    with voidPrimId, so the convenient thing is to initalise the UniariseEnv
+    with   (# #) :-> [voidPrimId]
+
+See also Note [Nullary unboxed tuple] in Type.hs.
 
 Note [Unarisation and arity]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
 Because of unarisation, the arity that will be recorded in the generated info table
 for an Id may be larger than the idArity. Instead we record what we call the RepArity,
 which is the Arity taking into account any expanded arguments, and corresponds to
@@ -39,7 +84,7 @@ import StgSyn
 import VarEnv
 import UniqSupply
 import Id
-import MkId (realWorldPrimId)
+import MkId ( voidPrimId, voidArgId )
 import Type
 import TysWiredIn
 import DataCon
@@ -58,13 +103,12 @@ import BasicTypes
 -- the domain of the mapping at all.
 type UnariseEnv = VarEnv [Id]
 
-ubxTupleId0 :: Id
-ubxTupleId0 = dataConWorkId (tupleDataCon Unboxed 0)
-
 unarise :: UniqSupply -> [StgBinding] -> [StgBinding]
 unarise us binds = zipWith (\us -> unariseBinding us init_env) (listSplitUniqSupply us) binds
-  where -- See Note [Nullary unboxed tuple] in Type.hs
-        init_env = unitVarEnv ubxTupleId0 [realWorldPrimId]
+  where
+     -- See Note [Unarisation and nullary tuples]
+     nullary_tup = dataConWorkId unboxedUnitDataCon
+     init_env = unitVarEnv nullary_tup [voidPrimId]
 
 unariseBinding :: UniqSupply -> UnariseEnv -> StgBinding -> StgBinding
 unariseBinding us rho bind = case bind of
@@ -170,7 +214,7 @@ unariseIds rho = concatMap (unariseId rho)
 unariseId :: UnariseEnv -> Id -> [Id]
 unariseId rho x
   | Just ys <- lookupVarEnv rho x
-  = ASSERT2( case repType (idType x) of UbxTupleRep _ -> True; _ -> x == ubxTupleId0
+  = ASSERT2( case repType (idType x) of UbxTupleRep _ -> True; _ -> False
            , text "unariseId: not unboxed tuple" <+> ppr x )
     ys
 
@@ -182,13 +226,24 @@ unariseId rho x
 unariseIdBinders :: UniqSupply -> UnariseEnv -> [Id] -> (UniqSupply, UnariseEnv, [Id])
 unariseIdBinders us rho xs = third3 concat $ mapAccumL2 unariseIdBinder us rho xs
 
-unariseIdBinder :: UniqSupply -> UnariseEnv -> Id -> (UniqSupply, UnariseEnv, [Id])
+unariseIdBinder :: UniqSupply -> UnariseEnv
+                -> Id                -- Binder
+                -> (UniqSupply,
+                    UnariseEnv,      -- What to expand to at occurrence sites
+                    [Id])            -- What to expand to at binding site
 unariseIdBinder us rho x = case repType (idType x) of
-    UnaryRep _      -> (us, rho, [x])
-    UbxTupleRep tys -> let (us0, us1) = splitUniqSupply us
-                           ys   = unboxedTupleBindersFrom us0 x tys
-                           rho' = extendVarEnv rho x ys
-                       in (us1, rho', ys)
+    UnaryRep {} -> (us, rho, [x])
+
+    UbxTupleRep tys
+      | null tys  -> -- See Note [Unarisation and nullary tuples]
+                     let ys = [voidPrimId]
+                         rho' = extendVarEnv rho x ys
+                     in (us, rho', [voidArgId])
+
+      | otherwise -> let (us0, us1) = splitUniqSupply us
+                         ys   = unboxedTupleBindersFrom us0 x tys
+                         rho' = extendVarEnv rho x ys
+                      in (us1, rho', ys)
 
 unboxedTupleBindersFrom :: UniqSupply -> Id -> [UnaryType] -> [Id]
 unboxedTupleBindersFrom us x tys = zipWith (mkSysLocalOrCoVar fs) (uniqsFromSupply us) tys
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 913664e..9aaf3de 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -141,7 +141,7 @@ module Type (
         tyConsOfType,
 
         -- * Type representation for the code generator
-        typePrimRep, typeRepArity, kindPrimRep, tyConPrimRep,
+        typePrimRep, typeRepArity, tyConPrimRep,
 
         -- * Main type substitution data types
         TvSubstEnv,     -- Representation widely visible
@@ -1715,7 +1715,7 @@ typeSize (CoercionTy co)  = coercionSize co
 ********************************************************************** -}
 
 {- Note [Nullary unboxed tuple]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 At runtime we represent the nullary unboxed tuple as the type Void#.
 To see why, consider
     f2 :: (# Int, Int #) -> Int
@@ -1731,6 +1731,8 @@ we'll transform to
 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
+
+See Note [Unarisation and nullary tuples] in UnariseStg for more detail.
 -}
 
 type UnaryType = Type
@@ -1777,9 +1779,7 @@ repType ty
       = 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)
+      = UbxTupleRep (concatMap (flattenRepType . go rec_nts) non_rr_tys)
       where
           -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
         non_rr_tys = dropRuntimeRepArgs tys



More information about the ghc-commits mailing list