{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Internal.Elf where

import Control.Exception.ChainedException
import Data.Elf.Constants
import Data.Elf.Headers hiding (Header)
import qualified Data.Elf.Headers as H
import Data.Interval as I

import Control.Lens.Combinators hiding (contains)
import Control.Lens.Operators
import Control.Monad
import Control.Monad.Catch
import Control.Monad.State as MS
import Data.Binary
import Data.Bits as Bin
import Data.ByteString.Lazy.Char8 as BSL8
import Data.ByteString.Lazy as BSL
import Data.Foldable
import Data.Int
import qualified Data.List as L
import Data.Maybe
import Data.Monoid

-- | @RBuilder@ is an intermediate internal data type that is used by parser.
-- It contains information about layout of the ELF file that can be used
-- by `Data.Elf.PrettyPrint.printLayout`
data RBuilder c
    = RBuilderHeader
        { forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbhHeader :: HeaderXX c
        }
    | RBuilderSectionTable
        { forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbstHeader :: HeaderXX c
        }
    | RBuilderSegmentTable
        { forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbptHeader :: HeaderXX c
        }
    | RBuilderSection
        { forall (c :: ElfClass). RBuilder c -> SectionXX c
rbsHeader :: SectionXX c
        , forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
rbsN      :: ElfSectionIndex
        , forall (c :: ElfClass). RBuilder c -> String
rbsName   :: String
        }
    | RBuilderSegment
        { forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpHeader :: SegmentXX c
        , forall (c :: ElfClass). RBuilder c -> Word16
rbpN      :: Word16
        , forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpData   :: [RBuilder c]
        }
    | RBuilderRawData
        { forall (c :: ElfClass). RBuilder c -> Interval (WordXX c)
rbrdInterval :: Interval (WordXX c)
        }
    | RBuilderRawAlign
        { forall (c :: ElfClass). RBuilder c -> WordXX c
rbraOffset :: WordXX c
        , forall (c :: ElfClass). RBuilder c -> WordXX c
rbraAlign  :: WordXX c
        }

data LZip a = LZip [a] (Maybe a) [a]

instance Foldable LZip where
    foldMap :: forall m a. Monoid m => (a -> m) -> LZip a -> m
foldMap a -> m
f (LZip [a]
l  (Just a
c) [a]
r) = (a -> m) -> LZip a -> m
forall m a. Monoid m => (a -> m) -> LZip a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (LZip a -> m) -> LZip a -> m
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe a -> [a] -> LZip a
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l Maybe a
forall a. Maybe a
Nothing (a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
r)
    foldMap a -> m
f (LZip [a]
l  Maybe a
Nothing  [a]
r) = (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f ([a] -> m) -> [a] -> m
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
r

-- | t`Elf` is a forrest of trees of type `ElfXX`.
-- Trees are composed of `ElfXX` nodes, `ElfSegment` can contain subtrees
data ElfNodeType = Header | SectionTable | SegmentTable | Section | Segment | RawData | RawAlign

-- | List of ELF nodes.
data ElfListXX c where
    ElfListCons :: ElfXX t c -> ElfListXX c -> ElfListXX c
    ElfListNull :: ElfListXX c

-- | Elf is a sigma type where the first entry defines the type of the second one
data Elf = forall a . Elf (SingElfClass a) (ElfListXX a)

-- | Section data may contain a string table.
-- If a section contains a string table with section names, the data
-- for such a section is generated and `esData` should contain `ElfSectionDataStringTable`
data ElfSectionData c
    = ElfSectionData                -- ^ Regular section data
        { forall (c :: ElfClass). ElfSectionData c -> ByteString
esdData :: BSL.ByteString -- ^ The content of the section
        }
    | ElfSectionDataStringTable     -- ^ Section data will be generated from section names
    | ElfSectionDataNoBits          -- ^ SHT_NOBITS uninitialized section data: section has size but no content
        { forall (c :: ElfClass). ElfSectionData c -> WordXX c
esdSize :: WordXX c       -- ^ Size of the section
        }

-- | The type of node that defines Elf structure.
data ElfXX t c where
    ElfHeader ::
        { forall (c :: ElfClass). ElfXX 'Header c -> ElfData
ehData       :: ElfData    -- ^ Data encoding (big- or little-endian)
        , forall (c :: ElfClass). ElfXX 'Header c -> ElfOSABI
ehOSABI      :: ElfOSABI   -- ^ OS/ABI identification
        , forall (c :: ElfClass). ElfXX 'Header c -> Word8
ehABIVersion :: Word8      -- ^ ABI version
        , forall (c :: ElfClass). ElfXX 'Header c -> ElfType
ehType       :: ElfType    -- ^ Object file type
        , forall (c :: ElfClass). ElfXX 'Header c -> ElfMachine
ehMachine    :: ElfMachine -- ^ Machine type
        , forall (c :: ElfClass). ElfXX 'Header c -> WordXX c
ehEntry      :: WordXX c   -- ^ Entry point address
        , forall (c :: ElfClass). ElfXX 'Header c -> Word32
ehFlags      :: Word32     -- ^ Processor-specific flags
        } -> ElfXX 'Header c
    ElfSectionTable :: ElfXX 'SectionTable c
    ElfSegmentTable :: ElfXX 'SegmentTable c
    ElfSection ::
        { forall (c :: ElfClass). ElfXX 'Section c -> String
esName      :: String         -- ^ Section name (NB: string, not offset in the string table)
        , forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esType      :: ElfSectionType -- ^ Section type
        , forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esFlags     :: ElfSectionFlag -- ^ Section attributes
        , forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddr      :: WordXX c       -- ^ Virtual address in memory
        , forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: WordXX c       -- ^ Address alignment boundary
        , forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize   :: WordXX c       -- ^ Size of entries, if section has table
        , forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esN         :: ElfSectionIndex -- ^ Section number
        , forall (c :: ElfClass). ElfXX 'Section c -> Word32
esInfo      :: Word32         -- ^ Miscellaneous information
        , forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink      :: Word32         -- ^ Link to other section
        , forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esData      :: ElfSectionData c -- ^ The content of the section
        } -> ElfXX 'Section c
    ElfSegment ::
        { forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentType
epType       :: ElfSegmentType -- ^ Type of segment
        , forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentFlag
epFlags      :: ElfSegmentFlag -- ^ Segment attributes
        , forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epVirtAddr   :: WordXX c       -- ^ Virtual address in memory
        , forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epPhysAddr   :: WordXX c       -- ^ Physical address
        , forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAddMemSize :: WordXX c       -- ^ Add this amount of memory after the section when the section is loaded to memory by execution system.
                                         --   Or, in other words this is how much `pMemSize` is bigger than `pFileSize`
        , forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAlign      :: WordXX c       -- ^ Alignment of segment
        , forall (c :: ElfClass). ElfXX 'Segment c -> ElfListXX c
epData       :: ElfListXX c    -- ^ Content of the segment
        } -> ElfXX 'Segment c
    -- | Some ELF files (some executables) don't bother to define
    -- sections for linking and have just raw data in segments.
    ElfRawData ::
        { forall (c :: ElfClass). ElfXX 'RawData c -> ByteString
edData :: BSL.ByteString -- ^ Raw data in ELF file
        } -> ElfXX 'RawData c
    -- | Align the next data in the ELF file.
    -- The offset of the next data in the ELF file
    -- will be the minimal @x@ such that
    -- @x mod eaAlign == eaOffset mod eaAlign @
    ElfRawAlign ::
        { forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaOffset :: WordXX c -- ^ Align value
        , forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaAlign  :: WordXX c -- ^ Align module
        } -> ElfXX 'RawAlign c

data WBuilderData
    = WBuilderDataHeader
    | WBuilderDataByteStream { WBuilderData -> ByteString
wbdData :: BSL.ByteString }
    | WBuilderDataSectionTable
    | WBuilderDataSegmentTable

data WBuilderState a =
    WBuilderState
        { forall (a :: ElfClass).
WBuilderState a -> [(ElfSectionIndex, SectionXX a)]
_wbsSections         :: [(ElfSectionIndex, SectionXX a)]
        , forall (a :: ElfClass). WBuilderState a -> [SegmentXX a]
_wbsSegmentsReversed :: [SegmentXX a]
        , forall (a :: ElfClass). WBuilderState a -> [WBuilderData]
_wbsDataReversed     :: [WBuilderData]
        , forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsOffset           :: WordXX a
        , forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsPhOff            :: WordXX a
        , forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsShOff            :: WordXX a
        , forall (a :: ElfClass). WBuilderState a -> ElfSectionIndex
_wbsShStrNdx         :: ElfSectionIndex
        , forall (a :: ElfClass). WBuilderState a -> [Int64]
_wbsNameIndexes      :: [Int64]
        }

makeLenses ''WBuilderState

infixr 9 ~:

-- | Helper for `ElfListCons`
(~:) :: ElfXX t a -> ElfListXX a -> ElfListXX a
~: :: forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
(~:) = ElfXX t a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons

foldMapElfList :: Monoid m => (forall t' . (ElfXX t' a -> m)) -> ElfListXX a -> m
foldMapElfList :: forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList forall (t' :: ElfNodeType). ElfXX t' a -> m
f (ElfListCons v :: ElfXX t a
v@(ElfSegment { ElfSegmentType
ElfSegmentFlag
WordXX a
ElfListXX a
epType :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentType
epFlags :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentFlag
epVirtAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epPhysAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAddMemSize :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAlign :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epData :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfListXX c
epType :: ElfSegmentType
epFlags :: ElfSegmentFlag
epVirtAddr :: WordXX a
epPhysAddr :: WordXX a
epAddMemSize :: WordXX a
epAlign :: WordXX a
epData :: ElfListXX a
.. }) ElfListXX a
l) = ElfXX t a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfXX t a
v m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfListXX a
epData m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfListXX a
l
foldMapElfList forall (t' :: ElfNodeType). ElfXX t' a -> m
f (ElfListCons ElfXX t a
v ElfListXX a
l)                     = ElfXX t a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfXX t a
v m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfListXX a
l
foldMapElfList forall (t' :: ElfNodeType). ElfXX t' a -> m
_  ElfListXX a
ElfListNull                          = m
forall a. Monoid a => a
mempty

foldMapElfList' :: Monoid m => (forall t' . (ElfXX t' a -> m)) -> ElfListXX a -> m
foldMapElfList' :: forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList' forall (t' :: ElfNodeType). ElfXX t' a -> m
f (ElfListCons ElfXX t a
v ElfListXX a
l) = ElfXX t a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfXX t a
v m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList' ElfXX t' a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfListXX a
l
foldMapElfList' forall (t' :: ElfNodeType). ElfXX t' a -> m
_  ElfListXX a
ElfListNull      = m
forall a. Monoid a => a
mempty

mapMElfList :: Monad m => (forall t' . (ElfXX t' a -> m b)) -> ElfListXX a -> m [b]
mapMElfList :: forall (m :: * -> *) (a :: ElfClass) b.
Monad m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m b)
-> ElfListXX a -> m [b]
mapMElfList forall (t' :: ElfNodeType). ElfXX t' a -> m b
f ElfListXX a
l = [m b] -> m [b]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([m b] -> m [b]) -> [m b] -> m [b]
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType). ElfXX t' a -> [m b])
-> ElfListXX a -> [m b]
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList' ((m b -> [m b] -> [m b]
forall a. a -> [a] -> [a]
: []) (m b -> [m b]) -> (ElfXX t' a -> m b) -> ElfXX t' a -> [m b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfXX t' a -> m b
forall (t' :: ElfNodeType). ElfXX t' a -> m b
f) ElfListXX a
l

headerInterval :: forall a . SingElfClassI a => HeaderXX a -> Interval (WordXX a)
headerInterval :: forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
headerInterval HeaderXX a
_ = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
0 (WordXX a -> Interval (WordXX a))
-> WordXX a -> Interval (WordXX a)
forall a b. (a -> b) -> a -> b
$ ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
headerSize (ElfClass -> WordXX a) -> ElfClass -> WordXX a
forall a b. (a -> b) -> a -> b
$ SingElfClass a -> ElfClass
forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass (SingElfClass a -> ElfClass) -> SingElfClass a -> ElfClass
forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a

sectionTableInterval :: SingElfClassI a => HeaderXX a -> Interval (WordXX a)
sectionTableInterval :: forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
sectionTableInterval HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX a
hPhOff :: WordXX a
hShOff :: WordXX a
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
..} = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
hShOff (WordXX a -> Interval (WordXX a))
-> WordXX a -> Interval (WordXX a)
forall a b. (a -> b) -> a -> b
$ Word16 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> WordXX a) -> Word16 -> WordXX a
forall a b. (a -> b) -> a -> b
$ Word16
hShEntSize Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
hShNum

segmentTableInterval :: SingElfClassI a => HeaderXX a -> Interval (WordXX a)
segmentTableInterval :: forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
segmentTableInterval HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX a
hPhOff :: WordXX a
hShOff :: WordXX a
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
..} = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
hPhOff (WordXX a -> Interval (WordXX a))
-> WordXX a -> Interval (WordXX a)
forall a b. (a -> b) -> a -> b
$ Word16 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> WordXX a) -> Word16 -> WordXX a
forall a b. (a -> b) -> a -> b
$ Word16
hPhEntSize Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
hPhNum

sectionInterval :: SingElfClassI a => SectionXX a -> Interval (WordXX a)
sectionInterval :: forall (a :: ElfClass).
SingElfClassI a =>
SectionXX a -> Interval (WordXX a)
sectionInterval SectionXX{Word32
ElfSectionType
WordXX a
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX a
sAddr :: WordXX a
sOffset :: WordXX a
sSize :: WordXX a
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX a
sEntSize :: WordXX a
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sName :: forall (c :: ElfClass). SectionXX c -> Word32
..} = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
sOffset if ElfSectionType
sType ElfSectionType -> ElfSectionType -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSectionType
SHT_NOBITS then WordXX a
0 else WordXX a
sSize

segmentInterval :: SingElfClassI a => SegmentXX a -> Interval (WordXX a)
segmentInterval :: forall (a :: ElfClass).
SingElfClassI a =>
SegmentXX a -> Interval (WordXX a)
segmentInterval SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX a
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pType :: ElfSegmentType
pFlags :: ElfSegmentFlag
pOffset :: WordXX a
pVirtAddr :: WordXX a
pPhysAddr :: WordXX a
pFileSize :: WordXX a
pMemSize :: WordXX a
pAlign :: WordXX a
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
..} = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
pOffset WordXX a
pFileSize

rBuilderInterval :: SingElfClassI a => RBuilder a -> Interval (WordXX a)
rBuilderInterval :: forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilderHeader{HeaderXX a
rbhHeader :: forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbhHeader :: HeaderXX a
..}       = HeaderXX a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
headerInterval HeaderXX a
rbhHeader
rBuilderInterval RBuilderSectionTable{HeaderXX a
rbstHeader :: forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbstHeader :: HeaderXX a
..} = HeaderXX a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
sectionTableInterval HeaderXX a
rbstHeader
rBuilderInterval RBuilderSegmentTable{HeaderXX a
rbptHeader :: forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbptHeader :: HeaderXX a
..} = HeaderXX a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
segmentTableInterval HeaderXX a
rbptHeader
rBuilderInterval RBuilderSection{String
ElfSectionIndex
SectionXX a
rbsHeader :: forall (c :: ElfClass). RBuilder c -> SectionXX c
rbsN :: forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
rbsName :: forall (c :: ElfClass). RBuilder c -> String
rbsHeader :: SectionXX a
rbsN :: ElfSectionIndex
rbsName :: String
..}      = SectionXX a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
SectionXX a -> Interval (WordXX a)
sectionInterval SectionXX a
rbsHeader
rBuilderInterval RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..}      = SegmentXX a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
SegmentXX a -> Interval (WordXX a)
segmentInterval SegmentXX a
rbpHeader
rBuilderInterval RBuilderRawData{Interval (WordXX a)
rbrdInterval :: forall (c :: ElfClass). RBuilder c -> Interval (WordXX c)
rbrdInterval :: Interval (WordXX a)
..}      = Interval (WordXX a)
rbrdInterval
rBuilderInterval RBuilderRawAlign{}       = String -> Interval (WordXX a)
forall a. HasCallStack => String -> a
error String
"Internal error: rBuilderInterval is not defined for RBuilderRawAlign"

findInterval :: (Ord t, Num t) => (a -> Interval t) -> t -> [a] -> LZip a
findInterval :: forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval a -> Interval t
f t
e = [a] -> [a] -> LZip a
findInterval' []
    where
        findInterval' :: [a] -> [a] -> LZip a
findInterval' [a]
l []                           = [a] -> Maybe a -> [a] -> LZip a
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l Maybe a
forall a. Maybe a
Nothing []
        findInterval' [a]
l (a
x : [a]
xs) | t
e t -> Interval t -> Bool
forall {a}. (Ord a, Num a) => a -> Interval a -> Bool
`touches`  a -> Interval t
f a
x  = [a] -> Maybe a -> [a] -> LZip a
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l (a -> Maybe a
forall a. a -> Maybe a
Just a
x) [a]
xs
                                 | t
e t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< Interval t -> t
forall a. Interval a -> a
offset  (a -> Interval t
f a
x) = [a] -> Maybe a -> [a] -> LZip a
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l Maybe a
forall a. Maybe a
Nothing (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
                                 | Bool
otherwise         = [a] -> [a] -> LZip a
findInterval' (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
l) [a]
xs
        touches :: a -> Interval a -> Bool
touches a
a Interval a
i | Interval a -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval a
i = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> a
forall a. Interval a -> a
offset Interval a
i
                    | Bool
otherwise = a
a a -> Interval a -> Bool
forall {a}. (Ord a, Num a) => a -> Interval a -> Bool
`member` Interval a
i

showRBuilder' :: RBuilder a -> String
showRBuilder' :: forall (c :: ElfClass). RBuilder c -> String
showRBuilder' RBuilderHeader{}       = String
"header"
showRBuilder' RBuilderSectionTable{} = String
"section table"
showRBuilder' RBuilderSegmentTable{} = String
"segment table"
showRBuilder' RBuilderSection{String
ElfSectionIndex
SectionXX a
rbsHeader :: forall (c :: ElfClass). RBuilder c -> SectionXX c
rbsN :: forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
rbsName :: forall (c :: ElfClass). RBuilder c -> String
rbsHeader :: SectionXX a
rbsN :: ElfSectionIndex
rbsName :: String
..}    = String
"section " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ElfSectionIndex -> String
forall a. Show a => a -> String
show ElfSectionIndex
rbsN
showRBuilder' RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..}    = String
"segment " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
rbpN
showRBuilder' RBuilderRawData{}      = String
"raw data" -- should not be called
showRBuilder' RBuilderRawAlign{}     = String
"alignment" -- should not be called

showRBuilder :: SingElfClassI a => RBuilder a -> String
showRBuilder :: forall (a :: ElfClass). SingElfClassI a => RBuilder a -> String
showRBuilder RBuilder a
v = RBuilder a -> String
forall (c :: ElfClass). RBuilder c -> String
showRBuilder' RBuilder a
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Interval (WordXX a) -> String
forall a. Show a => a -> String
show (RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
v) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

-- showERBList :: SingElfClassI a => [RBuilder a] -> String
-- showERBList l = "[" ++ (L.concat $ L.intersperse ", " $ fmap showRBuilder l) ++ "]"

intersectMessage :: SingElfClassI a => RBuilder a -> RBuilder a -> String
intersectMessage :: forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
x RBuilder a
y = RBuilder a -> String
forall (a :: ElfClass). SingElfClassI a => RBuilder a -> String
showRBuilder RBuilder a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RBuilder a -> String
forall (a :: ElfClass). SingElfClassI a => RBuilder a -> String
showRBuilder RBuilder a
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" intersect"

addRBuilders :: forall a m . (SingElfClassI a, MonadCatch m) => [RBuilder a] -> m [RBuilder a]
addRBuilders :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> m [RBuilder a]
addRBuilders [RBuilder a]
newts =
    let
        addRBuilders' :: (a -> b -> m b) -> t a -> b -> m b
addRBuilders' a -> b -> m b
f t a
newts' b
l = (b -> a -> m b) -> b -> t a -> m b
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((a -> b -> m b) -> b -> a -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> m b
f) b
l t a
newts'

        addRBuilderEmpty :: (SingElfClassI a, MonadCatch m) => RBuilder a -> [RBuilder a] -> m [RBuilder a]
        addRBuilderEmpty :: (SingElfClassI a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderEmpty RBuilder a
t [RBuilder a]
ts =
            -- (unsafePerformIO $ Prelude.putStrLn $ "Add Empty " ++ showRBuilder t ++ " to " ++ showERBList ts) `seq`
            let
                to' :: WordXX a
to' = Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset (Interval (WordXX a) -> WordXX a)
-> Interval (WordXX a) -> WordXX a
forall a b. (a -> b) -> a -> b
$ RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
t
                (LZip [RBuilder a]
l Maybe (RBuilder a)
c' [RBuilder a]
r) = (RBuilder a -> Interval (WordXX a))
-> WordXX a -> [RBuilder a] -> LZip (RBuilder a)
forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval WordXX a
to' [RBuilder a]
ts

                -- Let `(le, lo)` is the result of `allEmptyStarting a l`.
                -- Then `le` is the initial sublist of `l` each element of which is empty and starts at `a`,
                -- `lo` is the rest of `l`.
                allEmptyStartingAt :: WordXX a -> [RBuilder a] -> ([RBuilder a], [RBuilder a])
                allEmptyStartingAt :: WordXX a -> [RBuilder a] -> ([RBuilder a], [RBuilder a])
allEmptyStartingAt WordXX a
a [RBuilder a]
ls = ([RBuilder a], [RBuilder a]) -> ([RBuilder a], [RBuilder a])
f ([], [RBuilder a]
ls)
                    where
                        f :: ([RBuilder a], [RBuilder a]) -> ([RBuilder a], [RBuilder a])
f ([RBuilder a]
le, []) = ([RBuilder a] -> [RBuilder a]
forall a. [a] -> [a]
L.reverse [RBuilder a]
le, [])
                        f ([RBuilder a]
le, RBuilder a
h : [RBuilder a]
lo) =
                            let
                                hi :: Interval (WordXX a)
hi = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
h
                            in if Bool -> Bool
not (Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval (WordXX a)
hi) Bool -> Bool -> Bool
|| (Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset Interval (WordXX a)
hi WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
a)
                                then ([RBuilder a] -> [RBuilder a]
forall a. [a] -> [a]
L.reverse [RBuilder a]
le, RBuilder a
h RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
lo)
                                else ([RBuilder a], [RBuilder a]) -> ([RBuilder a], [RBuilder a])
f (RBuilder a
h RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
le, [RBuilder a]
lo)
            in case Maybe (RBuilder a)
c' of
                Just RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..} -> do
                    [RBuilder a]
d <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a] -> m [RBuilder a]
(Loc -> String -> m [RBuilder a] -> m [RBuilder a])
-> String -> Loc -> m [RBuilder a] -> m [RBuilder a]
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m [RBuilder a] -> m [RBuilder a])
-> m [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ (SingElfClassI a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderEmpty RBuilder a
t [RBuilder a]
rbpData
                    [RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a]
d, Word16
SegmentXX a
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
.. }) [RBuilder a]
r
                Just RBuilder a
c ->
                    if Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset (RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c) WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
to' then
                        $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a]
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m [RBuilder a]) -> String -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
t RBuilder a
c
                    else
                        let
                            ([RBuilder a]
ce, [RBuilder a]
re') = WordXX a -> [RBuilder a] -> ([RBuilder a], [RBuilder a])
allEmptyStartingAt WordXX a
to' (RBuilder a
c RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
r)
                        in case RBuilder a
t of
                            RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..} ->
                                [RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a]
ce, Word16
SegmentXX a
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
.. }) [RBuilder a]
re'
                            RBuilder a
_ ->
                                [RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l Maybe (RBuilder a)
forall a. Maybe a
Nothing ([RBuilder a]
ce [RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ (RBuilder a
t RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
re'))
                Maybe (RBuilder a)
Nothing -> [RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
t) [RBuilder a]
r

        addRBuilderNonEmpty :: (SingElfClassI a, MonadCatch m) => RBuilder a -> [RBuilder a] -> m [RBuilder a]
        addRBuilderNonEmpty :: (SingElfClassI a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderNonEmpty RBuilder a
t [RBuilder a]
ts =
            -- (unsafePerformIO $ Prelude.putStrLn $ "Add NonEmpty " ++ showRBuilder t ++ " to " ++ showERBList ts) `seq`
            let
                ti :: Interval (WordXX a)
ti = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
t
                (LZip [RBuilder a]
l Maybe (RBuilder a)
c' [RBuilder a]
r) = (RBuilder a -> Interval (WordXX a))
-> WordXX a -> [RBuilder a] -> LZip (RBuilder a)
forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval (Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset Interval (WordXX a)
ti) [RBuilder a]
ts

                addRBuildersNonEmpty :: (SingElfClassI a, MonadCatch m) => [RBuilder a] -> RBuilder a -> m (RBuilder a)
                addRBuildersNonEmpty :: (SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [] RBuilder a
x = RBuilder a -> m (RBuilder a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return RBuilder a
x
                addRBuildersNonEmpty [RBuilder a]
ts' RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..} = do
                    [RBuilder a]
d <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a] -> m [RBuilder a]
(Loc -> String -> m [RBuilder a] -> m [RBuilder a])
-> String -> Loc -> m [RBuilder a] -> m [RBuilder a]
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m [RBuilder a] -> m [RBuilder a])
-> m [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ (RBuilder a -> [RBuilder a] -> m [RBuilder a])
-> [RBuilder a] -> [RBuilder a] -> m [RBuilder a]
forall {t :: * -> *} {m :: * -> *} {a} {b}.
(Foldable t, Monad m) =>
(a -> b -> m b) -> t a -> b -> m b
addRBuilders' (SingElfClassI a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderNonEmpty [RBuilder a]
ts' [RBuilder a]
rbpData
                    RBuilder a -> m (RBuilder a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a]
d, Word16
SegmentXX a
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
.. }
                addRBuildersNonEmpty (RBuilder a
x:[RBuilder a]
_) RBuilder a
y = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a)
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m (RBuilder a)) -> String -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
x RBuilder a
y

            in case Maybe (RBuilder a)
c' of

                Just RBuilder a
c ->

                    if Interval (WordXX a)
ti Interval (WordXX a) -> Interval (WordXX a) -> Bool
forall a. Eq a => a -> a -> Bool
== RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c then

                        case RBuilder a
t of

                                -- NB: If a segment A has number greater than segment B and they have same size, then
                                --     segment A contains segment B
                                --     This should be taken into account in the serialization code.
                                RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..} ->

                                    [RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a
c], Word16
SegmentXX a
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
.. }) [RBuilder a]
r

                                RBuilder a
_ ->  do

                                    RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [RBuilder a
t] RBuilder a
c
                                    [RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r

                    else if RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c Interval (WordXX a) -> Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Interval a -> Bool
`contains` Interval (WordXX a)
ti then do

                        RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [RBuilder a
t] RBuilder a
c
                        [RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r

                    else if Interval (WordXX a)
ti Interval (WordXX a) -> Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Interval a -> Bool
`contains` RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c then

                        let

                            tir :: WordXX a
tir = Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset Interval (WordXX a)
ti WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
size Interval (WordXX a)
ti WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1
                            (LZip [RBuilder a]
l2 Maybe (RBuilder a)
c2' [RBuilder a]
r2) = (RBuilder a -> Interval (WordXX a))
-> WordXX a -> [RBuilder a] -> LZip (RBuilder a)
forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval WordXX a
tir [RBuilder a]
r

                        in case Maybe (RBuilder a)
c2' of

                            Maybe (RBuilder a)
Nothing -> do

                                -- add this:     ......[t__________________________]...................
                                -- to this list: ......[c__]......[l2__]...[l2__].....[________].......
                                -- no need to keep the order of l2 as each member of the list will be placed independently from scratch
                                RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty (RBuilder a
c RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
l2) RBuilder a
t
                                [RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2

                            Just RBuilder a
c2 ->

                                if Interval (WordXX a)
ti Interval (WordXX a) -> Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Interval a -> Bool
`contains` RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c2 then do

                                    -- add this:     ......[t______________________]........................
                                    -- to this list: ......[c_________]......[c2___]......[________]........
                                    RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty (RBuilder a
c RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: RBuilder a
c2 RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
l2) RBuilder a
t
                                    [RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2
                                else

                                    -- add this:     ......[t_________________].............................
                                    -- to this list: ......[c_________]......[c2___]......[________]........
                                    $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a]
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m [RBuilder a]) -> String -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
t RBuilder a
c2

                    else

                        -- add this:     ..........[t________].............................
                        -- to this list: ......[c_________]......[_____]......[________]...
                        $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a]
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m [RBuilder a]) -> String -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
t RBuilder a
c

                Maybe (RBuilder a)
Nothing ->

                    let
                        tir :: WordXX a
tir = Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset Interval (WordXX a)
ti WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
size Interval (WordXX a)
ti WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1
                        (LZip [RBuilder a]
l2 Maybe (RBuilder a)
c2' [RBuilder a]
r2) = (RBuilder a -> Interval (WordXX a))
-> WordXX a -> [RBuilder a] -> LZip (RBuilder a)
forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval WordXX a
tir [RBuilder a]
r
                    in case Maybe (RBuilder a)
c2' of

                        Maybe (RBuilder a)
Nothing -> do

                            -- add this:     ....[t___].........................................
                            -- or this:      ....[t_________________________]...................
                            -- to this list: .............[l2__]...[l2__].....[________]........
                            RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [RBuilder a]
l2 RBuilder a
t
                            [RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2

                        Just RBuilder a
c2 ->

                            if Interval (WordXX a)
ti Interval (WordXX a) -> Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Interval a -> Bool
`contains` RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c2 then do

                                -- add this:     ....[t_________________________________]........
                                -- to this list: ..........[l2__]..[l2__].....[c2_______]........
                                RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty (RBuilder a
c2 RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
l2) RBuilder a
t
                                [RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2

                            else

                                -- add this:     ....[t_______________________________]..........
                                -- to this list: ..........[l2__]..[l2__].....[c2_______]........
                                $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a]
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m [RBuilder a]) -> String -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
t RBuilder a
c2

        ([RBuilder a]
emptyRBs, [RBuilder a]
nonEmptyRBs) = (RBuilder a -> Bool)
-> [RBuilder a] -> ([RBuilder a], [RBuilder a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty (Interval (WordXX a) -> Bool)
-> (RBuilder a -> Interval (WordXX a)) -> RBuilder a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval) [RBuilder a]
newts

    in
        (RBuilder a -> [RBuilder a] -> m [RBuilder a])
-> [RBuilder a] -> [RBuilder a] -> m [RBuilder a]
forall {t :: * -> *} {m :: * -> *} {a} {b}.
(Foldable t, Monad m) =>
(a -> b -> m b) -> t a -> b -> m b
addRBuilders' (SingElfClassI a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderNonEmpty [RBuilder a]
nonEmptyRBs [] m [RBuilder a]
-> ([RBuilder a] -> m [RBuilder a]) -> m [RBuilder a]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (RBuilder a -> [RBuilder a] -> m [RBuilder a])
-> [RBuilder a] -> [RBuilder a] -> m [RBuilder a]
forall {t :: * -> *} {m :: * -> *} {a} {b}.
(Foldable t, Monad m) =>
(a -> b -> m b) -> t a -> b -> m b
addRBuilders' (SingElfClassI a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderEmpty [RBuilder a]
emptyRBs

-- | Find section with a given number
elfFindSection :: forall a m b . (SingElfClassI a, MonadThrow m, Integral b, Show b)
               => ElfListXX a          -- ^ Structured ELF data
               -> b                    -- ^ Number of the section
               -> m (ElfXX 'Section a) -- ^ The section in question
elfFindSection :: forall (a :: ElfClass) (m :: * -> *) b.
(SingElfClassI a, MonadThrow m, Integral b, Show b) =>
ElfListXX a -> b -> m (ElfXX 'Section a)
elfFindSection ElfListXX a
elfs b
n = if b
n b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
0
    then $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (ElfXX 'Section a)
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"no section 0"
    else $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> Maybe (ElfXX 'Section a) -> m (ElfXX 'Section a)
forall (m :: * -> *) a.
MonadThrow m =>
Loc -> String -> Maybe a -> m a
maybeAddContext (String
"no section " String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
n) Maybe (ElfXX 'Section a)
maybeSection
        where
            maybeSection :: Maybe (ElfXX 'Section a)
maybeSection = First (ElfXX 'Section a) -> Maybe (ElfXX 'Section a)
forall a. First a -> Maybe a
getFirst (First (ElfXX 'Section a) -> Maybe (ElfXX 'Section a))
-> First (ElfXX 'Section a) -> Maybe (ElfXX 'Section a)
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType).
 ElfXX t' a -> First (ElfXX 'Section a))
-> ElfListXX a -> First (ElfXX 'Section a)
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> First (ElfXX 'Section a)
forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Section a)
f ElfListXX a
elfs
            f :: ElfXX t a -> First (ElfXX 'Section a)
            f :: forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Section a)
f s :: ElfXX t a
s@ElfSection{String
Word32
ElfSectionType
ElfSectionFlag
ElfSectionIndex
WordXX a
ElfSectionData a
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esName :: String
esType :: ElfSectionType
esFlags :: ElfSectionFlag
esAddr :: WordXX a
esAddrAlign :: WordXX a
esEntSize :: WordXX a
esN :: ElfSectionIndex
esInfo :: Word32
esLink :: Word32
esData :: ElfSectionData a
..} | ElfSectionIndex
esN ElfSectionIndex -> ElfSectionIndex -> Bool
forall a. Eq a => a -> a -> Bool
== b -> ElfSectionIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n = Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a)
forall a. Maybe a -> First a
First (Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a))
-> Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'Section a -> Maybe (ElfXX 'Section a)
forall a. a -> Maybe a
Just ElfXX t a
ElfXX 'Section a
s
            f ElfXX t a
_ = Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a)
forall a. Maybe a -> First a
First Maybe (ElfXX 'Section a)
forall a. Maybe a
Nothing

-- | Find section with a given name
elfFindSectionByName :: forall a m . (SingElfClassI a, MonadThrow m)
                     => ElfListXX a          -- ^ Structured ELF data
                     -> String               -- ^ Section name
                     -> m (ElfXX 'Section a) -- ^ The section in question
elfFindSectionByName :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadThrow m) =>
ElfListXX a -> String -> m (ElfXX 'Section a)
elfFindSectionByName ElfListXX a
elfs String
n = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> Maybe (ElfXX 'Section a) -> m (ElfXX 'Section a)
forall (m :: * -> *) a.
MonadThrow m =>
Loc -> String -> Maybe a -> m a
maybeAddContext (String
"no section \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"") Maybe (ElfXX 'Section a)
maybeSection
    where
        maybeSection :: Maybe (ElfXX 'Section a)
maybeSection = First (ElfXX 'Section a) -> Maybe (ElfXX 'Section a)
forall a. First a -> Maybe a
getFirst (First (ElfXX 'Section a) -> Maybe (ElfXX 'Section a))
-> First (ElfXX 'Section a) -> Maybe (ElfXX 'Section a)
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType).
 ElfXX t' a -> First (ElfXX 'Section a))
-> ElfListXX a -> First (ElfXX 'Section a)
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> First (ElfXX 'Section a)
forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Section a)
f ElfListXX a
elfs
        f :: ElfXX t a -> First (ElfXX 'Section a)
        f :: forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Section a)
f s :: ElfXX t a
s@ElfSection{String
Word32
ElfSectionType
ElfSectionFlag
ElfSectionIndex
WordXX a
ElfSectionData a
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esName :: String
esType :: ElfSectionType
esFlags :: ElfSectionFlag
esAddr :: WordXX a
esAddrAlign :: WordXX a
esEntSize :: WordXX a
esN :: ElfSectionIndex
esInfo :: Word32
esLink :: Word32
esData :: ElfSectionData a
..} | String
esName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n = Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a)
forall a. Maybe a -> First a
First (Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a))
-> Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'Section a -> Maybe (ElfXX 'Section a)
forall a. a -> Maybe a
Just ElfXX t a
ElfXX 'Section a
s
        f ElfXX t a
_ = Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a)
forall a. Maybe a -> First a
First Maybe (ElfXX 'Section a)
forall a. Maybe a
Nothing

-- | Find ELF header
elfFindHeader :: forall a m . (SingElfClassI a, MonadThrow m)
              => ElfListXX a         -- ^ Structured ELF data
              -> m (ElfXX 'Header a) -- ^ ELF header
elfFindHeader :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadThrow m) =>
ElfListXX a -> m (ElfXX 'Header a)
elfFindHeader ElfListXX a
elfs = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> Maybe (ElfXX 'Header a) -> m (ElfXX 'Header a)
forall (m :: * -> *) a.
MonadThrow m =>
Loc -> String -> Maybe a -> m a
maybeAddContext String
"no header" Maybe (ElfXX 'Header a)
maybeHeader
    where
        maybeHeader :: Maybe (ElfXX 'Header a)
maybeHeader = First (ElfXX 'Header a) -> Maybe (ElfXX 'Header a)
forall a. First a -> Maybe a
getFirst (First (ElfXX 'Header a) -> Maybe (ElfXX 'Header a))
-> First (ElfXX 'Header a) -> Maybe (ElfXX 'Header a)
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Header a))
-> ElfListXX a -> First (ElfXX 'Header a)
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> First (ElfXX 'Header a)
forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Header a)
f ElfListXX a
elfs
        f :: ElfXX t a -> First (ElfXX 'Header a)
        f :: forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Header a)
f h :: ElfXX t a
h@ElfHeader{} = Maybe (ElfXX 'Header a) -> First (ElfXX 'Header a)
forall a. Maybe a -> First a
First (Maybe (ElfXX 'Header a) -> First (ElfXX 'Header a))
-> Maybe (ElfXX 'Header a) -> First (ElfXX 'Header a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'Header a -> Maybe (ElfXX 'Header a)
forall a. a -> Maybe a
Just ElfXX t a
ElfXX 'Header a
h
        f ElfXX t a
_ = Maybe (ElfXX 'Header a) -> First (ElfXX 'Header a)
forall a. Maybe a -> First a
First Maybe (ElfXX 'Header a)
forall a. Maybe a
Nothing

cut :: BSL.ByteString -> Int64 -> Int64 -> BSL.ByteString
cut :: ByteString -> Int64 -> Int64 -> ByteString
cut ByteString
content Int64
offset Int64
size = Int64 -> ByteString -> ByteString
BSL.take Int64
size (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop Int64
offset ByteString
content

tail' :: [a] -> [a]
tail' :: forall a. [a] -> [a]
tail' [] = []
tail' (a
_ : [a]
xs) = [a]
xs

nextOffset :: SingElfClassI a => WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset :: forall (a :: ElfClass).
SingElfClassI a =>
WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset WordXX a
_ WordXX a
0 WordXX a
a = WordXX a
a
nextOffset WordXX a
t WordXX a
m WordXX a
a | WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Bits a => a -> a -> a
.&. (WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1) WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
0 = String -> WordXX a
forall a. HasCallStack => String -> a
error (String -> WordXX a) -> String -> WordXX a
forall a b. (a -> b) -> a -> b
$ String
"align module is not power of two " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WordXX a -> String
forall a. Show a => a -> String
show WordXX a
m
                 | Bool
otherwise          = if WordXX a
a' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
t' WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
a then WordXX a
a' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
t' else WordXX a
a' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
t'
    where
        a' :: WordXX a
a' = WordXX a
a WordXX a -> WordXX a -> WordXX a
forall a. Bits a => a -> a -> a
.&. WordXX a -> WordXX a
forall a. Bits a => a -> a
complement (WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1)
        t' :: WordXX a
t' = WordXX a
t WordXX a -> WordXX a -> WordXX a
forall a. Bits a => a -> a -> a
.&. (WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1)

addRawData :: forall a . SingElfClassI a => BSL.ByteString -> [RBuilder a] -> [RBuilder a]
addRawData :: forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> [RBuilder a] -> [RBuilder a]
addRawData ByteString
_ [] = []
addRawData ByteString
bs [RBuilder a]
rBuilders = (WordXX a, [RBuilder a]) -> [RBuilder a]
forall a b. (a, b) -> b
snd ((WordXX a, [RBuilder a]) -> [RBuilder a])
-> (WordXX a, [RBuilder a]) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ WordXX a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
addRawData' WordXX a
0 (WordXX a
lrbie, [RBuilder a]
rBuilders)
    where

        -- e, e', ee and lrbie stand for the first occupied byte after the place being fixed
        -- lrbi: last rBuilder interval (begin, size)
        lrbi :: Interval (WordXX a)
lrbi@(I WordXX a
lrbib WordXX a
lrbis) = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval (RBuilder a -> Interval (WordXX a))
-> RBuilder a -> Interval (WordXX a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a
forall a. HasCallStack => [a] -> a
L.last [RBuilder a]
rBuilders
        lrbie :: WordXX a
lrbie = if Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval (WordXX a)
lrbi then WordXX a
lrbib else WordXX a
lrbib WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
lrbis

        allEmpty :: WordXX a -> WordXX a -> Bool
        allEmpty :: WordXX a -> WordXX a -> Bool
allEmpty WordXX a
b WordXX a
s = (Word8 -> Bool) -> ByteString -> Bool
BSL.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bs'
            where
                bs' :: ByteString
bs' = ByteString -> Int64 -> Int64 -> ByteString
cut ByteString
bs (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
b) (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
s)

        addRawData' :: WordXX a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
        addRawData' :: WordXX a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
addRawData' WordXX a
alignHint (WordXX a
e, [RBuilder a]
rbs) = (RBuilder a
 -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a]))
-> (WordXX a, [RBuilder a])
-> [RBuilder a]
-> (WordXX a, [RBuilder a])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr RBuilder a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
f (WordXX a
e, []) ([RBuilder a] -> (WordXX a, [RBuilder a]))
-> [RBuilder a] -> (WordXX a, [RBuilder a])
forall a b. (a -> b) -> a -> b
$ (RBuilder a -> RBuilder a) -> [RBuilder a] -> [RBuilder a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RBuilder a -> RBuilder a
fixRBuilder [RBuilder a]
rbs
            where
                f :: RBuilder a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
f RBuilder a
rb (WordXX a
e', [RBuilder a]
rbs') =
                    let
                        i :: Interval (WordXX a)
i@(I WordXX a
b WordXX a
s) = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
rb
                        b' :: WordXX a
b' = if Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval (WordXX a)
i then WordXX a
b else WordXX a
b WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
s
                        rbs'' :: [RBuilder a]
rbs'' = WordXX a -> WordXX a -> [RBuilder a] -> [RBuilder a]
addRaw WordXX a
b' WordXX a
e' [RBuilder a]
rbs'
                    in
                        (WordXX a
b, RBuilder a
rb RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'')

                fixRBuilder :: RBuilder a -> RBuilder a
                fixRBuilder :: RBuilder a -> RBuilder a
fixRBuilder RBuilder a
p | Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty (Interval (WordXX a) -> Bool) -> Interval (WordXX a) -> Bool
forall a b. (a -> b) -> a -> b
$ RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
p = RBuilder a
p
                fixRBuilder p :: RBuilder a
p@RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..} =
                    RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = WordXX a -> WordXX a -> [RBuilder a] -> [RBuilder a]
addRaw WordXX a
b WordXX a
ee' [RBuilder a]
rbs', Word16
SegmentXX a
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
..}
                        where
                            (I WordXX a
b WordXX a
s) = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
p
                            ee :: WordXX a
ee = WordXX a
b WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
s
                            alignHint' :: WordXX a
alignHint' = WordXX a -> WordXX a -> WordXX a
forall a. Ord a => a -> a -> a
max (SegmentXX a -> WordXX a
forall (c :: ElfClass). SegmentXX c -> WordXX c
pAlign SegmentXX a
rbpHeader) WordXX a
alignHint
                            (WordXX a
ee', [RBuilder a]
rbs') = WordXX a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
addRawData' WordXX a
alignHint' (WordXX a
ee, [RBuilder a]
rbpData)
                fixRBuilder RBuilder a
x = RBuilder a
x

                -- b is the first free byte
                addRaw :: WordXX a -> WordXX a -> [RBuilder a] -> [RBuilder a]
                addRaw :: WordXX a -> WordXX a -> [RBuilder a] -> [RBuilder a]
addRaw WordXX a
b WordXX a
ee [RBuilder a]
rbs' =
                    if WordXX a
b WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
ee
                        then
                            if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ WordXX a -> WordXX a -> Bool
allEmpty WordXX a
b WordXX a
s
                                then
                                    Interval (WordXX a) -> RBuilder a
forall (c :: ElfClass). Interval (WordXX c) -> RBuilder c
RBuilderRawData (WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
b WordXX a
s) RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'
                                else
                                    -- check e' < ee means
                                    -- check if next section/segment was actually placed (ee) with greater offset
                                    -- than is required by alignment rules (e')
                                    if WordXX a
e' WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
ee Bool -> Bool -> Bool
&& WordXX a
e'' WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
== WordXX a
ee
                                        then
                                            WordXX a -> WordXX a -> RBuilder a
forall (c :: ElfClass). WordXX c -> WordXX c -> RBuilder c
RBuilderRawAlign WordXX a
ee WordXX a
alignHint RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'
                                        else
                                            [RBuilder a]
rbs'
                        else
                            [RBuilder a]
rbs'
                    where
                        s :: WordXX a
s = WordXX a
ee WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
b
                        eAddr :: WordXX a
eAddr = case [RBuilder a]
rbs' of
                            (RBuilderSegment{rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpHeader = SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX a
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
pType :: ElfSegmentType
pFlags :: ElfSegmentFlag
pOffset :: WordXX a
pVirtAddr :: WordXX a
pPhysAddr :: WordXX a
pFileSize :: WordXX a
pMemSize :: WordXX a
pAlign :: WordXX a
..}} : [RBuilder a]
_) -> WordXX a
pVirtAddr
                            [RBuilder a]
_ -> WordXX a
0
                        eAddrAlign :: WordXX a
eAddrAlign = case [RBuilder a]
rbs' of
                            (RBuilderSegment{rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpHeader = SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX a
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
pType :: ElfSegmentType
pFlags :: ElfSegmentFlag
pOffset :: WordXX a
pVirtAddr :: WordXX a
pPhysAddr :: WordXX a
pFileSize :: WordXX a
pMemSize :: WordXX a
pAlign :: WordXX a
..}} : [RBuilder a]
_) -> WordXX a
pAlign
                            (RBuilderSection{rbsHeader :: forall (c :: ElfClass). RBuilder c -> SectionXX c
rbsHeader = SectionXX{Word32
ElfSectionType
WordXX a
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sName :: forall (c :: ElfClass). SectionXX c -> Word32
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX a
sAddr :: WordXX a
sOffset :: WordXX a
sSize :: WordXX a
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX a
sEntSize :: WordXX a
..}} : [RBuilder a]
_) -> WordXX a
sAddrAlign
                            [RBuilder a]
_ -> ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
wordSize (ElfClass -> WordXX a) -> ElfClass -> WordXX a
forall a b. (a -> b) -> a -> b
$ SingElfClass a -> ElfClass
forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass (SingElfClass a -> ElfClass) -> SingElfClass a -> ElfClass
forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a
                        -- e' here is the address of the next section/segment
                        -- according to the regular alignment rules
                        e' :: WordXX a
e' = WordXX a -> WordXX a -> WordXX a -> WordXX a
forall (a :: ElfClass).
SingElfClassI a =>
WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset WordXX a
eAddr WordXX a
eAddrAlign WordXX a
b
                        e'' :: WordXX a
e'' = WordXX a -> WordXX a -> WordXX a -> WordXX a
forall (a :: ElfClass).
SingElfClassI a =>
WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset WordXX a
ee WordXX a
alignHint WordXX a
b

infix 9 !!?

(!!?) :: (Integral b) => [a] -> b -> Maybe a
!!? :: forall b a. Integral b => [a] -> b -> Maybe a
(!!?) [a]
xs b
i
    | b
i b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0     = Maybe a
forall a. Maybe a
Nothing
    | Bool
otherwise = b -> [a] -> Maybe a
forall b a. Integral b => b -> [a] -> Maybe a
go b
i [a]
xs
  where
    go :: (Integral b) => b -> [a] -> Maybe a
    go :: forall b a. Integral b => b -> [a] -> Maybe a
go b
0 (a
x:[a]
_)  = a -> Maybe a
forall a. a -> Maybe a
Just a
x
    go b
j (a
_:[a]
ys) = b -> [a] -> Maybe a
forall b a. Integral b => b -> [a] -> Maybe a
go (b
j b -> b -> b
forall a. Num a => a -> a -> a
- b
1) [a]
ys
    go b
_ []     = Maybe a
forall a. Maybe a
Nothing

-- | Parse ELF file and produce [`RBuilder`]
parseRBuilder :: (SingElfClassI a, MonadCatch m)
              => HeaderXX a     -- ^ ELF header
              -> [SectionXX a]  -- ^ Section table
              -> [SegmentXX a]  -- ^ Segment table
              -> BSL.ByteString -- ^ ELF file
              -> m [RBuilder a]
parseRBuilder :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
HeaderXX a
-> [SectionXX a] -> [SegmentXX a] -> ByteString -> m [RBuilder a]
parseRBuilder hdr :: HeaderXX a
hdr@HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX a
hPhOff :: WordXX a
hShOff :: WordXX a
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
..} [SectionXX a]
ss [SegmentXX a]
ps ByteString
bs = do


    let
        maybeStringSectionData :: Maybe ByteString
maybeStringSectionData = ByteString -> SectionXX a -> ByteString
forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> SectionXX a -> ByteString
getSectionData ByteString
bs (SectionXX a -> ByteString)
-> Maybe (SectionXX a) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([SectionXX a]
ss [SectionXX a] -> ElfSectionIndex -> Maybe (SectionXX a)
forall b a. Integral b => [a] -> b -> Maybe a
!!? ElfSectionIndex
hShStrNdx)

        mkRBuilderSection :: (SingElfClassI a, MonadCatch m) => (ElfSectionIndex, SectionXX a) -> m (RBuilder a)
        mkRBuilderSection :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
(ElfSectionIndex, SectionXX a) -> m (RBuilder a)
mkRBuilderSection (ElfSectionIndex
n, s :: SectionXX a
s@SectionXX{Word32
ElfSectionType
WordXX a
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sName :: forall (c :: ElfClass). SectionXX c -> Word32
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX a
sAddr :: WordXX a
sOffset :: WordXX a
sSize :: WordXX a
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX a
sEntSize :: WordXX a
..}) = do
            ByteString
stringSectionData <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> Maybe ByteString -> m ByteString
forall (m :: * -> *) a.
MonadThrow m =>
Loc -> String -> Maybe a -> m a
maybeAddContext String
"No string table" Maybe ByteString
maybeStringSectionData
            RBuilder a -> m (RBuilder a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RBuilder a -> m (RBuilder a)) -> RBuilder a -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ SectionXX a -> ElfSectionIndex -> String -> RBuilder a
forall (c :: ElfClass).
SectionXX c -> ElfSectionIndex -> String -> RBuilder c
RBuilderSection SectionXX a
s ElfSectionIndex
n (String -> RBuilder a) -> String -> RBuilder a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> String
getString ByteString
stringSectionData (Int64 -> String) -> Int64 -> String
forall a b. (a -> b) -> a -> b
$ Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sName

        mkRBuilderSegment :: (SingElfClassI a, MonadCatch m) => (Word16, SegmentXX a) -> m (RBuilder a)
        mkRBuilderSegment :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
(Word16, SegmentXX a) -> m (RBuilder a)
mkRBuilderSegment (Word16
n, SegmentXX a
p) = RBuilder a -> m (RBuilder a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RBuilder a -> m (RBuilder a)) -> RBuilder a -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ SegmentXX a -> Word16 -> [RBuilder a] -> RBuilder a
forall (c :: ElfClass).
SegmentXX c -> Word16 -> [RBuilder c] -> RBuilder c
RBuilderSegment SegmentXX a
p Word16
n []

    [RBuilder a]
sections <- ((ElfSectionIndex, SectionXX a) -> m (RBuilder a))
-> [(ElfSectionIndex, SectionXX a)] -> m [RBuilder a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ElfSectionIndex, SectionXX a) -> m (RBuilder a)
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
(ElfSectionIndex, SectionXX a) -> m (RBuilder a)
mkRBuilderSection ([(ElfSectionIndex, SectionXX a)] -> m [RBuilder a])
-> [(ElfSectionIndex, SectionXX a)] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [(ElfSectionIndex, SectionXX a)]
-> [(ElfSectionIndex, SectionXX a)]
forall a. [a] -> [a]
tail' ([(ElfSectionIndex, SectionXX a)]
 -> [(ElfSectionIndex, SectionXX a)])
-> [(ElfSectionIndex, SectionXX a)]
-> [(ElfSectionIndex, SectionXX a)]
forall a b. (a -> b) -> a -> b
$ [ElfSectionIndex]
-> [SectionXX a] -> [(ElfSectionIndex, SectionXX a)]
forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [ElfSectionIndex
0 .. ] [SectionXX a]
ss
    [RBuilder a]
segments <- ((Word16, SegmentXX a) -> m (RBuilder a))
-> [(Word16, SegmentXX a)] -> m [RBuilder a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Word16, SegmentXX a) -> m (RBuilder a)
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
(Word16, SegmentXX a) -> m (RBuilder a)
mkRBuilderSegment ([(Word16, SegmentXX a)] -> m [RBuilder a])
-> [(Word16, SegmentXX a)] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$         [Word16] -> [SegmentXX a] -> [(Word16, SegmentXX a)]
forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [Word16
0 .. ] [SegmentXX a]
ps

    let

        header :: RBuilder a
header            = HeaderXX a -> RBuilder a
forall (c :: ElfClass). HeaderXX c -> RBuilder c
RBuilderHeader HeaderXX a
hdr
        maybeSectionTable :: Maybe (RBuilder a)
maybeSectionTable = if Word16
hShNum Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0 then Maybe (RBuilder a)
forall a. Maybe a
Nothing else  RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just (RBuilder a -> Maybe (RBuilder a))
-> RBuilder a -> Maybe (RBuilder a)
forall a b. (a -> b) -> a -> b
$ HeaderXX a -> RBuilder a
forall (c :: ElfClass). HeaderXX c -> RBuilder c
RBuilderSectionTable HeaderXX a
hdr
        maybeSegmentTable :: Maybe (RBuilder a)
maybeSegmentTable = if Word16
hPhNum Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0 then Maybe (RBuilder a)
forall a. Maybe a
Nothing else  RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just (RBuilder a -> Maybe (RBuilder a))
-> RBuilder a -> Maybe (RBuilder a)
forall a b. (a -> b) -> a -> b
$ HeaderXX a -> RBuilder a
forall (c :: ElfClass). HeaderXX c -> RBuilder c
RBuilderSegmentTable HeaderXX a
hdr

    [RBuilder a]
rbs <- [RBuilder a] -> m [RBuilder a]
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> m [RBuilder a]
addRBuilders ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a
header] [RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ Maybe (RBuilder a) -> [RBuilder a]
forall a. Maybe a -> [a]
maybeToList Maybe (RBuilder a)
maybeSectionTable
                                   [RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ Maybe (RBuilder a) -> [RBuilder a]
forall a. Maybe a -> [a]
maybeToList Maybe (RBuilder a)
maybeSegmentTable
                                   [RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ [RBuilder a]
segments
                                   [RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ [RBuilder a]
sections
    [RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ ByteString -> [RBuilder a] -> [RBuilder a]
forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> [RBuilder a] -> [RBuilder a]
addRawData ByteString
bs [RBuilder a]
rbs

parseElf' :: forall a m . (SingElfClassI a, MonadCatch m) =>
                                               HeaderXX a ->
                                            [SectionXX a] ->
                                            [SegmentXX a] ->
                                           BSL.ByteString -> m Elf
parseElf' :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
HeaderXX a -> [SectionXX a] -> [SegmentXX a] -> ByteString -> m Elf
parseElf' hdr :: HeaderXX a
hdr@HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX a
hPhOff :: WordXX a
hShOff :: WordXX a
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
..} [SectionXX a]
ss [SegmentXX a]
ps ByteString
bs = do

    [RBuilder a]
rbs <- HeaderXX a
-> [SectionXX a] -> [SegmentXX a] -> ByteString -> m [RBuilder a]
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
HeaderXX a
-> [SectionXX a] -> [SegmentXX a] -> ByteString -> m [RBuilder a]
parseRBuilder HeaderXX a
hdr [SectionXX a]
ss [SegmentXX a]
ps ByteString
bs

    let
        rBuilderToElf :: RBuilder a -> ElfListXX a -> m (ElfListXX a)
        rBuilderToElf :: RBuilder a -> ElfListXX a -> m (ElfListXX a)
rBuilderToElf RBuilderHeader{} ElfListXX a
l =
            ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'Header a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons ElfHeader
                { ehData :: ElfData
ehData       = ElfData
hData
                , ehOSABI :: ElfOSABI
ehOSABI      = ElfOSABI
hOSABI
                , ehABIVersion :: Word8
ehABIVersion = Word8
hABIVersion
                , ehType :: ElfType
ehType       = ElfType
hType
                , ehMachine :: ElfMachine
ehMachine    = ElfMachine
hMachine
                , ehEntry :: WordXX a
ehEntry      = WordXX a
hEntry
                , ehFlags :: Word32
ehFlags      = Word32
hFlags
                } ElfListXX a
l
        rBuilderToElf RBuilderSectionTable{} ElfListXX a
l =
            ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'SectionTable a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons ElfXX 'SectionTable a
forall (c :: ElfClass). ElfXX 'SectionTable c
ElfSectionTable ElfListXX a
l
        rBuilderToElf RBuilderSegmentTable{} ElfListXX a
l =
            ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'SegmentTable a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons ElfXX 'SegmentTable a
forall (c :: ElfClass). ElfXX 'SegmentTable c
ElfSegmentTable ElfListXX a
l
        rBuilderToElf RBuilderSection{ rbsHeader :: forall (c :: ElfClass). RBuilder c -> SectionXX c
rbsHeader = s :: SectionXX a
s@SectionXX{Word32
ElfSectionType
WordXX a
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sName :: forall (c :: ElfClass). SectionXX c -> Word32
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX a
sAddr :: WordXX a
sOffset :: WordXX a
sSize :: WordXX a
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX a
sEntSize :: WordXX a
..}, String
ElfSectionIndex
rbsN :: forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
rbsName :: forall (c :: ElfClass). RBuilder c -> String
rbsN :: ElfSectionIndex
rbsName :: String
..} ElfListXX a
l =
            ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'Section a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons ElfSection
                { esName :: String
esName      = String
rbsName
                , esType :: ElfSectionType
esType      = ElfSectionType
sType
                , esFlags :: ElfSectionFlag
esFlags     = WordXX a -> ElfSectionFlag
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
sFlags
                , esAddr :: WordXX a
esAddr      = WordXX a
sAddr
                , esAddrAlign :: WordXX a
esAddrAlign = WordXX a
sAddrAlign
                , esEntSize :: WordXX a
esEntSize   = WordXX a
sEntSize
                , esN :: ElfSectionIndex
esN         = ElfSectionIndex
rbsN
                , esInfo :: Word32
esInfo      = Word32
sInfo
                , esLink :: Word32
esLink      = Word32
sLink
                , esData :: ElfSectionData a
esData      =
                    if ElfSectionIndex
rbsN ElfSectionIndex -> ElfSectionIndex -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSectionIndex
hShStrNdx
                        then ElfSectionData a
forall (c :: ElfClass). ElfSectionData c
ElfSectionDataStringTable
                        else if ElfSectionType
sType ElfSectionType -> ElfSectionType -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSectionType
SHT_NOBITS
                            then WordXX a -> ElfSectionData a
forall (c :: ElfClass). WordXX c -> ElfSectionData c
ElfSectionDataNoBits WordXX a
sSize
                            else ByteString -> ElfSectionData a
forall (c :: ElfClass). ByteString -> ElfSectionData c
ElfSectionData (ByteString -> ElfSectionData a) -> ByteString -> ElfSectionData a
forall a b. (a -> b) -> a -> b
$ ByteString -> SectionXX a -> ByteString
forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> SectionXX a -> ByteString
getSectionData ByteString
bs SectionXX a
s
                } ElfListXX a
l
        rBuilderToElf RBuilderSegment{ rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpHeader = SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX a
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
pType :: ElfSegmentType
pFlags :: ElfSegmentFlag
pOffset :: WordXX a
pVirtAddr :: WordXX a
pPhysAddr :: WordXX a
pFileSize :: WordXX a
pMemSize :: WordXX a
pAlign :: WordXX a
..}, [RBuilder a]
Word16
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpN :: Word16
rbpData :: [RBuilder a]
..} ElfListXX a
l = do
            ElfListXX a
d <- (RBuilder a -> ElfListXX a -> m (ElfListXX a))
-> ElfListXX a -> [RBuilder a] -> m (ElfListXX a)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM RBuilder a -> ElfListXX a -> m (ElfListXX a)
rBuilderToElf ElfListXX a
forall (c :: ElfClass). ElfListXX c
ElfListNull [RBuilder a]
rbpData
            WordXX a
addMemSize <- if WordXX a
pMemSize WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
0 Bool -> Bool -> Bool
&& WordXX a
pFileSize WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
0 Bool -> Bool -> Bool
&& WordXX a
pMemSize WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
pFileSize
                then $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (WordXX a)
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"memSize < fileSize"
                else WordXX a -> m (WordXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (WordXX a
pMemSize WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
pFileSize)
            ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'Segment a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons ElfSegment
                { epType :: ElfSegmentType
epType        = ElfSegmentType
pType
                , epFlags :: ElfSegmentFlag
epFlags       = ElfSegmentFlag
pFlags
                , epVirtAddr :: WordXX a
epVirtAddr    = WordXX a
pVirtAddr
                , epPhysAddr :: WordXX a
epPhysAddr    = WordXX a
pPhysAddr
                , epAddMemSize :: WordXX a
epAddMemSize  = WordXX a
addMemSize
                , epAlign :: WordXX a
epAlign       = WordXX a
pAlign
                , epData :: ElfListXX a
epData        = ElfListXX a
d
                } ElfListXX a
l
        rBuilderToElf RBuilderRawData{ rbrdInterval :: forall (c :: ElfClass). RBuilder c -> Interval (WordXX c)
rbrdInterval = I WordXX a
o WordXX a
s } ElfListXX a
l =
            ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'RawData a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons (ByteString -> ElfXX 'RawData a
forall (c :: ElfClass). ByteString -> ElfXX 'RawData c
ElfRawData (ByteString -> ElfXX 'RawData a) -> ByteString -> ElfXX 'RawData a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> Int64 -> ByteString
cut ByteString
bs (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
o) (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
s)) ElfListXX a
l
        rBuilderToElf RBuilderRawAlign{WordXX a
rbraOffset :: forall (c :: ElfClass). RBuilder c -> WordXX c
rbraAlign :: forall (c :: ElfClass). RBuilder c -> WordXX c
rbraOffset :: WordXX a
rbraAlign :: WordXX a
..} ElfListXX a
l =
            ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'RawAlign a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons (WordXX a -> WordXX a -> ElfXX 'RawAlign a
forall (c :: ElfClass). WordXX c -> WordXX c -> ElfXX 'RawAlign c
ElfRawAlign WordXX a
rbraOffset WordXX a
rbraAlign) ElfListXX a
l

    ElfListXX a
el <- (RBuilder a -> ElfListXX a -> m (ElfListXX a))
-> ElfListXX a -> [RBuilder a] -> m (ElfListXX a)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM RBuilder a -> ElfListXX a -> m (ElfListXX a)
rBuilderToElf ElfListXX a
forall (c :: ElfClass). ElfListXX c
ElfListNull [RBuilder a]
rbs --  mapM rBuilderToElf rbs
    Elf -> m Elf
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Elf -> m Elf) -> Elf -> m Elf
forall a b. (a -> b) -> a -> b
$ SingElfClass a -> ElfListXX a -> Elf
forall (a :: ElfClass). SingElfClass a -> ElfListXX a -> Elf
Elf SingElfClass a
forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass ElfListXX a
el

-- | Parse ELF file
parseElf :: MonadCatch m => BSL.ByteString -> m Elf
parseElf :: forall (m :: * -> *). MonadCatch m => ByteString -> m Elf
parseElf ByteString
bs = do
    Headers SingElfClass a
classS HeaderXX a
hdr [SectionXX a]
ss [SegmentXX a]
ps <- ByteString -> m Headers
forall (m :: * -> *). MonadThrow m => ByteString -> m Headers
parseHeaders ByteString
bs
    SingElfClass a
-> (SingElfClassI a =>
    HeaderXX a
    -> [SectionXX a] -> [SegmentXX a] -> ByteString -> m Elf)
-> HeaderXX a
-> [SectionXX a]
-> [SegmentXX a]
-> ByteString
-> m Elf
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass a
classS HeaderXX a -> [SectionXX a] -> [SegmentXX a] -> ByteString -> m Elf
SingElfClassI a =>
HeaderXX a -> [SectionXX a] -> [SegmentXX a] -> ByteString -> m Elf
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
HeaderXX a -> [SectionXX a] -> [SegmentXX a] -> ByteString -> m Elf
parseElf' HeaderXX a
hdr [SectionXX a]
ss [SegmentXX a]
ps ByteString
bs

-------------------------------------------------------------------------------
--
-------------------------------------------------------------------------------

wbStateInit :: forall a . SingElfClassI a => WBuilderState a
wbStateInit :: forall (a :: ElfClass). SingElfClassI a => WBuilderState a
wbStateInit = WBuilderState
    { _wbsSections :: [(ElfSectionIndex, SectionXX a)]
_wbsSections         = []
    , _wbsSegmentsReversed :: [SegmentXX a]
_wbsSegmentsReversed = []
    , _wbsDataReversed :: [WBuilderData]
_wbsDataReversed     = []
    , _wbsOffset :: WordXX a
_wbsOffset           = WordXX a
0
    , _wbsPhOff :: WordXX a
_wbsPhOff            = WordXX a
0
    , _wbsShOff :: WordXX a
_wbsShOff            = WordXX a
0
    , _wbsShStrNdx :: ElfSectionIndex
_wbsShStrNdx         = ElfSectionIndex
0
    , _wbsNameIndexes :: [Int64]
_wbsNameIndexes      = []
    }

zeroSection :: forall a . SingElfClassI a => SectionXX a
zeroSection :: forall (a :: ElfClass). SingElfClassI a => SectionXX a
zeroSection = Word32
-> ElfSectionType
-> WordXX a
-> WordXX a
-> WordXX a
-> WordXX a
-> Word32
-> Word32
-> WordXX a
-> WordXX a
-> SectionXX a
forall (c :: ElfClass).
Word32
-> ElfSectionType
-> WordXX c
-> WordXX c
-> WordXX c
-> WordXX c
-> Word32
-> Word32
-> WordXX c
-> WordXX c
-> SectionXX c
SectionXX Word32
0 ElfSectionType
0 WordXX a
0 WordXX a
0 WordXX a
0 WordXX a
0 Word32
0 Word32
0 WordXX a
0 WordXX a
0

neighbours :: [a] -> (a -> a -> b) -> [b]
neighbours :: forall a b. [a] -> (a -> a -> b) -> [b]
neighbours          [] a -> a -> b
_ = []
neighbours x :: [a]
x@(a
_:[a]
xtail) a -> a -> b
f = ((a, a) -> b) -> [(a, a)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a -> b) -> (a, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> b
f) ([(a, a)] -> [b]) -> [(a, a)] -> [b]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [a]
x [a]
xtail

-- make string table and indexes for it from a list of strings
mkStringTable :: [String] -> (BSL.ByteString, [Int64])
mkStringTable :: [String] -> (ByteString, [Int64])
mkStringTable [String]
sectionNames = (ByteString
stringTable, [Int64]
os)
    where

        -- names:
        -- i for indexes of the section entry in section table
        -- n for section name string
        -- o for offset of the string in the string table
        -- in, io -- for pairs
        -- ins, ios -- for lists of pairs
        -- etc

        ([(Word32, String)]
ins0, [(Word32, String)]
ins) = ((Word32, String) -> Bool)
-> [(Word32, String)] -> ([(Word32, String)], [(Word32, String)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") (String -> Bool)
-> ((Word32, String) -> String) -> (Word32, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32, String) -> String
forall a b. (a, b) -> b
snd) ([(Word32, String)] -> ([(Word32, String)], [(Word32, String)]))
-> [(Word32, String)] -> ([(Word32, String)], [(Word32, String)])
forall a b. (a -> b) -> a -> b
$ ((Word32, String) -> Int)
-> [(Word32, String)] -> [(Word32, String)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length (String -> Int)
-> ((Word32, String) -> String) -> (Word32, String) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32, String) -> String
forall a b. (a, b) -> b
snd) ([(Word32, String)] -> [(Word32, String)])
-> [(Word32, String)] -> [(Word32, String)]
forall a b. (a -> b) -> a -> b
$ [Word32] -> [String] -> [(Word32, String)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [(Word32
1 :: Word32) .. ] [String]
sectionNames
        ios0 :: [(Word32, Int64)]
ios0 = ((Word32, String) -> (Word32, Int64))
-> [(Word32, String)] -> [(Word32, Int64)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32, String) -> (Word32, Int64)
forall {b} {a} {b}. Num b => (a, b) -> (a, b)
f' [(Word32, String)]
ins0
            where
                f' :: (a, b) -> (a, b)
f' (a
i, b
_) = (a
i, b
0)

        (ByteString
stringTable, [(Word32, Int64)]
ios, [(Word32, String)]
_) = (ByteString, [(Word32, Int64)], [(Word32, String)])
-> (ByteString, [(Word32, Int64)], [(Word32, String)])
forall {a}.
(ByteString, [(a, Int64)], [(a, String)])
-> (ByteString, [(a, Int64)], [(a, String)])
f (Word8 -> ByteString
BSL.singleton Word8
0, [], [(Word32, String)] -> [(Word32, String)]
forall a. [a] -> [a]
L.reverse [(Word32, String)]
ins)

        os :: [Int64]
os = ((Word32, Int64) -> Int64) -> [(Word32, Int64)] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32, Int64) -> Int64
forall a b. (a, b) -> b
snd ([(Word32, Int64)] -> [Int64]) -> [(Word32, Int64)] -> [Int64]
forall a b. (a -> b) -> a -> b
$ ((Word32, Int64) -> Word32)
-> [(Word32, Int64)] -> [(Word32, Int64)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (Word32, Int64) -> Word32
forall a b. (a, b) -> a
fst ([(Word32, Int64)] -> [(Word32, Int64)])
-> [(Word32, Int64)] -> [(Word32, Int64)]
forall a b. (a -> b) -> a -> b
$ [(Word32, Int64)]
ios0 [(Word32, Int64)] -> [(Word32, Int64)] -> [(Word32, Int64)]
forall a. [a] -> [a] -> [a]
++ [(Word32, Int64)]
ios

        -- create string table.  If one name is a suffix of another,
        -- allocate only the longest name in string table
        f :: (ByteString, [(a, Int64)], [(a, String)])
-> (ByteString, [(a, Int64)], [(a, String)])
f x :: (ByteString, [(a, Int64)], [(a, String)])
x@(ByteString
_, [(a, Int64)]
_, []) = (ByteString, [(a, Int64)], [(a, String)])
x
        f (ByteString
st, [(a, Int64)]
iosf, (a
i, String
n) : [(a, String)]
insf) = (ByteString, [(a, Int64)], [(a, String)])
-> (ByteString, [(a, Int64)], [(a, String)])
f (ByteString
st', [(a, Int64)]
iosf'', [(a, String)]
insf')

            where

                st' :: ByteString
st' = ByteString
st ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BSL8.pack String
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BSL.singleton Word8
0
                o :: Int64
o = ByteString -> Int64
BSL.length ByteString
st
                iosf'' :: [(a, Int64)]
iosf'' = (a
i, Int64
o) (a, Int64) -> [(a, Int64)] -> [(a, Int64)]
forall a. a -> [a] -> [a]
: [(a, Int64)]
iosf' [(a, Int64)] -> [(a, Int64)] -> [(a, Int64)]
forall a. [a] -> [a] -> [a]
++ [(a, Int64)]
iosf

                ([(a, Int64)]
iosf', [(a, String)]
insf') = [(a, String)] -> ([(a, Int64)], [(a, String)])
ff [(a, String)]
insf

                -- look if there exists a name that is a suffix for the currently allocated name
                -- in the list of unallocated indexed section names
                ff :: [(a, String)] -> ([(a, Int64)], [(a, String)])
ff = ((a, String)
 -> ([(a, Int64)], [(a, String)]) -> ([(a, Int64)], [(a, String)]))
-> ([(a, Int64)], [(a, String)])
-> [(a, String)]
-> ([(a, Int64)], [(a, String)])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr (a, String)
-> ([(a, Int64)], [(a, String)]) -> ([(a, Int64)], [(a, String)])
fff ([], [])
                    where
                        fff :: (a, String)
-> ([(a, Int64)], [(a, String)]) -> ([(a, Int64)], [(a, String)])
fff (a
i', String
n') ([(a, Int64)]
iosff, [(a, String)]
insff) = if String
n' String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` String
n
                            then
                                let
                                    o' :: Int64
o' = Int64
o Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
n')
                                in
                                    ((a
i', Int64
o') (a, Int64) -> [(a, Int64)] -> [(a, Int64)]
forall a. a -> [a] -> [a]
: [(a, Int64)]
iosff, [(a, String)]
insff)
                            else ([(a, Int64)]
iosff, (a
i', String
n') (a, String) -> [(a, String)] -> [(a, String)]
forall a. a -> [a] -> [a]
: [(a, String)]
insff)

serializeElf' :: forall a m . (SingElfClassI a, MonadCatch m) => ElfListXX a -> m BSL.ByteString
serializeElf' :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
ElfListXX a -> m ByteString
serializeElf' ElfListXX a
elfs = do

    -- FIXME: it's better to match constructor here, but there is a bug that prevents to conclude that
    -- the match is irrefutable:
    -- https://stackoverflow.com/questions/72803815/phantom-type-makes-pattern-matching-irrefutable-but-that-seemingly-does-not-wor
    -- https://gitlab.haskell.org/ghc/ghc/-/issues/15681#note_165436
    -- But if I use lazy pattern match, then some other bug comes up that prevents type inference
    -- on GHC 9.0.2
    ElfXX 'Header a
header' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (ElfXX 'Header a) -> m (ElfXX 'Header a)
(Loc -> String -> m (ElfXX 'Header a) -> m (ElfXX 'Header a))
-> String -> Loc -> m (ElfXX 'Header a) -> m (ElfXX 'Header a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (ElfXX 'Header a) -> m (ElfXX 'Header a))
-> m (ElfXX 'Header a) -> m (ElfXX 'Header a)
forall a b. (a -> b) -> a -> b
$ ElfListXX a -> m (ElfXX 'Header a)
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadThrow m) =>
ElfListXX a -> m (ElfXX 'Header a)
elfFindHeader ElfListXX a
elfs

    let

        elfClass :: ElfClass
elfClass = SingElfClass a -> ElfClass
forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass (SingElfClass a -> ElfClass) -> SingElfClass a -> ElfClass
forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a

        sectionN :: Num b => b
        sectionN :: forall b. Num b => b
sectionN = Sum b -> b
forall a. Sum a -> a
getSum (Sum b -> b) -> Sum b -> b
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType). ElfXX t' a -> Sum b)
-> ElfListXX a -> Sum b
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> Sum b
forall {a} {t :: ElfNodeType} {c :: ElfClass}.
Num a =>
ElfXX t c -> Sum a
forall (t' :: ElfNodeType). ElfXX t' a -> Sum b
f ElfListXX a
elfs
            where
                f :: ElfXX t c -> Sum a
f ElfSection{} = a -> Sum a
forall a. a -> Sum a
Sum a
1
                f ElfXX t c
_ =  a -> Sum a
forall a. a -> Sum a
Sum a
0

        sectionNames :: [String]
        sectionNames :: [String]
sectionNames = (forall (t' :: ElfNodeType). ElfXX t' a -> [String])
-> ElfListXX a -> [String]
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> [String]
forall (t' :: ElfNodeType). ElfXX t' a -> [String]
f ElfListXX a
elfs
            where
                f :: ElfXX t a -> [String]
                f :: forall (t' :: ElfNodeType). ElfXX t' a -> [String]
f ElfSection{String
Word32
ElfSectionType
ElfSectionFlag
ElfSectionIndex
WordXX a
ElfSectionData a
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esName :: String
esType :: ElfSectionType
esFlags :: ElfSectionFlag
esAddr :: WordXX a
esAddrAlign :: WordXX a
esEntSize :: WordXX a
esN :: ElfSectionIndex
esInfo :: Word32
esLink :: Word32
esData :: ElfSectionData a
..} = [ String
esName ]
                f ElfXX t a
_ = []

        (ByteString
stringTable, [Int64]
nameIndexes) = [String] -> (ByteString, [Int64])
mkStringTable [String]
sectionNames

        segmentN :: Num b => b
        segmentN :: forall b. Num b => b
segmentN = Sum b -> b
forall a. Sum a -> a
getSum (Sum b -> b) -> Sum b -> b
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType). ElfXX t' a -> Sum b)
-> ElfListXX a -> Sum b
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> Sum b
forall {a} {t :: ElfNodeType} {c :: ElfClass}.
Num a =>
ElfXX t c -> Sum a
forall (t' :: ElfNodeType). ElfXX t' a -> Sum b
f ElfListXX a
elfs
            where
                f :: ElfXX t c -> Sum a
f ElfSegment{} = a -> Sum a
forall a. a -> Sum a
Sum a
1
                f ElfXX t c
_ =  a -> Sum a
forall a. a -> Sum a
Sum a
0

        sectionTable :: Bool
        sectionTable :: Bool
sectionTable = Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType). ElfXX t' a -> Any)
-> ElfListXX a -> Any
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> Any
forall (t' :: ElfNodeType). ElfXX t' a -> Any
forall {t :: ElfNodeType} {c :: ElfClass}. ElfXX t c -> Any
f ElfListXX a
elfs
            where
                f :: ElfXX t c -> Any
f ElfXX t c
ElfSectionTable =  Bool -> Any
Any Bool
True
                f ElfXX t c
_ = Bool -> Any
Any Bool
False

        align :: (MonadThrow n, MonadState (WBuilderState a) n) => WordXX a -> WordXX a -> n ()
        align :: forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
WordXX a -> WordXX a -> n ()
align WordXX a
_ WordXX a
0 = () -> n ()
forall a. a -> n a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        align WordXX a
_ WordXX a
1 = () -> n ()
forall a. a -> n a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        align WordXX a
t WordXX a
m | WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Bits a => a -> a -> a
.&. (WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1) WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
0 = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> n ()
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> n ()) -> String -> n ()
forall a b. (a -> b) -> a -> b
$ String
"align module is not power of two " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WordXX a -> String
forall a. Show a => a -> String
show WordXX a
m
                  | Bool
otherwise = do
            WordXX a
offset  <- Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset
            (WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
 -> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= WordXX a -> WordXX a -> WordXX a -> WordXX a
forall (a :: ElfClass).
SingElfClassI a =>
WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset WordXX a
t WordXX a
m WordXX a
offset
            WordXX a
offset' <- Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset
            ([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
 -> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ByteString -> WBuilderData
WBuilderDataByteStream (Int64 -> Word8 -> ByteString
BSL.replicate (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordXX a -> Int64) -> WordXX a -> Int64
forall a b. (a -> b) -> a -> b
$ WordXX a
offset' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
offset) Word8
0) WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)

        alignWord :: (MonadThrow n, MonadState (WBuilderState a) n) => n ()
        alignWord :: forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
n ()
alignWord = WordXX a -> WordXX a -> n ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
WordXX a -> WordXX a -> n ()
align WordXX a
0 (WordXX a -> n ()) -> WordXX a -> n ()
forall a b. (a -> b) -> a -> b
$ ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
wordSize (ElfClass -> WordXX a) -> ElfClass -> WordXX a
forall a b. (a -> b) -> a -> b
$ SingElfClass a -> ElfClass
forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass (SingElfClass a -> ElfClass) -> SingElfClass a -> ElfClass
forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a

        dataIsEmpty :: ElfSectionData c -> Bool
        dataIsEmpty :: forall (c :: ElfClass). ElfSectionData c -> Bool
dataIsEmpty (ElfSectionData ByteString
bs)       = ByteString -> Bool
BSL.null ByteString
bs
        dataIsEmpty ElfSectionData c
ElfSectionDataStringTable = ByteString -> Bool
BSL.null ByteString
stringTable
        dataIsEmpty (ElfSectionDataNoBits WordXX c
_)  = Bool
True

        lastSection :: ElfListXX a -> (forall t' . (ElfXX t' a -> b)) -> b -> b
        lastSection :: forall b.
ElfListXX a
-> (forall (t' :: ElfNodeType). ElfXX t' a -> b) -> b -> b
lastSection ElfListXX a
ElfListNull forall (t' :: ElfNodeType). ElfXX t' a -> b
_ b
b = b
b
        lastSection (ElfListCons ElfXX t a
v ElfListXX a
ElfListNull) forall (t' :: ElfNodeType). ElfXX t' a -> b
f b
_ = ElfXX t a -> b
forall (t' :: ElfNodeType). ElfXX t' a -> b
f ElfXX t a
v
        lastSection (ElfListCons ElfXX t a
_ ElfListXX a
l) forall (t' :: ElfNodeType). ElfXX t' a -> b
f b
b = ElfListXX a
-> (forall (t' :: ElfNodeType). ElfXX t' a -> b) -> b -> b
forall b.
ElfListXX a
-> (forall (t' :: ElfNodeType). ElfXX t' a -> b) -> b -> b
lastSection ElfListXX a
l ElfXX t' a -> b
forall (t' :: ElfNodeType). ElfXX t' a -> b
f b
b

        lastSectionIsEmpty :: ElfListXX a -> Bool
        lastSectionIsEmpty :: ElfListXX a -> Bool
lastSectionIsEmpty ElfListXX a
l = ElfListXX a
-> (forall (t' :: ElfNodeType). ElfXX t' a -> Bool) -> Bool -> Bool
forall b.
ElfListXX a
-> (forall (t' :: ElfNodeType). ElfXX t' a -> b) -> b -> b
lastSection ElfListXX a
l ElfXX t' a -> Bool
forall (t' :: ElfNodeType). ElfXX t' a -> Bool
forall {t :: ElfNodeType} {c :: ElfClass}. ElfXX t c -> Bool
f Bool
False
            where
                f :: ElfXX t c -> Bool
f ElfSection { String
Word32
ElfSectionType
ElfSectionFlag
ElfSectionIndex
WordXX c
ElfSectionData c
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esName :: String
esType :: ElfSectionType
esFlags :: ElfSectionFlag
esAddr :: WordXX c
esAddrAlign :: WordXX c
esEntSize :: WordXX c
esN :: ElfSectionIndex
esInfo :: Word32
esLink :: Word32
esData :: ElfSectionData c
.. } = ElfSectionData c -> Bool
forall (c :: ElfClass). ElfSectionData c -> Bool
dataIsEmpty ElfSectionData c
esData
                f ElfXX t c
_                 = Bool
False

        elf2WBuilder :: (MonadThrow n, MonadState (WBuilderState a) n) => ElfXX t a -> n ()
        elf2WBuilder :: forall (n :: * -> *) (t :: ElfNodeType).
(MonadThrow n, MonadState (WBuilderState a) n) =>
ElfXX t a -> n ()
elf2WBuilder ElfHeader{} = do
            -- FIXME: add push monad
            ([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
 -> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (WBuilderData
WBuilderDataHeader WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)
            (WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
 -> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
headerSize ElfClass
elfClass
        elf2WBuilder ElfXX t a
ElfSectionTable = do
            n ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
n ()
alignWord
            Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset n (WordXX a) -> (WordXX a -> n ()) -> n ()
forall a b. n a -> (a -> n b) -> n b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((WordXX a -> Identity (WordXX a))
 -> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsShOff
            ([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
 -> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (WBuilderData
WBuilderDataSectionTable WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)
            (WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
 -> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= (WordXX a
forall b. Num b => b
sectionN WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
1) WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
* ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
sectionTableEntrySize ElfClass
elfClass
        elf2WBuilder ElfXX t a
ElfSegmentTable = do
            n ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
n ()
alignWord
            Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset n (WordXX a) -> (WordXX a -> n ()) -> n ()
forall a b. n a -> (a -> n b) -> n b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((WordXX a -> Identity (WordXX a))
 -> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsPhOff
            ([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
 -> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (WBuilderData
WBuilderDataSegmentTable WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)
            (WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
 -> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= WordXX a
forall b. Num b => b
segmentN WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
* ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
segmentTableEntrySize ElfClass
elfClass
        elf2WBuilder ElfSection{esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esFlags = ElfSectionFlag Word64
f, String
Word32
ElfSectionType
ElfSectionIndex
WordXX a
ElfSectionData a
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esName :: String
esType :: ElfSectionType
esAddr :: WordXX a
esAddrAlign :: WordXX a
esEntSize :: WordXX a
esN :: ElfSectionIndex
esInfo :: Word32
esLink :: Word32
esData :: ElfSectionData a
..} = do
            Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word64
f Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. WordXX a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordXX a -> WordXX a
forall a. Bits a => a -> a
complement (forall a. Bounded a => a
maxBound @(WordXX a))) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0) do
                $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> n ()
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> n ()) -> String -> n ()
forall a b. (a -> b) -> a -> b
$ String
"section flags at section " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ElfSectionIndex -> String
forall a. Show a => a -> String
show ElfSectionIndex
esN String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"don't fit"
            -- I don't see any sense in aligning NOBITS section data
            -- still gcc does it for .o files
            Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ElfSectionType
esType ElfSectionType -> ElfSectionType -> Bool
forall a. Eq a => a -> a -> Bool
/= ElfSectionType
SHT_NOBITS Bool -> Bool -> Bool
|| (ElfXX 'Header a -> ElfType
forall (c :: ElfClass). ElfXX 'Header c -> ElfType
ehType ElfXX 'Header a
header') ElfType -> ElfType -> Bool
forall a. Eq a => a -> a -> Bool
== ElfType
ET_REL) do
                WordXX a -> WordXX a -> n ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
WordXX a -> WordXX a -> n ()
align WordXX a
0 WordXX a
esAddrAlign
            (Int64
n, [Int64]
ns) <- LensLike' (Const (Int64, [Int64])) (WBuilderState a) [Int64]
-> ([Int64] -> (Int64, [Int64])) -> n (Int64, [Int64])
forall s (m :: * -> *) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses LensLike' (Const (Int64, [Int64])) (WBuilderState a) [Int64]
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([Int64] -> f [Int64]) -> WBuilderState a -> f (WBuilderState a)
wbsNameIndexes \case
                Int64
n' : [Int64]
ns' -> (Int64
n', [Int64]
ns')
                [Int64]
_ -> String -> (Int64, [Int64])
forall a. HasCallStack => String -> a
error String
"internal error: different number of sections in two iterations"
            ElfSectionIndex
shStrNdx' <- Getting ElfSectionIndex (WBuilderState a) ElfSectionIndex
-> n ElfSectionIndex
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ElfSectionIndex (WBuilderState a) ElfSectionIndex
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(ElfSectionIndex -> f ElfSectionIndex)
-> WBuilderState a -> f (WBuilderState a)
wbsShStrNdx
            let
                (ByteString
d, ElfSectionIndex
shStrNdx, WordXX a
sz) = case ElfSectionData a
esData of
                    ElfSectionData { ByteString
esdData :: forall (c :: ElfClass). ElfSectionData c -> ByteString
esdData :: ByteString
.. } -> (ByteString
esdData, ElfSectionIndex
shStrNdx', Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> WordXX a) -> Int64 -> WordXX a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length ByteString
esdData)
                    ElfSectionData a
ElfSectionDataStringTable -> (ByteString
stringTable, ElfSectionIndex
esN, Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> WordXX a) -> Int64 -> WordXX a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length ByteString
stringTable)
                    ElfSectionDataNoBits { WordXX a
esdSize :: forall (c :: ElfClass). ElfSectionData c -> WordXX c
esdSize :: WordXX a
.. } -> (ByteString
BSL.empty, ElfSectionIndex
shStrNdx', WordXX a
esdSize)
                sName :: Word32
sName = Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n                 -- Word32
                sType :: ElfSectionType
sType = ElfSectionType
esType                         -- ElfSectionType
                sFlags :: WordXX a
sFlags = Word64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
f
                sAddr :: WordXX a
sAddr = WordXX a
esAddr                         -- WXX c
                sSize :: WordXX a
sSize = WordXX a
sz                             -- WXX c
                sLink :: Word32
sLink = Word32
esLink                         -- Word32
                sInfo :: Word32
sInfo = Word32
esInfo                         -- Word32
                sAddrAlign :: WordXX a
sAddrAlign = WordXX a
esAddrAlign               -- WXX c
                sEntSize :: WordXX a
sEntSize = WordXX a
esEntSize                   -- WXX c
            WordXX a
sOffset <- Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset                   -- WXX c
            ([(ElfSectionIndex, SectionXX a)]
 -> Identity [(ElfSectionIndex, SectionXX a)])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([(ElfSectionIndex, SectionXX a)]
 -> f [(ElfSectionIndex, SectionXX a)])
-> WBuilderState a -> f (WBuilderState a)
wbsSections (([(ElfSectionIndex, SectionXX a)]
  -> Identity [(ElfSectionIndex, SectionXX a)])
 -> WBuilderState a -> Identity (WBuilderState a))
-> ([(ElfSectionIndex, SectionXX a)]
    -> [(ElfSectionIndex, SectionXX a)])
-> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((ElfSectionIndex
esN, SectionXX { Word32
ElfSectionType
WordXX a
sEntSize :: WordXX a
sAddrAlign :: WordXX a
sInfo :: Word32
sLink :: Word32
sSize :: WordXX a
sOffset :: WordXX a
sAddr :: WordXX a
sFlags :: WordXX a
sType :: ElfSectionType
sName :: Word32
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX a
sAddr :: WordXX a
sSize :: WordXX a
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX a
sEntSize :: WordXX a
sOffset :: WordXX a
.. }) (ElfSectionIndex, SectionXX a)
-> [(ElfSectionIndex, SectionXX a)]
-> [(ElfSectionIndex, SectionXX a)]
forall a. a -> [a] -> [a]
:)
            ([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
 -> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ByteString -> WBuilderData
WBuilderDataByteStream ByteString
d WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)
            (WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
 -> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
d)
            (ElfSectionIndex -> Identity ElfSectionIndex)
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(ElfSectionIndex -> f ElfSectionIndex)
-> WBuilderState a -> f (WBuilderState a)
wbsShStrNdx ((ElfSectionIndex -> Identity ElfSectionIndex)
 -> WBuilderState a -> Identity (WBuilderState a))
-> ElfSectionIndex -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ElfSectionIndex
shStrNdx
            ([Int64] -> Identity [Int64])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([Int64] -> f [Int64]) -> WBuilderState a -> f (WBuilderState a)
wbsNameIndexes (([Int64] -> Identity [Int64])
 -> WBuilderState a -> Identity (WBuilderState a))
-> [Int64] -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [Int64]
ns
        elf2WBuilder ElfSegment { ElfSegmentType
ElfSegmentFlag
WordXX a
ElfListXX a
epType :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentType
epFlags :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentFlag
epVirtAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epPhysAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAddMemSize :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAlign :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epData :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfListXX c
epType :: ElfSegmentType
epFlags :: ElfSegmentFlag
epVirtAddr :: WordXX a
epPhysAddr :: WordXX a
epAddMemSize :: WordXX a
epAlign :: WordXX a
epData :: ElfListXX a
.. } = do
            WordXX a -> WordXX a -> n ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
WordXX a -> WordXX a -> n ()
align WordXX a
epVirtAddr WordXX a
epAlign
            WordXX a
offset <- Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset
            n [()] -> n ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (n [()] -> n ()) -> n [()] -> n ()
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType). ElfXX t' a -> n ())
-> ElfListXX a -> n [()]
forall (m :: * -> *) (a :: ElfClass) b.
Monad m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m b)
-> ElfListXX a -> m [b]
mapMElfList ElfXX t' a -> n ()
forall (t' :: ElfNodeType). ElfXX t' a -> n ()
forall (n :: * -> *) (t :: ElfNodeType).
(MonadThrow n, MonadState (WBuilderState a) n) =>
ElfXX t a -> n ()
elf2WBuilder ElfListXX a
epData
            WordXX a
offset' <- Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset
            let
                -- allocate one more byte in the end of segment if there exists an empty section
                -- at the end so that that empty section will go to the current segment
                add1 :: Bool
add1 = ElfListXX a -> Bool
lastSectionIsEmpty ElfListXX a
epData Bool -> Bool -> Bool
&& WordXX a
offset WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
offset'
                pType :: ElfSegmentType
pType = ElfSegmentType
epType
                pFlags :: ElfSegmentFlag
pFlags = ElfSegmentFlag
epFlags
                pOffset :: WordXX a
pOffset = WordXX a
offset
                pVirtAddr :: WordXX a
pVirtAddr = WordXX a
epVirtAddr
                pPhysAddr :: WordXX a
pPhysAddr = WordXX a
epPhysAddr
                pFileSize :: WordXX a
pFileSize = WordXX a
offset' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
offset WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ if Bool
add1 then WordXX a
1 else WordXX a
0
                pMemSize :: WordXX a
pMemSize = WordXX a
pFileSize WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
epAddMemSize
                pAlign :: WordXX a
pAlign = WordXX a
epAlign
            ([SegmentXX a] -> Identity [SegmentXX a])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([SegmentXX a] -> f [SegmentXX a])
-> WBuilderState a -> f (WBuilderState a)
wbsSegmentsReversed (([SegmentXX a] -> Identity [SegmentXX a])
 -> WBuilderState a -> Identity (WBuilderState a))
-> ([SegmentXX a] -> [SegmentXX a]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (SegmentXX { ElfSegmentType
ElfSegmentFlag
WordXX a
pMemSize :: WordXX a
pFileSize :: WordXX a
pAlign :: WordXX a
pPhysAddr :: WordXX a
pVirtAddr :: WordXX a
pOffset :: WordXX a
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
pType :: ElfSegmentType
pFlags :: ElfSegmentFlag
pOffset :: WordXX a
pVirtAddr :: WordXX a
pPhysAddr :: WordXX a
pFileSize :: WordXX a
pMemSize :: WordXX a
pAlign :: WordXX a
.. } SegmentXX a -> [SegmentXX a] -> [SegmentXX a]
forall a. a -> [a] -> [a]
:)
            Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
add1 do
                ([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
 -> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ByteString -> WBuilderData
WBuilderDataByteStream (Word8 -> ByteString
BSL.singleton Word8
0) WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)
                (WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
 -> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= WordXX a
1
        elf2WBuilder ElfRawData { ByteString
edData :: forall (c :: ElfClass). ElfXX 'RawData c -> ByteString
edData :: ByteString
.. } = do
            ([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
 -> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ByteString -> WBuilderData
WBuilderDataByteStream ByteString
edData WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)
            (WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
 -> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
edData)
        elf2WBuilder ElfRawAlign { WordXX a
eaOffset :: forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaAlign :: forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaOffset :: WordXX a
eaAlign :: WordXX a
.. } = WordXX a -> WordXX a -> n ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
WordXX a -> WordXX a -> n ()
align WordXX a
eaOffset WordXX a
eaAlign

        fixSections :: [(ElfSectionIndex, SectionXX a)] -> m [SectionXX a]
        fixSections :: [(ElfSectionIndex, SectionXX a)] -> m [SectionXX a]
fixSections [(ElfSectionIndex, SectionXX a)]
ss = do
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(ElfSectionIndex, SectionXX a)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [(ElfSectionIndex, SectionXX a)]
ss Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall b. Num b => b
sectionN) (String -> m ()
forall a. HasCallStack => String -> a
error String
"internal error: L.length ss /= sectionN")
            let
                f :: (a, b) -> (a, b) -> Ordering
f (a
ln, b
_) (a
rn, b
_) = a
ln a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
rn
                sorted :: [(ElfSectionIndex, SectionXX a)]
sorted = ((ElfSectionIndex, SectionXX a)
 -> (ElfSectionIndex, SectionXX a) -> Ordering)
-> [(ElfSectionIndex, SectionXX a)]
-> [(ElfSectionIndex, SectionXX a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (ElfSectionIndex, SectionXX a)
-> (ElfSectionIndex, SectionXX a) -> Ordering
forall {a} {b} {b}. Ord a => (a, b) -> (a, b) -> Ordering
f [(ElfSectionIndex, SectionXX a)]
ss
                next :: (a, b) -> (a, b) -> Bool
next (a
ln, b
_) (a
rn, b
_) = a
ln a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
rn
                checkNeibours :: Bool
checkNeibours = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ [(ElfSectionIndex, SectionXX a)]
-> ((ElfSectionIndex, SectionXX a)
    -> (ElfSectionIndex, SectionXX a) -> Bool)
-> [Bool]
forall a b. [a] -> (a -> a -> b) -> [b]
neighbours [(ElfSectionIndex, SectionXX a)]
sorted (ElfSectionIndex, SectionXX a)
-> (ElfSectionIndex, SectionXX a) -> Bool
forall {a} {b} {b}. (Eq a, Num a) => (a, b) -> (a, b) -> Bool
next

            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
checkNeibours ($Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m ()
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"sections are not consistent")
            [SectionXX a] -> m [SectionXX a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SectionXX a] -> m [SectionXX a])
-> [SectionXX a] -> m [SectionXX a]
forall a b. (a -> b) -> a -> b
$ ((ElfSectionIndex, SectionXX a) -> SectionXX a)
-> [(ElfSectionIndex, SectionXX a)] -> [SectionXX a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ElfSectionIndex, SectionXX a) -> SectionXX a
forall a b. (a, b) -> b
snd [(ElfSectionIndex, SectionXX a)]
sorted

        wbState2ByteString :: WBuilderState a -> m BSL.ByteString
        wbState2ByteString :: WBuilderState a -> m ByteString
wbState2ByteString WBuilderState{[Int64]
[(ElfSectionIndex, SectionXX a)]
[SegmentXX a]
[WBuilderData]
ElfSectionIndex
WordXX a
_wbsSections :: forall (a :: ElfClass).
WBuilderState a -> [(ElfSectionIndex, SectionXX a)]
_wbsSegmentsReversed :: forall (a :: ElfClass). WBuilderState a -> [SegmentXX a]
_wbsDataReversed :: forall (a :: ElfClass). WBuilderState a -> [WBuilderData]
_wbsOffset :: forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsPhOff :: forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsShOff :: forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsShStrNdx :: forall (a :: ElfClass). WBuilderState a -> ElfSectionIndex
_wbsNameIndexes :: forall (a :: ElfClass). WBuilderState a -> [Int64]
_wbsSections :: [(ElfSectionIndex, SectionXX a)]
_wbsSegmentsReversed :: [SegmentXX a]
_wbsDataReversed :: [WBuilderData]
_wbsOffset :: WordXX a
_wbsPhOff :: WordXX a
_wbsShOff :: WordXX a
_wbsShStrNdx :: ElfSectionIndex
_wbsNameIndexes :: [Int64]
..} = do

            [SectionXX a]
sections <- [(ElfSectionIndex, SectionXX a)] -> m [SectionXX a]
fixSections [(ElfSectionIndex, SectionXX a)]
_wbsSections

            let
                f :: WBuilderData -> ByteString
f WBuilderData
WBuilderDataHeader =
                    case ElfXX 'Header a
header' of
                        ElfHeader{Word8
Word32
ElfOSABI
ElfType
ElfMachine
WordXX a
ElfData
ehData :: forall (c :: ElfClass). ElfXX 'Header c -> ElfData
ehOSABI :: forall (c :: ElfClass). ElfXX 'Header c -> ElfOSABI
ehABIVersion :: forall (c :: ElfClass). ElfXX 'Header c -> Word8
ehType :: forall (c :: ElfClass). ElfXX 'Header c -> ElfType
ehMachine :: forall (c :: ElfClass). ElfXX 'Header c -> ElfMachine
ehEntry :: forall (c :: ElfClass). ElfXX 'Header c -> WordXX c
ehFlags :: forall (c :: ElfClass). ElfXX 'Header c -> Word32
ehData :: ElfData
ehOSABI :: ElfOSABI
ehABIVersion :: Word8
ehType :: ElfType
ehMachine :: ElfMachine
ehEntry :: WordXX a
ehFlags :: Word32
..} ->
                            let
                                hData :: ElfData
hData       = ElfData
ehData
                                hOSABI :: ElfOSABI
hOSABI      = ElfOSABI
ehOSABI
                                hABIVersion :: Word8
hABIVersion = Word8
ehABIVersion
                                hType :: ElfType
hType       = ElfType
ehType
                                hMachine :: ElfMachine
hMachine    = ElfMachine
ehMachine
                                hEntry :: WordXX a
hEntry      = WordXX a
ehEntry
                                hPhOff :: WordXX a
hPhOff      = WordXX a
_wbsPhOff
                                hShOff :: WordXX a
hShOff      = WordXX a
_wbsShOff
                                hFlags :: Word32
hFlags      = Word32
ehFlags
                                hPhEntSize :: Word16
hPhEntSize  = ElfClass -> Word16
forall a. Num a => ElfClass -> a
segmentTableEntrySize ElfClass
elfClass
                                hPhNum :: Word16
hPhNum      = Word16
forall b. Num b => b
segmentN :: Word16
                                hShEntSize :: Word16
hShEntSize  = ElfClass -> Word16
forall a. Num a => ElfClass -> a
sectionTableEntrySize ElfClass
elfClass
                                hShNum :: Word16
hShNum      = (if Bool
sectionTable then Word16
forall b. Num b => b
sectionN Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1 else Word16
0) :: Word16
                                hShStrNdx :: ElfSectionIndex
hShStrNdx   = ElfSectionIndex
_wbsShStrNdx

                                h :: H.Header
                                h :: Header
h = SingElfClass a -> HeaderXX a -> Header
forall (a :: ElfClass). SingElfClass a -> HeaderXX a -> Header
H.Header (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hShStrNdx :: ElfSectionIndex
hShNum :: Word16
hShEntSize :: Word16
hPhNum :: Word16
hPhEntSize :: Word16
hFlags :: Word32
hShOff :: WordXX a
hPhOff :: WordXX a
hEntry :: WordXX a
hMachine :: ElfMachine
hType :: ElfType
hABIVersion :: Word8
hOSABI :: ElfOSABI
hData :: ElfData
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX a
hPhOff :: WordXX a
hShOff :: WordXX a
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
..}
                            in
                                Header -> ByteString
forall a. Binary a => a -> ByteString
encode Header
h
                f WBuilderDataByteStream {ByteString
wbdData :: WBuilderData -> ByteString
wbdData :: ByteString
..} = ByteString
wbdData
                f WBuilderData
WBuilderDataSectionTable =
                    ElfData -> [SectionXX a] -> ByteString
forall a.
(Binary (Le a), Binary (Be a)) =>
ElfData -> [a] -> ByteString
serializeBList (ElfXX 'Header a -> ElfData
forall (c :: ElfClass). ElfXX 'Header c -> ElfData
ehData ElfXX 'Header a
header') ([SectionXX a] -> ByteString) -> [SectionXX a] -> ByteString
forall a b. (a -> b) -> a -> b
$ SectionXX a
forall (a :: ElfClass). SingElfClassI a => SectionXX a
zeroSection SectionXX a -> [SectionXX a] -> [SectionXX a]
forall a. a -> [a] -> [a]
: [SectionXX a]
sections
                f WBuilderData
WBuilderDataSegmentTable =
                    ElfData -> [SegmentXX a] -> ByteString
forall a.
(Binary (Le a), Binary (Be a)) =>
ElfData -> [a] -> ByteString
serializeBList (ElfXX 'Header a -> ElfData
forall (c :: ElfClass). ElfXX 'Header c -> ElfData
ehData ElfXX 'Header a
header') ([SegmentXX a] -> ByteString) -> [SegmentXX a] -> ByteString
forall a b. (a -> b) -> a -> b
$ [SegmentXX a] -> [SegmentXX a]
forall a. [a] -> [a]
L.reverse [SegmentXX a]
_wbsSegmentsReversed

            ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ (WBuilderData -> ByteString) -> [WBuilderData] -> ByteString
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WBuilderData -> ByteString
f ([WBuilderData] -> ByteString) -> [WBuilderData] -> ByteString
forall a b. (a -> b) -> a -> b
$ [WBuilderData] -> [WBuilderData]
forall a. [a] -> [a]
L.reverse [WBuilderData]
_wbsDataReversed

    StateT (WBuilderState a) m [()]
-> WBuilderState a -> m (WBuilderState a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ((forall (t' :: ElfNodeType).
 ElfXX t' a -> StateT (WBuilderState a) m ())
-> ElfListXX a -> StateT (WBuilderState a) m [()]
forall (m :: * -> *) (a :: ElfClass) b.
Monad m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m b)
-> ElfListXX a -> m [b]
mapMElfList ElfXX t' a -> StateT (WBuilderState a) m ()
forall (t' :: ElfNodeType).
ElfXX t' a -> StateT (WBuilderState a) m ()
forall (n :: * -> *) (t :: ElfNodeType).
(MonadThrow n, MonadState (WBuilderState a) n) =>
ElfXX t a -> n ()
elf2WBuilder ElfListXX a
elfs) WBuilderState a
forall (a :: ElfClass). SingElfClassI a => WBuilderState a
wbStateInit{ _wbsNameIndexes = nameIndexes } m (WBuilderState a)
-> (WBuilderState a -> m ByteString) -> m ByteString
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WBuilderState a -> m ByteString
wbState2ByteString

-- | Serialze ELF file
serializeElf :: MonadCatch m => Elf -> m BSL.ByteString
serializeElf :: forall (m :: * -> *). MonadCatch m => Elf -> m ByteString
serializeElf (Elf SingElfClass a
classS ElfListXX a
ls) = SingElfClass a
-> (SingElfClassI a => ElfListXX a -> m ByteString)
-> ElfListXX a
-> m ByteString
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass a
classS SingElfClassI a => ElfListXX a -> m ByteString
ElfListXX a -> m ByteString
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
ElfListXX a -> m ByteString
serializeElf' ElfListXX a
ls

-------------------------------------------------------------------------------
--
-------------------------------------------------------------------------------

-- FIXME: move this to a separate file

-- | Parsed ELF symbol table entry. NB: This is work in progress
data ElfSymbolXX c =
    ElfSymbolXX
        { forall (c :: ElfClass). ElfSymbolXX c -> String
steName  :: String           -- ^ Symbol name (NB: String, not string index)
        , forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolBinding
steBind  :: ElfSymbolBinding -- ^ Symbol binding attributes
        , forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolType
steType  :: ElfSymbolType    -- ^ Symbol Type
        , forall (c :: ElfClass). ElfSymbolXX c -> ElfSectionIndex
steShNdx :: ElfSectionIndex  -- ^ Section table index
        , forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steValue :: WordXX c         -- ^ Symbol value
        , forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steSize  :: WordXX c         -- ^ Size of object
        }

getStringFromData :: BSL.ByteString -> Word32 -> String
getStringFromData :: ByteString -> Word32 -> String
getStringFromData ByteString
stringTable Word32
offset = ByteString -> String
BSL8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
BSL.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offset) ByteString
stringTable

mkElfSymbolTableEntry :: SingElfClassI a => BSL.ByteString -> SymbolXX a -> ElfSymbolXX a
mkElfSymbolTableEntry :: forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> SymbolXX a -> ElfSymbolXX a
mkElfSymbolTableEntry ByteString
stringTable SymbolXX{Word8
Word32
ElfSectionIndex
WordXX a
stName :: Word32
stInfo :: Word8
stOther :: Word8
stShNdx :: ElfSectionIndex
stValue :: WordXX a
stSize :: WordXX a
stSize :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stValue :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stShNdx :: forall (c :: ElfClass). SymbolXX c -> ElfSectionIndex
stOther :: forall (c :: ElfClass). SymbolXX c -> Word8
stInfo :: forall (c :: ElfClass). SymbolXX c -> Word8
stName :: forall (c :: ElfClass). SymbolXX c -> Word32
..} =
    let
        steName :: String
steName  = ByteString -> Word32 -> String
getStringFromData ByteString
stringTable Word32
stName
        steBind :: ElfSymbolBinding
steBind  = Word8 -> ElfSymbolBinding
ElfSymbolBinding (Word8 -> ElfSymbolBinding) -> Word8 -> ElfSymbolBinding
forall a b. (a -> b) -> a -> b
$ Word8
stInfo Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
        steType :: ElfSymbolType
steType  = Word8 -> ElfSymbolType
ElfSymbolType (Word8 -> ElfSymbolType) -> Word8 -> ElfSymbolType
forall a b. (a -> b) -> a -> b
$ Word8
stInfo Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0f
        steShNdx :: ElfSectionIndex
steShNdx = ElfSectionIndex
stShNdx
        steValue :: WordXX a
steValue = WordXX a
stValue
        steSize :: WordXX a
steSize  = WordXX a
stSize
    in
        ElfSymbolXX{String
ElfSymbolType
ElfSymbolBinding
ElfSectionIndex
WordXX a
steName :: String
steBind :: ElfSymbolBinding
steType :: ElfSymbolType
steShNdx :: ElfSectionIndex
steValue :: WordXX a
steSize :: WordXX a
steName :: String
steBind :: ElfSymbolBinding
steType :: ElfSymbolType
steShNdx :: ElfSectionIndex
steValue :: WordXX a
steSize :: WordXX a
..}

-- | Parse symbol table
parseSymbolTable :: (MonadThrow m, SingElfClassI a)
                 => ElfData           -- ^ Endianness of the ELF file
                 -> ElfXX 'Section a  -- ^ Parsed section such that @`sectionIsSymbolTable` . `sType`@ is true.
                 -> ElfListXX a       -- ^ Structured ELF data
                 -> m [ElfSymbolXX a] -- ^ Symbol table
parseSymbolTable :: forall (m :: * -> *) (a :: ElfClass).
(MonadThrow m, SingElfClassI a) =>
ElfData -> ElfXX 'Section a -> ElfListXX a -> m [ElfSymbolXX a]
parseSymbolTable ElfData
d symbolTableSection :: ElfXX 'Section a
symbolTableSection@(ElfSection { String
Word32
ElfSectionType
ElfSectionFlag
ElfSectionIndex
WordXX a
ElfSectionData a
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esName :: String
esType :: ElfSectionType
esFlags :: ElfSectionFlag
esAddr :: WordXX a
esAddrAlign :: WordXX a
esEntSize :: WordXX a
esN :: ElfSectionIndex
esInfo :: Word32
esLink :: Word32
esData :: ElfSectionData a
.. }) ElfListXX a
elfs = do

    ByteString
symbolTable <- case ElfXX 'Section a
symbolTableSection of
        ElfSection{ esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esData = ElfSectionData ByteString
st } -> ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
st
        ElfXX 'Section a
_ -> $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m ByteString
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"wrong symbol table section data"

    ElfXX 'Section a
section <- ElfListXX a -> Word32 -> m (ElfXX 'Section a)
forall (a :: ElfClass) (m :: * -> *) b.
(SingElfClassI a, MonadThrow m, Integral b, Show b) =>
ElfListXX a -> b -> m (ElfXX 'Section a)
elfFindSection ElfListXX a
elfs Word32
esLink
    ByteString
stringTable <- case ElfXX 'Section a
section of
        ElfSection{ esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esData = ElfSectionData ByteString
st } -> ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
st
        ElfXX 'Section a
_ -> $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m ByteString
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"wrong string table section data"

    [SymbolXX a]
st <- ElfData -> ByteString -> m [SymbolXX a]
forall (m :: * -> *) a.
(MonadThrow m, Binary (Le a), Binary (Be a)) =>
ElfData -> ByteString -> m [a]
parseBList ElfData
d ByteString
symbolTable
    [ElfSymbolXX a] -> m [ElfSymbolXX a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> SymbolXX a -> ElfSymbolXX a
forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> SymbolXX a -> ElfSymbolXX a
mkElfSymbolTableEntry ByteString
stringTable (SymbolXX a -> ElfSymbolXX a) -> [SymbolXX a] -> [ElfSymbolXX a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SymbolXX a]
st)

mkSymbolTableEntry :: Word32 -> ElfSymbolXX a -> SymbolXX a
mkSymbolTableEntry :: forall (a :: ElfClass). Word32 -> ElfSymbolXX a -> SymbolXX a
mkSymbolTableEntry Word32
nameIndex ElfSymbolXX{String
ElfSymbolType
ElfSymbolBinding
ElfSectionIndex
WordXX a
steName :: forall (c :: ElfClass). ElfSymbolXX c -> String
steBind :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolBinding
steType :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolType
steShNdx :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSectionIndex
steValue :: forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steSize :: forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steName :: String
steBind :: ElfSymbolBinding
steType :: ElfSymbolType
steShNdx :: ElfSectionIndex
steValue :: WordXX a
steSize :: WordXX a
..} =
    let
        ElfSymbolBinding Word8
b = ElfSymbolBinding
steBind
        ElfSymbolType Word8
t = ElfSymbolType
steType

        stName :: Word32
stName  = Word32
nameIndex
        stInfo :: Word8
stInfo  = Word8
b Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shift` Int
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
t
        stOther :: Word8
stOther = Word8
0 :: Word8
        stShNdx :: ElfSectionIndex
stShNdx = ElfSectionIndex
steShNdx
        stValue :: WordXX a
stValue = WordXX a
steValue
        stSize :: WordXX a
stSize  = WordXX a
steSize
    in
        SymbolXX{Word8
Word32
ElfSectionIndex
WordXX a
stSize :: WordXX a
stValue :: WordXX a
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
stName :: Word32
stInfo :: Word8
stOther :: Word8
stShNdx :: ElfSectionIndex
stValue :: WordXX a
stSize :: WordXX a
..}

-- | Serialize symbol table
serializeSymbolTable :: (MonadThrow m, SingElfClassI a)
                     => ElfData                            -- ^ Endianness of the ELF file
                     -> [ElfSymbolXX a]                    -- ^ Symbol table
                     -> m (BSL.ByteString, BSL.ByteString) -- ^ Pair of symbol table section data and string table section data
serializeSymbolTable :: forall (m :: * -> *) (a :: ElfClass).
(MonadThrow m, SingElfClassI a) =>
ElfData -> [ElfSymbolXX a] -> m (ByteString, ByteString)
serializeSymbolTable ElfData
d [ElfSymbolXX a]
ss = do

    let
        (ByteString
stringTable, [Int64]
stringIndexes) = [String] -> (ByteString, [Int64])
mkStringTable ([String] -> (ByteString, [Int64]))
-> [String] -> (ByteString, [Int64])
forall a b. (a -> b) -> a -> b
$ (ElfSymbolXX a -> String) -> [ElfSymbolXX a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElfSymbolXX a -> String
forall (c :: ElfClass). ElfSymbolXX c -> String
steName [ElfSymbolXX a]
ss
        ssWithNameIndexes :: [(ElfSymbolXX a, Int64)]
ssWithNameIndexes = [ElfSymbolXX a] -> [Int64] -> [(ElfSymbolXX a, Int64)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [ElfSymbolXX a]
ss [Int64]
stringIndexes

        f :: (ElfSymbolXX a, Int64) -> SymbolXX a
        f :: forall (a :: ElfClass). (ElfSymbolXX a, Int64) -> SymbolXX a
f (ElfSymbolXX a
s, Int64
n) = Word32 -> ElfSymbolXX a -> SymbolXX a
forall (a :: ElfClass). Word32 -> ElfSymbolXX a -> SymbolXX a
mkSymbolTableEntry (Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) ElfSymbolXX a
s

        symbolTable :: ByteString
symbolTable = ElfData -> [SymbolXX a] -> ByteString
forall a.
(Binary (Le a), Binary (Be a)) =>
ElfData -> [a] -> ByteString
serializeBList ElfData
d ([SymbolXX a] -> ByteString) -> [SymbolXX a] -> ByteString
forall a b. (a -> b) -> a -> b
$ ((ElfSymbolXX a, Int64) -> SymbolXX a)
-> [(ElfSymbolXX a, Int64)] -> [SymbolXX a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ElfSymbolXX a, Int64) -> SymbolXX a
forall (a :: ElfClass). (ElfSymbolXX a, Int64) -> SymbolXX a
f [(ElfSymbolXX a, Int64)]
ssWithNameIndexes

    (ByteString, ByteString) -> m (ByteString, ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
symbolTable, ByteString
stringTable)