{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}
--
--  (c) The University of Glasgow 2002-2006
--

-- | Generate infotables for interpreter-made bytecodes
module GHC.ByteCode.InfoTable ( mkITbls ) where

import GHC.Prelude

import GHC.Platform
import GHC.Platform.Profile

import GHCi.Message

import GHC.Types.Name       ( Name, getName )
import GHC.Types.RepType

import GHC.Core.DataCon     ( DataCon, dataConRepArgTys, dataConIdentity )
import GHC.Core.TyCon       ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
import GHC.Core.Multiplicity     ( scaledThing )

import GHC.StgToCmm.Layout  ( mkVirtConstrSizes )
import GHC.StgToCmm.Closure ( tagForCon )

import GHC.Utils.Misc
import GHC.Utils.Panic

{-
  Manufacturing of info tables for DataCons
-}

-- Make info tables for the data decls in this module
mkITbls :: Profile -> [TyCon] -> [(Name, ConInfoTable)]
mkITbls :: Profile -> [TyCon] -> [(Name, ConInfoTable)]
mkITbls Profile
profile [TyCon]
tcs = (TyCon -> [(Name, ConInfoTable)])
-> [TyCon] -> [(Name, ConInfoTable)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyCon -> [(Name, ConInfoTable)]
mkITbl ((TyCon -> Bool) -> [TyCon] -> [TyCon]
forall a. (a -> Bool) -> [a] -> [a]
filter TyCon -> Bool
isDataTyCon [TyCon]
tcs)
 where
  mkITbl :: TyCon -> [(Name, ConInfoTable)]
  mkITbl :: TyCon -> [(Name, ConInfoTable)]
mkITbl TyCon
tc
    | [DataCon]
dcs [DataCon] -> WordOff -> Bool
forall a. [a] -> WordOff -> Bool
`lengthIs` WordOff
n -- paranoia; this is an assertion.
    = Profile -> [DataCon] -> [(Name, ConInfoTable)]
make_constr_itbls Profile
profile [DataCon]
dcs
       where
          dcs :: [DataCon]
dcs = TyCon -> [DataCon]
tyConDataCons TyCon
tc
          n :: WordOff
n   = TyCon -> WordOff
tyConFamilySize TyCon
tc
  mkITbl TyCon
_ = String -> [(Name, ConInfoTable)]
forall a. HasCallStack => String -> a
panic String
"mkITbl"

-- Assumes constructors are numbered from zero, not one
make_constr_itbls :: Profile -> [DataCon] -> [(Name, ConInfoTable)]
make_constr_itbls :: Profile -> [DataCon] -> [(Name, ConInfoTable)]
make_constr_itbls Profile
profile [DataCon]
cons =
  -- TODO: the profile should be bundled with the interpreter: the rts ways are
  -- fixed for an interpreter
  ((DataCon, WordOff) -> (Name, ConInfoTable))
-> [(DataCon, WordOff)] -> [(Name, ConInfoTable)]
forall a b. (a -> b) -> [a] -> [b]
map ((DataCon -> WordOff -> (Name, ConInfoTable))
-> (DataCon, WordOff) -> (Name, ConInfoTable)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DataCon -> WordOff -> (Name, ConInfoTable)
mk_itbl) ([DataCon] -> [WordOff] -> [(DataCon, WordOff)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DataCon]
cons [WordOff
0..])
  where
    mk_itbl :: DataCon -> Int -> (Name, ConInfoTable)
    mk_itbl :: DataCon -> WordOff -> (Name, ConInfoTable)
mk_itbl DataCon
dcon WordOff
conNo =
      ( DataCon -> Name
forall a. NamedThing a => a -> Name
getName DataCon
dcon,
        Bool
-> WordOff
-> WordOff
-> WordOff
-> WordOff
-> ByteString
-> ConInfoTable
ConInfoTable
          Bool
tables_next_to_code
          WordOff
ptrs'
          WordOff
nptrs_really
          WordOff
conNo
          (Platform -> DataCon -> WordOff
tagForCon Platform
platform DataCon
dcon)
          ByteString
descr
      )
      where
         rep_args :: [PrimRep]
rep_args = [ PrimRep
prim_rep
                    | Scaled Type
arg <- DataCon -> [Scaled Type]
dataConRepArgTys DataCon
dcon
                    , PrimRep
prim_rep <- HasDebugCallStack => Type -> [PrimRep]
Type -> [PrimRep]
typePrimRep (Scaled Type -> Type
forall a. Scaled a -> a
scaledThing Scaled Type
arg) ]

         (WordOff
tot_wds, WordOff
ptr_wds) =
             Profile -> [PrimRep] -> (WordOff, WordOff)
mkVirtConstrSizes Profile
profile [PrimRep]
rep_args

         ptrs' :: WordOff
ptrs'  = WordOff
ptr_wds
         nptrs' :: WordOff
nptrs' = WordOff
tot_wds WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
- WordOff
ptr_wds
         nptrs_really :: WordOff
nptrs_really
            | WordOff
ptrs' WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
+ WordOff
nptrs' WordOff -> WordOff -> Bool
forall a. Ord a => a -> a -> Bool
>= PlatformConstants -> WordOff
pc_MIN_PAYLOAD_SIZE PlatformConstants
constants = WordOff
nptrs'
            | Bool
otherwise = PlatformConstants -> WordOff
pc_MIN_PAYLOAD_SIZE PlatformConstants
constants WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
- WordOff
ptrs'

         descr :: ByteString
descr = DataCon -> ByteString
dataConIdentity DataCon
dcon

         platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
         constants :: PlatformConstants
constants = Platform -> PlatformConstants
platformConstants Platform
platform
         tables_next_to_code :: Bool
tables_next_to_code = Platform -> Bool
platformTablesNextToCode Platform
platform