From 27d03a39711cb3a849c1f832a9640a18ca11fe67 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Manuel=20B=C3=A4renz?= Date: Fri, 29 Nov 2024 15:46:41 +0100 Subject: [PATCH] Clean up module structure --- rhine/rhine.cabal | 1 + .../FRP/Rhine/Reactimation/ClockErasure.hs | 134 +---------- .../src/FRP/Rhine/Reactimation/Combinators.hs | 2 +- rhine/src/FRP/Rhine/SN.hs | 221 +++++++++++------- rhine/src/FRP/Rhine/SN/Combinators.hs | 2 +- rhine/src/FRP/Rhine/SN/Type.hs | 30 +++ rhine/src/FRP/Rhine/Type.hs | 1 + 7 files changed, 178 insertions(+), 213 deletions(-) create mode 100644 rhine/src/FRP/Rhine/SN/Type.hs diff --git a/rhine/rhine.cabal b/rhine/rhine.cabal index a9dc9a423..5aace1e6b 100644 --- a/rhine/rhine.cabal +++ b/rhine/rhine.cabal @@ -133,6 +133,7 @@ library FRP.Rhine.ResamplingBuffer.Util FRP.Rhine.SN FRP.Rhine.SN.Combinators + FRP.Rhine.SN.Type FRP.Rhine.Schedule FRP.Rhine.Type diff --git a/rhine/src/FRP/Rhine/Reactimation/ClockErasure.hs b/rhine/src/FRP/Rhine/Reactimation/ClockErasure.hs index a64baaa38..f1cf8f8a4 100644 --- a/rhine/src/FRP/Rhine/Reactimation/ClockErasure.hs +++ b/rhine/src/FRP/Rhine/Reactimation/ClockErasure.hs @@ -3,7 +3,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} {- | Translate clocked signal processing components to stream functions without explicit clock types. @@ -12,9 +11,6 @@ and is thus not exported from 'FRP.Rhine'. -} module FRP.Rhine.Reactimation.ClockErasure where --- base -import Control.Monad (join) - -- automaton import Data.Automaton.Trans.Reader import Data.Stream.Result (Result (..)) @@ -25,7 +21,7 @@ import FRP.Rhine.Clock import FRP.Rhine.Clock.Proxy import FRP.Rhine.Clock.Util import FRP.Rhine.ResamplingBuffer -import FRP.Rhine.Schedule (In, Out, SequentialClock) +import FRP.Rhine.SN.Type (SN (..)) {- | Run a clocked signal function as an automaton, accepting the timestamps and tags as explicit inputs. @@ -41,130 +37,20 @@ eraseClockClSF proxy initialTime clsf = proc (time, tag, a) -> do runReaderS clsf -< (timeInfo, a) {-# INLINE eraseClockClSF #-} --- Andras' trick: Encode in the domain -newtype SN m cl a b = SN {getSN :: Reader (Time cl) (Automaton m (Time cl, Tag cl, Maybe a) (Maybe b))} - -instance (GetClockProxy cl) => ToClockProxy (SN m cl a b) where - type Cl (SN m cl a b) = cl +{- | Remove the signal network type abstraction and reveal the underlying automaton. -eraseClockSN :: Time cl -> SN m cl a b -> (Automaton m (Time cl, Tag cl, Maybe a) (Maybe b)) +* To drive the network, the timestamps and tags of the clock are needed +Since the input and output clocks are not always guaranteed to tick, the i +-} +eraseClockSN :: + -- | Initial time + Time cl -> + -- The original signal network + SN m cl a b -> Automaton m (Time cl, Tag cl, Maybe a) (Maybe b) eraseClockSN time = flip runReader time . getSN {-# INLINE eraseClockSN #-} --- A synchronous signal network is run by erasing the clock from the clocked signal function. -synchronous :: - forall cl m a b. - (cl ~ In cl, cl ~ Out cl, Monad m, Clock m cl, GetClockProxy cl) => - ClSF m cl a b -> - SN m cl a b -synchronous clsf = SN $ reader $ \initialTime -> proc (time, tag, Just a) -> do - b <- eraseClockClSF (getClockProxy @cl) initialTime clsf -< (time, tag, a) - returnA -< Just b -{-# INLINE synchronous #-} - --- A sequentially composed signal network may either be triggered in its first component, --- or its second component. In either case, --- the resampling buffer (which connects the two components) may be triggered, --- but only if the outgoing clock of the first component ticks, --- or the incoming clock of the second component ticks. -sequential :: - ( Clock m clab - , Clock m clcd - , Clock m (Out clab) - , Clock m (Out clcd) - , Clock m (In clab) - , Clock m (In clcd) - , GetClockProxy clab - , GetClockProxy clcd - , Time clab ~ Time clcd - , Time clab ~ Time (Out clab) - , Time clcd ~ Time (In clcd) - , Monad m - ) => - SN m clab a b -> - ResamplingBuffer m (Out clab) (In clcd) b c -> - SN m clcd c d -> - SN m (SequentialClock clab clcd) a d -sequential sn1 resBuf sn2 = SN $ reader $ \initialTime -> - let - proxy1 = toClockProxy sn1 - proxy2 = toClockProxy sn2 - in - proc (time, tag, maybeA) -> do - resBufIn <- case tag of - Left tagL -> do - maybeB <- eraseClockSN initialTime sn1 -< (time, tagL, maybeA) - returnA -< Left <$> ((time,,) <$> outTag proxy1 tagL <*> maybeB) - Right tagR -> do - returnA -< Right . (time,) <$> inTag proxy2 tagR - maybeC <- mapMaybeS $ eraseClockResBuf (outProxy proxy1) (inProxy proxy2) initialTime resBuf -< resBufIn - case tag of - Left _ -> do - returnA -< Nothing - Right tagR -> do - eraseClockSN initialTime sn2 -< (time, tagR, join maybeC) -{-# INLINE sequential #-} - -parallel snL snR = SN $ reader $ \initialTime -> proc (time, tag, maybeA) -> do - case tag of - Left tagL -> eraseClockSN initialTime snL -< (time, tagL, maybeA) - Right tagR -> eraseClockSN initialTime snR -< (time, tagR, maybeA) -{-# INLINE parallel #-} - -postcompose sn clsf = SN $ reader $ \initialTime -> - let - proxy = toClockProxy sn - in - proc input@(time, tag, _) -> do - bMaybe <- eraseClockSN initialTime sn -< input - mapMaybeS $ eraseClockClSF (outProxy proxy) initialTime clsf -< (time,,) <$> outTag proxy tag <*> bMaybe -{-# INLINE postcompose #-} - -precompose clsf sn = SN $ reader $ \initialTime -> - let - proxy = toClockProxy sn - in - proc (time, tag, aMaybe) -> do - bMaybe <- mapMaybeS $ eraseClockClSF (inProxy proxy) initialTime clsf -< (time,,) <$> inTag proxy tag <*> aMaybe - eraseClockSN initialTime sn -< (time, tag, bMaybe) -{-# INLINE precompose #-} - -feedbackSN ResamplingBuffer {buffer, put, get} sn = SN $ reader $ \initialTime -> - let - proxy = toClockProxy sn - in - feedback buffer $ proc ((time, tag, aMaybe), buf) -> do - (cMaybe, buf') <- case inTag proxy tag of - Nothing -> do - returnA -< (Nothing, buf) - Just tagIn -> do - timeInfo <- genTimeInfo (inProxy proxy) initialTime -< (time, tagIn) - Result buf' c <- arrM $ uncurry get -< (timeInfo, buf) - returnA -< (Just c, buf') - bdMaybe <- eraseClockSN initialTime sn -< (time, tag, (,) <$> aMaybe <*> cMaybe) - case (,) <$> outTag proxy tag <*> bdMaybe of - Nothing -> do - returnA -< (Nothing, buf') - Just (tagOut, (b, d)) -> do - timeInfo <- genTimeInfo (outProxy proxy) initialTime -< (time, tagOut) - buf'' <- arrM $ uncurry $ uncurry put -< ((timeInfo, d), buf') - returnA -< (Just b, buf'') -{-# INLINE feedbackSN #-} -firstResampling sn buf = SN $ reader $ \initialTime -> - let - proxy = toClockProxy sn - in - proc (time, tag, acMaybe) -> do - bMaybe <- eraseClockSN initialTime sn -< (time, tag, fst <$> acMaybe) - let - resBufInput = case (inTag proxy tag, outTag proxy tag, snd <$> acMaybe) of - (Just tagIn, _, Just c) -> Just $ Left (time, tagIn, c) - (_, Just tagOut, _) -> Just $ Right (time, tagOut) - _ -> Nothing - dMaybe <- mapMaybeS $ eraseClockResBuf (inProxy proxy) (outProxy proxy) initialTime buf -< resBufInput - returnA -< (,) <$> bMaybe <*> join dMaybe -{-# INLINE firstResampling #-} {- | Translate a resampling buffer into an automaton. diff --git a/rhine/src/FRP/Rhine/Reactimation/Combinators.hs b/rhine/src/FRP/Rhine/Reactimation/Combinators.hs index 676682b7d..cea338e37 100644 --- a/rhine/src/FRP/Rhine/Reactimation/Combinators.hs +++ b/rhine/src/FRP/Rhine/Reactimation/Combinators.hs @@ -21,11 +21,11 @@ module FRP.Rhine.Reactimation.Combinators where import FRP.Rhine.ClSF.Core import FRP.Rhine.Clock import FRP.Rhine.Clock.Proxy -import FRP.Rhine.Reactimation.ClockErasure import FRP.Rhine.ResamplingBuffer import FRP.Rhine.SN.Combinators import FRP.Rhine.Schedule import FRP.Rhine.Type +import FRP.Rhine.SN -- * Combinators and syntactic sugar for high-level composition of signal networks. diff --git a/rhine/src/FRP/Rhine/SN.hs b/rhine/src/FRP/Rhine/SN.hs index 8cc92a676..f4b8b3792 100644 --- a/rhine/src/FRP/Rhine/SN.hs +++ b/rhine/src/FRP/Rhine/SN.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {- | @@ -11,7 +12,20 @@ all satisfying the appropriate clock type constraints. This module defines the 'SN' type, combinators are found in a submodule. -} -module FRP.Rhine.SN where +module FRP.Rhine.SN + ( + module FRP.Rhine.SN, + module FRP.Rhine.SN.Type + ) where + +-- base +import Control.Monad (join) + +-- transformers +import Control.Monad.Trans.Reader (reader) + +-- automata +import Data.Stream.Result (Result(..)) -- rhine import FRP.Rhine.ClSF.Core @@ -19,97 +33,130 @@ import FRP.Rhine.Clock import FRP.Rhine.Clock.Proxy import FRP.Rhine.ResamplingBuffer import FRP.Rhine.Schedule +import FRP.Rhine.Clock.Util (genTimeInfo) +import FRP.Rhine.SN.Type +import FRP.Rhine.Reactimation.ClockErasure -{- FOURMOLU_DISABLE -} - -{- | An 'SN' is a side-effectful asynchronous /__s__ignal __n__etwork/, -where input, data processing (including side effects) and output -need not happen at the same time. - -The type parameters are: - -* 'm': The monad in which side effects take place. -* 'cl': The clock of the whole signal network. - It may be sequentially or parallely composed from other clocks. -* 'a': The input type. Input arrives at the rate @In cl@. -* 'b': The output type. Output arrives at the rate @Out cl@. --} -data SN m cl a b where - -- | A synchronous automaton is the basic building block. - -- For such an 'SN', data enters and leaves the system at the same rate as it is processed. - Synchronous :: - ( cl ~ In cl, cl ~ Out cl) => - ClSF m cl a b -> - SN m cl a b - -- | Two 'SN's may be sequentially composed if there is a matching 'ResamplingBuffer' between them. - Sequential :: - ( Clock m clab, Clock m clcd - , Clock m (Out clab), Clock m (Out clcd) - , Clock m (In clab), Clock m (In clcd) - , GetClockProxy clab, GetClockProxy clcd - , Time clab ~ Time clcd - , Time clab ~ Time (Out clab) - , Time clcd ~ Time (In clcd) - ) => - SN m clab a b -> - ResamplingBuffer m (Out clab) (In clcd) b c -> - SN m clcd c d -> - SN m (SequentialClock clab clcd) a d +-- | A synchronous automaton is the basic building block. +-- For such an 'SN', data enters and leaves the system at the same rate as it is processed. +synchronous :: + forall cl m a b. + (cl ~ In cl, cl ~ Out cl, Monad m, Clock m cl, GetClockProxy cl) => + ClSF m cl a b -> + SN m cl a b +synchronous clsf = SN $ reader $ \initialTime -> proc (time, tag, Just a) -> do + b <- eraseClockClSF (getClockProxy @cl) initialTime clsf -< (time, tag, a) + returnA -< Just b +{-# INLINE synchronous #-} - -- | Two 'SN's with the same input and output data may be parallely composed. - Parallel :: - ( Clock m cl1, Clock m cl2 - , Clock m (Out cl1), Clock m (Out cl2) - , GetClockProxy cl1, GetClockProxy cl2 - , Time cl1 ~ Time (Out cl1) - , Time cl2 ~ Time (Out cl2) - , Time cl1 ~ Time cl2 - , Time cl1 ~ Time (In cl1) - , Time cl2 ~ Time (In cl2) - ) => - SN m cl1 a b -> - SN m cl2 a b -> - SN m (ParallelClock cl1 cl2) a b +-- | Two 'SN's may be sequentially composed if there is a matching 'ResamplingBuffer' between them. +sequential :: + ( Clock m clab + , Clock m clcd + , Clock m (Out clab) + , Clock m (Out clcd) + , Clock m (In clab) + , Clock m (In clcd) + , GetClockProxy clab + , GetClockProxy clcd + , Time clab ~ Time clcd + , Time clab ~ Time (Out clab) + , Time clcd ~ Time (In clcd) + , Monad m + ) => + SN m clab a b -> + ResamplingBuffer m (Out clab) (In clcd) b c -> + SN m clcd c d -> + SN m (SequentialClock clab clcd) a d +-- A sequentially composed signal network may either be triggered in its first component, +-- or its second component. In either case, +-- the resampling buffer (which connects the two components) may be triggered, +-- but only if the outgoing clock of the first component ticks, +-- or the incoming clock of the second component ticks. +sequential sn1 resBuf sn2 = SN $ reader $ \initialTime -> + let + proxy1 = toClockProxy sn1 + proxy2 = toClockProxy sn2 + in + proc (time, tag, maybeA) -> do + resBufIn <- case tag of + Left tagL -> do + maybeB <- eraseClockSN initialTime sn1 -< (time, tagL, maybeA) + returnA -< Left <$> ((time,,) <$> outTag proxy1 tagL <*> maybeB) + Right tagR -> do + returnA -< Right . (time,) <$> inTag proxy2 tagR + maybeC <- mapMaybeS $ eraseClockResBuf (outProxy proxy1) (inProxy proxy2) initialTime resBuf -< resBufIn + case tag of + Left _ -> do + returnA -< Nothing + Right tagR -> do + eraseClockSN initialTime sn2 -< (time, tagR, join maybeC) +{-# INLINE sequential #-} - -- | Bypass the signal network by forwarding data in parallel through a 'ResamplingBuffer'. - FirstResampling :: - ( Clock m (In cl), Clock m (Out cl) - , Time cl ~ Time (Out cl) - , Time cl ~ Time (In cl) - ) => - SN m cl a b -> - ResamplingBuffer m (In cl) (Out cl) c d -> - SN m cl (a, c) (b, d) +-- | Two 'SN's with the same input and output data may be parallely composed. +parallel snL snR = SN $ reader $ \initialTime -> proc (time, tag, maybeA) -> do + case tag of + Left tagL -> eraseClockSN initialTime snL -< (time, tagL, maybeA) + Right tagR -> eraseClockSN initialTime snR -< (time, tagR, maybeA) +{-# INLINE parallel #-} - -- | A 'ClSF' can always be postcomposed onto an 'SN' if the clocks match on the output. - Postcompose :: - ( Clock m (Out cl) - , Time cl ~ Time (Out cl) - ) => - SN m cl a b -> - ClSF m (Out cl) b c -> - SN m cl a c +-- | A 'ClSF' can always be postcomposed onto an 'SN' if the clocks match on the output. +postcompose sn clsf = SN $ reader $ \initialTime -> + let + proxy = toClockProxy sn + in + proc input@(time, tag, _) -> do + bMaybe <- eraseClockSN initialTime sn -< input + mapMaybeS $ eraseClockClSF (outProxy proxy) initialTime clsf -< (time,,) <$> outTag proxy tag <*> bMaybe +{-# INLINE postcompose #-} - -- | A 'ClSF' can always be precomposed onto an 'SN' if the clocks match on the input. - Precompose :: - ( Clock m (In cl) - , Time cl ~ Time (In cl) - ) => - ClSF m (In cl) a b -> - SN m cl b c -> - SN m cl a c +-- | A 'ClSF' can always be precomposed onto an 'SN' if the clocks match on the input. +precompose clsf sn = SN $ reader $ \initialTime -> + let + proxy = toClockProxy sn + in + proc (time, tag, aMaybe) -> do + bMaybe <- mapMaybeS $ eraseClockClSF (inProxy proxy) initialTime clsf -< (time,,) <$> inTag proxy tag <*> aMaybe + eraseClockSN initialTime sn -< (time, tag, bMaybe) +{-# INLINE precompose #-} - -- | Data can be looped back to the beginning of an 'SN', - -- but it must be resampled since the 'Out' and 'In' clocks are generally different. - Feedback :: - ( Clock m (In cl), Clock m (Out cl) - , Time (In cl) ~ Time cl - , Time (Out cl) ~ Time cl - ) => - ResBuf m (Out cl) (In cl) d c -> - SN m cl (a, c) (b, d) -> - SN m cl a b +-- | Data can be looped back to the beginning of an 'SN', +-- but it must be resampled since the 'Out' and 'In' clocks are generally different. +feedbackSN ResamplingBuffer {buffer, put, get} sn = SN $ reader $ \initialTime -> + let + proxy = toClockProxy sn + in + feedback buffer $ proc ((time, tag, aMaybe), buf) -> do + (cMaybe, buf') <- case inTag proxy tag of + Nothing -> do + returnA -< (Nothing, buf) + Just tagIn -> do + timeInfo <- genTimeInfo (inProxy proxy) initialTime -< (time, tagIn) + Result buf' c <- arrM $ uncurry get -< (timeInfo, buf) + returnA -< (Just c, buf') + bdMaybe <- eraseClockSN initialTime sn -< (time, tag, (,) <$> aMaybe <*> cMaybe) + case (,) <$> outTag proxy tag <*> bdMaybe of + Nothing -> do + returnA -< (Nothing, buf') + Just (tagOut, (b, d)) -> do + timeInfo <- genTimeInfo (outProxy proxy) initialTime -< (time, tagOut) + buf'' <- arrM $ uncurry $ uncurry put -< ((timeInfo, d), buf') + returnA -< (Just b, buf'') +{-# INLINE feedbackSN #-} -instance GetClockProxy cl => ToClockProxy (SN m cl a b) where - type Cl (SN m cl a b) = cl +-- | Bypass the signal network by forwarding data in parallel through a 'ResamplingBuffer'. +firstResampling sn buf = SN $ reader $ \initialTime -> + let + proxy = toClockProxy sn + in + proc (time, tag, acMaybe) -> do + bMaybe <- eraseClockSN initialTime sn -< (time, tag, fst <$> acMaybe) + let + resBufInput = case (inTag proxy tag, outTag proxy tag, snd <$> acMaybe) of + (Just tagIn, _, Just c) -> Just $ Left (time, tagIn, c) + (_, Just tagOut, _) -> Just $ Right (time, tagOut) + _ -> Nothing + dMaybe <- mapMaybeS $ eraseClockResBuf (inProxy proxy) (outProxy proxy) initialTime buf -< resBufInput + returnA -< (,) <$> bMaybe <*> join dMaybe +{-# INLINE firstResampling #-} diff --git a/rhine/src/FRP/Rhine/SN/Combinators.hs b/rhine/src/FRP/Rhine/SN/Combinators.hs index cb8b1bccd..4d2b1b36d 100644 --- a/rhine/src/FRP/Rhine/SN/Combinators.hs +++ b/rhine/src/FRP/Rhine/SN/Combinators.hs @@ -11,8 +11,8 @@ import Data.Functor ((<&>)) import FRP.Rhine.ClSF.Core import FRP.Rhine.Clock import FRP.Rhine.Clock.Proxy -import FRP.Rhine.Reactimation.ClockErasure import FRP.Rhine.Schedule +import FRP.Rhine.SN {- FOURMOLU_DISABLE -} -- | Postcompose a signal network with a pure function. diff --git a/rhine/src/FRP/Rhine/SN/Type.hs b/rhine/src/FRP/Rhine/SN/Type.hs new file mode 100644 index 000000000..6cd086042 --- /dev/null +++ b/rhine/src/FRP/Rhine/SN/Type.hs @@ -0,0 +1,30 @@ +module FRP.Rhine.SN.Type where + +-- transformers +import Control.Monad.Trans.Reader (Reader) + +-- automaton +import Data.Automaton + +-- rhine +import FRP.Rhine.Clock +import FRP.Rhine.Clock.Proxy + + +-- Andras Kovacs' trick: Encode in the domain +{- | An 'SN' is a side-effectful asynchronous /__s__ignal __n__etwork/, +where input, data processing (including side effects) and output +need not happen at the same time. + +The type parameters are: + +* 'm': The monad in which side effects take place. +* 'cl': The clock of the whole signal network. + It may be sequentially or parallely composed from other clocks. +* 'a': The input type. Input arrives at the rate @In cl@. +* 'b': The output type. Output arrives at the rate @Out cl@. +-} +newtype SN m cl a b = SN {getSN :: Reader (Time cl) (Automaton m (Time cl, Tag cl, Maybe a) (Maybe b))} + +instance (GetClockProxy cl) => ToClockProxy (SN m cl a b) where + type Cl (SN m cl a b) = cl diff --git a/rhine/src/FRP/Rhine/Type.hs b/rhine/src/FRP/Rhine/Type.hs index 218ccf7f9..7b0865884 100644 --- a/rhine/src/FRP/Rhine/Type.hs +++ b/rhine/src/FRP/Rhine/Type.hs @@ -16,6 +16,7 @@ import Data.Automaton -- rhine import FRP.Rhine.Clock import FRP.Rhine.Clock.Proxy +import FRP.Rhine.SN import FRP.Rhine.Reactimation.ClockErasure import FRP.Rhine.ResamplingBuffer (ResamplingBuffer) import FRP.Rhine.Schedule (In, Out)