Safe Haskell | None |
---|---|
Language | Haskell2010 |
Embed buffers into the program
Synopsis
- embedBytes :: [Word8] -> Q (TExp BufferE)
- embedFile :: FilePath -> Bool -> Maybe Word -> Maybe Word -> Maybe Word -> Q Exp
- embedBuffer :: Buffer mut pin fin heap -> Bool -> Maybe Word -> Maybe Word -> Maybe Word -> Q Exp
- embedPinnedBuffer :: Buffer mut Pinned fin heap -> Bool -> Maybe Word -> Maybe Word -> Maybe Word -> Q Exp
- embedUnpinnedBuffer :: Buffer mut NotPinned fin heap -> Bool -> Maybe Word -> Maybe Word -> Maybe Word -> Q Exp
- loadSymbol :: Word -> String -> Q Exp
- loadMutableSymbol :: Word -> String -> Q Exp
- toBufferE :: Ptr () -> Word# -> BufferE
- toBufferE' :: Addr# -> Word# -> BufferE
- toBufferME :: Ptr () -> Word# -> BufferME
- toBufferME' :: Addr# -> Word# -> BufferME
- makeEmbeddingFile :: FilePath -> [EmbedEntry] -> IO ()
- data EmbedEntry = EmbedEntry {}
- data SectionType
Documentation
embedBytes :: [Word8] -> Q (TExp BufferE) Source #
Embed bytes at compile time using GHC's literal strings.
>>>
:set -XTemplateHaskell
>>>
let b = $$(embedBytes [72,69,76,76,79])
>>>
bufferSize b
5
:: FilePath | File to embed |
-> Bool | Mutable buffer or not |
-> Maybe Word | Alignment |
-> Maybe Word | Offset in the file in bytes |
-> Maybe Word | Size to include in bytes (otherwise up to the end of the file) |
-> Q Exp | BufferE or BufferME depending on mutability |
Embed a file in the executable. Return a BufferE
:: Buffer mut pin fin heap | Source buffer |
-> Bool | Should the embedded buffer be mutable or not |
-> Maybe Word | Optional alignement constraint |
-> Maybe Word | Optional offset in the source buffer |
-> Maybe Word | Optional number of bytes to include |
-> Q Exp | BufferE or BufferME, depending on mutability parameter |
Embed a buffer in the executable. Return either a BufferE or a BufferME.
Internals
:: Buffer mut Pinned fin heap | Source buffer |
-> Bool | Should the embedded buffer be mutable |
-> Maybe Word | Alignement |
-> Maybe Word | Offset in the buffer |
-> Maybe Word | Number of Word8 to write |
-> Q Exp | BufferE or BufferME, depending on mutability parameter |
Embed a pinned buffer in the executable. Return either a BufferE or a BufferME.
:: Buffer mut NotPinned fin heap | Source buffer |
-> Bool | Should the embedded buffer be mutable |
-> Maybe Word | Alignement |
-> Maybe Word | Offset in the buffer |
-> Maybe Word | Number of Word8 to write |
-> Q Exp | BufferE or BufferME, depending on mutability parameter |
Embed a unpinned buffer in the executable. Return either a BufferE or a BufferME.
loadSymbol :: Word -> String -> Q Exp Source #
Load a buffer from a symbol. Return a BufferE
Note: we can't use Typed TH because of #13587
> -- Test.c > const char mydata[9] = {1,2,30,40,50,6,7,8,9};
> let b = $(loadSymbol 9 "mydata") > print (fmap (bufferReadWord8 b) [0..8])
- 1,2,30,40,50,6,7,8,9
loadMutableSymbol :: Word -> String -> Q Exp Source #
Load a buffer from a symbol. Return a BufferME
Note: we can't use Typed TH because of #13587
> -- Test.c > const char mydata[9] = {1,2,30,40,50,6,7,8,9}; > char mywrtdata[9] = {1,2,30,40,50,6,7,8,9};
> let w = $(loadMutableSymbol 9 "mywrtdata") > forM_ [0..8] (\i -> bufferWriteWord8IO w i (fromIntegral i)) > print =<< forM [0..8] (bufferReadWord8IO w)
- 0,1,2,3,4,5,6,7,8
Trying to write into constant memory: >> let err = $(loadMutableSymbol 9 "mydata") >> bufferWriteWordIO err 0 10 SEGFAULT
makeEmbeddingFile :: FilePath -> [EmbedEntry] -> IO () Source #
Create an assembler file for the given embedding entries
data EmbedEntry Source #
An embedding entry. Used to embed binary files into an executable
EmbedEntry | |
|
Instances
Eq EmbedEntry Source # | |
Defined in Haskus.Memory.Embed (==) :: EmbedEntry -> EmbedEntry -> Bool # (/=) :: EmbedEntry -> EmbedEntry -> Bool # | |
Ord EmbedEntry Source # | |
Defined in Haskus.Memory.Embed compare :: EmbedEntry -> EmbedEntry -> Ordering # (<) :: EmbedEntry -> EmbedEntry -> Bool # (<=) :: EmbedEntry -> EmbedEntry -> Bool # (>) :: EmbedEntry -> EmbedEntry -> Bool # (>=) :: EmbedEntry -> EmbedEntry -> Bool # max :: EmbedEntry -> EmbedEntry -> EmbedEntry # min :: EmbedEntry -> EmbedEntry -> EmbedEntry # | |
Show EmbedEntry Source # | |
Defined in Haskus.Memory.Embed showsPrec :: Int -> EmbedEntry -> ShowS # show :: EmbedEntry -> String # showList :: [EmbedEntry] -> ShowS # |
data SectionType Source #
Section type
ReadOnlySection | Read-only |
WriteableSection | Writable |
UninitializedSection | Uninitialized |
Instances
Eq SectionType Source # | |
Defined in Haskus.Memory.Embed (==) :: SectionType -> SectionType -> Bool # (/=) :: SectionType -> SectionType -> Bool # | |
Ord SectionType Source # | |
Defined in Haskus.Memory.Embed compare :: SectionType -> SectionType -> Ordering # (<) :: SectionType -> SectionType -> Bool # (<=) :: SectionType -> SectionType -> Bool # (>) :: SectionType -> SectionType -> Bool # (>=) :: SectionType -> SectionType -> Bool # max :: SectionType -> SectionType -> SectionType # min :: SectionType -> SectionType -> SectionType # | |
Show SectionType Source # | |
Defined in Haskus.Memory.Embed showsPrec :: Int -> SectionType -> ShowS # show :: SectionType -> String # showList :: [SectionType] -> ShowS # |