packages feed

elerea 0.4.0 → 0.5.0

raw patch · 5 files changed

+124/−90 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- FRP.Elerea: type Time = Double
- FRP.Elerea.Internal: SNL1 :: (t -> a) -> (Signal t) -> SignalNode a
- FRP.Elerea.Internal: SNL2 :: (t1 -> t2 -> a) -> (Signal t1) -> (Signal t2) -> SignalNode a
- FRP.Elerea.Internal: SNL3 :: (t1 -> t2 -> t3 -> a) -> (Signal t1) -> (Signal t2) -> (Signal t3) -> SignalNode a
- FRP.Elerea.Internal: SNL4 :: (t1 -> t2 -> t3 -> t4 -> a) -> (Signal t1) -> (Signal t2) -> (Signal t3) -> (Signal t4) -> SignalNode a
- FRP.Elerea.Internal: SNL5 :: (t1 -> t2 -> t3 -> t4 -> t5 -> a) -> (Signal t1) -> (Signal t2) -> (Signal t3) -> (Signal t4) -> (Signal t5) -> SignalNode a
- FRP.Elerea.Internal: type Time = Double
+ FRP.Elerea: (==>) :: Void -> a -> a
+ FRP.Elerea: restarter :: (Void -> Signal a) -> Signal (Signal a)
+ FRP.Elerea.Internal: (==>) :: Void -> a -> a
+ FRP.Elerea.Internal: SNF1 :: (t -> a) -> (Signal t) -> SignalNode a
+ FRP.Elerea.Internal: SNF2 :: (t1 -> t2 -> a) -> (Signal t1) -> (Signal t2) -> SignalNode a
+ FRP.Elerea.Internal: SNF3 :: (t1 -> t2 -> t3 -> a) -> (Signal t1) -> (Signal t2) -> (Signal t3) -> SignalNode a
+ FRP.Elerea.Internal: SNF4 :: (t1 -> t2 -> t3 -> t4 -> a) -> (Signal t1) -> (Signal t2) -> (Signal t3) -> (Signal t4) -> SignalNode a
+ FRP.Elerea.Internal: SNF5 :: (t1 -> t2 -> t3 -> t4 -> t5 -> a) -> (Signal t1) -> (Signal t2) -> (Signal t3) -> (Signal t4) -> (Signal t5) -> SignalNode a
+ FRP.Elerea.Internal: SNL :: (Signal a) -> (Signal Bool) -> (Signal (Signal a)) -> SignalNode a
+ FRP.Elerea.Internal: data Void
+ FRP.Elerea.Internal: restarter :: (Void -> Signal a) -> Signal (Signal a)
- FRP.Elerea.Internal: SNE :: (Signal a) -> (Signal Bool) -> (Signal (Signal a)) -> SignalNode a
+ FRP.Elerea.Internal: SNE :: (IORef a) -> SignalNode a
- FRP.Elerea.Internal: SNR :: (IORef a) -> SignalNode a
+ FRP.Elerea.Internal: SNR :: (Void -> a) -> SignalNode a

Files

CHANGES view
@@ -1,4 +1,9 @@-0.4.0 - 0904??+0.5.0 - 090502+* changed names of internal constructors to match primitives better+* added restarter and (==>)+* removed the unused type synonym Time++0.4.0 - 090501 * added keepAlive * made delay a primitive * completely separated sampling and aging
FRP/Elerea.hs view
@@ -30,12 +30,10 @@ -}  module FRP.Elerea (-  Time, DTime,-  Sink,-  Signal,-  superstep, keepAlive, (.@.),-  stateful, transfer, latcher, external,-  delay, edge,+  DTime, Sink, Signal,+  superstep, external, keepAlive, (.@.),+  stateful, transfer, latcher, restarter,+  delay, edge, (==>),   (==@), (/=@), (<@), (<=@), (>=@), (>@),   (&&@), (||@) ) where
FRP/Elerea/Graph.hs view
@@ -29,6 +29,7 @@     | Latcher Id Id Id     | External     | Delay Id+    | Restarter     | Lift1 Id     | Lift2 Id Id     | Lift3 Id Id Id@@ -58,37 +59,38 @@   (sf',st') <- buildStore (Map.insert p None st) sf   (sx',st'') <- buildStore st' sx   return (Map.insert p (App sf' sx') st'')-insertSignal st p (SNE s e ss) = do+insertSignal st p (SNL s e ss) = do   (s',st') <- buildStore (Map.insert p None st) s   (e',st'') <- buildStore st' e   (ss',st''') <- buildStore st'' ss   return (Map.insert p (Latcher s' e' ss') st''')-insertSignal st p (SNR _) = return (Map.insert p External st)+insertSignal st p (SNE _) = return (Map.insert p External st) insertSignal st p (SND _ s) = do   (s',st') <- buildStore (Map.insert p None st) s   return (Map.insert p (Delay s') st')+insertSignal st p (SNR _) = return (Map.insert p Restarter st) insertSignal st p (SNKA (S r) _) = do   Ready s <- readIORef r   insertSignal st p s-insertSignal st p (SNL1 _ s1) = do+insertSignal st p (SNF1 _ s1) = do   (s1',st') <- buildStore (Map.insert p None st) s1   return (Map.insert p (Lift1 s1') st')-insertSignal st p (SNL2 _ s1 s2) = do+insertSignal st p (SNF2 _ s1 s2) = do   (s1',st') <- buildStore (Map.insert p None st) s1   (s2',st'') <- buildStore st' s2   return (Map.insert p (Lift2 s1' s2') st'')-insertSignal st p (SNL3 _ s1 s2 s3) = do+insertSignal st p (SNF3 _ s1 s2 s3) = do   (s1',st') <- buildStore (Map.insert p None st) s1   (s2',st'') <- buildStore st' s2   (s3',st''') <- buildStore st'' s3   return (Map.insert p (Lift3 s1' s2' s3') st''')-insertSignal st p (SNL4 _ s1 s2 s3 s4) = do+insertSignal st p (SNF4 _ s1 s2 s3 s4) = do   (s1',st') <- buildStore (Map.insert p None st) s1   (s2',st'') <- buildStore st' s2   (s3',st''') <- buildStore st'' s3   (s4',st'''') <- buildStore st''' s4   return (Map.insert p (Lift4 s1' s2' s3' s4') st'''')-insertSignal st p (SNL5 _ s1 s2 s3 s4 s5) = do+insertSignal st p (SNF5 _ s1 s2 s3 s4 s5) = do   (s1',st') <- buildStore (Map.insert p None st) s1   (s2',st'') <- buildStore st' s2   (s3',st''') <- buildStore st'' s3@@ -104,6 +106,7 @@                       App _ _         -> "app"                       Latcher _ _ _   -> "latcher"                       External        -> "external"+                      Restarter       -> "restarter"                       Delay _         -> "delay"                       Lift1 _         -> "fun1"                       Lift2 _ _       -> "fun2"@@ -160,5 +163,6 @@                   Latcher _ _ _ -> "hexagon"                   External      -> "invtriangle"                   Delay _       -> "box"+                  Restarter     -> "house"                   _             -> "ellipse"   return $ "digraph G {\n" ++ concat rules ++ "}\n"
FRP/Elerea/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ExistentialQuantification, EmptyDataDecls #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}  {-|@@ -63,14 +63,17 @@  {-| Time is continuous.  Nothing fancy. -} -type Time = Double- type DTime = Double  {-| Sinks are used when feeding input into peripheral-bound signals. -}  type Sink a = a -> IO () +{-| An unpopulated type to use as a token for injecting data+dependencies in the restarter. -}++data Void+ -- ** The data structures behind signals  {-| A signal is represented as a /transactional/ structural node. -}@@ -93,7 +96,7 @@     | 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+type.  Note that the @SNFx@ nodes are only needed to optimise applicatives, they can all be expressed in terms of @SNK@ and @SNA@. -} @@ -108,25 +111,27 @@     | forall t . SNT (Signal t) a (DTime -> t -> a -> a)     -- | @SNA sf sx@: pointwise function application     | forall t . SNA (Signal (t -> a)) (Signal t)-    -- | @SNE s e ss@: latcher that starts out as @s@ and becomes the+    -- | @SNL s e ss@: latcher that starts out as @s@ and becomes the     -- current value of @ss@ at every moment when @e@ is true-    | SNE (Signal a) (Signal Bool) (Signal (Signal a))-    -- | @SNR r@: opaque reference to connect peripherals-    | SNR (IORef a)+    | SNL (Signal a) (Signal Bool) (Signal (Signal a))+    -- | @SNE r@: opaque reference to connect peripherals+    | SNE (IORef a)     -- | @SND s@: the @s@ signal delayed by one superstep     | SND a (Signal a)+    -- | @SNR f@: restarter; always reevaluates @f undefined@+    | SNR (Void -> a)     -- | @SNKA s l@: equivalent to @s@ while aging signal @l@     | forall t . SNKA (Signal a) (Signal t)-    -- | @SNL1 f@: @fmap f@-    | forall t . SNL1 (t -> a) (Signal t)-    -- | @SNL2 f@: @liftA2 f@-    | forall t1 t2 . SNL2 (t1 -> t2 -> a) (Signal t1) (Signal t2)-    -- | @SNL3 f@: @liftA3 f@-    | forall t1 t2 t3 . SNL3 (t1 -> t2 -> t3 -> a) (Signal t1) (Signal t2) (Signal t3)-    -- | @SNL4 f@: @liftA4 f@-    | forall t1 t2 t3 t4 . SNL4 (t1 -> t2 -> t3 -> t4 -> a) (Signal t1) (Signal t2) (Signal t3) (Signal t4)-    -- | @SNL5 f@: @liftA5 f@-    | forall t1 t2 t3 t4 t5 . SNL5 (t1 -> t2 -> t3 -> t4 -> t5 -> a) (Signal t1) (Signal t2) (Signal t3) (Signal t4) (Signal t5)+    -- | @SNF1 f@: @fmap f@+    | forall t . SNF1 (t -> a) (Signal t)+    -- | @SNF2 f@: @liftA2 f@+    | forall t1 t2 . SNF2 (t1 -> t2 -> a) (Signal t1) (Signal t2)+    -- | @SNF3 f@: @liftA3 f@+    | forall t1 t2 t3 . SNF3 (t1 -> t2 -> t3 -> a) (Signal t1) (Signal t2) (Signal t3)+    -- | @SNF4 f@: @liftA4 f@+    | forall t1 t2 t3 t4 . SNF4 (t1 -> t2 -> t3 -> t4 -> a) (Signal t1) (Signal t2) (Signal t3) (Signal t4)+    -- | @SNF5 f@: @liftA5 f@+    | forall t1 t2 t3 t4 t5 . SNF5 (t1 -> t2 -> t3 -> t4 -> t5 -> a) (Signal t1) (Signal t2) (Signal t3) (Signal t4) (Signal t5)  {-| You can uncomment the verbose version of this function to see the applicative optimisations in action. -}@@ -166,41 +171,41 @@           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)-            (SNK g,SNL2 h y1 y2)           -> debugLog "merge_02" $ opt (SNL2 (\y1 y2 -> g (h y1 y2)) y1 y2)-            (SNK g,SNL3 h y1 y2 y3)        -> debugLog "merge_03" $ opt (SNL3 (\y1 y2 y3 -> g (h y1 y2 y3)) y1 y2 y3)-            (SNK g,SNL4 h y1 y2 y3 y4)     -> debugLog "merge_04" $ opt (SNL4 (\y1 y2 y3 y4 -> g (h y1 y2 y3 y4)) y1 y2 y3 y4)-            (SNK g,SNL5 h y1 y2 y3 y4 y5)  -> debugLog "merge_05" $ opt (SNL5 (\y1 y2 y3 y4 y5 -> g (h y1 y2 y3 y4 y5)) y1 y2 y3 y4 y5)-            (SNK g,_)                      -> debugLog "lift_1x" $ opt (SNL1 g x)-            (SNL1 g x1,SNK y)              -> debugLog "merge_10" $ opt (SNL1 (\x1 -> g x1 y) x1)-            (SNL1 g x1,SNL1 h y1)          -> debugLog "merge_11" $ opt (SNL2 (\x1 y1 -> g x1 (h y1)) x1 y1)-            (SNL1 g x1,SNL2 h y1 y2)       -> debugLog "merge_12" $ opt (SNL3 (\x1 y1 y2 -> g x1 (h y1 y2)) x1 y1 y2)-            (SNL1 g x1,SNL3 h y1 y2 y3)    -> debugLog "merge_13" $ opt (SNL4 (\x1 y1 y2 y3 -> g x1 (h y1 y2 y3)) x1 y1 y2 y3)-            (SNL1 g x1,SNL4 h y1 y2 y3 y4) -> debugLog "merge_14" $ opt (SNL5 (\x1 y1 y2 y3 y4 -> g x1 (h y1 y2 y3 y4)) x1 y1 y2 y3 y4)-            (SNL1 g x1,_)                  -> debugLog "lift_2x" $ opt (SNL2 g x1 x)-            (SNL2 g x1 x2,SNK y)           -> debugLog "merge_20" $ opt (SNL2 (\x1 x2 -> g x1 x2 y) x1 x2)-            (SNL2 g x1 x2,SNL1 h y1)       -> debugLog "merge_21" $ opt (SNL3 (\x1 x2 y1 -> g x1 x2 (h y1)) x1 x2 y1)-            (SNL2 g x1 x2,SNL2 h y1 y2)    -> debugLog "merge_22" $ opt (SNL4 (\x1 x2 y1 y2 -> g x1 x2 (h y1 y2)) x1 x2 y1 y2)-            (SNL2 g x1 x2,SNL3 h y1 y2 y3) -> debugLog "merge_23" $ opt (SNL5 (\x1 x2 y1 y2 y3 -> g x1 x2 (h y1 y2 y3)) x1 x2 y1 y2 y3)-            (SNL2 g x1 x2,_)               -> debugLog "lift_3x" $ opt (SNL3 g x1 x2 x)-            (SNL3 g x1 x2 x3,SNK y)        -> debugLog "merge_30" $ opt (SNL3 (\x1 x2 x3 -> g x1 x2 x3 y) x1 x2 x3)-            (SNL3 g x1 x2 x3,SNL1 h y1)    -> debugLog "merge_31" $ opt (SNL4 (\x1 x2 x3 y1 -> g x1 x2 x3 (h y1)) x1 x2 x3 y1)-            (SNL3 g x1 x2 x3,SNL2 h y1 y2) -> debugLog "merge_32" $ opt (SNL5 (\x1 x2 x3 y1 y2 -> g x1 x2 x3 (h y1 y2)) x1 x2 x3 y1 y2)-            (SNL3 g x1 x2 x3,_)            -> debugLog "lift_4x" $ opt (SNL4 g x1 x2 x3 x)-            (SNL4 g x1 x2 x3 x4,SNK y)     -> debugLog "merge_40" $ opt (SNL4 (\x1 x2 x3 x4 -> g x1 x2 x3 x4 y) x1 x2 x3 x4)-            (SNL4 g x1 x2 x3 x4,SNL1 h y1) -> debugLog "merge_41" $ opt (SNL5 (\x1 x2 x3 x4 y1 -> g x1 x2 x3 x4 (h y1)) x1 x2 x3 x4 y1)-            (SNL4 g x1 x2 x3 x4,_)         -> debugLog "lift_5x" $ opt (SNL5 g x1 x2 x3 x4 x)-            (SNL5 g x1 x2 x3 x4 x5,SNK y)  -> debugLog "merge_50" $ opt (SNL5 (\x1 x2 x3 x4 x5 -> g x1 x2 x3 x4 x5 y) x1 x2 x3 x4 x5)+            (SNK g,SNF1 h y1)              -> debugLog "merge_01" $ opt (SNF1 (g.h) y1)+            (SNK g,SNF2 h y1 y2)           -> debugLog "merge_02" $ opt (SNF2 (\y1 y2 -> g (h y1 y2)) y1 y2)+            (SNK g,SNF3 h y1 y2 y3)        -> debugLog "merge_03" $ opt (SNF3 (\y1 y2 y3 -> g (h y1 y2 y3)) y1 y2 y3)+            (SNK g,SNF4 h y1 y2 y3 y4)     -> debugLog "merge_04" $ opt (SNF4 (\y1 y2 y3 y4 -> g (h y1 y2 y3 y4)) y1 y2 y3 y4)+            (SNK g,SNF5 h y1 y2 y3 y4 y5)  -> debugLog "merge_05" $ opt (SNF5 (\y1 y2 y3 y4 y5 -> g (h y1 y2 y3 y4 y5)) y1 y2 y3 y4 y5)+            (SNK g,_)                      -> debugLog "lift_1x" $ opt (SNF1 g x)+            (SNF1 g x1,SNK y)              -> debugLog "merge_10" $ opt (SNF1 (\x1 -> g x1 y) x1)+            (SNF1 g x1,SNF1 h y1)          -> debugLog "merge_11" $ opt (SNF2 (\x1 y1 -> g x1 (h y1)) x1 y1)+            (SNF1 g x1,SNF2 h y1 y2)       -> debugLog "merge_12" $ opt (SNF3 (\x1 y1 y2 -> g x1 (h y1 y2)) x1 y1 y2)+            (SNF1 g x1,SNF3 h y1 y2 y3)    -> debugLog "merge_13" $ opt (SNF4 (\x1 y1 y2 y3 -> g x1 (h y1 y2 y3)) x1 y1 y2 y3)+            (SNF1 g x1,SNF4 h y1 y2 y3 y4) -> debugLog "merge_14" $ opt (SNF5 (\x1 y1 y2 y3 y4 -> g x1 (h y1 y2 y3 y4)) x1 y1 y2 y3 y4)+            (SNF1 g x1,_)                  -> debugLog "lift_2x" $ opt (SNF2 g x1 x)+            (SNF2 g x1 x2,SNK y)           -> debugLog "merge_20" $ opt (SNF2 (\x1 x2 -> g x1 x2 y) x1 x2)+            (SNF2 g x1 x2,SNF1 h y1)       -> debugLog "merge_21" $ opt (SNF3 (\x1 x2 y1 -> g x1 x2 (h y1)) x1 x2 y1)+            (SNF2 g x1 x2,SNF2 h y1 y2)    -> debugLog "merge_22" $ opt (SNF4 (\x1 x2 y1 y2 -> g x1 x2 (h y1 y2)) x1 x2 y1 y2)+            (SNF2 g x1 x2,SNF3 h y1 y2 y3) -> debugLog "merge_23" $ opt (SNF5 (\x1 x2 y1 y2 y3 -> g x1 x2 (h y1 y2 y3)) x1 x2 y1 y2 y3)+            (SNF2 g x1 x2,_)               -> debugLog "lift_3x" $ opt (SNF3 g x1 x2 x)+            (SNF3 g x1 x2 x3,SNK y)        -> debugLog "merge_30" $ opt (SNF3 (\x1 x2 x3 -> g x1 x2 x3 y) x1 x2 x3)+            (SNF3 g x1 x2 x3,SNF1 h y1)    -> debugLog "merge_31" $ opt (SNF4 (\x1 x2 x3 y1 -> g x1 x2 x3 (h y1)) x1 x2 x3 y1)+            (SNF3 g x1 x2 x3,SNF2 h y1 y2) -> debugLog "merge_32" $ opt (SNF5 (\x1 x2 x3 y1 y2 -> g x1 x2 x3 (h y1 y2)) x1 x2 x3 y1 y2)+            (SNF3 g x1 x2 x3,_)            -> debugLog "lift_4x" $ opt (SNF4 g x1 x2 x3 x)+            (SNF4 g x1 x2 x3 x4,SNK y)     -> debugLog "merge_40" $ opt (SNF4 (\x1 x2 x3 x4 -> g x1 x2 x3 x4 y) x1 x2 x3 x4)+            (SNF4 g x1 x2 x3 x4,SNF1 h y1) -> debugLog "merge_41" $ opt (SNF5 (\x1 x2 x3 x4 y1 -> g x1 x2 x3 x4 (h y1)) x1 x2 x3 x4 y1)+            (SNF4 g x1 x2 x3 x4,_)         -> debugLog "lift_5x" $ opt (SNF5 g x1 x2 x3 x4 x)+            (SNF5 g x1 x2 x3 x4 x5,SNK y)  -> debugLog "merge_50" $ opt (SNF5 (\x1 x2 x3 x4 x5 -> g x1 x2 x3 x4 x5 y) x1 x2 x3 x4 x5)             _                              -> return ()           return True          -- Lifting into higher arity not knowing the argument         when (not merged) $ case nf of-          SNK g              -> debugLog "lift_1" $ opt (SNL1 g x)-          SNL1 g x1          -> debugLog "lift_2" $ opt (SNL2 g x1 x)-          SNL2 g x1 x2       -> debugLog "lift_3" $ opt (SNL3 g x1 x2 x)-          SNL3 g x1 x2 x3    -> debugLog "lift_4" $ opt (SNL4 g x1 x2 x3 x)-          SNL4 g x1 x2 x3 x4 -> debugLog "lift_5" $ opt (SNL5 g x1 x2 x3 x4 x)+          SNK g              -> debugLog "lift_1" $ opt (SNF1 g x)+          SNF1 g x1          -> debugLog "lift_2" $ opt (SNF2 g x1 x)+          SNF2 g x1 x2       -> debugLog "lift_3" $ opt (SNF3 g x1 x2 x)+          SNF3 g x1 x2 x3    -> debugLog "lift_4" $ opt (SNF4 g x1 x2 x3 x)+          SNF4 g x1 x2 x3 x4 -> debugLog "lift_5" $ opt (SNF5 g x1 x2 x3 x4 x)           _                  -> return ()        -- The final version@@ -304,14 +309,14 @@                       case s' of                         SNT s _ _             -> age s dt                         SNA sf sx             -> age sf dt >> age sx dt-                        SNE s e ss            -> age s dt >> age e dt >> age ss dt+                        SNL s e ss            -> age s dt >> age e dt >> age ss dt                         SND _ s               -> age s dt                          SNKA s l              -> age s dt >> age l dt-                        SNL1 _ s              -> age s dt -                        SNL2 _ s1 s2          -> age s1 dt >> age s2 dt-                        SNL3 _ s1 s2 s3       -> age s1 dt >> age s2 dt >> age s3 dt-                        SNL4 _ s1 s2 s3 s4    -> age s1 dt >> age s2 dt >> age s3 dt >> age s4 dt-                        SNL5 _ s1 s2 s3 s4 s5 -> age s1 dt >> age s2 dt >> age s3 dt >> age s4 dt >> age s5 dt+                        SNF1 _ s              -> age s dt +                        SNF2 _ s1 s2          -> age s1 dt >> age s2 dt+                        SNF3 _ s1 s2 s3       -> age s1 dt >> age s2 dt >> age s3 dt+                        SNF4 _ s1 s2 s3 s4    -> age s1 dt >> age s2 dt >> age s3 dt >> age s4 dt+                        SNF5 _ s1 s2 s3 s4 s5 -> age s1 dt >> age s2 dt >> age s3 dt >> age s4 dt >> age s5 dt                         _                     -> return ()     Aged _ _    -> return ()      _           -> error "Inconsistent state: signal not sampled properly!"@@ -327,14 +332,14 @@                    case s of                      SNT s _ _             -> commit s                      SNA sf sx             -> commit sf >> commit sx-                     SNE s e ss            -> commit s >> commit e >> commit ss+                     SNL s e ss            -> commit s >> commit e >> commit ss                      SND _ s               -> commit s                       SNKA s l              -> commit s >> commit l-                     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+                     SNF1 _ s              -> commit s +                     SNF2 _ s1 s2          -> commit s1 >> commit s2+                     SNF3 _ s1 s2 s3       -> commit s1 >> commit s2 >> commit s3+                     SNF4 _ s1 s2 s3 s4    -> commit s1 >> commit s2 >> commit s3 >> commit s4+                     SNF5 _ s1 s2 s3 s4 s5 -> commit s1 >> commit s2 >> commit s3 >> commit s4 >> commit s5                      _                     -> return ()     Ready _     -> return ()     _           -> error "Inconsistent state: signal not aged properly!"@@ -346,11 +351,11 @@ 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!+advance sw@(SNL _ e ss) _ dt = do -- These are ready samples!                                   b <- signalValue e dt                                   s' <- signalValue ss dt                                   if b-                                    then return (SNE s' e ss)+                                    then return (SNL s' e ss)                                     else return sw advance (SND _ s)       _ dt = do x <- signalValue s dt                                   return (SND x s)@@ -358,7 +363,7 @@  {-| Sampling the signal at the current moment.  This is where static nodes propagate changes to those they depend on.  Transfer functions-('SNT') and latchers ('SNE') work without delay, i.e. the effects of+('SNT') and latchers ('SNL') work without delay, i.e. the effects of their input signals can be observed in the same superstep. -}  sample :: SignalNode a -> DTime -> IO a@@ -367,18 +372,19 @@ 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 e ss)            dt = do b <- signalValue e dt+sample (SNL 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 (SNE r)                 _  = readIORef r sample (SND v _)               _  = return v+sample (SNR f)                 _  = return (f undefined) sample (SNKA s l)              dt = do signalValue l dt                                        signalValue s dt-sample (SNL1 f s)              dt = f <$> signalValue s dt-sample (SNL2 f s1 s2)          dt = liftM2 f (signalValue s1 dt) (signalValue s2 dt)-sample (SNL3 f s1 s2 s3)       dt = liftM3 f (signalValue s1 dt) (signalValue s2 dt) (signalValue s3 dt)-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)+sample (SNF1 f s)              dt = f <$> signalValue s dt+sample (SNF2 f s1 s2)          dt = liftM2 f (signalValue s1 dt) (signalValue s2 dt)+sample (SNF3 f s1 s2 s3)       dt = liftM3 f (signalValue s1 dt) (signalValue s2 dt) (signalValue s3 dt)+sample (SNF4 f s1 s2 s3 s4)    dt = liftM4 f (signalValue s1 dt) (signalValue s2 dt) (signalValue s3 dt) (signalValue s4 dt)+sample (SNF5 f s1 s2 s3 s4 s5) dt = liftM5 f (signalValue s1 dt) (signalValue s2 dt) (signalValue s3 dt) (signalValue s4 dt) (signalValue s5 dt)  {-| Sampling the signal with some kind of delay in order to resolve dependency loops.  Transfer functions simply return their previous@@ -390,7 +396,7 @@  sampleDelayed :: SignalNode a -> DTime -> IO a sampleDelayed (SNT _ x _) _  = return x-sampleDelayed (SNE s _ _) dt = signalValue s dt+sampleDelayed (SNL s _ _) dt = signalValue s dt sampleDelayed sn          dt = sample sn dt  -- ** Userland primitives@@ -435,7 +441,7 @@         -> Signal Bool       -- ^ @e@: latch control signal         -> Signal (Signal a) -- ^ @ss@: signal of potential future behaviours         -> Signal a-latcher s e ss = createSignal (SNE s e ss)+latcher s e ss = createSignal (SNL s e ss)  {-| A signal that can be directly fed through the sink function returned.  This can be used to attach the network to the outer@@ -445,7 +451,7 @@          -> IO (Signal a, Sink a) -- ^ the signal and an IO function to feed it external x0 = do   ref <- newIORef x0-  snr <- newIORef (Ready (SNR ref))+  snr <- newIORef (Ready (SNE ref))   return (S snr,writeIORef ref)  {-| The `delay` transfer function emits the value of a signal from the@@ -460,10 +466,31 @@  {-| Dependency injection to allow aging signals whose output is not necessarily needed to produce the current sample of the first-argument.  It is more or less equivalent to @liftA2 const@, the-difference being that it evaluates its second argument first. -}+argument.  It equivalent to @(flip . liftA2 . flip) const@, as it+evaluates its second argument first. -}  keepAlive :: Signal a -- ^ the actual output           -> Signal t -- ^ a signal guaranteed to age when this one is sampled           -> Signal a keepAlive s l = createSignal (SNKA s l)++{-| Dependency injection to allow signals to be partly restarted,+notably the parts synthesised by the function passed to 'restarter'.+The function receives a dummy value that must not be evaluated (it is+'undefined'), but the result should depend on it somehow to prevent+let-floating from memoising the result outside the function.  Such a+dependency can be established with the '==>' operator.  Effectively,+'restarter' is a non-memoising version of 'pure' limited to construct+higher-order signals. -}++restarter :: (Void -> Signal a) -- ^ the function to synthesise signal+          -> Signal (Signal a)+restarter f = createSignal (SNR f)++{-| An operator that ignores its first argument and returns the+second, but hides the fact that the first argument is not needed.  It+is equivalent to @flip const@, but it cannot be inlined. -}++{-# NOINLINE (==>) #-}+(==>) :: Void -> a -> a+_ ==> x = x
elerea.cabal view
@@ -1,5 +1,5 @@ Name:                elerea-Version:             0.4.0+Version:             0.5.0 Cabal-Version:       >= 1.2 Synopsis:            A minimalistic FRP library Category:            reactivity, FRP