Mate/Strings.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE ForeignFunctionInterface #-}
   3 module Mate.Strings (
   4   getUniqueStringAddr
   5   ) where
   6
   7 import Data.Word
   8 import qualified Data.Map as M
   9 import qualified Data.ByteString.Lazy as B
  10 import qualified Data.ByteString.Internal as BI
  11 import Text.Printf
  12
  13 import Foreign.Ptr
  14 import Foreign.Marshal.Alloc
  15 import Foreign.Marshal.Utils
  16 import Foreign.Marshal.Array
  17
  18 import Mate.Types
  19
  20
  21 getUniqueStringAddr :: B.ByteString -> IO Word32
  22 getUniqueStringAddr str = do
  23   smap <- get_stringsmap >>= ptr2stringsmap
  24   case M.lookup str smap of
  25     Nothing -> do
  26       addr <- allocateJavaString str
  27       let smap' = M.insert str addr smap
  28       stringsmap2ptr smap' >>= set_stringsmap
  29       return addr
  30     Just addr -> return addr
  31
  32 allocateJavaString :: B.ByteString -> IO Word32
  33 allocateJavaString str = do
  34   -- TODO(bernhard): is this also true for UTF8 stuff?
  35   let strlen = fromIntegral $ B.length str
  36   arr <- newArray $ ((map fromIntegral $ B.unpack str) :: [Word8])
  37   -- (+1) for \0
  38   newstr <- mallocBytes (strlen + 1)
  39   BI.memset newstr 0 (fromIntegral $ strlen + 1)
  40   copyBytes newstr arr strlen
  41   let w32_ptr = fromIntegral $ ptrToIntPtr newstr
  42   printf "new str ptr: 0x%08x (%s)@%d\n" w32_ptr (toString str) strlen
  43   return w32_ptr