elerea 0.1.0 → 0.2.0

raw patch · 4 files changed

+207/−107 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES +8/−0
• FRP/Elerea.hs +65/−7
• FRP/Elerea/Internal.hs +128/−94
• elerea.cabal +6/−6

@@ -0,0 +1,8 @@+0.2.0 - 090412+* removed primitives time and stateless+* removed default delay on stateful combinators and added experimental cycle detection+* added some non-primitive combinators: delay, edge, comparisons, logic relations+* added signal instances for various numeric classes++0.1.0 - 090410+* first public version

@@ -23,7 +23,9 @@  integral x0 s = transfer x0 (\\dt x x0 -> x0+x*realToFrac dt) s @ -Head to "FRP.Elerea.Internal" for the implementation details.+Head to "FRP.Elerea.Internal" for the implementation details.  To get+a general idea how to use the library, check out the sources in the+@elerea-examples@ package.  -} @@ -32,12 +34,68 @@   Sink,   Signal,   superstep,-  time,-  stateless,-  stateful,-  transfer,-  latcher,-  external+  stateful, transfer, latcher, external,+  delay, edge,+  (==@), (/=@), (<@), (<=@), (>=@), (>@),+  (&&@), (||@) ) where +import Control.Applicative import FRP.Elerea.Internal++infix  4 ==@, /=@, <@, <=@, >=@, >@+infixr 3 &&@+infixr 2 ||@++{-| The `delay` transfer function emits the value of a signal from the+previous superstep, starting with the filler value `v0`. -}++delay :: a -> Signal a -> Signal a+delay v0 s = snd <$> transfer (v0,undefined) (\_ v' (v,_) -> (v',v)) s++{-| The `edge` transfer function takes a bool signal and emits another+bool signal that turns true only at the moment when there is a rising+edge on the input. -}++edge :: Signal Bool -> Signal Bool+edge b = (not <$> delay True b) &&@ b++{-| Point-wise equality of two signals. -}++(==@) :: Eq a => Signal a -> Signal a -> Signal Bool+(==@) = liftA2 (==)++{-| Point-wise inequality of two signals. -}++(/=@) :: Eq a => Signal a -> Signal a -> Signal Bool+(/=@) = liftA2 (/=)++{-| Point-wise comparison of two signals. -}++(<@) :: Ord a => Signal a -> Signal a -> Signal Bool+(<@) = liftA2 (<)++{-| Point-wise comparison of two signals. -}++(<=@) :: Ord a => Signal a -> Signal a -> Signal Bool+(<=@) = liftA2 (<=)++{-| Point-wise comparison of two signals. -}++(>=@) :: Ord a => Signal a -> Signal a -> Signal Bool+(>=@) = liftA2 (>=)++{-| Point-wise comparison of two signals. -}++(>@) :: Ord a => Signal a -> Signal a -> Signal Bool+(>@) = liftA2 (>)++{-| Point-wise OR of two boolean signals. -}++(||@) :: Signal Bool -> Signal Bool -> Signal Bool+(||@) = liftA2 (||)++{-| Point-wise AND of two boolean signals. -}++(&&@) :: Signal Bool -> Signal Bool -> Signal Bool+(&&@) = liftA2 (&&)

@@ -32,10 +32,13 @@ sample is simply reused, and no further aging is performed.  After successfully sampling the top-level signal, the finalisation process throws away the intermediate samples and marks the aged signals as the-current ones, ready to be sampled again.  Evaluation is done by the-'signalValue' function, while finalisation is done by 'commit'.  Since-these functions are invoked recursively on a data structure with-existential types, their types also need to be explicity quantified.+current ones, ready to be sampled again.  If there is a dependency+loop, the system tries to use the `sampleDelayed` function instead of+`sample` to get a useful value at the problematic spot instead of+entering an infinite loop.  Evaluation is done by the 'signalValue'+function, while finalisation is done by 'commit'.  Since these+functions are invoked recursively on a data structure with existential+types, their types also need to be explicity quantified.  As a bonus, applicative nodes are automatically collapsed into lifted functions of up to five arguments.  This optimisation significantly@@ -70,15 +73,22 @@  newtype Signal a = S (IORef (SignalTrans a)) -{-| A node can have two states: stable (freshly created or finalised)-or mutating (in the process of aging). -}+{-| A node can have four states that distinguish various stages of+sampling and aging. -}  data SignalTrans a-    -- | @Cur s@ is simply the signal @s@-    = Cur (SignalNode a)-    -- | @Tra x s@ is an already sampled signal, where @x@ is the-    -- current value and @s@ is the new version of the signal-    | Tra a (SignalNode a)+    -- | @Ready s@ is simply the signal @s@ that was not sampled yet+    = Ready (SignalNode a)+    -- | @Sampling s@ is still @s@ after its current value was+    -- requested, but still not delivered+    | Sampling (SignalNode a)+    -- | @Sample x@ is just the value @x@, eventually to be replaced+    -- by the aged version of its corresponding signal+    | Sample a+    -- | @Aged x s@ is an already sampled signal, where @x@ is the+    -- current value and @s@ is the new version of the signal for the+    -- next superstep+    | Aged a (SignalNode a)  {-| The possible structures of a node are defined by the 'SignalNode' type.  Note that the @SNLx@ nodes are only needed to optimise@@ -88,8 +98,6 @@ data SignalNode a     -- | @SNK x@: constantly @x@     = SNK a-    -- | @SNF f@: time function @f@ (absolute time)-    | SNF (Time -> a)     -- | @SNS x t@: stateful generator, where @x@ is current state and     -- @t@ is the update function     | SNS a (DTime -> a -> a)@@ -136,20 +144,20 @@     -- | Point-wise application of a function and a data signal (like @ZipList@)     f@(S rf) <*> x@(S rx) = unsafePerformIO $ do       -- General fall-back case-      c <- newIORef (Cur (SNA f x))+      c <- newIORef (Ready (SNA f x)) -      let opt s = writeIORef c (Cur s)+      let opt s = writeIORef c (Ready s)        -- Optimisations might go haywire in the presence of loops,       -- so we need to prepare to meeting undefined references by       -- wrapping reads into exception handlers.        flip catch (const (return ())) $ do-        Cur nf <- readIORef rf+        Ready nf <- readIORef rf          merged <- flip catch (const (return False)) $ do           -- Merging constant branches from the two sides-          Cur nx <- readIORef rx+          Ready nx <- readIORef rx           case (nf,nx) of             (SNK g,SNK y)                  -> debugLog "merge_00" $ opt (SNK (g y))             (SNK g,SNL1 h y1)              -> debugLog "merge_01" $ opt (SNL1 (g.h) y1)@@ -197,7 +205,7 @@ instance Show (Signal a) where     showsPrec _ _ s = "<SIGNAL>" ++ s -{-| The equality test checks whether to signals are physically the same. -}+{-| The equality test checks whether two signals are physically the same. -}  instance Eq (Signal a) where     S s1 == S s2 = s1 == s2@@ -216,13 +224,33 @@     recip = fmap recip     fromRational = pure . fromRational +instance Floating t => Floating (Signal t) where+    pi = pure pi+    exp = fmap exp+    sqrt = fmap sqrt+    log = fmap log+    (**) = liftA2 (**)+    logBase = liftA2 logBase+    sin = fmap sin+    tan = fmap tan+    cos = fmap cos+    asin = fmap asin+    atan = fmap atan+    acos = fmap acos+    sinh = fmap sinh+    tanh = fmap tanh+    cosh = fmap cosh+    asinh = fmap asinh+    atanh = fmap atanh+    acosh = fmap acosh+ -- ** Internal functions to run the network  {-| This function is really just a shorthand to create a reference to a given node. -}  createSignal :: SignalNode a -> Signal a-createSignal = S . unsafePerformIO . newIORef . Cur+createSignal = S . unsafePerformIO . newIORef . Ready  {-| Sampling and aging the signal and all of its dependencies, at the same time.  We don't need the aged signal in the current superstep,@@ -234,19 +262,35 @@ signalValue (S r) dt = do   t <- readIORef r   case t of-    Cur s   -> do -- TODO: advance can be evaluated in a separate-                  -- thread, since we don't need its result right away,-                  -- only in the next superstep.-                  v <- sample s dt-                  -- We memorise the sample to handle loops nicely.-                  -- The undefined future signal cannot bite us,-                  -- because we don't need it during the evaluation-                  -- phase.-                  writeIORef r (Tra v undefined)-                  s' <- advance s dt-                  writeIORef r (Tra v s')-                  return v-    Tra v _ -> return v+    Ready s    -> do writeIORef r (Sampling s)+                     -- TODO: advance can be evaluated in a separate+                     -- thread, since we don't need its result right+                     -- away, only in the next superstep.+                     v <- sample s dt+                     -- We memorise the sample to handle loops+                     -- nicely.  The undefined future signal cannot+                     -- bite us, because we don't need it during the+                     -- evaluation phase.+                     writeIORef r (Sample v)+                     s' <- advance s v dt+                     writeIORef r (Aged v s')+                     return v+    Sampling s -> do -- We started sampling this already, so there is+                     -- a dependency cycle we have to resolve by+                     -- adding a delay to stateful signals. Stateless+                     -- signals should not form a loop, which is+                     -- obvious...+                     v <- sampleDelayed s dt+                     writeIORef r (Sample v)+                     -- Since we are sampling this already, aging+                     -- will be performed by the case above.  Also,+                     -- the result is memoised by the system, so we+                     -- are not calculating anything twice.  Note+                     -- that this is an old value, so it shouldn't be+                     -- used for aging anyway.+                     return v+    Sample v   -> return v+    Aged v _   -> return v  {-| Finalising the aged signals for the next round. -} @@ -254,52 +298,50 @@ commit (S s) = do   t <- readIORef s   case t of-    Tra _ s' -> do writeIORef s (Cur s')-                   -- TODO: branching can be trivially parallelised-                   case s' of-                     SNT s _ _             -> commit s-                     SNA sf sx             -> commit sf >> commit sx-                     SNL1 _ s              -> commit s-                     SNL2 _ s1 s2          -> commit s1 >> commit s2-                     SNL3 _ s1 s2 s3       -> commit s1 >> commit s2 >> commit s3-                     SNL4 _ s1 s2 s3 s4    -> commit s1 >> commit s2 >> commit s3 >> commit s4-                     SNL5 _ s1 s2 s3 s4 s5 -> commit s1 >> commit s2 >> commit s3 >> commit s4 >> commit s5-                     SNE s e ss            -> commit s >> commit e >> commit ss-                     _                     -> return ()-    _        -> return () +    Aged _ s' -> do writeIORef s (Ready s')+                    -- TODO: branching can be trivially parallelised+                    case s' of+                      SNT s _ _             -> commit s+                      SNA sf sx             -> commit sf >> commit sx+                      SNL1 _ s              -> commit s+                      SNL2 _ s1 s2          -> commit s1 >> commit s2+                      SNL3 _ s1 s2 s3       -> commit s1 >> commit s2 >> commit s3+                      SNL4 _ s1 s2 s3 s4    -> commit s1 >> commit s2 >> commit s3 >> commit s4+                      SNL5 _ s1 s2 s3 s4 s5 -> commit s1 >> commit s2 >> commit s3 >> commit s4 >> commit s5+                      SNE s e ss            -> commit s >> commit e >> commit ss+                      _                     -> return ()+    Ready _   -> return () +    _         -> error "Inconsistent state: signal not aged!"  {-| Aging the signal.  Stateful signals have their state forced to prevent building up big thunks, and the latcher also does its job here.  The other nodes are structurally static. -} -advance :: SignalNode a -> DTime -> IO (SignalNode a)-advance (SNS x f)       dt = x `seq` return (SNS (f dt x) f)-advance (SNT s x f)     dt = x `seq` do t <- signalValue s dt-                                        return (SNT s (f dt t x) f)-advance sw@(SNE _ e ss) dt = do b <- signalValue e dt-                                s' <- signalValue ss dt-                                if b-                                  then return (SNE s' e ss)-                                  else return sw-advance s               _  = return s+advance :: SignalNode a -> a -> DTime -> IO (SignalNode a)+advance (SNS x f)       _ dt = x `seq` return (SNS (f dt x) f)+advance (SNT s _ f)     v _  = v `seq` return (SNT s v f)+advance sw@(SNE _ e ss) _ dt = do -- These are ready samples!+                                  b <- signalValue e dt+                                  s' <- signalValue ss dt+                                  if b+                                    then return (SNE s' e ss)+                                    else return sw+advance s               _ _  = return s  {-| Sampling the signal at the current moment.  This is where static-nodes propagate changes to those they depend on.  Note the latcher-rule ('SNE'): the signal is sampled before latching takes place,-therefore even if the change is instantaneous, its effect cannot be-observed at the moment of latching.  This is needed to prevent-dependency loops and make recursive definitions involving latching-possible.  The stateful signals 'SNS' and 'SNT' are similar, although-it is only the transfer function where it matters that the input-signal cannot affect the current output, only the next one. -}+nodes propagate changes to those they depend on.  Transfer functions+('SNT') and latchers ('SNE') work without delay, i.e. the effects of+their input signals can be observed in the same superstep. -}  sample :: SignalNode a -> DTime -> IO a sample (SNK x)                 _  = return x-sample (SNF f)                 _  = f <$> readIORef timeRef sample (SNS x _)               _  = return x-sample (SNT _ x _)             _  = return x+sample (SNT s x f)             dt = do t <- signalValue s dt+                                       return $! f dt t x sample (SNA sf sx)             dt = signalValue sf dt <*> signalValue sx dt-sample (SNE s _ _)             dt = signalValue s dt+sample (SNE s e ss)            dt = do b <- signalValue e dt+                                       s' <- signalValue ss dt+                                       signalValue (if b then s' else s) dt sample (SNR r)                 _  = readIORef r sample (SNL1 f s)              dt = f <$> signalValue s dt sample (SNL2 f s1 s2)          dt = liftM2 f (signalValue s1 dt) (signalValue s2 dt)@@ -307,53 +349,45 @@ sample (SNL4 f s1 s2 s3 s4)    dt = liftM4 f (signalValue s1 dt) (signalValue s2 dt) (signalValue s3 dt) (signalValue s4 dt) sample (SNL5 f s1 s2 s3 s4 s5) dt = liftM5 f (signalValue s1 dt) (signalValue s2 dt) (signalValue s3 dt) (signalValue s4 dt) (signalValue s5 dt) -{-| The actual variable that keeps track of global time. -}+{-| Sampling the signal with some kind of delay in order to resolve+dependency loops.  Transfer functions simply return their previous+output, while latchers postpone the change and pass through the+current value of their current signal even if the latch control signal+is true at the moment.  Other types of signals are always handled by+the `sample` function, so it is not possible to create a stateful loop+composed of solely stateless combinators. -} -{-# NOINLINE timeRef #-}-timeRef :: IORef Time-timeRef = unsafePerformIO (newIORef 0)+sampleDelayed :: SignalNode a -> DTime -> IO a+sampleDelayed (SNT _ x _) _  = return x+sampleDelayed (SNE s _ _) dt = signalValue s dt+sampleDelayed sn          dt = sample sn dt  -- ** Userland primitives  {-| Advancing the whole network that the given signal depends on by-the amount of time given in the second argument. Note that the shared-'time' signal is also advanced, so this function should only be used-for sampling the top level. -}+the amount of time given in the second argument. -}  superstep :: Signal a -- ^ the top-level signal           -> DTime    -- ^ the amount of time to advance-          -> IO a     -- ^ the value of the signal before the update+          -> IO a     -- ^ the current value of the signal superstep world dt = do   snapshot <- signalValue world dt   commit world-  t <- readIORef timeRef-  let t' = t+dt-  writeIORef timeRef $! t'   return snapshot -{-| The global time. -}--{-# NOINLINE time #-}-time :: Signal Time-time = createSignal (SNR timeRef)--{-| A pure time function. -}--stateless :: (Time -> a) -- ^ the function to wrap-          -> Signal a-stateless = createSignal . SNF--{-| A pure stateful signal. -}+{-| A pure stateful signal.  The initial state is the first output. -}  stateful :: a                 -- ^ initial state          -> (DTime -> a -> a) -- ^ state transformation          -> Signal a stateful x0 f = createSignal (SNS x0 f) -{-| A stateful transfer function.  The current input can only affect-the next output, i.e. there is an implicit delay. -}+{-| A stateful transfer function.  The current input affects the+current output, i.e. the initial state given in the first argument is+considered to appear before the first output, and can only be directly+observed by the `sampleDelayed` function. -} -transfer :: a                      -- ^ initial state+transfer :: a                      -- ^ initial internal state          -> (DTime -> t -> a -> a) -- ^ state updater function          -> Signal t               -- ^ input signal          -> Signal a@@ -377,5 +411,5 @@          -> IO (Signal a, Sink a) -- ^ the signal and an IO function to feed it external x0 = do   ref <- newIORef x0-  snr <- newIORef (Cur (SNR ref))+  snr <- newIORef (Ready (SNR ref))   return (S snr,writeIORef ref)

@@ -1,5 +1,5 @@ Name:                elerea-Version:             0.1.0+Version:             0.2.0 Cabal-Version:       >= 1.2 Synopsis:            A minimalistic FRP library Category:            reactivity, FRP@@ -13,11 +13,9 @@  .  Elerea provides an easy to use applicative interface, supports  recursive signals (a definition like @sine = integral 0 (integral 1- (-sine))@ works without a hitch) and arbitrary external- input. Cycles are allowed by the implicit delay on stateful transfer- functions. For the time being it is not possible to create arbitrary- transfer functions without a delay, but this limitation can be- removed later.+ (-sine))@ works without a hitch) and arbitrary external input. Cyclic+ dependencies are detected on the fly and resolved by inserting delays+ dynamically, unless the user does it explicitly.  .  This is a minimal library that defines only some basic primitives,  and you are advised to install @elerea-examples@ as well to get an@@ -31,6 +29,8 @@ License-File:        LICENSE Stability:           experimental Build-Type:          Simple+Extra-Source-Files:+  CHANGES  Library   Exposed-Modules: