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.ForeignPtr
  15 import Foreign.Marshal.Array
  16
  17 import Mate.Types
  18
  19
  20 getUniqueStringAddr :: B.ByteString -> IO Word32
  21 getUniqueStringAddr str = do
  22   smap <- get_stringsmap >>= ptr2stringsmap
  23   case M.lookup str smap of
  24     Nothing -> do
  25       addr <- allocateJavaString str
  26       let smap' = M.insert str addr smap
  27       stringsmap2ptr smap' >>= set_stringsmap
  28       return addr
  29     Just addr -> return addr
  30
  31 -- TOOD(bernhard): quite hackish
  32 allocateJavaString :: B.ByteString -> IO Word32
  33 allocateJavaString str = do
  34   let strlen = fromIntegral $ B.length str
  35   let str_unpacked = (map fromIntegral $ B.unpack str) :: [Word8]
  36   arr <- newArray str_unpacked
  37   newstr <- BI.create strlen (\x -> BI.memcpy x arr (fromIntegral strlen))
  38   let (newstrptr, _, _) = BI.toForeignPtr newstr
  39   let w32_ptr = fromIntegral $ ptrToIntPtr $ unsafeForeignPtrToPtr newstrptr
  40   printf "new str ptr: 0x%08x\n" w32_ptr
  41   return w32_ptr