foreign-store (empty) → 0.0

raw patch · 5 files changed

+173/−0 lines, 5 filesdep +basesetup-changed

Dependencies added: base

Files

LICENSE +24/−0
Setup.hs +2/−0
cbits/store.c +45/−0
foreign-store.cabal +20/−0
src/Foreign/Store.hs +82/−0

+ LICENSE view

@@ -0,0 +1,24 @@+Copyright (c) 2014, foreign-store+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright+      notice, this list of conditions and the following disclaimer in the+      documentation and/or other materials provided with the distribution.+    * Neither the name of foreign-store nor the+      names of its contributors may be used to endorse or promote products+      derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ cbits/store.c view

@@ -0,0 +1,45 @@+#include <stdlib.h>+#include <stdint.h>++void **values = NULL;+size_t size = 0;++uint32_t x_store(void*value) {+  int no_slot = 1;+  uint32_t i;+  uint32_t index;+  for (i = 0; i < size; i++) {+    if (values[i] == NULL) {+      index = i;+      no_slot = 0;+      break;+    }+  }+  if (values == NULL || no_slot) {+    size++;+    values = realloc(values,size * sizeof(void*));+    index = size-1;+  }+  values[index] = value;+  return index;+}++void *x_get(uint32_t index) {+  return values[index];+}++uint32_t x_lookup(uint32_t index) {+  if (values == NULL)+    return 0;+  else {+    if (index < size) {+      return values[index] == NULL? 0 : 1;+    } else {+      return 0;+    }+  }+}++void x_delete(uint32_t index) {+  values[index] = NULL;+}

+ foreign-store.cabal view

@@ -0,0 +1,20 @@+name:                foreign-store+version:             0.0+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+license-file:        LICENSE+author:              Chris Done+maintainer:          chrisdone@gmail.com+copyright:           2014 Chris Done+category:            Development+build-type:          Simple+cabal-version:       >=1.8++library+  hs-source-dirs:    src/+  ghc-options:       -Wall -O2+  exposed-modules:   Foreign.Store+  build-depends:     base >= 4 && <5+  c-sources:         cbits/store.c+  include-dirs:      cbits

+ src/Foreign/Store.hs view

@@ -0,0 +1,82 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ForeignFunctionInterface #-}++-- | Store a stable pointer in a foreign context to be retrieved+-- later. Persists through GHCi reloads.++module Foreign.Store+  (newStore+  ,lookupStore+  ,readStore+  ,deleteStore+  ,Store(..))+  where++import Control.Exception+import Data.Typeable+import Data.Word+import Foreign.Ptr+import Foreign.StablePtr++data StoreException+  = StoreNotFound+  deriving (Show,Eq,Typeable)++instance Exception StoreException++-- | A hideously unsafe store. Only for use if you are suave.+data Store a =+  Store Word32+  deriving (Show,Eq)++-- | Lookup from the store.+lookupStore :: Word32 -> IO (Maybe (Store a))+lookupStore i =+  do r <- x_lookup i+     if r == 0+        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.+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.+readStore :: Store a -> IO a+readStore (Store i) =+  do sptr <- x_get i+     if castStablePtrToPtr sptr == nullPtr+        then throw StoreNotFound+        else deRefStablePtr sptr++-- | Frees the stable pointer for GC and frees up the slot in the+-- store. Deleting an already deleted store is a no-op.+deleteStore :: Store a -> IO ()+deleteStore (Store i) = do+  sptr <- x_get i+  if castStablePtrToPtr sptr == nullPtr+     then return ()+     else do freeStablePtr sptr+             x_delete i++foreign import ccall+  "x-helpers.h x_store"+  x_store :: StablePtr a -> IO Word32++foreign import ccall+  "x-helpers.h x_get"+  x_get :: Word32 -> IO (StablePtr a)++foreign import ccall+  "x-helpers.h x_lookup"+  x_lookup :: Word32 -> IO Word32++foreign import ccall+  "x-helpers.h x_delete"+  x_delete :: Word32 -> IO ()