Etage 0.1.3 → 0.1.4
raw patch · 3 files changed
+10/−18 lines, 3 files
Files
- Etage.cabal +2/−2
- lib/Control/Etage/Externals.hs +5/−13
- lib/Control/Etage/Incubator.hs +3/−3
Etage.cabal view
@@ -1,5 +1,5 @@ Name: Etage-Version: 0.1.3+Version: 0.1.4 Synopsis: A general data-flow framework Description: A general data-flow framework featuring nondeterminism, laziness and neurological pseudo-terminology. It can be used for example for data-flow computations or event propagation networks. It tries hard to aide type checking and to@@ -21,7 +21,7 @@ Author: Mitar Milutinovic Maintainer: mitar.haskell@tnode.com Copyright: (c) 2010 Mitar Milutinovic-Category: Control+Category: Control, AI Build-type: Simple Cabal-version: >= 1.8 Stability: experimental
lib/Control/Etage/Externals.hs view
@@ -56,8 +56,7 @@ prepareEnvironment, getCurrentImpulseTime, impulseEq,- impulseCompare,- bracketOnErrorUnmasked+ impulseCompare ) where import Prelude hiding (catch)@@ -68,6 +67,7 @@ import Data.List import Control.Exception import Data.Time.Clock.POSIX+import GHC.IO (unsafeUnmask) import GHC.Conc (forkOnIO, numCapabilities) import System.IO import System.Posix.Signals@@ -295,13 +295,14 @@ has 'dissolve'd for 'detachAndWait' and 'detachManyAndWait'. -} attach' :: Neuron n => (NeuronOptions n -> NeuronOptions n) -> Nerve (NeuronFromImpulse n) fromConductivity (NeuronForImpulse n) forConductivity -> IO LiveNeuron-attach' optionsSetter nerve = mask $ \restore -> do+attach' optionsSetter nerve = mask_ $ do currentThread <- myThreadId dissolved <- newEmptySampleVar defOptions <- mkDefaultOptions let options = optionsSetter defOptions nid <- divideNeuron options $- bracket (grow options) dissolve (restore . live nerve) `catches` [+ -- TODO: Remove unsafeUnmask in favor of forkIOWithUnmask when it will be available+ bracket (grow options) dissolve (unsafeUnmask . live nerve) `catches` [ Handler (\(_ :: DissolveException) -> return ()), -- we ignore DissolveException Handler (\(e :: SomeException) -> uninterruptible $ throwTo currentThread e) ] `finally` uninterruptible (writeSampleVar dissolved ())@@ -429,12 +430,3 @@ -} impulseCompare :: (Impulse i, Impulse j) => i -> j -> Ordering impulseCompare a b = (impulseTime a, impulseValue a) `compare` (impulseTime b, impulseValue b)--{-|-Similar to 'bracketOnError' only that the first computation does not have asynchronous exceptions masked.--}-bracketOnErrorUnmasked :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c-bracketOnErrorUnmasked before after thing =- mask $ \restore -> do- a <- restore before- restore (thing a) `onException` after a
lib/Control/Etage/Incubator.hs view
@@ -54,7 +54,7 @@ -- > grow options = do -- > ... -- > nerve <- growNerve- -- > bracketOnErrorUnmasked (attach defaultOptions nerve) detachAndWait $ \neuron -> do+ -- > bracketOnError (attach defaultOptions nerve) detachAndWait $ \neuron -> do -- > ... -- > return $ YourNeuron ... neuron nerve -- >@@ -62,7 +62,7 @@ -- > detachAndWait neuron -- > ... --- -- We use 'bracketOnErrorUnmasked' there to be sure that 'Neuron' is properly 'dissolve'd even if there is an exception later on in+ -- We use 'bracketOnError' there to be sure that 'Neuron' is properly 'dissolve'd even if there is an exception later on in -- 'grow'ing the parent 'Neuron'. And we use 'detachAndWait' so that we give time for child 'Neuron' to 'dissolve' properly. -- Which 'Neuron' you want is in this case inferred from the type of the 'Nerve' you defined. growNerve,@@ -117,7 +117,7 @@ eval ns cs ats (NeuronOperation optionsSetter :>>= is) = do nerve <- liftIO growNerve let c = getFromChan nerve- bracketOnErrorUnmasked (attach optionsSetter nerve) detachAndWait $ \n -> interpret (n:ns) (c ++ cs) ats . is $ nerve+ bracketOnError (attach optionsSetter nerve) detachAndWait $ \n -> interpret (n:ns) (c ++ cs) ats . is $ nerve eval ns cs ats (AttachOperation from for :>>= is) = do let c = head . getFromChan $ from -- we know there exists from chan as type checking assures that (from is conductive) (from', ats') <- if c `notElem` ats