foreign-store 0.0 → 0.1

raw patch · 3 files changed

+69/−11 lines, 3 files

Files

• cbits/store.c +17/−2
• foreign-store.cabal +6/−1
• src/Foreign/Store.hs +46/−8

@@ -1,4 +1,5 @@ #include <stdlib.h>+#include <memory.h> #include <stdint.h>  void **values = NULL;@@ -24,15 +25,29 @@   return index; } +void x_set(uint32_t index,void*value) {+  if (index + 1 > size) {+    size_t new_size = index + 1;+    values = realloc(values,new_size * sizeof(void*));+    memset(values + size,0,new_size - size);+    size = new_size;+  }+  values[index] = value;+}+ void *x_get(uint32_t index) {-  return values[index];+  if (index >= 0 && index < size) {+    return values[index];+  } else {+    return NULL;+  } }  uint32_t x_lookup(uint32_t index) {   if (values == NULL)     return 0;   else {-    if (index < size) {+    if (index >= 0 && index < size) {       return values[index] == NULL? 0 : 1;     } else {       return 0;

@@ -1,5 +1,5 @@ name:                foreign-store-version:             0.0+version:             0.1 synopsis:            Store a stable pointer in a foreign context to be retrieved later. Persists through GHCi reloads. description:         Store a stable pointer in a foreign context to be retrieved later. Persists through GHCi reloads. license:             BSD3@@ -10,6 +10,7 @@ category:            Development build-type:          Simple cabal-version:       >=1.8+Homepage:            https://github.com/chrisdone/foreign-store  library   hs-source-dirs:    src/@@ -18,3 +19,7 @@   build-depends:     base >= 4 && <5   c-sources:         cbits/store.c   include-dirs:      cbits++source-repository head+  type:     git+  location: git://github.com/chrisdone/foreign-store.git

@@ -2,13 +2,17 @@ {-# LANGUAGE ForeignFunctionInterface #-}  -- | Store a stable pointer in a foreign context to be retrieved--- later. Persists through GHCi reloads.+-- later. Persists through GHCi reloads. Not thread-safe.  module Foreign.Store-  (newStore+  (-- * Foreign stores+   writeStore+  ,newStore   ,lookupStore   ,readStore   ,deleteStore+  ,storeAction+  ,withStore   ,Store(..))   where @@ -18,6 +22,7 @@ import Foreign.Ptr import Foreign.StablePtr +-- | An exception when working with stores. data StoreException   = StoreNotFound   deriving (Show,Eq,Typeable)@@ -29,7 +34,7 @@   Store Word32   deriving (Show,Eq) --- | Lookup from the store.+-- | Lookup from the store if an index is allocated. lookupStore :: Word32 -> IO (Maybe (Store a)) lookupStore i =   do r <- x_lookup i@@ -37,17 +42,32 @@         then return Nothing         else return (Just (Store i)) --- | Make a new store. The internal vector of stores grows in--- side. When stores are deleted the vector does not shrink, but old--- slots are re-used.+-- | Allocates or finds an unallocated store. The index is random. The+-- internal vector of stores grows in size. When stores are deleted+-- the vector does not shrink, but old slots are re-used.+-- Not thread-safe. newStore :: a -> IO (Store a) newStore a =   do sptr <- newStablePtr a      i <- x_store sptr      return (Store i) --- | Read from the store. If the store has been deleted, this will--- throw an exception.+-- | Write to the store at the given index. If a store doesn't exist,+-- creates one and resizes the store vector to fit. If there is+-- already a store at the given index, deletes that store with+-- 'deleteStore' before replacing it.+-- Not thread-safe.+writeStore :: Store a -> a -> IO ()+writeStore (Store i) a =+  do existing <- lookupStore i+     maybe (return ()) deleteStore existing+     sptr <- newStablePtr a+     x_set i sptr+     return ()++-- | Read from the store. If the store has been deleted or is+-- unallocated, this will throw an exception.+-- Not thread-safe. readStore :: Store a -> IO a readStore (Store i) =   do sptr <- x_get i@@ -57,6 +77,7 @@  -- | Frees the stable pointer for GC and frees up the slot in the -- store. Deleting an already deleted store is a no-op.+-- Not thread-safe. deleteStore :: Store a -> IO () deleteStore (Store i) = do   sptr <- x_get i@@ -65,9 +86,26 @@      else do freeStablePtr sptr              x_delete i +-- | Run the action and store the result.+storeAction :: Store a -> IO a -> IO a+storeAction s m =+  do v <- m+     writeStore s v+     return v++-- | Run the action and store the result.+withStore :: Store a -> (a -> IO b) -> IO b+withStore s f =+  do v <- readStore s+     f v+ foreign import ccall   "x-helpers.h x_store"   x_store :: StablePtr a -> IO Word32++foreign import ccall+  "x-helpers.h x_set"+  x_set :: Word32 -> StablePtr a -> IO ()  foreign import ccall   "x-helpers.h x_get"