GHCi support for levity-polymorphic join points
[ghc.git] / compiler / simplStg / RepType.hs
index f59a854..522eeb1 100644 (file)
@@ -23,6 +23,8 @@ module RepType
 
 #include "HsVersions.h"
 
+import GhcPrelude
+
 import BasicTypes (Arity, RepArity)
 import DataCon
 import Outputable
@@ -35,7 +37,7 @@ import Util
 import TysPrim
 import {-# SOURCE #-} TysWiredIn ( anyTypeOfKind )
 
-import Data.List (foldl', sort)
+import Data.List (sort)
 import qualified Data.IntSet as IS
 
 {- **********************************************************************
@@ -62,7 +64,7 @@ isNvUnaryType ty
   = False
 
 -- INVARIANT: the result list is never empty.
-typePrimRepArgs :: Type -> [PrimRep]
+typePrimRepArgs :: HasDebugCallStack => Type -> [PrimRep]
 typePrimRepArgs ty
   | [] <- reps
   = [VoidRep]
@@ -155,7 +157,7 @@ ubxSumRepType constrs0
   -- 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
+  | constrs0 `lengthLessThan` 2
   = [WordSlot]
 
   | otherwise
@@ -226,6 +228,9 @@ layoutUbxSum sum_slots0 arg_slots0 =
 --   - Float slots: Shared between floating point types.
 --
 --   - Void slots: Shared between void types. Not used in sums.
+--
+-- TODO(michalt): We should probably introduce `SlotTy`s for 8-/16-/32-bit
+-- values, so that we can pack things more tightly.
 data SlotTy = PtrSlot | WordSlot | Word64Slot | FloatSlot | DoubleSlot
   deriving (Eq, Ord)
     -- Constructor order is important! If slot A could fit into slot B
@@ -253,8 +258,12 @@ primRepSlot VoidRep     = pprPanic "primRepSlot" (text "No slot for VoidRep")
 primRepSlot LiftedRep   = PtrSlot
 primRepSlot UnliftedRep = PtrSlot
 primRepSlot IntRep      = WordSlot
-primRepSlot WordRep     = WordSlot
+primRepSlot Int8Rep     = WordSlot
+primRepSlot Int16Rep    = WordSlot
 primRepSlot Int64Rep    = Word64Slot
+primRepSlot WordRep     = WordSlot
+primRepSlot Word8Rep    = WordSlot
+primRepSlot Word16Rep   = WordSlot
 primRepSlot Word64Rep   = Word64Slot
 primRepSlot AddrRep     = WordSlot
 primRepSlot FloatRep    = FloatSlot
@@ -335,7 +344,7 @@ tyConPrimRep1 tc = case tyConPrimRep tc of
 -- of values of types of this kind.
 kindPrimRep :: HasDebugCallStack => SDoc -> Kind -> [PrimRep]
 kindPrimRep doc ki
-  | Just ki' <- coreViewOneStarKind ki
+  | Just ki' <- coreView ki
   = kindPrimRep doc ki'
 kindPrimRep doc (TyConApp typ [runtime_rep])
   = ASSERT( typ `hasKey` tYPETyConKey )
@@ -343,10 +352,6 @@ kindPrimRep doc (TyConApp typ [runtime_rep])
 kindPrimRep doc ki
   = 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]