Stasis (empty) → 0.0.1
raw patch · 6 files changed
+267/−0 lines, 6 filesdep +basedep +containerssetup-changed
Dependencies added: base, containers
Files
- LICENSE +27/−0
- Setup.hs +2/−0
- Stasis.cabal +37/−0
- src/Control/Stasis.hs +142/−0
- src/Control/Unsafe/Stasis.hs +32/−0
- src/Main.hs +27/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2014, Courtney Robinson+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 the {organization} 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS 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
+ Stasis.cabal view
@@ -0,0 +1,37 @@+name: Stasis +version: 0.0.1+cabal-version: >=1.2 +build-type: Simple +author: zcourts+stability: Experimental+maintainer: zcourts+homepage: https://github.com/zcourts/Stasis+category: Concurrency+synopsis: A simple MVCC like library+description: Multi-version concurrency control+license: BSD3+copyright: Courtney Robinson+license-file: LICENSE+ +library + hs-source-dirs: src + build-depends: + base >= 4 && <= 4.6.0.1,+ containers >=0.5.0 && <0.6+ ghc-options: -Wall + exposed-modules: + Control.Stasis,+ Control.Unsafe.Stasis+ other-modules: Main + +executable Stasis + build-depends: + base >= 4 && <= 4.6.0.1 + hs-source-dirs: src + ghc-options: -Wall + other-modules: + Control.Stasis,+ Control.Unsafe.Stasis,+ Main+ main-is: Main.hs+
+ src/Control/Stasis.hs view
@@ -0,0 +1,142 @@+{-|+ Stasis is a modified implementation of Multi-version concurrency control MVCC.+ The original purpose of Stasis was to provide a mechanism for having safe,+ \"mutable\" variables WITHOUT any locking whatsoever.++ How Stasis works++ Given an object a.+ When a is passed to a function it is wrapped in a 'Pod' which creates a+ "stasis" like environment for a.+++ At any point, any function that received the 'Pod' can \"update\" it by+ 'put'ting a new version of a.+++ i.e. a itself is not updated, it is replaced. So what the 'Pod' does is + store the address of an a and an update changes the address the 'Pod' points + to, to another a.+++ The address of a can only change to point to another value of a,+ i.e. it is type safe.+++ At any time, a function who's received a 'Pod' can "freeze" it. In this case, + every time that function 'fetch'es a from the 'FrozenPod', the same version + that was frozen is always returned and at any time the function can also get + the latest version of a by 'get'ting the current non-frozen version.++ Internally b maintains a map of addresses to frozen IDs, when a function+ freezes a version of a it stores the address of a with a unique freeze id+ that is returned to the function. The function must then pass the freeze id+ each time it wants to get the frozen version of a for that id. This also means+ that a function can lock multiple versions of a.++ Originally the intention was to use pointers but IORefs works with atomic+ operations and achieves effectively the same thing.+ <http://hackage.haskell.org/package/base-4.5.1.0/docs/Foreign-StablePtr.html>+ <http://hackage.haskell.org/package/base-4.6.0.1/docs/Data-IORef.html>+-}+module Control.Stasis(+ -- * Primitives+ -- $prims+ Pod(..), FrozenPod(..),+ -- * Operations+ -- $ops+ stasis, version, versionF, put, get, fetch, freeze, defrost+ ) where+import Data.IORef(IORef, atomicModifyIORef', newIORef, readIORef)+import qualified Data.Map.Strict as M+--import qualified Data.Unique as U (newUnique, hashUnique)+import Data.Maybe (fromMaybe)++--newStasisId :: IO Int+--newStasisId = do u <- U.newUnique; return (U.hashUnique u)++data Pod a = Stasis { val :: IORef (PodContent a), + frozenVersions :: IORef (M.Map a Int) + } deriving (Eq)++data PodContent a = Content {contentVal :: a, stasisVersion :: Int}+data FrozenPod a = FrozenPod { addr :: a, oPod :: Pod a, frozenAt :: Int}++stasis :: a -> IO (Pod a)+stasis v = do p <- newIORef M.empty+ c <- newIORef Content { contentVal = v, stasisVersion = 1}+ return Stasis{val = c, frozenVersions = p }++put :: a -> Pod a -> IO Bool+put v p = atomicModifyIORef' (val p) $ + \x -> let y = x{ contentVal = v, stasisVersion = stasisVersion x + 1}+ in (y,True)++-- | Fetch the current version of a 'Pod'+version :: Pod a -> IO Int +version v = do c <- readIORef(val v)+ return $ stasisVersion c++-- | Fetch the version the value was frozen at+versionF :: FrozenPod a -> Int +versionF = frozenAt++-- | Get the value currently in 'Stasis'+get :: Pod a -> IO a+get pod = do c <- readIORef(val pod)+ return $ contentVal c++-- | Fetch the frozen value from the given 'FrozenPod'+fetch :: FrozenPod a -> a+fetch = addr++-- | Freeze the value of a at the current version+freeze :: Ord a => Pod a -> IO (FrozenPod a)+freeze p = do v <- get p+ cv <- version p+ let fp = FrozenPod { addr = v, oPod = p, frozenAt = cv}+ m <- readIORef(frozenVersions p)+ let count = fromMaybe 0 (M.lookup v m) -- get current count or 0+ _ <- atomicModifyIORef' (frozenVersions p) $+ -- set count for v to current val + 1+ \x -> let r = M.insertWith (+) v (count + 1) x in (r,r)+ return fp++{-| Defrosting a 'FrozenPod' to a 'Pod' causes the value in stasis to be de-referenced.+Once this happens the value can be GC'd as would normally happen. Unless another function+has frozen the same version, in which case that function has to unfreeze the value as well+ -}+defrost ::Ord a => FrozenPod a -> IO (Pod a)+defrost fp = do let v = fetch fp+ let fv = frozenVersions (oPod fp)+ m <- readIORef fv+ let count = fromMaybe 0 (M.lookup v m)+ atomicModifyIORef' fv $+ \x -> let r = M.insertWith (-) v (count + 1) x in (r,oPod fp)++{-$ops+ The type b supports 6 operations, 'stasis', 'put','get','fetch','freeze','defrost'.++ 1. 'stasis' - creates a new 'Pod' which can be passed around in place of a++ 2. 'put' - Put adds a new version of a to an existing 'Pod'++ 3. 'get' - Gets the current version of a from a 'Pod'++ 4. 'freeze' - Freezes a version of a in stasis, use 'defrost' on the returned+ 'FrozenPod' to get the value back++ 5. 'defrost' Returns the version of a for the given 'FrozenPod', i.e. it gets+ the value of a when it was frozen++ 6. 'fetch' the same as 'defrost' but leaves a in a 'FrozenPod' which means it+ will not be garbage collected until it is 'defrost'ed+-}++{-$prims++'Stasis' has two primitives, a 'Pod' and a 'FrozenPod'.+A 'Pod' is 'created from any value a, once created, only new versions of a can be placed in the same pod.+A 'Pod' gets passed around in place of an ordinary value. 'Pod's can be frozen+to create a 'FrozenPod', when frozen the value of a is stays the same+-}
+ src/Control/Unsafe/Stasis.hs view
@@ -0,0 +1,32 @@+module Control.Unsafe.Stasis(+ Pod(..), FrozenPod(..),+ stasis,version, put, get+ ) where+import Data.IORef(IORef, atomicModifyIORef', newIORef, readIORef)+import qualified Data.Map.Strict as M+import System.IO.Unsafe (unsafePerformIO)++data Pod a = Stasis { val :: IORef (PodContent a), + frozenVersions :: IORef (M.Map a Int) + } deriving (Eq)++data PodContent a = Content {contentVal :: a, stasisVersion :: Int}+data FrozenPod a = FrozenPod { addr :: Pod a, frozenId :: Int }++stasis :: a -> Pod a+stasis v = let p = unsafePerformIO $ newIORef M.empty+ c = unsafePerformIO $ newIORef Content { contentVal = v, stasisVersion = 1}+ in+ Stasis{val = c, frozenVersions = p }++put :: a -> Pod a -> Bool+put v p = unsafePerformIO $ + atomicModifyIORef' (val p) $ + \x -> let y = x{ contentVal = v, stasisVersion = stasisVersion x + 1}+ in (y,True)++version :: Pod a -> Int +version v = stasisVersion (unsafePerformIO $ readIORef(val v))++get :: Pod a -> a+get pod = contentVal $ unsafePerformIO $ readIORef(val pod)
+ src/Main.hs view
@@ -0,0 +1,27 @@+module Main where +import qualified Control.Stasis as S + +main :: IO () +main = do + -- put the value "abc" into stasis + s <- S.stasis "abc" + v <- S.get s + ver <- S.version s + print(show ver ++ ":" ++ v) -- version 1, abc + --forever $ do + -- replace "abc" with hello + _ <- S.put "hello " s + v2 <- S.get s + ver2 <- S.version s + print(show ver2 ++ ":" ++ v2) -- version 2, hello + --freeze version two + frozenS <- S.freeze s + _ <- S.put " replaced hello" s + v3 <- S.get s + ver3 <- S.version s + -- notice action on frozen version is pure, always returns same thing + let v2Frozen = S.fetch frozenS + let ver2F = S.versionF frozenS + print(show ver3 ++ ":" ++ v3) + -- 2:hello because these values were frozen at version 2 + print(show ver2F ++ ":" ++ v2Frozen) --