diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,10 @@ +2018-10-21 Ivan Perez + * Yampa.cabal: Version bump (0.12). + * README.md: Documents testing. + * src/: Introduces FutureSF, needed for testing. + * extensions/test/: Introduces testing library. + * Thanks to @chriz-keera. + 2018-08-11 Ivan Perez * Yampa.cabal: Version bump (0.11.1). * README.md: Documents papers. diff --git a/Yampa.cabal b/Yampa.cabal --- a/Yampa.cabal +++ b/Yampa.cabal @@ -1,5 +1,5 @@ name: Yampa -version: 0.11.1 +version: 0.12 cabal-version: >= 1.8 license: BSD3 license-file: LICENSE diff --git a/src/FRP/Yampa.hs b/src/FRP/Yampa.hs --- a/src/FRP/Yampa.hs +++ b/src/FRP/Yampa.hs @@ -426,6 +426,11 @@ deltaEncodeBy, -- :: (a -> a -> Bool) -> DTime -> [a] -- -> (a, [(DTime, Maybe a)]) + FutureSF, + evalAtZero, + evalAt, + evalFuture, + -- * Auxiliary definitions -- Reverse function composition and arrow plumbing aids ( # ), -- :: (a -> b) -> (b -> c) -> (a -> c), infixl 9 diff --git a/src/FRP/Yampa/MergeableRecord.hs b/src/FRP/Yampa/MergeableRecord.hs --- a/src/FRP/Yampa/MergeableRecord.hs +++ b/src/FRP/Yampa/MergeableRecord.hs @@ -49,14 +49,17 @@ -- @ ----------------------------------------------------------------------------------------- -module FRP.Yampa.MergeableRecord ( +module FRP.Yampa.MergeableRecord + {-# DEPRECATED "No longer supported." #-} + ( MergeableRecord(..), MR, -- Abstract mrMake, (~+~), mrMerge, mrFinalize -) where + ) + where -- | Superclass providing operations on records. Record operations can be -- merged (composed). To obtain a record from a sequence of merging operations diff --git a/src/FRP/Yampa/Simulation.hs b/src/FRP/Yampa/Simulation.hs --- a/src/FRP/Yampa/Simulation.hs +++ b/src/FRP/Yampa/Simulation.hs @@ -1,4 +1,6 @@ {-# LANGUAGE GADTs, Rank2Types, CPP #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------------------- -- | -- Module : FRP.Yampa.Simulation @@ -12,10 +14,11 @@ -- Execution/simulation of signal functions. -- -- SFs can be executed in two ways: by running them, feeding input samples one --- by one, obtained from a monadic environment (presumably, |IO|), or by +-- by one, obtained from a monadic environment (presumably, @IO@), or by -- passing an input stream and calculating an output stream. The former is -- called /reactimation/, and the latter is called /embedding/. -- +-- * Running: -- Normally, to run an SF, you would use 'reactimate', providing input samples, -- and consuming the output samples in the 'IO' monad. This function takes over -- the program, implementing a "main loop". If you want more control over the @@ -23,11 +26,14 @@ -- backend that also implements some main loop), you may want to use the -- lower-level API for reactimation ('ReactHandle', 'reactInit', 'react'). -- +-- * Embedding: -- You can use 'embed' for testing, to evaluate SFs in a terminal, and to embed -- an SF inside a larger system. The helper functions 'deltaEncode' and -- 'deltaEncodeBy' facilitate producing input /signals/ from plain lists of -- input samples. -- +-- This module also includes debugging aids needed to execute signal functions +-- step by step, which are used by Yampa's testing facilities. ----------------------------------------------------------------------------------------- module FRP.Yampa.Simulation ( @@ -56,6 +62,14 @@ deltaEncodeBy, -- :: (a -> a -> Bool) -> DTime -> [a] -- -> (a, [(DTime, Maybe a)]) + -- * Debugging / Step by step simulation + + FutureSF, + evalAtZero, + evalAt, + evalFuture, + + ) where import Control.Monad (unless) @@ -279,23 +293,7 @@ | t' <= tp = advance tp tbtbs advance _ _ = undefined --- | Spaces a list of samples by a fixed time delta, avoiding --- unnecessary samples when the input has not changed since --- the last sample. -deltaEncode :: Eq a => DTime -> [a] -> (a, [(DTime, Maybe a)]) -deltaEncode _ [] = usrErr "AFRP" "deltaEncode" "Empty input list." -deltaEncode dt aas@(_:_) = deltaEncodeBy (==) dt aas - --- | 'deltaEncode' parameterized by the equality test. -deltaEncodeBy :: (a -> a -> Bool) -> DTime -> [a] -> (a, [(DTime, Maybe a)]) -deltaEncodeBy _ _ [] = usrErr "AFRP" "deltaEncodeBy" "Empty input list." -deltaEncodeBy eq dt (a0:as) = (a0, zip (repeat dt) (debAux a0 as)) - where - debAux _ [] = [] - debAux a_prev (a:as) | a `eq` a_prev = Nothing : debAux a as - | otherwise = Just a : debAux a as - -- Embedding and missing events. -- Suppose a subsystem is super sampled. Then some of the output -- samples will have to be dropped. If we are unlycky, the dropped @@ -318,6 +316,81 @@ -- But what do we do if the inner system runs more slowly than the -- outer one? Then we need to extrapolate the output from the -- inner system, and we have the same problem with events AGAIN! + +-- | Spaces a list of samples by a fixed time delta, avoiding +-- unnecessary samples when the input has not changed since +-- the last sample. +deltaEncode :: Eq a => DTime -> [a] -> (a, [(DTime, Maybe a)]) +deltaEncode _ [] = usrErr "AFRP" "deltaEncode" "Empty input list." +deltaEncode dt aas@(_:_) = deltaEncodeBy (==) dt aas + + +-- | 'deltaEncode' parameterized by the equality test. +deltaEncodeBy :: (a -> a -> Bool) -> DTime -> [a] -> (a, [(DTime, Maybe a)]) +deltaEncodeBy _ _ [] = usrErr "AFRP" "deltaEncodeBy" "Empty input list." +deltaEncodeBy eq dt (a0:as) = (a0, zip (repeat dt) (debAux a0 as)) + where + debAux _ [] = [] + debAux a_prev (a:as) | a `eq` a_prev = Nothing : debAux a as + | otherwise = Just a : debAux a as + + +-- * Debugging / Step by step simulation + +-- | A wrapper around an initialized SF (continuation), needed for testing and +-- debugging purposes. +-- +newtype FutureSF a b = FutureSF { unsafeSF :: SF' a b } + + +-- | Evaluate an SF, and return an output and an initialized SF. +-- +-- /WARN/: Do not use this function for standard simulation. This function is +-- intended only for debugging/testing. Apart from being potentially slower +-- and consuming more memory, it also breaks the FRP abstraction by making +-- samples discrete and step based. +evalAtZero :: SF a b + -> a -- ^ Input sample + -> (b, FutureSF a b) -- ^ Output x Continuation +evalAtZero (SF { sfTF = tf }) a = (b, FutureSF tf' ) + where (tf', b) = tf a + + +-- | Evaluate an initialized SF, and return an output and a continuation. +-- +-- /WARN/: Do not use this function for standard simulation. This function is +-- intended only for debugging/testing. Apart from being potentially slower +-- and consuming more memory, it also breaks the FRP abstraction by making +-- samples discrete and step based. +evalAt :: FutureSF a b + -> DTime -> a -- ^ Input sample + -> (b, FutureSF a b) -- ^ Output x Continuation +evalAt (FutureSF { unsafeSF = tf }) dt a = (b, FutureSF tf') + where (tf', b) = (sfTF' tf) dt a + + +-- | Given a signal function and time delta, it moves the signal function into +-- the future, returning a new uninitialized SF and the initial output. +-- +-- While the input sample refers to the present, the time delta refers to the +-- future (or to the time between the current sample and the next sample). +-- +-- /WARN/: Do not use this function for standard simulation. This function is +-- intended only for debugging/testing. Apart from being potentially slower +-- and consuming more memory, it also breaks the FRP abstraction by making +-- samples discrete and step based. +-- +evalFuture :: SF a b -> a -> DTime -> (b, SF a b) +evalFuture sf a dt = (b, sf' dt) + where (b, sf') = evalStep sf a + + +-- | Steps the signal function into the future one step. It returns the current +-- output, and a signal function that expects, apart from an input, a time +-- between samples. +evalStep :: SF a b -> a -> (b, DTime -> SF a b) +evalStep (SF sf) a = (b, \dt -> SF (sfTF' sf' dt)) + where (sf', b) = sf a -- Vim modeline -- vim:set tabstop=8 expandtab: diff --git a/tests/AFRPTestsCommon.hs b/tests/AFRPTestsCommon.hs --- a/tests/AFRPTestsCommon.hs +++ b/tests/AFRPTestsCommon.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-tabs #-} -{- $Id: AFRPTestsCommon.hs,v 1.2 2003/11/10 21:28:58 antony Exp $ +{- ****************************************************************************** * A F R P * * * @@ -160,6 +160,8 @@ ------------------------------------------------------------------------------ -- Some utilities used for testing laws ------------------------------------------------------------------------------ + +fun_prod f g = \(x,y) -> (f x, g y) assoc :: ((a,b),c) -> (a,(b,c)) assoc ((a,b),c) = (a,(b,c))