{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------
--
-- Stg to C--: code generation for constructors
--
-- This module provides the support code for StgToCmm to deal with
-- constructors on the RHSs of let(rec)s.
--
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------

module GHC.StgToCmm.DataCon (
        cgTopRhsCon, buildDynCon, bindConArgs
    ) where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Platform
import GHC.Platform.Profile

import GHC.Stg.Syntax
import GHC.Core  ( AltCon(..) )

import GHC.StgToCmm.Monad
import GHC.StgToCmm.Env
import GHC.StgToCmm.Heap
import GHC.StgToCmm.Layout
import GHC.StgToCmm.Utils
import GHC.StgToCmm.Closure

import GHC.Cmm.Expr
import GHC.Cmm.Utils
import GHC.Cmm.CLabel
import GHC.Cmm.Graph
import GHC.Runtime.Heap.Layout
import GHC.Types.CostCentre
import GHC.Unit
import GHC.Core.DataCon
import GHC.Driver.Session
import GHC.Data.FastString
import GHC.Types.Id
import GHC.Types.Id.Info( CafInfo( NoCafRefs ) )
import GHC.Types.Name (isInternalName)
import GHC.Types.RepType (countConRepArgs)
import GHC.Types.Literal
import GHC.Builtin.Utils
import GHC.Utils.Panic
import GHC.Utils.Misc
import GHC.Utils.Monad (mapMaybeM)

import Control.Monad
import Data.Char

---------------------------------------------------------------
--      Top-level constructors
---------------------------------------------------------------

cgTopRhsCon :: DynFlags
            -> Id               -- Name of thing bound to this RHS
            -> DataCon          -- Id
            -> ConstructorNumber
            -> [NonVoid StgArg] -- Args
            -> (CgIdInfo, FCode ())
cgTopRhsCon :: DynFlags
-> Id
-> DataCon
-> ConstructorNumber
-> [NonVoid StgArg]
-> (CgIdInfo, FCode ())
cgTopRhsCon DynFlags
dflags Id
id DataCon
con ConstructorNumber
mn [NonVoid StgArg]
args
  | Just CgIdInfo
static_info <- DynFlags -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo
precomputedStaticConInfo_maybe DynFlags
dflags Id
id DataCon
con [NonVoid StgArg]
args
  , let static_code :: FCode ()
static_code | Name -> Bool
isInternalName Name
name = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    | Bool
otherwise           = FCode ()
gen_code
  = -- There is a pre-allocated static closure available; use it
    -- See Note [Precomputed static closures].
    -- For External bindings we must keep the binding,
    -- since importing modules will refer to it by name;
    -- but for Internal ones we can drop it altogether
    -- See Note [About the NameSorts] in "GHC.Types.Name" for Internal/External
    (CgIdInfo
static_info, FCode ()
static_code)

  -- Otherwise generate a closure for the constructor.
  | Bool
otherwise
  = (CgIdInfo
id_Info, FCode ()
gen_code)

  where
   platform :: Platform
platform      = DynFlags -> Platform
targetPlatform DynFlags
dflags
   id_Info :: CgIdInfo
id_Info       = Platform -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
litIdInfo Platform
platform Id
id (DataCon -> LambdaFormInfo
mkConLFInfo DataCon
con) (CLabel -> CmmLit
CmmLabel CLabel
closure_label)
   name :: Name
name          = Id -> Name
idName Id
id
   caffy :: CafInfo
caffy         = Id -> CafInfo
idCafInfo Id
id -- any stgArgHasCafRefs args
   closure_label :: CLabel
closure_label = Name -> CafInfo -> CLabel
mkClosureLabel Name
name CafInfo
caffy

   gen_code :: FCode ()
gen_code =
     do { Profile
profile <- FCode Profile
getProfile
        ; Module
this_mod <- FCode Module
getModuleName
        ; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Platform -> OS
platformOS Platform
platform forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32) forall a b. (a -> b) -> a -> b
$
              -- Windows DLLs have a problem with static cross-DLL refs.
              MASSERT( not (isDllConApp dflags this_mod con (map fromNonVoid args)) )
        ; ASSERT( args `lengthIs` countConRepArgs con ) return ()

        -- LAY IT OUT
        ; let
            (Int
tot_wds, --  #ptr_wds + #nonptr_wds
             Int
ptr_wds, --  #ptr_wds
             [FieldOffOrPadding StgArg]
nv_args_w_offsets) =
                 forall a.
Profile
-> ClosureHeader
-> [NonVoid (PrimRep, a)]
-> (Int, Int, [FieldOffOrPadding a])
mkVirtHeapOffsetsWithPadding Profile
profile ClosureHeader
StdHeader ([NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)]
addArgReps [NonVoid StgArg]
args)

        ; let
            -- Decompose padding into units of length 8, 4, 2, or 1 bytes to
            -- allow the implementation of mk_payload to use widthFromBytes,
            -- which only handles these cases.
            fix_padding :: [FieldOffOrPadding a] -> [FieldOffOrPadding a]
fix_padding (x :: FieldOffOrPadding a
x@(Padding Int
n Int
off) : [FieldOffOrPadding a]
rest)
              | Int
n forall a. Eq a => a -> a -> Bool
== Int
0                 = [FieldOffOrPadding a] -> [FieldOffOrPadding a]
fix_padding [FieldOffOrPadding a]
rest
              | Int
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1,Int
2,Int
4,Int
8]     = FieldOffOrPadding a
x forall a. a -> [a] -> [a]
: [FieldOffOrPadding a] -> [FieldOffOrPadding a]
fix_padding [FieldOffOrPadding a]
rest
              | Int
n forall a. Ord a => a -> a -> Bool
> Int
8                  = Int -> [FieldOffOrPadding a]
add_pad Int
8
              | Int
n forall a. Ord a => a -> a -> Bool
> Int
4                  = Int -> [FieldOffOrPadding a]
add_pad Int
4
              | Int
n forall a. Ord a => a -> a -> Bool
> Int
2                  = Int -> [FieldOffOrPadding a]
add_pad Int
2
              | Bool
otherwise              = Int -> [FieldOffOrPadding a]
add_pad Int
1
              where add_pad :: Int -> [FieldOffOrPadding a]
add_pad Int
m = forall a. Int -> Int -> FieldOffOrPadding a
Padding Int
m Int
off forall a. a -> [a] -> [a]
: [FieldOffOrPadding a] -> [FieldOffOrPadding a]
fix_padding (forall a. Int -> Int -> FieldOffOrPadding a
Padding (Int
nforall a. Num a => a -> a -> a
-Int
m) (Int
offforall a. Num a => a -> a -> a
+Int
m) forall a. a -> [a] -> [a]
: [FieldOffOrPadding a]
rest)
            fix_padding (FieldOffOrPadding a
x : [FieldOffOrPadding a]
rest)     = FieldOffOrPadding a
x forall a. a -> [a] -> [a]
: [FieldOffOrPadding a] -> [FieldOffOrPadding a]
fix_padding [FieldOffOrPadding a]
rest
            fix_padding []             = []

            mk_payload :: FieldOffOrPadding StgArg -> FCode CmmLit
mk_payload (Padding Int
len Int
_) = forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Width -> CmmLit
CmmInt Integer
0 (Int -> Width
widthFromBytes Int
len))
            mk_payload (FieldOff NonVoid StgArg
arg Int
_) = do
                CmmExpr
amode <- NonVoid StgArg -> FCode CmmExpr
getArgAmode NonVoid StgArg
arg
                case CmmExpr
amode of
                  CmmLit CmmLit
lit -> forall (m :: * -> *) a. Monad m => a -> m a
return CmmLit
lit
                  CmmExpr
_          -> forall a. String -> a
panic String
"GHC.StgToCmm.DataCon.cgTopRhsCon"

            nonptr_wds :: Int
nonptr_wds = Int
tot_wds forall a. Num a => a -> a -> a
- Int
ptr_wds

             -- we're not really going to emit an info table, so having
             -- to make a CmmInfoTable is a bit overkill, but mkStaticClosureFields
             -- needs to poke around inside it.
            info_tbl :: CmmInfoTable
info_tbl = Profile
-> DataCon
-> ConInfoTableLocation
-> Bool
-> Int
-> Int
-> CmmInfoTable
mkDataConInfoTable Profile
profile DataCon
con (Module -> ConstructorNumber -> ConInfoTableLocation
addModuleLoc Module
this_mod ConstructorNumber
mn) Bool
True Int
ptr_wds Int
nonptr_wds


        ; [CmmLit]
payload <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FieldOffOrPadding StgArg -> FCode CmmLit
mk_payload (forall {a}. [FieldOffOrPadding a] -> [FieldOffOrPadding a]
fix_padding [FieldOffOrPadding StgArg]
nv_args_w_offsets)
                -- NB1: nv_args_w_offsets is sorted into ptrs then non-ptrs
                -- NB2: all the amodes should be Lits!
                --      TODO (osa): Why?

                -- BUILD THE OBJECT
                --
            -- We're generating info tables, so we don't know and care about
            -- what the actual arguments are. Using () here as the place holder.

        ; CLabel -> CmmInfoTable -> CostCentreStack -> [CmmLit] -> FCode ()
emitDataCon CLabel
closure_label CmmInfoTable
info_tbl CostCentreStack
dontCareCCS [CmmLit]
payload }

addModuleLoc :: Module -> ConstructorNumber -> ConInfoTableLocation
addModuleLoc :: Module -> ConstructorNumber -> ConInfoTableLocation
addModuleLoc Module
this_mod ConstructorNumber
mn = do
  case ConstructorNumber
mn of
    ConstructorNumber
NoNumber -> ConInfoTableLocation
DefinitionSite
    Numbered Int
n -> Module -> Int -> ConInfoTableLocation
UsageSite Module
this_mod Int
n

---------------------------------------------------------------
--      Lay out and allocate non-top-level constructors
---------------------------------------------------------------

buildDynCon :: Id                 -- Name of the thing to which this constr will
                                  -- be bound
            -> ConstructorNumber
            -> Bool               -- is it genuinely bound to that name, or just
                                  -- for profiling?
            -> CostCentreStack    -- Where to grab cost centre from;
                                  -- current CCS if currentOrSubsumedCCS
            -> DataCon            -- The data constructor
            -> [NonVoid StgArg]   -- Its args
            -> FCode (CgIdInfo, FCode CmmAGraph)
               -- Return details about how to find it and initialization code
buildDynCon :: Id
-> ConstructorNumber
-> Bool
-> CostCentreStack
-> DataCon
-> [NonVoid StgArg]
-> FCode (CgIdInfo, FCode CmmAGraph)
buildDynCon Id
binder ConstructorNumber
mn Bool
actually_bound CostCentreStack
cc DataCon
con [NonVoid StgArg]
args
    = do DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
         DynFlags
-> Id
-> ConstructorNumber
-> Bool
-> CostCentreStack
-> DataCon
-> [NonVoid StgArg]
-> FCode (CgIdInfo, FCode CmmAGraph)
buildDynCon' DynFlags
dflags Id
binder ConstructorNumber
mn Bool
actually_bound CostCentreStack
cc DataCon
con [NonVoid StgArg]
args


buildDynCon' :: DynFlags
             -> Id -> ConstructorNumber
             -> Bool
             -> CostCentreStack
             -> DataCon
             -> [NonVoid StgArg]
             -> FCode (CgIdInfo, FCode CmmAGraph)

{- We used to pass a boolean indicating whether all the
args were of size zero, so we could use a static
constructor; but I concluded that it just isn't worth it.
Now I/O uses unboxed tuples there just aren't any constructors
with all size-zero args.

The reason for having a separate argument, rather than looking at
the addr modes of the args is that we may be in a "knot", and
premature looking at the args will cause the compiler to black-hole!
-}

buildDynCon' :: DynFlags
-> Id
-> ConstructorNumber
-> Bool
-> CostCentreStack
-> DataCon
-> [NonVoid StgArg]
-> FCode (CgIdInfo, FCode CmmAGraph)
buildDynCon' DynFlags
dflags Id
binder ConstructorNumber
_ Bool
_ CostCentreStack
_cc DataCon
con [NonVoid StgArg]
args
  | Just CgIdInfo
cgInfo <- DynFlags -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo
precomputedStaticConInfo_maybe DynFlags
dflags Id
binder DataCon
con [NonVoid StgArg]
args
  -- , pprTrace "noCodeLocal:" (ppr (binder,con,args,cgInfo)) True
  = forall (m :: * -> *) a. Monad m => a -> m a
return (CgIdInfo
cgInfo, forall (m :: * -> *) a. Monad m => a -> m a
return CmmAGraph
mkNop)

-------- buildDynCon': the general case -----------
buildDynCon' DynFlags
_ Id
binder ConstructorNumber
mn Bool
actually_bound CostCentreStack
ccs DataCon
con [NonVoid StgArg]
args
  = do  { (CgIdInfo
id_info, LocalReg
reg) <- Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg)
rhsIdInfo Id
binder LambdaFormInfo
lf_info
        ; forall (m :: * -> *) a. Monad m => a -> m a
return (CgIdInfo
id_info, LocalReg -> FCode CmmAGraph
gen_code LocalReg
reg)
        }
 where
  lf_info :: LambdaFormInfo
lf_info = DataCon -> LambdaFormInfo
mkConLFInfo DataCon
con

  gen_code :: LocalReg -> FCode CmmAGraph
gen_code LocalReg
reg
    = do  { Module
modu <- FCode Module
getModuleName
          ; Profile
profile <- FCode Profile
getProfile
          ; let platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
                (Int
tot_wds, Int
ptr_wds, [(NonVoid StgArg, Int)]
args_w_offsets)
                   = forall a.
Profile -> [NonVoid (PrimRep, a)] -> (Int, Int, [(NonVoid a, Int)])
mkVirtConstrOffsets Profile
profile ([NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)]
addArgReps [NonVoid StgArg]
args)
                nonptr_wds :: Int
nonptr_wds = Int
tot_wds forall a. Num a => a -> a -> a
- Int
ptr_wds
                info_tbl :: CmmInfoTable
info_tbl = Profile
-> DataCon
-> ConInfoTableLocation
-> Bool
-> Int
-> Int
-> CmmInfoTable
mkDataConInfoTable Profile
profile DataCon
con (Module -> ConstructorNumber -> ConInfoTableLocation
addModuleLoc Module
modu ConstructorNumber
mn) Bool
False
                                Int
ptr_wds Int
nonptr_wds
          ; let ticky_name :: Maybe Id
ticky_name | Bool
actually_bound = forall a. a -> Maybe a
Just Id
binder
                           | Bool
otherwise = forall a. Maybe a
Nothing

          ; CmmExpr
hp_plus_n <- Maybe Id
-> CmmInfoTable
-> LambdaFormInfo
-> CmmExpr
-> CmmExpr
-> [(NonVoid StgArg, Int)]
-> FCode CmmExpr
allocDynClosure Maybe Id
ticky_name CmmInfoTable
info_tbl LambdaFormInfo
lf_info
                                          CmmExpr
use_cc CmmExpr
blame_cc [(NonVoid StgArg, Int)]
args_w_offsets
          ; forall (m :: * -> *) a. Monad m => a -> m a
return (Platform -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph
mkRhsInit Platform
platform LocalReg
reg LambdaFormInfo
lf_info CmmExpr
hp_plus_n) }
    where
      use_cc :: CmmExpr
use_cc      -- cost-centre to stick in the object
        | CostCentreStack -> Bool
isCurrentCCS CostCentreStack
ccs = CmmExpr
cccsExpr
        | Bool
otherwise        = forall a. String -> a
panic String
"buildDynCon: non-current CCS not implemented"

      blame_cc :: CmmExpr
blame_cc = CmmExpr
use_cc -- cost-centre on which to blame the alloc (same)

{- Note [Precomputed static closures]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

For Char/Int closures there are some value closures
built into the RTS. This is the case for all values in
the range mINT_INTLIKE .. mAX_INTLIKE (or CHARLIKE).
See Note [CHARLIKE and INTLIKE closures.] in the RTS code.

Similarly zero-arity constructors have a closure
in their defining Module we can use.

If possible we prefer to refer to those existing
closure instead of building new ones.

This is true at compile time where we do this replacement
in this module.
But also at runtime where the GC does the same (but only for
INT/CHAR closures).

`precomputedStaticConInfo_maybe` checks if a given constructor application
can be replaced with a reference to a existing static closure.

If so the code will reference the existing closure when accessing
the binding.
Unless the binding is visible to other modules we also generate
no code for the binding itself. We can do this since then we can
always reference the existing closure.

See Note [About the NameSorts] for the definition of external names.
For external bindings we must still generate a closure,
but won't use it inside this module.
This can sometimes reduce cache pressure. Since:
* If somebody uses the exported binding:
  + This module will reference the existing closure.
  + GC will reference the existing closure.
  + The importing module will reference the built closure.
* If nobody uses the exported binding:
  + This module will reference the RTS closures.
  + GC references the RTS closures

In the later case we avoided loading the built closure into the cache which
is what we optimize for here.

Consider this example using Ints.

    module M(externalInt, foo, bar) where

    externalInt = 1 :: Int
    internalInt = 1 :: Int
    { -# NOINLINE foo #- }
    foo = Just internalInt :: Maybe Int
    bar = Just externalInt

    ==================== STG: ====================
    externalInt = I#! [1#];

    bar = Just! [externalInt];

    internalInt_rc = I#! [2#];

    foo = Just! [internalInt_rc];

For externally visible bindings we must generate closures
since those may be referenced by their symbol `<name>_closure`
when imported.

`externalInt` is visible to other modules so we generate a closure:

    [section ""data" . M.externalInt_closure" {
        M.externalInt_closure:
            const GHC.Types.I#_con_info;
            const 1;
    }]

It will be referenced inside this module via `M.externalInt_closure+1`

`internalInt` is however a internal name. As such we generate no code for
it. References to it are replaced with references to the static closure as
we can see in the closure built for `foo`:

    [section ""data" . M.foo_closure" {
        M.foo_closure:
            const GHC.Maybe.Just_con_info;
            const stg_INTLIKE_closure+289; // == I# 2
            const 3;
    }]

This holds for both local and top level bindings.

We don't support this optimization when compiling into Windows DLLs yet
because they don't support cross package data references well.
-}

-- (precomputedStaticConInfo_maybe dflags id con args)
--     returns (Just cg_id_info)
-- if there is a precomputed static closure for (con args).
-- In that case, cg_id_info addresses it.
-- See Note [Precomputed static closures]
precomputedStaticConInfo_maybe :: DynFlags -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo
precomputedStaticConInfo_maybe :: DynFlags -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo
precomputedStaticConInfo_maybe DynFlags
dflags Id
binder DataCon
con []
-- Nullary constructors
  | DataCon -> Bool
isNullaryRepDataCon DataCon
con
  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Platform -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
litIdInfo (DynFlags -> Platform
targetPlatform DynFlags
dflags) Id
binder (DataCon -> LambdaFormInfo
mkConLFInfo DataCon
con)
                (CLabel -> CmmLit
CmmLabel (Name -> CafInfo -> CLabel
mkClosureLabel (DataCon -> Name
dataConName DataCon
con) CafInfo
NoCafRefs))
precomputedStaticConInfo_maybe DynFlags
dflags Id
binder DataCon
con [NonVoid StgArg
arg]
  -- Int/Char values with existing closures in the RTS
  | Bool
intClosure Bool -> Bool -> Bool
|| Bool
charClosure
  , Platform -> OS
platformOS Platform
platform forall a. Eq a => a -> a -> Bool
/= OS
OSMinGW32 Bool -> Bool -> Bool
|| Bool -> Bool
not (DynFlags -> Bool
positionIndependent DynFlags
dflags)
  , Just Integer
val <- NonVoid StgArg -> Maybe Integer
getClosurePayload NonVoid StgArg
arg
  , Integer -> Bool
inRange Integer
val
  = let intlike_lbl :: CLabel
intlike_lbl   = UnitId -> FastString -> CLabel
mkCmmClosureLabel UnitId
rtsUnitId (String -> FastString
fsLit String
label)
        val_int :: Int
val_int = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
val :: Int
        offsetW :: Int
offsetW = (Int
val_int forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
min_static_range)) forall a. Num a => a -> a -> a
* (Profile -> Int
fixedHdrSizeW Profile
profile forall a. Num a => a -> a -> a
+ Int
1)
                -- INTLIKE/CHARLIKE closures consist of a header and one word payload
        static_amode :: CmmLit
static_amode = Platform -> CLabel -> Int -> CmmLit
cmmLabelOffW Platform
platform CLabel
intlike_lbl Int
offsetW
    in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Platform -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
litIdInfo Platform
platform Id
binder (DataCon -> LambdaFormInfo
mkConLFInfo DataCon
con) CmmLit
static_amode
  where
    profile :: Profile
profile = DynFlags -> Profile
targetProfile DynFlags
dflags
    platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
    intClosure :: Bool
intClosure = DataCon -> Bool
maybeIntLikeCon DataCon
con
    charClosure :: Bool
charClosure = DataCon -> Bool
maybeCharLikeCon DataCon
con
    getClosurePayload :: NonVoid StgArg -> Maybe Integer
getClosurePayload (NonVoid (StgLitArg (LitNumber LitNumType
LitNumInt Integer
val))) = forall a. a -> Maybe a
Just Integer
val
    getClosurePayload (NonVoid (StgLitArg (LitChar Char
val))) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord forall a b. (a -> b) -> a -> b
$ Char
val)
    getClosurePayload NonVoid StgArg
_ = forall a. Maybe a
Nothing
    -- Avoid over/underflow by comparisons at type Integer!
    inRange :: Integer -> Bool
    inRange :: Integer -> Bool
inRange Integer
val
      = Integer
val forall a. Ord a => a -> a -> Bool
>= Integer
min_static_range Bool -> Bool -> Bool
&& Integer
val forall a. Ord a => a -> a -> Bool
<= Integer
max_static_range

    constants :: PlatformConstants
constants = Platform -> PlatformConstants
platformConstants Platform
platform

    min_static_range :: Integer
    min_static_range :: Integer
min_static_range
      | Bool
intClosure = forall a b. (Integral a, Num b) => a -> b
fromIntegral (PlatformConstants -> Int
pc_MIN_INTLIKE PlatformConstants
constants)
      | Bool
charClosure = forall a b. (Integral a, Num b) => a -> b
fromIntegral (PlatformConstants -> Int
pc_MIN_CHARLIKE PlatformConstants
constants)
      | Bool
otherwise = forall a. String -> a
panic String
"precomputedStaticConInfo_maybe: Unknown closure type"
    max_static_range :: Integer
max_static_range
      | Bool
intClosure = forall a b. (Integral a, Num b) => a -> b
fromIntegral (PlatformConstants -> Int
pc_MAX_INTLIKE PlatformConstants
constants)
      | Bool
charClosure = forall a b. (Integral a, Num b) => a -> b
fromIntegral (PlatformConstants -> Int
pc_MAX_CHARLIKE PlatformConstants
constants)
      | Bool
otherwise = forall a. String -> a
panic String
"precomputedStaticConInfo_maybe: Unknown closure type"
    label :: String
label
      | Bool
intClosure = String
"stg_INTLIKE"
      | Bool
charClosure =  String
"stg_CHARLIKE"
      | Bool
otherwise = forall a. String -> a
panic String
"precomputedStaticConInfo_maybe: Unknown closure type"

precomputedStaticConInfo_maybe DynFlags
_ Id
_ DataCon
_ [NonVoid StgArg]
_ = forall a. Maybe a
Nothing

---------------------------------------------------------------
--      Binding constructor arguments
---------------------------------------------------------------

bindConArgs :: AltCon -> LocalReg -> [NonVoid Id] -> FCode [LocalReg]
-- bindConArgs is called from cgAlt of a case
-- (bindConArgs con args) augments the environment with bindings for the
-- binders args, assuming that we have just returned from a 'case' which
-- found a con
bindConArgs :: AltCon -> LocalReg -> [NonVoid Id] -> FCode [LocalReg]
bindConArgs (DataAlt DataCon
con) LocalReg
base [NonVoid Id]
args
  = ASSERT(not (isUnboxedTupleDataCon con))
    do Profile
profile <- FCode Profile
getProfile
       Platform
platform <- FCode Platform
getPlatform
       let (Int
_, Int
_, [(NonVoid Id, Int)]
args_w_offsets) = forall a.
Profile -> [NonVoid (PrimRep, a)] -> (Int, Int, [(NonVoid a, Int)])
mkVirtConstrOffsets Profile
profile ([NonVoid Id] -> [NonVoid (PrimRep, Id)]
addIdReps [NonVoid Id]
args)
           tag :: Int
tag = Platform -> DataCon -> Int
tagForCon Platform
platform DataCon
con

           -- The binding below forces the masking out of the tag bits
           -- when accessing the constructor field.
           bind_arg :: (NonVoid Id, ByteOff) -> FCode (Maybe LocalReg)
           bind_arg :: (NonVoid Id, Int) -> FCode (Maybe LocalReg)
bind_arg (arg :: NonVoid Id
arg@(NonVoid Id
b), Int
offset)
             | Id -> Bool
isDeadBinder Id
b  -- See Note [Dead-binder optimisation] in GHC.StgToCmm.Expr
             = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
             | Bool
otherwise
             = do { CmmAGraph -> FCode ()
emit forall a b. (a -> b) -> a -> b
$ Platform -> LocalReg -> LocalReg -> Int -> Int -> CmmAGraph
mkTaggedObjectLoad Platform
platform (Platform -> NonVoid Id -> LocalReg
idToReg Platform
platform NonVoid Id
arg)
                                              LocalReg
base Int
offset Int
tag
                  ; forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonVoid Id -> FCode LocalReg
bindArgToReg NonVoid Id
arg }

       forall (m :: * -> *) a b.
Applicative m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (NonVoid Id, Int) -> FCode (Maybe LocalReg)
bind_arg [(NonVoid Id, Int)]
args_w_offsets

bindConArgs AltCon
_other_con LocalReg
_base [NonVoid Id]
args
  = ASSERT( null args ) return []