Implement unboxed sum primitive type

Summary:
This patch implements primitive unboxed sum types, as described in
https://ghc.haskell.org/trac/ghc/wiki/UnpackedSumTypes.

Main changes are:

- Add new syntax for unboxed sums types, terms and patterns. Hidden
  behind `-XUnboxedSums`.

- Add unlifted unboxed sum type constructors and data constructors,
  extend type and pattern checkers and desugarer.

- Add new RuntimeRep for unboxed sums.

- Extend unarise pass to translate unboxed sums to unboxed tuples right
  before code generation.

- Add `StgRubbishArg` to `StgArg`, and a new type `CmmArg` for better
  code generation when sum values are involved.

- Add user manual section for unboxed sums.

Some other changes:

- Generalize `UbxTupleRep` to `MultiRep` and `UbxTupAlt` to
  `MultiValAlt` to be able to use those with both sums and tuples.

- Don't use `tyConPrimRep` in `isVoidTy`: `tyConPrimRep` is really
  wrong, given an `Any` `TyCon`, there's no way to tell what its kind
  is, but `kindPrimRep` and in turn `tyConPrimRep` returns `PtrRep`.

- Fix some bugs on the way: #12375.

Not included in this patch:

- Update Haddock for new the new unboxed sum syntax.

- `TemplateHaskell` support is left as future work.

For reviewers:

- Front-end code is mostly trivial and adapted from unboxed tuple code
  for type checking, pattern checking, renaming, desugaring etc.

- Main translation routines are in `RepType` and `UnariseStg`.
  Documentation in `UnariseStg` should be enough for understanding
  what's going on.

Credits:

- Johan Tibell wrote the initial front-end and interface file
  extensions.

- Simon Peyton Jones reviewed this patch many times, wrote some code,
  and helped with debugging.

Reviewers: bgamari, alanz, goldfire, RyanGlScott, simonpj, austin,
           simonmar, hvr, erikd

Reviewed By: simonpj

Subscribers: Iceland_jack, ggreif, ezyang, RyanGlScott, goldfire,
             thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D2259

1 files changed, 18 insertions, 17 deletions

diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 5d6710197b..f1437eb640 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -38,7 +38,7 @@ module StgCmmUtils (
         addToMem, addToMemE, addToMemLblE, addToMemLbl,
         mkWordCLit,
         newStringCLit, newByteStringCLit,
-        blankWord
+        blankWord, rubbishExpr
   ) where
 
 #include "HsVersions.h"
@@ -67,6 +67,7 @@ import UniqSupply (MonadUnique(..))
 import DynFlags
 import FastString
 import Outputable
+import RepType
 
 import qualified Data.ByteString as BS
 import qualified Data.Map as M
@@ -193,7 +194,7 @@ emitRtsCallGen res lbl args safe
   where
     call updfr_off =
       if safe then
-        emit =<< mkCmmCall fun_expr res' args' updfr_off
+        emit =<< mkCmmCall fun_expr res' (map CmmExprArg args') updfr_off
       else do
         let conv = ForeignConvention CCallConv arg_hints res_hints CmmMayReturn
         emit $ mkUnsafeCall (ForeignTarget fun_expr conv) res' args'
@@ -251,7 +252,7 @@ callerSaveVolatileRegs dflags = (caller_save, caller_load)
 
     callerRestoreGlobalReg reg
         = mkAssign (CmmGlobal reg)
-                    (CmmLoad (get_GlobalReg_addr dflags reg) (globalRegType dflags reg))
+                   (CmmLoad (get_GlobalReg_addr dflags reg) (globalRegType dflags reg))
 
 -- -----------------------------------------------------------------------------
 -- Global registers
@@ -361,15 +362,11 @@ newUnboxedTupleRegs res_ty
         ; sequel <- getSequel
         ; regs <- choose_regs dflags sequel
         ; ASSERT( regs `equalLength` reps )
-          return (regs, map primRepForeignHint reps) }
+          return (regs, map slotForeignHint reps) }
   where
-    UbxTupleRep ty_args = repType res_ty
-    reps = [ rep
-           | ty <- ty_args
-           , let rep = typePrimRep ty
-           , not (isVoidRep rep) ]
+    MultiRep reps = repType res_ty
     choose_regs _ (AssignTo regs _) = return regs
-    choose_regs dflags _            = mapM (newTemp . primRepCmmType dflags) reps
+    choose_regs dflags _            = mapM (newTemp . slotCmmType dflags) reps
 
 
 
@@ -377,14 +374,14 @@ newUnboxedTupleRegs res_ty
 --      emitMultiAssign
 -------------------------------------------------------------------------
 
-emitMultiAssign :: [LocalReg] -> [CmmExpr] -> FCode ()
+emitMultiAssign :: [LocalReg] -> [CmmArg] -> FCode ()
 -- Emit code to perform the assignments in the
 -- input simultaneously, using temporary variables when necessary.
 
 type Key  = Int
 type Vrtx = (Key, Stmt) -- Give each vertex a unique number,
                         -- for fast comparison
-type Stmt = (LocalReg, CmmExpr) -- r := e
+type Stmt = (LocalReg, CmmArg) -- r := e
 
 -- We use the strongly-connected component algorithm, in which
 --      * the vertices are the statements
@@ -393,7 +390,7 @@ type Stmt = (LocalReg, CmmExpr) -- r := e
 --        that is, if s1 should *follow* s2 in the final order
 
 emitMultiAssign []    []    = return ()
-emitMultiAssign [reg] [rhs] = emitAssign (CmmLocal reg) rhs
+emitMultiAssign [reg] [rhs] = emitAssign' (CmmLocal reg) rhs
 emitMultiAssign regs rhss   = do
   dflags <- getDynFlags
   ASSERT2( equalLength regs rhss, ppr regs $$ ppr rhss )
@@ -432,16 +429,20 @@ unscramble dflags vertices = mapM_ do_component components
 
         split :: DynFlags -> Unique -> Stmt -> (Stmt, Stmt)
         split dflags uniq (reg, rhs)
-          = ((tmp, rhs), (reg, CmmReg (CmmLocal tmp)))
+          = ((tmp, rhs), (reg, CmmExprArg (CmmReg (CmmLocal tmp))))
           where
-            rep = cmmExprType dflags rhs
+            rep = cmmArgType dflags rhs
             tmp = LocalReg uniq rep
 
         mk_graph :: Stmt -> FCode ()
-        mk_graph (reg, rhs) = emitAssign (CmmLocal reg) rhs
+        mk_graph (reg, rhs) = emitAssign' (CmmLocal reg) rhs
 
         mustFollow :: Stmt -> Stmt -> Bool
-        (reg, _) `mustFollow` (_, rhs) = regUsedIn dflags (CmmLocal reg) rhs
+        (reg, _) `mustFollow` (_, rhs) = regUsedIn' dflags (CmmLocal reg) rhs
+
+regUsedIn' :: DynFlags -> CmmReg -> CmmArg -> Bool
+regUsedIn' _      _   (CmmRubbishArg _) = False
+regUsedIn' dflags reg (CmmExprArg expr) = regUsedIn dflags reg expr
 
 -------------------------------------------------------------------------
 --      mkSwitch