    -----------------------------------------------------------------------------
    --
    -- Argument representations used in GHC.StgToCmm.Layout.
    --
    -- (c) The University of Glasgow 2013
    --
    -----------------------------------------------------------------------------

    {-# LANGUAGE LambdaCase #-}

    module GHC.StgToCmm.ArgRep (
            ArgRep(..), toArgRep, toArgRepOrV, argRepSizeW,

            argRepString, isNonV, idArgRep,

            slowCallPattern,

            ) where

    import GHC.Prelude
    import GHC.Platform

    import GHC.StgToCmm.Closure    ( idPrimRep1 )
    import GHC.Runtime.Heap.Layout ( WordOff )
    import GHC.Types.Id            ( Id )
    import GHC.Core.TyCon          ( PrimRep(..), PrimOrVoidRep(..), primElemRepSizeB )
    import GHC.Types.Basic         ( RepArity )
    import GHC.Settings.Constants  ( wORD64_SIZE, dOUBLE_SIZE )

    import GHC.Utils.Outputable
    import GHC.Data.FastString

    -- I extricated this code as this new module in order to avoid a
    -- cyclic dependency between GHC.StgToCmm.Layout and GHC.StgToCmm.Ticky.
    --
    -- NSF 18 Feb 2013

    -------------------------------------------------------------------------
    --      Classifying arguments: ArgRep
    -------------------------------------------------------------------------

    -- ArgRep is re-exported by GHC.StgToCmm.Layout, but only for use in the
    -- byte-code generator which also needs to know about the
    -- classification of arguments.

    data ArgRep = P   -- GC Ptr
                | N   -- Word-sized non-ptr
                | L   -- 64-bit non-ptr (long)
                | V   -- Void
                | F   -- Float
                | D   -- Double
                | V16 -- 16-byte (128-bit) vectors of Float/Double/Int8/Word32/etc.
                | V32 -- 32-byte (256-bit) vectors of Float/Double/Int8/Word32/etc.
                | V64 -- 64-byte (512-bit) vectors of Float/Double/Int8/Word32/etc.
                deriving ArgRep -> ArgRep -> Bool
    (ArgRep -> ArgRep -> Bool)
    -> (ArgRep -> ArgRep -> Bool) -> Eq ArgRep
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ArgRep -> ArgRep -> Bool
    == :: ArgRep -> ArgRep -> Bool
    $c/= :: ArgRep -> ArgRep -> Bool
    /= :: ArgRep -> ArgRep -> Bool
    Eq
    instance Outputable ArgRep where ppr :: ArgRep -> SDoc
    ppr = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String -> SDoc) -> (ArgRep -> String) -> ArgRep -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ArgRep -> String
    argRepString

    argRepString :: ArgRep -> String
    argRepString :: ArgRep -> String
    argRepString ArgRep
    P = String
    "P"
    argRepString ArgRep
    N = String
    "N"
    argRepString ArgRep
    L = String
    "L"
    argRepString ArgRep
    V = String
    "V"
    argRepString ArgRep
    F = String
    "F"
    argRepString ArgRep
    D = String
    "D"
    argRepString ArgRep
    V16 = String
    "V16"
    argRepString ArgRep
    V32 = String
    "V32"
    argRepString ArgRep
    V64 = String
    "V64"

    toArgRep :: Platform -> PrimRep -> ArgRep
    toArgRep :: Platform -> PrimRep -> ArgRep
    toArgRep Platform
    platform PrimRep
    rep = case PrimRep
    rep of
       BoxedRep Maybe Levity
    _        -> ArgRep
    P
       PrimRep
    IntRep            -> ArgRep
    N
       PrimRep
    WordRep           -> ArgRep
    N
       PrimRep
    Int8Rep           -> ArgRep
    N  -- Gets widened to native word width for calls
       PrimRep
    Word8Rep          -> ArgRep
    N  -- Gets widened to native word width for calls
       PrimRep
    Int16Rep          -> ArgRep
    N  -- Gets widened to native word width for calls
       PrimRep
    Word16Rep         -> ArgRep
    N  -- Gets widened to native word width for calls
       PrimRep
    Int32Rep          -> ArgRep
    N  -- Gets widened to native word width for calls
       PrimRep
    Word32Rep         -> ArgRep
    N  -- Gets widened to native word width for calls
       PrimRep
    AddrRep           -> ArgRep
    N
       PrimRep
    Int64Rep          -> case Platform -> PlatformWordSize
    platformWordSize Platform
    platform of
                               PlatformWordSize
    PW4 -> ArgRep
    L
                               PlatformWordSize
    PW8 -> ArgRep
    N
       PrimRep
    Word64Rep         -> case Platform -> PlatformWordSize
    platformWordSize Platform
    platform of
                               PlatformWordSize
    PW4 -> ArgRep
    L
                               PlatformWordSize
    PW8 -> ArgRep
    N
       PrimRep
    FloatRep          -> ArgRep
    F
       PrimRep
    DoubleRep         -> ArgRep
    D
       (VecRep WordOff
    len PrimElemRep
    elem) -> case WordOff
    lenWordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    *Platform -> PrimElemRep -> WordOff
    primElemRepSizeB Platform
    platform PrimElemRep
    elem of
                               WordOff
    16 -> ArgRep
    V16
                               WordOff
    32 -> ArgRep
    V32
                               WordOff
    64 -> ArgRep
    V64
                               WordOff
    _  -> String -> ArgRep
    forall a. HasCallStack => String -> a
    error String
    "toArgRep: bad vector primrep"

    toArgRepOrV :: Platform -> PrimOrVoidRep -> ArgRep
    toArgRepOrV :: Platform -> PrimOrVoidRep -> ArgRep
    toArgRepOrV Platform
    _ PrimOrVoidRep
    VoidRep = ArgRep
    V
    toArgRepOrV Platform
    platform (NVRep PrimRep
    rep) = Platform -> PrimRep -> ArgRep
    toArgRep Platform
    platform PrimRep
    rep

    isNonV :: ArgRep -> Bool
    isNonV :: ArgRep -> Bool
    isNonV ArgRep
    V = Bool
    False
    isNonV ArgRep
    _ = Bool
    True

    argRepSizeW :: Platform -> ArgRep -> WordOff -- Size in words
    argRepSizeW :: Platform -> ArgRep -> WordOff
    argRepSizeW Platform
    platform = \case
       ArgRep
    N   -> WordOff
    1
       ArgRep
    P   -> WordOff
    1
       ArgRep
    F   -> WordOff
    1
       ArgRep
    L   -> WordOff
    wORD64_SIZE WordOff -> WordOff -> WordOff
    forall a. Integral a => a -> a -> a
    `quot` WordOff
    ws
       ArgRep
    D   -> WordOff
    dOUBLE_SIZE WordOff -> WordOff -> WordOff
    forall a. Integral a => a -> a -> a
    `quot` WordOff
    ws
       ArgRep
    V   -> WordOff
    0
       ArgRep
    V16 -> WordOff
    16          WordOff -> WordOff -> WordOff
    forall a. Integral a => a -> a -> a
    `quot` WordOff
    ws
       ArgRep
    V32 -> WordOff
    32          WordOff -> WordOff -> WordOff
    forall a. Integral a => a -> a -> a
    `quot` WordOff
    ws
       ArgRep
    V64 -> WordOff
    64          WordOff -> WordOff -> WordOff
    forall a. Integral a => a -> a -> a
    `quot` WordOff
    ws
      where
       ws :: WordOff
    ws       = Platform -> WordOff
    platformWordSizeInBytes Platform
    platform

    idArgRep :: Platform -> Id -> ArgRep
    idArgRep :: Platform -> Id -> ArgRep
    idArgRep Platform
    platform = Platform -> PrimOrVoidRep -> ArgRep
    toArgRepOrV Platform
    platform (PrimOrVoidRep -> ArgRep) -> (Id -> PrimOrVoidRep) -> Id -> ArgRep
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> PrimOrVoidRep
    idPrimRep1

    -- This list of argument patterns should be kept in sync with at least
    -- the following:
    --
    --  * GHC.StgToCmm.Layout.stdPattern maybe to some degree?
    --
    --  * the RTS_RET(stg_ap_*) and RTS_FUN_DECL(stg_ap_*_fast)
    --  declarations in rts/include/stg/MiscClosures.h
    --
    --  * the SLOW_CALL_*_ctr declarations in rts/include/stg/Ticky.h,
    --
    --  * the TICK_SLOW_CALL_*() #defines in rts/include/Cmm.h,
    --
    --  * the PR_CTR(SLOW_CALL_*_ctr) calls in rts/Ticky.c,
    --
    --  * and the SymI_HasProto(stg_ap_*_{ret,info,fast}) calls and
    --  SymI_HasProto(SLOW_CALL_*_ctr) calls in rts/Linker.c
    --
    -- There may be more places that I haven't found; I merely igrep'd for
    -- pppppp and excluded things that seemed ghci-specific.
    --
    -- Also, it seems at the moment that ticky counters with void
    -- arguments will never be bumped, but I'm still declaring those
    -- counters, defensively.
    --
    -- NSF 6 Mar 2013

    slowCallPattern :: [ArgRep] -> (FastString, RepArity)
    -- Returns the generic apply function and arity
    --
    -- The first batch of cases match (some) specialised entries
    -- The last group deals exhaustively with the cases for the first argument
    --   (and the zero-argument case)
    --
    -- In 99% of cases this function will match *all* the arguments in one batch

    slowCallPattern :: [ArgRep] -> (FastString, WordOff)
    slowCallPattern (ArgRep
    P: ArgRep
    P: ArgRep
    P: ArgRep
    P: ArgRep
    P: ArgRep
    P: [ArgRep]
    _) = (String -> FastString
    fsLit String
    "stg_ap_pppppp", WordOff
    6)
    slowCallPattern (ArgRep
    P: ArgRep
    P: ArgRep
    P: ArgRep
    P: ArgRep
    P: [ArgRep]
    _)    = (String -> FastString
    fsLit String
    "stg_ap_ppppp", WordOff
    5)
    slowCallPattern (ArgRep
    P: ArgRep
    P: ArgRep
    P: ArgRep
    P: [ArgRep]
    _)       = (String -> FastString
    fsLit String
    "stg_ap_pppp", WordOff
    4)
    slowCallPattern (ArgRep
    P: ArgRep
    P: ArgRep
    P: ArgRep
    V: [ArgRep]
    _)       = (String -> FastString
    fsLit String
    "stg_ap_pppv", WordOff
    4)
    slowCallPattern (ArgRep
    P: ArgRep
    P: ArgRep
    P: [ArgRep]
    _)          = (String -> FastString
    fsLit String
    "stg_ap_ppp", WordOff
    3)
    slowCallPattern (ArgRep
    P: ArgRep
    P: ArgRep
    V: [ArgRep]
    _)          = (String -> FastString
    fsLit String
    "stg_ap_ppv", WordOff
    3)
    slowCallPattern (ArgRep
    P: ArgRep
    P: [ArgRep]
    _)             = (String -> FastString
    fsLit String
    "stg_ap_pp", WordOff
    2)
    slowCallPattern (ArgRep
    P: ArgRep
    V: [ArgRep]
    _)             = (String -> FastString
    fsLit String
    "stg_ap_pv", WordOff
    2)
    slowCallPattern (ArgRep
    P: [ArgRep]
    _)                = (String -> FastString
    fsLit String
    "stg_ap_p", WordOff
    1)
    slowCallPattern (ArgRep
    V: [ArgRep]
    _)                = (String -> FastString
    fsLit String
    "stg_ap_v", WordOff
    1)
    slowCallPattern (ArgRep
    N: [ArgRep]
    _)                = (String -> FastString
    fsLit String
    "stg_ap_n", WordOff
    1)
    slowCallPattern (ArgRep
    F: [ArgRep]
    _)                = (String -> FastString
    fsLit String
    "stg_ap_f", WordOff
    1)
    slowCallPattern (ArgRep
    D: [ArgRep]
    _)                = (String -> FastString
    fsLit String
    "stg_ap_d", WordOff
    1)
    slowCallPattern (ArgRep
    L: [ArgRep]
    _)                = (String -> FastString
    fsLit String
    "stg_ap_l", WordOff
    1)
    slowCallPattern (ArgRep
    V16: [ArgRep]
    _)              = (String -> FastString
    fsLit String
    "stg_ap_v16", WordOff
    1)
    slowCallPattern (ArgRep
    V32: [ArgRep]
    _)              = (String -> FastString
    fsLit String
    "stg_ap_v32", WordOff
    1)
    slowCallPattern (ArgRep
    V64: [ArgRep]
    _)              = (String -> FastString
    fsLit String
    "stg_ap_v64", WordOff
    1)
    slowCallPattern []                    = (String -> FastString
    fsLit String
    "stg_ap_0", WordOff
    0)