module GHC.StgToCmm.ArgRep (
ArgRep(..), toArgRep, argRepSizeW,
argRepString, isNonV, idArgRep,
slowCallPattern,
) where
import GHC.Prelude
import GHC.Platform
import GHC.StgToCmm.Closure ( idPrimRep )
import GHC.Runtime.Heap.Layout ( WordOff )
import GHC.Types.Id ( Id )
import GHC.Core.TyCon ( PrimRep(..), primElemRepSizeB )
import GHC.Types.Basic ( RepArity )
import GHC.Settings.Constants ( wORD64_SIZE, dOUBLE_SIZE )
import GHC.Utils.Outputable
import GHC.Data.FastString
data ArgRep = P
| N
| L
| V
| F
| D
| V16
| V32
| V64
instance Outputable ArgRep where ppr = text . argRepString
argRepString :: ArgRep -> String
argRepString P = "P"
argRepString N = "N"
argRepString L = "L"
argRepString V = "V"
argRepString F = "F"
argRepString D = "D"
argRepString V16 = "V16"
argRepString V32 = "V32"
argRepString V64 = "V64"
toArgRep :: PrimRep -> ArgRep
toArgRep VoidRep = V
toArgRep LiftedRep = P
toArgRep UnliftedRep = P
toArgRep IntRep = N
toArgRep WordRep = N
toArgRep Int8Rep = N
toArgRep Word8Rep = N
toArgRep Int16Rep = N
toArgRep Word16Rep = N
toArgRep Int32Rep = N
toArgRep Word32Rep = N
toArgRep AddrRep = N
toArgRep Int64Rep = L
toArgRep Word64Rep = L
toArgRep FloatRep = F
toArgRep DoubleRep = D
toArgRep (VecRep len elem) = case len*primElemRepSizeB elem of
16 -> V16
32 -> V32
64 -> V64
_ -> error "toArgRep: bad vector primrep"
isNonV :: ArgRep -> Bool
isNonV V = False
isNonV _ = True
argRepSizeW :: Platform -> ArgRep -> WordOff
argRepSizeW platform = \case
N -> 1
P -> 1
F -> 1
L -> wORD64_SIZE `quot` ws
D -> dOUBLE_SIZE `quot` ws
V -> 0
V16 -> 16 `quot` ws
V32 -> 32 `quot` ws
V64 -> 64 `quot` ws
where
ws = platformWordSizeInBytes platform
idArgRep :: Id -> ArgRep
idArgRep = toArgRep . idPrimRep
slowCallPattern :: [ArgRep] -> (FastString, RepArity)
slowCallPattern (P: P: P: P: P: P: _) = (fsLit "stg_ap_pppppp", 6)
slowCallPattern (P: P: P: P: P: _) = (fsLit "stg_ap_ppppp", 5)
slowCallPattern (P: P: P: P: _) = (fsLit "stg_ap_pppp", 4)
slowCallPattern (P: P: P: V: _) = (fsLit "stg_ap_pppv", 4)
slowCallPattern (P: P: P: _) = (fsLit "stg_ap_ppp", 3)
slowCallPattern (P: P: V: _) = (fsLit "stg_ap_ppv", 3)
slowCallPattern (P: P: _) = (fsLit "stg_ap_pp", 2)
slowCallPattern (P: V: _) = (fsLit "stg_ap_pv", 2)
slowCallPattern (P: _) = (fsLit "stg_ap_p", 1)
slowCallPattern (V: _) = (fsLit "stg_ap_v", 1)
slowCallPattern (N: _) = (fsLit "stg_ap_n", 1)
slowCallPattern (F: _) = (fsLit "stg_ap_f", 1)
slowCallPattern (D: _) = (fsLit "stg_ap_d", 1)
slowCallPattern (L: _) = (fsLit "stg_ap_l", 1)
slowCallPattern (V16: _) = (fsLit "stg_ap_v16", 1)
slowCallPattern (V32: _) = (fsLit "stg_ap_v32", 1)
slowCallPattern (V64: _) = (fsLit "stg_ap_v64", 1)
slowCallPattern [] = (fsLit "stg_ap_0", 0)