{-# LANGUAGE RecordWildCards, DeriveGeneric, GeneralizedNewtypeDeriving,
    BangPatterns, CPP #-}
module GHCi.ResolvedBCO
  ( ResolvedBCO(..)
  , ResolvedBCOPtr(..)
  , isLittleEndian
  ) where

import Prelude -- See note [Why do we import Prelude here?]
import SizedSeq
import GHCi.RemoteTypes
import GHCi.BreakArray

import Data.Array.Unboxed
import Data.Binary
import GHC.Generics
import GHCi.BinaryArray


#include "MachDeps.h"

isLittleEndian :: Bool
#if defined(WORDS_BIGENDIAN)
isLittleEndian = True
#else
isLittleEndian :: Bool
isLittleEndian = Bool
False
#endif

-- -----------------------------------------------------------------------------
-- ResolvedBCO

-- | A 'ResolvedBCO' is one in which all the 'Name' references have been
-- resolved to actual addresses or 'RemoteHValues'.
--
-- Note, all arrays are zero-indexed (we assume this when
-- serializing/deserializing)
data ResolvedBCO
   = ResolvedBCO {
        ResolvedBCO -> Bool
resolvedBCOIsLE   :: Bool,
        ResolvedBCO -> Int
resolvedBCOArity  :: {-# UNPACK #-} !Int,
        ResolvedBCO -> UArray Int Word16
resolvedBCOInstrs :: UArray Int Word16,         -- insns
        ResolvedBCO -> UArray Int Word64
resolvedBCOBitmap :: UArray Int Word64,         -- bitmap
        ResolvedBCO -> UArray Int Word64
resolvedBCOLits   :: UArray Int Word64,         -- non-ptrs
        ResolvedBCO -> SizedSeq ResolvedBCOPtr
resolvedBCOPtrs   :: (SizedSeq ResolvedBCOPtr)  -- ptrs
   }
   deriving ((forall x. ResolvedBCO -> Rep ResolvedBCO x)
-> (forall x. Rep ResolvedBCO x -> ResolvedBCO)
-> Generic ResolvedBCO
forall x. Rep ResolvedBCO x -> ResolvedBCO
forall x. ResolvedBCO -> Rep ResolvedBCO x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResolvedBCO x -> ResolvedBCO
$cfrom :: forall x. ResolvedBCO -> Rep ResolvedBCO x
Generic, Int -> ResolvedBCO -> ShowS
[ResolvedBCO] -> ShowS
ResolvedBCO -> String
(Int -> ResolvedBCO -> ShowS)
-> (ResolvedBCO -> String)
-> ([ResolvedBCO] -> ShowS)
-> Show ResolvedBCO
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedBCO] -> ShowS
$cshowList :: [ResolvedBCO] -> ShowS
show :: ResolvedBCO -> String
$cshow :: ResolvedBCO -> String
showsPrec :: Int -> ResolvedBCO -> ShowS
$cshowsPrec :: Int -> ResolvedBCO -> ShowS
Show)

-- | The Binary instance for ResolvedBCOs.
--
-- Note, that we do encode the endianness, however there is no support for mixed
-- endianness setups.  This is primarily to ensure that ghc and iserv share the
-- same endianness.
instance Binary ResolvedBCO where
  put :: ResolvedBCO -> Put
put ResolvedBCO{Bool
Int
UArray Int Word16
UArray Int Word64
SizedSeq ResolvedBCOPtr
resolvedBCOPtrs :: SizedSeq ResolvedBCOPtr
resolvedBCOLits :: UArray Int Word64
resolvedBCOBitmap :: UArray Int Word64
resolvedBCOInstrs :: UArray Int Word16
resolvedBCOArity :: Int
resolvedBCOIsLE :: Bool
resolvedBCOPtrs :: ResolvedBCO -> SizedSeq ResolvedBCOPtr
resolvedBCOLits :: ResolvedBCO -> UArray Int Word64
resolvedBCOBitmap :: ResolvedBCO -> UArray Int Word64
resolvedBCOInstrs :: ResolvedBCO -> UArray Int Word16
resolvedBCOArity :: ResolvedBCO -> Int
resolvedBCOIsLE :: ResolvedBCO -> Bool
..} = do
    Bool -> Put
forall t. Binary t => t -> Put
put Bool
resolvedBCOIsLE
    Int -> Put
forall t. Binary t => t -> Put
put Int
resolvedBCOArity
    UArray Int Word16 -> Put
forall i a. Binary i => UArray i a -> Put
putArray UArray Int Word16
resolvedBCOInstrs
    UArray Int Word64 -> Put
forall i a. Binary i => UArray i a -> Put
putArray UArray Int Word64
resolvedBCOBitmap
    UArray Int Word64 -> Put
forall i a. Binary i => UArray i a -> Put
putArray UArray Int Word64
resolvedBCOLits
    SizedSeq ResolvedBCOPtr -> Put
forall t. Binary t => t -> Put
put SizedSeq ResolvedBCOPtr
resolvedBCOPtrs
  get :: Get ResolvedBCO
get = Bool
-> Int
-> UArray Int Word16
-> UArray Int Word64
-> UArray Int Word64
-> SizedSeq ResolvedBCOPtr
-> ResolvedBCO
ResolvedBCO
        (Bool
 -> Int
 -> UArray Int Word16
 -> UArray Int Word64
 -> UArray Int Word64
 -> SizedSeq ResolvedBCOPtr
 -> ResolvedBCO)
-> Get Bool
-> Get
     (Int
      -> UArray Int Word16
      -> UArray Int Word64
      -> UArray Int Word64
      -> SizedSeq ResolvedBCOPtr
      -> ResolvedBCO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
forall t. Binary t => Get t
get Get
  (Int
   -> UArray Int Word16
   -> UArray Int Word64
   -> UArray Int Word64
   -> SizedSeq ResolvedBCOPtr
   -> ResolvedBCO)
-> Get Int
-> Get
     (UArray Int Word16
      -> UArray Int Word64
      -> UArray Int Word64
      -> SizedSeq ResolvedBCOPtr
      -> ResolvedBCO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get
  (UArray Int Word16
   -> UArray Int Word64
   -> UArray Int Word64
   -> SizedSeq ResolvedBCOPtr
   -> ResolvedBCO)
-> Get (UArray Int Word16)
-> Get
     (UArray Int Word64
      -> UArray Int Word64 -> SizedSeq ResolvedBCOPtr -> ResolvedBCO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (UArray Int Word16)
forall i a.
(Binary i, Ix i, MArray IOUArray a IO) =>
Get (UArray i a)
getArray Get
  (UArray Int Word64
   -> UArray Int Word64 -> SizedSeq ResolvedBCOPtr -> ResolvedBCO)
-> Get (UArray Int Word64)
-> Get
     (UArray Int Word64 -> SizedSeq ResolvedBCOPtr -> ResolvedBCO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (UArray Int Word64)
forall i a.
(Binary i, Ix i, MArray IOUArray a IO) =>
Get (UArray i a)
getArray Get (UArray Int Word64 -> SizedSeq ResolvedBCOPtr -> ResolvedBCO)
-> Get (UArray Int Word64)
-> Get (SizedSeq ResolvedBCOPtr -> ResolvedBCO)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (UArray Int Word64)
forall i a.
(Binary i, Ix i, MArray IOUArray a IO) =>
Get (UArray i a)
getArray Get (SizedSeq ResolvedBCOPtr -> ResolvedBCO)
-> Get (SizedSeq ResolvedBCOPtr) -> Get ResolvedBCO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (SizedSeq ResolvedBCOPtr)
forall t. Binary t => Get t
get

data ResolvedBCOPtr
  = ResolvedBCORef {-# UNPACK #-} !Int
      -- ^ reference to the Nth BCO in the current set
  | ResolvedBCOPtr {-# UNPACK #-} !(RemoteRef HValue)
      -- ^ reference to a previously created BCO
  | ResolvedBCOStaticPtr {-# UNPACK #-} !(RemotePtr ())
      -- ^ reference to a static ptr
  | ResolvedBCOPtrBCO ResolvedBCO
      -- ^ a nested BCO
  | ResolvedBCOPtrBreakArray {-# UNPACK #-} !(RemoteRef BreakArray)
      -- ^ Resolves to the MutableArray# inside the BreakArray
  deriving ((forall x. ResolvedBCOPtr -> Rep ResolvedBCOPtr x)
-> (forall x. Rep ResolvedBCOPtr x -> ResolvedBCOPtr)
-> Generic ResolvedBCOPtr
forall x. Rep ResolvedBCOPtr x -> ResolvedBCOPtr
forall x. ResolvedBCOPtr -> Rep ResolvedBCOPtr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResolvedBCOPtr x -> ResolvedBCOPtr
$cfrom :: forall x. ResolvedBCOPtr -> Rep ResolvedBCOPtr x
Generic, Int -> ResolvedBCOPtr -> ShowS
[ResolvedBCOPtr] -> ShowS
ResolvedBCOPtr -> String
(Int -> ResolvedBCOPtr -> ShowS)
-> (ResolvedBCOPtr -> String)
-> ([ResolvedBCOPtr] -> ShowS)
-> Show ResolvedBCOPtr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolvedBCOPtr] -> ShowS
$cshowList :: [ResolvedBCOPtr] -> ShowS
show :: ResolvedBCOPtr -> String
$cshow :: ResolvedBCOPtr -> String
showsPrec :: Int -> ResolvedBCOPtr -> ShowS
$cshowsPrec :: Int -> ResolvedBCOPtr -> ShowS
Show)

instance Binary ResolvedBCOPtr