module GHC.StgToJS.Symbols
( moduleGlobalSymbol
, moduleExportsSymbol
, mkJsSymbol
, mkJsSymbolBS
, mkFreshJsSymbol
, mkRawSymbol
, intBS
) where
import GHC.Prelude
import GHC.Data.FastString
import GHC.Unit.Module
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Lazy as BSL
intBS :: Int -> ByteString
intBS :: Int -> ByteString
intBS = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Int -> ByteString) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString (Builder -> ByteString) -> (Int -> Builder) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Builder
BSB.wordHex (Word -> Builder) -> (Int -> Word) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral
unitModuleStringZ :: Module -> ByteString
unitModuleStringZ :: Module -> ByteString
unitModuleStringZ Module
mod = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ FastZString -> ByteString
fastZStringToByteString (FastString -> FastZString
zEncodeFS (UnitId -> FastString
unitIdFS (Module -> UnitId
moduleUnitId Module
mod)))
, String -> ByteString
BSC.pack String
"ZC"
, FastZString -> ByteString
fastZStringToByteString (FastString -> FastZString
zEncodeFS (ModuleName -> FastString
moduleNameFS (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)))
]
moduleGlobalSymbol :: Module -> FastString
moduleGlobalSymbol :: Module -> FastString
moduleGlobalSymbol Module
m = ByteString -> FastString
mkFastStringByteString (ByteString -> FastString) -> ByteString -> FastString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ ByteString
hd
, Module -> ByteString
unitModuleStringZ Module
m
, String -> ByteString
BSC.pack String
"_<global>"
]
moduleExportsSymbol :: Module -> FastString
moduleExportsSymbol :: Module -> FastString
moduleExportsSymbol Module
m = ByteString -> FastString
mkFastStringByteString (ByteString -> FastString) -> ByteString -> FastString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ ByteString
hd
, Module -> ByteString
unitModuleStringZ Module
m
, String -> ByteString
BSC.pack String
"_<exports>"
]
mkJsSymbolBS :: Bool -> Module -> FastString -> ByteString
mkJsSymbolBS :: Bool -> Module -> FastString -> ByteString
mkJsSymbolBS Bool
exported Module
mod FastString
s = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ if Bool
exported then ByteString
hd else ByteString
hdd
, Module -> ByteString
unitModuleStringZ Module
mod
, String -> ByteString
BSC.pack String
"zi"
, FastZString -> ByteString
fastZStringToByteString (FastString -> FastZString
zEncodeFS FastString
s)
]
mkJsSymbol :: Bool -> Module -> FastString -> FastString
mkJsSymbol :: Bool -> Module -> FastString -> FastString
mkJsSymbol Bool
exported Module
mod FastString
s = ByteString -> FastString
mkFastStringByteString (Bool -> Module -> FastString -> ByteString
mkJsSymbolBS Bool
exported Module
mod FastString
s)
mkFreshJsSymbol :: Module -> Int -> FastString
mkFreshJsSymbol :: Module -> Int -> FastString
mkFreshJsSymbol Module
mod Int
i = ByteString -> FastString
mkFastStringByteString (ByteString -> FastString) -> ByteString -> FastString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
[ ByteString
hdd
, Module -> ByteString
unitModuleStringZ Module
mod
, String -> ByteString
BSC.pack String
"_"
, Int -> ByteString
intBS Int
i
]
mkRawSymbol :: Bool -> FastString -> FastString
mkRawSymbol :: Bool -> FastString -> FastString
mkRawSymbol Bool
exported FastString
fs
| Bool
exported = ByteString -> FastString
mkFastStringByteString (ByteString -> FastString) -> ByteString -> FastString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [ ByteString
hd, FastString -> ByteString
bytesFS FastString
fs ]
| Bool
otherwise = ByteString -> FastString
mkFastStringByteString (ByteString -> FastString) -> ByteString -> FastString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [ ByteString
hdd, FastString -> ByteString
bytesFS FastString
fs ]
hdd :: ByteString
hdd :: ByteString
hdd = String -> ByteString
BSC.pack String
"h$$"
hd :: ByteString
hd :: ByteString
hd = Int -> ByteString -> ByteString
BSC.take Int
2 ByteString
hdd