-- | JS symbol generation
module GHC.StgToJS.Symbols
  ( moduleGlobalSymbol
  , moduleExportsSymbol
  , mkJsSymbol
  , mkJsSymbolBS
  , mkFreshJsSymbol
  , mkRawSymbol
  , intBS
  , word64BS
  ) where

import GHC.Prelude

import GHC.Data.FastString
import GHC.Unit.Module
import GHC.Utils.Word64 (intToWord64)
import Data.ByteString (ByteString)
import Data.Word (Word64)
import qualified Data.ByteString.Char8   as BSC
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Lazy    as BSL

-- | Hexadecimal representation of an int
--
-- Used for the sub indices.
intBS :: Int -> ByteString
intBS :: Int -> ByteString
intBS = Word64 -> ByteString
word64BS (Word64 -> ByteString) -> (Int -> Word64) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Int -> Word64
Int -> Word64
intToWord64

-- | Hexadecimal representation of a 64-bit word
--
-- Used for uniques. We could use base-62 as GHC usually does but this is likely
-- faster.
word64BS :: Word64 -> ByteString
word64BS :: Word64 -> ByteString
word64BS = LazyByteString -> ByteString
BSL.toStrict (LazyByteString -> ByteString)
-> (Word64 -> LazyByteString) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
BSB.toLazyByteString (Builder -> LazyByteString)
-> (Word64 -> Builder) -> Word64 -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Builder
BSB.word64Hex

-- | Return z-encoded unit:module
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" -- z-encoding for ":"
  , FastZString -> ByteString
fastZStringToByteString (FastString -> FastZString
zEncodeFS (ModuleName -> FastString
moduleNameFS (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)))
  ]

-- | the global linkable unit of a module exports this symbol, depend on it to
--   include that unit (used for cost centres)
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>"
  ]

-- | Make JS symbol corresponding to the given Haskell symbol in the given
-- module
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" -- z-encoding of "."
  , FastZString -> ByteString
fastZStringToByteString (FastString -> FastZString
zEncodeFS FastString
s)
  ]

-- | Make JS symbol corresponding to the given Haskell symbol in the given
-- module
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)

-- | Make JS symbol for given module and unique.
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
  ]

-- | Make symbol "h$XYZ" or "h$$XYZ"
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 ]

-- | "h$$" constant string
hdd :: ByteString
hdd :: ByteString
hdd = String -> ByteString
BSC.pack String
"h$$"

-- | "h$" constant string
hd :: ByteString
hd :: ByteString
hd = Int -> ByteString -> ByteString
BSC.take Int
2 ByteString
hdd