Mate/Strings.hs

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