Update levity polymorphism

This commit implements the proposal in
https://github.com/ghc-proposals/ghc-proposals/pull/29 and
https://github.com/ghc-proposals/ghc-proposals/pull/35.

Here are some of the pieces of that proposal:

* Some of RuntimeRep's constructors have been shortened.

* TupleRep and SumRep are now parameterized over a list of RuntimeReps.
* This
means that two types with the same kind surely have the same
representation.
Previously, all unboxed tuples had the same kind, and thus the fact
above was
false.

* RepType.typePrimRep and friends now return a *list* of PrimReps. These
functions can now work successfully on unboxed tuples. This change is
necessary because we allow abstraction over unboxed tuple types and so
cannot
always handle unboxed tuples specially as we did before.

* We sometimes have to create an Id from a PrimRep. I thus split PtrRep
* into
LiftedRep and UnliftedRep, so that the created Ids have the right
strictness.

* The RepType.RepType type was removed, as it didn't seem to help with
* much.

* The RepType.repType function is also removed, in favor of typePrimRep.

* I have waffled a good deal on whether or not to keep VoidRep in
TyCon.PrimRep. In the end, I decided to keep it there. PrimRep is *not*
represented in RuntimeRep, and typePrimRep will never return a list
including
VoidRep. But it's handy to have in, e.g., ByteCodeGen and friends. I can
imagine another design choice where we have a PrimRepV type that is
PrimRep
with an extra constructor. That seemed to be a heavier design, though,
and I'm
not sure what the benefit would be.

* The last, unused vestiges of # (unliftedTypeKind) have been removed.

* There were several pretty-printing bugs that this change exposed;
* these are fixed.

* We previously checked for levity polymorphism in the types of binders.
* But we
also must exclude levity polymorphism in function arguments. This is
hard to check
for, requiring a good deal of care in the desugarer. See Note [Levity
polymorphism
checking] in DsMonad.

* In order to efficiently check for levity polymorphism in functions, it
* was necessary
to add a new bit of IdInfo. See Note [Levity info] in IdInfo.

* It is now safe for unlifted types to be unsaturated in Core. Core Lint
* is updated
accordingly.

* We can only know strictness after zonking, so several checks around
* strictness
in the type-checker (checkStrictBinds, the check for unlifted variables
under a ~
pattern) have been moved to the desugarer.

* Along the way, I improved the treatment of unlifted vs. banged
* bindings. See
Note [Strict binds checks] in DsBinds and #13075.

* Now that we print type-checked source, we must be careful to print
* ConLikes correctly.
This is facilitated by a new HsConLikeOut constructor to HsExpr.
Particularly troublesome
are unlifted pattern synonyms that get an extra void# argument.

* Includes a submodule update for haddock, getting rid of #.

* New testcases:
  typecheck/should_fail/StrictBinds
  typecheck/should_fail/T12973
  typecheck/should_run/StrictPats
  typecheck/should_run/T12809
  typecheck/should_fail/T13105
  patsyn/should_fail/UnliftedPSBind
  typecheck/should_fail/LevPolyBounded
  typecheck/should_compile/T12987
  typecheck/should_compile/T11736

* Fixed tickets:
  #12809
  #12973
  #11736
  #13075
  #12987

* This also adds a test case for #13105. This test case is
* "compile_fail" and
succeeds, because I want the testsuite to monitor the error message.
When #13105 is fixed, the test case will compile cleanly.

2 files changed, 198 insertions, 201 deletions

diff --git a/compiler/simplStg/RepType.hs b/compiler/simplStg/RepType.hs
index 6309aecb3a..f59a8548f1 100644
--- a/compiler/simplStg/RepType.hs
+++ b/compiler/simplStg/RepType.hs
@@ -2,37 +2,40 @@
 {-# LANGUAGE FlexibleContexts #-}
 
 module RepType
-  ( -- * Code generator views onto Types
+  (
+    -- * Code generator views onto Types
     UnaryType, NvUnaryType, isNvUnaryType,
-    RepType(..), repType, repTypeArgs, isUnaryRep, isMultiRep,
+    unwrapType,
 
     -- * Predicates on types
-    isVoidTy, typePrimRep,
+    isVoidTy,
 
     -- * Type representation for the code generator
-    countConRepArgs, idFunRepArity, tyConPrimRep,
+    typePrimRep, typePrimRep1,
+    runtimeRepPrimRep, typePrimRepArgs,
+    PrimRep(..), primRepToType,
+    countFunRepArgs, countConRepArgs, tyConPrimRep, tyConPrimRep1,
 
     -- * Unboxed sum representation type
-    ubxSumRepType, layout, typeSlotTy, SlotTy (..), slotTyToType,
-    slotPrimRep, repTypeSlots
+    ubxSumRepType, layoutUbxSum, typeSlotTy, SlotTy (..),
+    slotPrimRep, primRepSlot
   ) where
 
 #include "HsVersions.h"
 
 import BasicTypes (Arity, RepArity)
 import DataCon
-import Id
 import Outputable
 import PrelNames
+import Coercion
 import TyCon
 import TyCoRep
 import Type
-import TysPrim
-import TysWiredIn
 import Util
+import TysPrim
+import {-# SOURCE #-} TysWiredIn ( anyTypeOfKind )
 
 import Data.List (foldl', sort)
-import Data.Maybe (maybeToList)
 import qualified Data.IntSet as IS
 
 {- **********************************************************************
@@ -49,101 +52,64 @@ type UnaryType   = Type
      --   NvUnaryType : never an unboxed tuple or sum, or void
      --
      --   UnaryType   : never an unboxed tuple or sum;
-     --                 can be Void# (but not (# #))
+     --                 can be Void# or (# #)
 
 isNvUnaryType :: Type -> Bool
 isNvUnaryType ty
-  = case repType ty of
-      UnaryRep _  -> True
-      MultiRep ss -> not (null ss)
-
-data RepType
-  = MultiRep [SlotTy]     -- Represented by multiple values (e.g. unboxed tuple or sum)
-  | UnaryRep NvUnaryType  -- Represented by a single value; but never Void#, or any
-                          -- other zero-width type (isVoidTy)
-
-instance Outputable RepType where
-  ppr (MultiRep slots) = text "MultiRep" <+> ppr slots
-  ppr (UnaryRep ty)    = text "UnaryRep" <+> ppr ty
-
-isMultiRep :: RepType -> Bool
-isMultiRep (MultiRep _) = True
-isMultiRep _            = False
-
-isUnaryRep :: RepType -> Bool
-isUnaryRep (UnaryRep _) = True
-isUnaryRep _            = False
+  | [_] <- typePrimRep ty
+  = True
+  | otherwise
+  = False
 
 -- INVARIANT: the result list is never empty.
-repTypeArgs :: Type -> [UnaryType]
-repTypeArgs ty = case repType ty of
-                    MultiRep []    -> [voidPrimTy]
-                    MultiRep slots -> map slotTyToType slots
-                    UnaryRep ty    -> [ty]
-
-repTypeSlots :: RepType -> [SlotTy]
-repTypeSlots (MultiRep slots) = slots
-repTypeSlots (UnaryRep ty)    = maybeToList (typeSlotTy 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
+typePrimRepArgs :: Type -> [PrimRep]
+typePrimRepArgs ty
+  | [] <- reps
+  = [VoidRep]
+  | otherwise
+  = reps
   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 _ ty2)         -- Drop type foralls
-      = go rec_nts ty2
-
-    go rec_nts ty@(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
-      = MultiRep (concatMap (repTypeSlots . go rec_nts) non_rr_tys)
-
-      | isUnboxedSumTyCon tc
-      = MultiRep (ubxSumRepType non_rr_tys)
-
-      | isVoidTy ty
-      = MultiRep []
-      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
-
-
-idFunRepArity :: Id -> RepArity
-idFunRepArity x = countFunRepArgs (idArity x) (idType x)
+    reps = typePrimRep ty
+
+-- | Gets rid of the stuff that prevents us from understanding the
+-- runtime representation of a type. Including:
+--   1. Casts
+--   2. Newtypes
+--   3. Foralls
+--   4. Synonyms
+-- But not type/data families, because we don't have the envs to hand.
+unwrapType :: Type -> Type
+unwrapType ty
+  | Just (_, unwrapped)
+      <- topNormaliseTypeX stepper mappend inner_ty
+  = unwrapped
+  | otherwise
+  = inner_ty
+  where
+    inner_ty = go ty
+
+    go t | Just t' <- coreView t = go t'
+    go (ForAllTy _ t)            = go t
+    go (CastTy t _)              = go t
+    go t                         = t
+
+     -- cf. Coercion.unwrapNewTypeStepper
+    stepper rec_nts tc tys
+      | Just (ty', _) <- instNewTyCon_maybe tc tys
+      = case checkRecTc rec_nts tc of
+          Just rec_nts' -> NS_Step rec_nts' (go ty') ()
+          Nothing       -> NS_Abort   -- infinite newtypes
+      | otherwise
+      = NS_Done
 
 countFunRepArgs :: Arity -> Type -> RepArity
 countFunRepArgs 0 _
   = 0
 countFunRepArgs n ty
-  | UnaryRep (FunTy arg res) <- repType ty
-  = length (repTypeArgs arg) + countFunRepArgs (n - 1) res
+  | FunTy arg res <- unwrapType ty
+  = length (typePrimRepArgs arg) + countFunRepArgs (n - 1) res
   | otherwise
-  = pprPanic "countFunRepArgs: arity greater than type can handle" (ppr (n, ty, repType ty))
+  = pprPanic "countFunRepArgs: arity greater than type can handle" (ppr (n, ty, typePrimRep ty))
 
 countConRepArgs :: DataCon -> RepArity
 countConRepArgs dc = go (dataConRepArity dc) (dataConRepType dc)
@@ -152,14 +118,14 @@ countConRepArgs dc = go (dataConRepArity dc) (dataConRepType dc)
     go 0 _
       = 0
     go n ty
-      | UnaryRep (FunTy arg res) <- repType ty
-      = length (repTypeSlots (repType arg)) + go (n - 1) res
+      | FunTy arg res <- unwrapType ty
+      = length (typePrimRep arg) + go (n - 1) res
       | otherwise
-      = pprPanic "countConRepArgs: arity greater than type can handle" (ppr (n, ty, repType ty))
+      = pprPanic "countConRepArgs: arity greater than type can handle" (ppr (n, ty, typePrimRep ty))
 
 -- | True if the type has zero width.
 isVoidTy :: Type -> Bool
-isVoidTy ty = typePrimRep ty == VoidRep
+isVoidTy = null . typePrimRep
 
 
 {- **********************************************************************
@@ -176,52 +142,59 @@ type SortedSlotTys = [SlotTy]
 --
 -- E.g.
 --
---   (# Int | Maybe Int | (# Int, Bool #) #)
+--   (# Int# | Maybe Int | (# Int#, Float# #) #)
 --
--- We call `ubxSumRepType [ Int, Maybe Int, (# Int,Bool #) ]`,
--- which returns [Tag#, PtrSlot, PtrSlot]
+-- We call `ubxSumRepType [ [IntRep], [LiftedRep], [IntRep, FloatRep] ]`,
+-- which returns [WordSlot, PtrSlot, WordSlot, FloatSlot]
 --
 -- INVARIANT: Result slots are sorted (via Ord SlotTy), except that at the head
 -- of the list we have the slot for the tag.
-ubxSumRepType :: [Type] -> [SlotTy]
-ubxSumRepType constrs0 =
-  ASSERT2( length constrs0 > 1, ppr constrs0 ) -- otherwise it isn't a sum type
-  let
-    combine_alts :: [SortedSlotTys]  -- slots of constructors
-                 -> SortedSlotTys    -- final slots
-    combine_alts constrs = foldl' merge [] constrs
-
-    merge :: SortedSlotTys -> SortedSlotTys -> SortedSlotTys
-    merge existing_slots []
-      = existing_slots
-    merge [] needed_slots
-      = needed_slots
-    merge (es : ess) (s : ss)
-      | Just s' <- s `fitsIn` es
-      = -- found a slot, use it
-        s' : merge ess ss
-      | s < es
-      = -- we need a new slot and this is the right place for it
-        s : merge (es : ess) ss
-      | otherwise
-      = -- keep searching for a slot
-        es : merge ess (s : ss)
-
-    -- Nesting unboxed tuples and sums is OK, so we need to flatten first.
-    rep :: Type -> SortedSlotTys
-    rep ty = sort (repTypeSlots (repType ty))
-
-    sumRep = WordSlot : combine_alts (map rep constrs0)
-             -- WordSlot: for the tag of the sum
-  in
-    sumRep
-
-layout :: SortedSlotTys -- Layout of sum. Does not include tag.
-                        -- We assume that they are in increasing order
-       -> [SlotTy]      -- Slot types of things we want to map to locations in the
-                        -- sum layout
-       -> [Int]         -- Where to map 'things' in the sum layout
-layout sum_slots0 arg_slots0 =
+ubxSumRepType :: [[PrimRep]] -> [SlotTy]
+ubxSumRepType constrs0
+  -- These first two cases never classify an actual unboxed sum, which always
+  -- has at least two disjuncts. But it could happen if a user writes, e.g.,
+  -- forall (a :: TYPE (SumRep [IntRep])). ...
+  -- which could never be instantiated. We still don't want to panic.
+  | length constrs0 < 2
+  = [WordSlot]
+
+  | otherwise
+  = let
+      combine_alts :: [SortedSlotTys]  -- slots of constructors
+                   -> SortedSlotTys    -- final slots
+      combine_alts constrs = foldl' merge [] constrs
+
+      merge :: SortedSlotTys -> SortedSlotTys -> SortedSlotTys
+      merge existing_slots []
+        = existing_slots
+      merge [] needed_slots
+        = needed_slots
+      merge (es : ess) (s : ss)
+        | Just s' <- s `fitsIn` es
+        = -- found a slot, use it
+          s' : merge ess ss
+        | s < es
+        = -- we need a new slot and this is the right place for it
+          s : merge (es : ess) ss
+        | otherwise
+        = -- keep searching for a slot
+          es : merge ess (s : ss)
+
+      -- Nesting unboxed tuples and sums is OK, so we need to flatten first.
+      rep :: [PrimRep] -> SortedSlotTys
+      rep ty = sort (map primRepSlot ty)
+
+      sumRep = WordSlot : combine_alts (map rep constrs0)
+               -- WordSlot: for the tag of the sum
+    in
+      sumRep
+
+layoutUbxSum :: SortedSlotTys -- Layout of sum. Does not include tag.
+                              -- We assume that they are in increasing order
+             -> [SlotTy]      -- Slot types of things we want to map to locations in the
+                              -- sum layout
+             -> [Int]         -- Where to map 'things' in the sum layout
+layoutUbxSum sum_slots0 arg_slots0 =
     go arg_slots0 IS.empty
   where
     go :: [SlotTy] -> IS.IntSet -> [Int]
@@ -273,11 +246,12 @@ typeSlotTy ty
   | isVoidTy ty
   = Nothing
   | otherwise
-  = Just (primRepSlot (typePrimRep ty))
+  = Just (primRepSlot (typePrimRep1 ty))
 
 primRepSlot :: PrimRep -> SlotTy
 primRepSlot VoidRep     = pprPanic "primRepSlot" (text "No slot for VoidRep")
-primRepSlot PtrRep      = PtrSlot
+primRepSlot LiftedRep   = PtrSlot
+primRepSlot UnliftedRep = PtrSlot
 primRepSlot IntRep      = WordSlot
 primRepSlot WordRep     = WordSlot
 primRepSlot Int64Rep    = Word64Slot
@@ -287,16 +261,8 @@ primRepSlot FloatRep    = FloatSlot
 primRepSlot DoubleRep   = DoubleSlot
 primRepSlot VecRep{}    = pprPanic "primRepSlot" (text "No slot for VecRep")
 
--- Used when unarising sum binders (need to give unarised Ids types)
-slotTyToType :: SlotTy -> Type
-slotTyToType PtrSlot    = anyTypeOfKind liftedTypeKind
-slotTyToType Word64Slot = int64PrimTy
-slotTyToType WordSlot   = intPrimTy
-slotTyToType DoubleSlot = doublePrimTy
-slotTyToType FloatSlot  = floatPrimTy
-
 slotPrimRep :: SlotTy -> PrimRep
-slotPrimRep PtrSlot     = PtrRep
+slotPrimRep PtrSlot     = LiftedRep   -- choice between lifted & unlifted seems arbitrary
 slotPrimRep Word64Slot  = Word64Rep
 slotPrimRep WordSlot    = WordRep
 slotPrimRep DoubleSlot  = DoubleRep
@@ -332,41 +298,68 @@ fitsIn ty1 ty2
 *                                                                       *
 ********************************************************************** -}
 
--- | Discovers the primitive representation of a more abstract 'UnaryType'
-typePrimRep :: HasDebugCallStack => UnaryType -> PrimRep
-typePrimRep ty = kindPrimRep (text "kindRep ty" <+> ppr ty $$ ppr (typeKind ty))
+-- | Discovers the primitive representation of a 'Type'. Returns
+-- a list of 'PrimRep': it's a list because of the possibility of
+-- no runtime representation (void) or multiple (unboxed tuple/sum)
+typePrimRep :: HasDebugCallStack => Type -> [PrimRep]
+typePrimRep ty = kindPrimRep (text "typePrimRep" <+>
+                              parens (ppr ty <+> dcolon <+> ppr (typeKind ty)))
                              (typeKind ty)
 
+-- | Like 'typePrimRep', but assumes that there is precisely one 'PrimRep' output;
+-- an empty list of PrimReps becomes a VoidRep
+typePrimRep1 :: HasDebugCallStack => UnaryType -> PrimRep
+typePrimRep1 ty = case typePrimRep ty of
+  []    -> VoidRep
+  [rep] -> rep
+  _     -> pprPanic "typePrimRep1" (ppr ty $$ ppr (typePrimRep ty))
+
 -- | Find the runtime representation of a 'TyCon'. Defined here to
--- avoid module loops. Do not call this on unboxed tuples or sums,
--- because they don't /have/ a runtime representation
-tyConPrimRep :: HasDebugCallStack => TyCon -> PrimRep
+-- avoid module loops. Returns a list of the register shapes necessary.
+tyConPrimRep :: HasDebugCallStack => TyCon -> [PrimRep]
 tyConPrimRep tc
-  = ASSERT2( not (isUnboxedTupleTyCon tc), ppr tc )
-    ASSERT2( not (isUnboxedSumTyCon   tc), ppr tc )
-    kindPrimRep (text "kindRep tc" <+> ppr tc $$ ppr res_kind)
+  = kindPrimRep (text "kindRep tc" <+> ppr tc $$ ppr res_kind)
                 res_kind
   where
     res_kind = tyConResKind tc
 
--- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep'
+-- | Like 'tyConPrimRep', but assumed that there is precisely zero or
+-- one 'PrimRep' output
+tyConPrimRep1 :: HasDebugCallStack => TyCon -> PrimRep
+tyConPrimRep1 tc = case tyConPrimRep tc of
+  []    -> VoidRep
+  [rep] -> rep
+  _     -> pprPanic "tyConPrimRep1" (ppr tc $$ ppr (tyConPrimRep tc))
+
+-- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep's
 -- of values of types of this kind.
-kindPrimRep :: HasDebugCallStack => SDoc -> Kind -> PrimRep
+kindPrimRep :: HasDebugCallStack => SDoc -> Kind -> [PrimRep]
 kindPrimRep doc ki
   | Just ki' <- coreViewOneStarKind ki
   = kindPrimRep doc ki'
-kindPrimRep _ (TyConApp typ [runtime_rep])
+kindPrimRep doc (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)
+    runtimeRepPrimRep doc runtime_rep
 kindPrimRep doc ki
-  = WARN( True, text "kindPrimRep defaulting to PtrRep on" <+> ppr ki $$ doc )
-    PtrRep  -- this can happen legitimately for, e.g., Any
+  = pprPanic "kindPrimRep" (ppr ki $$ doc)
+
+  -- TODO (RAE): Remove:
+  -- WARN( True, text "kindPrimRep defaulting to LiftedRep on" <+> ppr ki $$ doc )
+  -- [LiftedRep]  -- this can happen legitimately for, e.g., Any
+
+-- | Take a type of kind RuntimeRep and extract the list of 'PrimRep' that
+-- it encodes.
+runtimeRepPrimRep :: HasDebugCallStack => SDoc -> Type -> [PrimRep]
+runtimeRepPrimRep doc rr_ty
+  | Just rr_ty' <- coreView rr_ty
+  = runtimeRepPrimRep doc rr_ty'
+  | TyConApp rr_dc args <- rr_ty
+  , RuntimeRep fun <- tyConRuntimeRepInfo rr_dc
+  = fun args
+  | otherwise
+  = pprPanic "runtimeRepPrimRep" (doc $$ ppr rr_ty)
+
+-- | Convert a PrimRep back to a Type. Used only in the unariser to give types
+-- to fresh Ids. Really, only the type's representation matters.
+primRepToType :: PrimRep -> Type
+primRepToType = anyTypeOfKind . tYPE . primRepToRuntimeRep
diff --git a/compiler/simplStg/UnariseStg.hs b/compiler/simplStg/UnariseStg.hs
index e8ba200d0a..aa42586cd1 100644
--- a/compiler/simplStg/UnariseStg.hs
+++ b/compiler/simplStg/UnariseStg.hs
@@ -209,7 +209,7 @@ import Outputable
 import RepType
 import StgSyn
 import Type
-import TysPrim (intPrimTyCon, intPrimTy)
+import TysPrim (intPrimTy)
 import TysWiredIn
 import UniqSupply
 import Util
@@ -225,7 +225,7 @@ import qualified Data.IntMap as IM
 --
 --   x :-> MultiVal [a,b,c] in rho
 --
--- iff  x's repType is a MultiRep, or equivalently
+-- iff  x's typePrimRep is not a singleton, or equivalently
 --      x's type is an unboxed tuple, sum or void.
 --
 --    x :-> UnaryVal x'
@@ -487,24 +487,24 @@ mapTupleIdBinders
 mapTupleIdBinders ids args0 rho0
   = ASSERT(not (any (isVoidTy . stgArgType) args0))
     let
-      ids_unarised :: [(Id, RepType)]
-      ids_unarised = map (\id -> (id, repType (idType id))) ids
+      ids_unarised :: [(Id, [PrimRep])]
+      ids_unarised = map (\id -> (id, typePrimRep (idType id))) ids
 
-      map_ids :: UnariseEnv -> [(Id, RepType)] -> [StgArg] -> UnariseEnv
+      map_ids :: UnariseEnv -> [(Id, [PrimRep])] -> [StgArg] -> UnariseEnv
       map_ids rho [] _  = rho
-      map_ids rho ((x, x_rep) : xs) args =
+      map_ids rho ((x, x_reps) : xs) args =
         let
-          x_arity = length (repTypeSlots x_rep)
+          x_arity = length x_reps
           (x_args, args') =
             ASSERT(args `lengthAtLeast` x_arity)
             splitAt x_arity args
 
           rho'
-            | isMultiRep x_rep
-            = extendRho rho x (MultiVal x_args)
-            | otherwise
+            | x_arity == 1
             = ASSERT(x_args `lengthIs` 1)
               extendRho rho x (UnaryVal (head x_args))
+            | otherwise
+            = extendRho rho x (MultiVal x_args)
         in
           map_ids rho' xs args'
     in
@@ -521,9 +521,9 @@ mapSumIdBinders
 mapSumIdBinders [id] args rho0
   = ASSERT(not (any (isVoidTy . stgArgType) args))
     let
-      arg_slots = concatMap (repTypeSlots . repType . stgArgType) args
-      id_slots  = repTypeSlots (repType (idType id))
-      layout1   = layout arg_slots id_slots
+      arg_slots = map primRepSlot $ concatMap (typePrimRep . stgArgType) args
+      id_slots  = map primRepSlot $ typePrimRep (idType id)
+      layout1   = layoutUbxSum arg_slots id_slots
     in
       if isMultiValBndr id
         then extendRho rho0 id (MultiVal [ args !! i | i <- layout1 ])
@@ -550,12 +550,12 @@ mkUbxSum
   -> [OutStgArg]  -- Final tuple arguments
 mkUbxSum dc ty_args args0
   = let
-      (_ : sum_slots) = ubxSumRepType ty_args
+      (_ : sum_slots) = ubxSumRepType (map typePrimRep ty_args)
         -- drop tag slot
 
       tag = dataConTag dc
 
-      layout'  = layout sum_slots (mapMaybe (typeSlotTy . stgArgType) args0)
+      layout'  = layoutUbxSum sum_slots (mapMaybe (typeSlotTy . stgArgType) args0)
       tag_arg  = StgLitArg (MachInt (fromIntegral tag))
       arg_idxs = IM.fromList (zipEqual "mkUbxSum" layout' args0)
 
@@ -656,12 +656,12 @@ unariseFunArgBinders rho xs = second concat <$> mapAccumLM unariseFunArgBinder r
 unariseFunArgBinder :: UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
 -- Result list of binders is never empty
 unariseFunArgBinder rho x  =
-  case repType (idType x) of
-    UnaryRep _     -> return (rho, [x])
-    MultiRep []    -> return (extendRho rho x (MultiVal []), [voidArgId])
-                            -- NB: do not remove void binders
-    MultiRep slots -> do
-      xs <- mkIds (mkFastString "us") (map slotTyToType slots)
+  case typePrimRep (idType x) of
+    []   -> return (extendRho rho x (MultiVal []), [voidArgId])
+                           -- NB: do not remove void binders
+    [_]  -> return (rho, [x])
+    reps -> do
+      xs <- mkIds (mkFastString "us") (map primRepToType reps)
       return (extendRho rho x (MultiVal (map StgVarArg xs)), xs)
 
 --------------------------------------------------------------------------------
@@ -687,10 +687,10 @@ unariseConArgBinders rho xs = second concat <$> mapAccumLM unariseConArgBinder r
 
 unariseConArgBinder :: UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
 unariseConArgBinder rho x =
-  case repType (idType x) of
-    UnaryRep _     -> return (rho, [x])
-    MultiRep slots -> do
-      xs <- mkIds (mkFastString "us") (map slotTyToType slots)
+  case typePrimRep (idType x) of
+    [_]  -> return (rho, [x])
+    reps -> do
+      xs <- mkIds (mkFastString "us") (map primRepToType reps)
       return (extendRho rho x (MultiVal (map StgVarArg xs)), xs)
 
 unariseFreeVars :: UnariseEnv -> [InId] -> [OutId]
@@ -720,7 +720,11 @@ mkId :: FastString -> UnaryType -> UniqSM Id
 mkId = mkSysLocalOrCoVarM
 
 isMultiValBndr :: Id -> Bool
-isMultiValBndr = isMultiRep . repType . idType
+isMultiValBndr id
+  | [_] <- typePrimRep (idType id)
+  = False
+  | otherwise
+  = True
 
 isUnboxedSumBndr :: Id -> Bool
 isUnboxedSumBndr = isUnboxedSumType . idType
@@ -732,7 +736,7 @@ mkTuple :: [StgArg] -> StgExpr
 mkTuple args = StgConApp (tupleDataCon Unboxed (length args)) args (map stgArgType args)
 
 tagAltTy :: AltType
-tagAltTy = PrimAlt intPrimTyCon
+tagAltTy = PrimAlt IntRep
 
 tagTy :: Type
 tagTy = intPrimTy