----------------------------------------------------------------------------- -- | -- Module : ForSyDe.Shallow.Signal -- Copyright : (c) SAM Group, KTH/ICT/ECS 2007-2008 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : forsyde-dev@ict.kth.se -- Stability : experimental -- Portability : portable -- -- This module defines the shallow-embedded 'Signal' datatype and -- functions operating on it. ----------------------------------------------------------------------------- module ForSyDe.Shallow.Signal( Signal (NullS, (:-)), (-:), (+-+), (!-), signal, fromSignal, unitS, nullS, headS, tailS, atS, takeS, dropS, lengthS, infiniteS, copyS, selectS, writeS, readS, fanS ) where infixr 5 :- infixr 5 -: infixr 5 +-+ infixr 5 !- -- | A signal is defined as a list of events. An event has a tag and a value. The tag of an event is defined by the position in the list. A signal is defined as an instance of the classes 'Read' and 'Show'. The signal 1 :- 2 :- NullS is represented as \{1,2\}. data Signal a = NullS | a :- Signal a deriving (Eq) -- | The function 'signal' converts a list into a signal. signal :: [a] -> Signal a -- | The function 'fromSignal' converts a signal into a list. fromSignal :: Signal a -> [a] -- | The function 'unitS' creates a signal with one value. unitS :: a -> Signal a -- | The function 'nullS' checks if a signal is empty. nullS :: Signal a -> Bool -- | The function 'headS' gives the first value - the head - of a signal. headS :: Signal a -> a -- | The function 'tailS' gives the rest of the signal - the tail. tailS :: Signal a -> Signal a -- | The function 'atS' returns the n-th event in a signal. The numbering of events in a signal starts with 0. There is also an operator version of this function, '(!-)'. atS :: Int -> Signal a -> a -- | The function 'takeS' returns the first n values of a signal. takeS :: Int -> Signal a -> Signal a -- | The function 'dropS' drops the first $n$ values from a signal. dropS :: Int -> Signal a -> Signal a -- | The function 'selectS' takes three parameters, an offset, a stepsize and a signal and returns some elements of the signal such as in the following example: -- -- @ -- Signal> selectS 2 3 (signal[1,2,3,4,5,6,7,8,9,10]) -- {3,6,9} :: Signal Integer -- @ selectS :: Int -> Int -> Signal a -> Signal a -- | The function 'lengthS' returns the length of a 'finite' signal. lengthS :: Signal b -> Int -- | The function 'infiniteS' creates an infinite signal. The first argument 'f' is a function that is applied on the current value. The second argument 'x' gives the first value of the signal. -- -- > Signal> takeS 5 (infiniteS (*3) 1) -- > {1,3,9,27,81} :: Signal Integer -- infiniteS :: (a -> a) -> a -> Signal a -- | The function 'writeS' transforms a signal into a string of the following format: -- -- @ -- Signal> writeS (signal[1,2,3,4,5]) -- "1\n2\n3\n4\n5\n" :: [Char] -- @ writeS :: Show a => Signal a -> [Char] -- | The function 'readS' transforms a formatted string into a signal. -- -- @ -- Signal> readS "1\n2\n3\n4\n5\n" :: Signal Int -- {1,2,3,4,5} :: Signal Int -- @ readS :: Read a => [Char] -> Signal a -- | The operator '-:' adds at an element to a signal at the tail. (-:) :: Signal a -> a -> Signal a -- | The operator '+-+' concatinates two signals into one signal. (+-+) :: Signal a -> Signal a -> Signal a -- | The function 'copyS' creates a signal with n values 'x'. copyS :: Num a => a -> b -> Signal b -- | The combinator 'fanS' takes two processes 'p1' and 'p2' and and generates a process network, where a signal is split and processed by the processes 'p1' and 'p2'. fanS :: (Signal a -> Signal b) -> (Signal a -> Signal c) -> Signal a -> (Signal b, Signal c) -- Implementation instance (Show a) => Show (Signal a) where showsPrec p NullS = showParen (p > 9) ( showString "{}") showsPrec p xs = showParen (p > 9) ( showChar '{' . showSignal1 xs) where showSignal1 NullS = showChar '}' showSignal1 (y:-NullS) = shows y . showChar '}' showSignal1 (y:-ys) = shows y . showChar ',' . showSignal1 ys instance Read a => Read (Signal a) where readsPrec _ s = readsSignal s readsSignal :: (Read a) => ReadS (Signal a) readsSignal s = [((x:-NullS), rest) | ("{", r2) <- lex s, (x, r3) <- reads r2, ("}", rest) <- lex r3] ++ [(NullS, r4) | ("{", r5) <- lex s, ("}", r4) <- lex r5] ++ [((x:-xs), r6) | ("{", r7) <- lex s, (x, r8) <- reads r7, (",", r9) <- lex r8, (xs, r6) <- readsValues r9] readsValues :: (Read a) => ReadS (Signal a) readsValues s = [((x:-NullS), r1) | (x, r2) <- reads s, ("}", r1) <- lex r2] ++ [((x:-xs), r3) | (x, r4) <- reads s, (",", r5) <- lex r4, (xs, r3) <- readsValues r5] signal [] = NullS signal (x:xs) = x :- signal xs fromSignal NullS = [] fromSignal (x:-xs) = x : fromSignal xs unitS x = x :- NullS nullS NullS = True nullS _ = False headS NullS = error "headS : Signal is empty" headS (x:-_) = x tailS NullS = error "tailS : Signal is empty" tailS (_:-xs) = xs atS _ NullS = error "atS: Signal has not enough elements" atS 0 (x:-_) = x atS n (_:-xs) = atS (n-1) xs (!-) :: Signal a -> Int -> a (!-) xs n = atS n xs takeS 0 _ = NullS takeS _ NullS = NullS takeS n (x:-xs) | n <= 0 = NullS | otherwise = x :- takeS (n-1) xs dropS 0 NullS = NullS dropS _ NullS = NullS dropS n (x:-xs) | n <= 0 = x:-xs | otherwise = dropS (n-1) xs selectS offset step xs = select1S step (dropS offset xs) where select1S _ NullS = NullS select1S st (y:-ys) = y :- select1S st (dropS (st-1) ys) (-:) xs x = xs +-+ (x :- NullS) (+-+) NullS ys = ys (+-+) (x:-xs) ys = x :- (xs +-+ ys) lengthS NullS = 0 lengthS (_:-xs) = 1 + lengthS xs infiniteS f x = x :- infiniteS f (f x) copyS 0 _ = NullS copyS n x = x :- copyS (n-1) x fanS p1 p2 xs = (p1 xs, p2 xs) writeS NullS = [] writeS (x:-xs) = show x ++ "\n" ++ writeS xs readS xs = readS' (words xs) where readS' [] = NullS readS' ("\n":ys) = readS' ys readS' (y:ys) = read y :- readS' ys