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 +6/−1
- FRP/Elerea.hs +4/−6
- FRP/Elerea/Graph.hs +11/−7
- FRP/Elerea/Internal.hs +102/−75
- elerea.cabal +1/−1
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