module ForSyDe.Shallow.Core.Signal(
Signal (NullS, (:-)), (-:), (+-+), (!-),
signal, fromSignal,
unitS, nullS, headS, tailS, atS, takeS, dropS,
lengthS, infiniteS, copyS, selectS, writeS, readS, fanS,
foldrS, allS
) where
infixr 5 :-
infixr 5 -:
infixr 5 +-+
infixr 5 !-
data Signal a = NullS
| a :- Signal a deriving (Signal a -> Signal a -> Bool
(Signal a -> Signal a -> Bool)
-> (Signal a -> Signal a -> Bool) -> Eq (Signal a)
forall a. Eq a => Signal a -> Signal a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signal a -> Signal a -> Bool
$c/= :: forall a. Eq a => Signal a -> Signal a -> Bool
== :: Signal a -> Signal a -> Bool
$c== :: forall a. Eq a => Signal a -> Signal a -> Bool
Eq)
signal :: [a] -> Signal a
fromSignal :: Signal a -> [a]
unitS :: a -> Signal a
nullS :: Signal a -> Bool
headS :: Signal a -> a
tailS :: Signal a -> Signal a
atS :: Int -> Signal a -> a
takeS :: Int -> Signal a -> Signal a
dropS :: Int -> Signal a -> Signal a
selectS :: Int -> Int -> Signal a -> Signal a
lengthS :: Signal b -> Int
infiniteS :: (a -> a) -> a -> Signal a
writeS :: Show a => Signal a -> [Char]
readS :: Read a => [Char] -> Signal a
(-:) :: Signal a -> a -> Signal a
(+-+) :: Signal a -> Signal a -> Signal a
copyS :: (Num a, Eq a) => a -> b -> Signal b
fanS :: (Signal a -> Signal b) -> (Signal a -> Signal c)
-> Signal a -> (Signal b, Signal c)
foldrS :: (t -> p -> p) -> p -> Signal t -> p
allS :: (a -> Bool) -> Signal a -> Bool
instance (Show a) => Show (Signal a) where
showsPrec :: Int -> Signal a -> ShowS
showsPrec Int
p Signal a
NullS = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (String -> ShowS
showString String
"{}")
showsPrec Int
p Signal a
xs = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (Char -> ShowS
showChar Char
'{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal a -> ShowS
forall a. Show a => Signal a -> ShowS
showSignal1 Signal a
xs)
where
showSignal1 :: Signal a -> ShowS
showSignal1 Signal a
NullS = Char -> ShowS
showChar Char
'}'
showSignal1 (a
y:-Signal a
NullS) = a -> ShowS
forall a. Show a => a -> ShowS
shows a
y ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
showSignal1 (a
y:-Signal a
ys) = a -> ShowS
forall a. Show a => a -> ShowS
shows a
y ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal a -> ShowS
showSignal1 Signal a
ys
instance Read a => Read (Signal a) where
readsPrec :: Int -> ReadS (Signal a)
readsPrec Int
_ String
s = ReadS (Signal a)
forall a. Read a => ReadS (Signal a)
readsSignal String
s
readsSignal :: (Read a) => ReadS (Signal a)
readsSignal :: ReadS (Signal a)
readsSignal String
s
= [((a
xa -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:-Signal a
forall a. Signal a
NullS), String
rest)
| (String
"{", String
r2) <- ReadS String
lex String
s,
(a
x, String
r3) <- ReadS a
forall a. Read a => ReadS a
reads String
r2,
(String
"}", String
rest) <- ReadS String
lex String
r3]
[(Signal a, String)]
-> [(Signal a, String)] -> [(Signal a, String)]
forall a. [a] -> [a] -> [a]
++ [(Signal a
forall a. Signal a
NullS, String
r4)
| (String
"{", String
r5) <- ReadS String
lex String
s,
(String
"}", String
r4) <- ReadS String
lex String
r5]
[(Signal a, String)]
-> [(Signal a, String)] -> [(Signal a, String)]
forall a. [a] -> [a] -> [a]
++ [((a
xa -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:-Signal a
xs), String
r6)
| (String
"{", String
r7) <- ReadS String
lex String
s,
(a
x, String
r8) <- ReadS a
forall a. Read a => ReadS a
reads String
r7,
(String
",", String
r9) <- ReadS String
lex String
r8,
(Signal a
xs, String
r6) <- ReadS (Signal a)
forall a. Read a => ReadS (Signal a)
readsValues String
r9]
readsValues :: (Read a) => ReadS (Signal a)
readsValues :: ReadS (Signal a)
readsValues String
s
= [((a
xa -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:-Signal a
forall a. Signal a
NullS), String
r1)
| (a
x, String
r2) <- ReadS a
forall a. Read a => ReadS a
reads String
s,
(String
"}", String
r1) <- ReadS String
lex String
r2]
[(Signal a, String)]
-> [(Signal a, String)] -> [(Signal a, String)]
forall a. [a] -> [a] -> [a]
++ [((a
xa -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:-Signal a
xs), String
r3)
| (a
x, String
r4) <- ReadS a
forall a. Read a => ReadS a
reads String
s,
(String
",", String
r5) <- ReadS String
lex String
r4,
(Signal a
xs, String
r3) <- ReadS (Signal a)
forall a. Read a => ReadS (Signal a)
readsValues String
r5]
signal :: [a] -> Signal a
signal [] = Signal a
forall a. Signal a
NullS
signal (a
x:[a]
xs) = a
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- [a] -> Signal a
forall a. [a] -> Signal a
signal [a]
xs
fromSignal :: Signal a -> [a]
fromSignal Signal a
NullS = []
fromSignal (a
x:-Signal a
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Signal a -> [a]
forall a. Signal a -> [a]
fromSignal Signal a
xs
unitS :: a -> Signal a
unitS a
x = a
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- Signal a
forall a. Signal a
NullS
nullS :: Signal a -> Bool
nullS Signal a
NullS = Bool
True
nullS Signal a
_ = Bool
False
headS :: Signal a -> a
headS Signal a
NullS = String -> a
forall a. HasCallStack => String -> a
error String
"headS : Signal is empty"
headS (a
x:-Signal a
_) = a
x
tailS :: Signal a -> Signal a
tailS Signal a
NullS = String -> Signal a
forall a. HasCallStack => String -> a
error String
"tailS : Signal is empty"
tailS (a
_:-Signal a
xs) = Signal a
xs
atS :: Int -> Signal a -> a
atS Int
_ Signal a
NullS = String -> a
forall a. HasCallStack => String -> a
error String
"atS: Signal has not enough elements"
atS Int
0 (a
x:-Signal a
_) = a
x
atS Int
n (a
_:-Signal a
xs) = Int -> Signal a -> a
forall a. Int -> Signal a -> a
atS (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Signal a
xs
(!-) :: Signal a -> Int -> a
!- :: Signal a -> Int -> a
(!-) Signal a
xs Int
n = Int -> Signal a -> a
forall a. Int -> Signal a -> a
atS Int
n Signal a
xs
takeS :: Int -> Signal a -> Signal a
takeS Int
0 Signal a
_ = Signal a
forall a. Signal a
NullS
takeS Int
_ Signal a
NullS = Signal a
forall a. Signal a
NullS
takeS Int
n (a
x:-Signal a
xs)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Signal a
forall a. Signal a
NullS
| Bool
otherwise = a
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- Int -> Signal a -> Signal a
forall a. Int -> Signal a -> Signal a
takeS (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Signal a
xs
dropS :: Int -> Signal a -> Signal a
dropS Int
0 Signal a
NullS = Signal a
forall a. Signal a
NullS
dropS Int
_ Signal a
NullS = Signal a
forall a. Signal a
NullS
dropS Int
n (a
x:-Signal a
xs)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = a
xa -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:-Signal a
xs
| Bool
otherwise = Int -> Signal a -> Signal a
forall a. Int -> Signal a -> Signal a
dropS (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Signal a
xs
selectS :: Int -> Int -> Signal a -> Signal a
selectS Int
offset Int
step Signal a
xs = Int -> Signal a -> Signal a
forall a. Int -> Signal a -> Signal a
select1S Int
step (Int -> Signal a -> Signal a
forall a. Int -> Signal a -> Signal a
dropS Int
offset Signal a
xs)
where
select1S :: Int -> Signal a -> Signal a
select1S Int
_ Signal a
NullS = Signal a
forall a. Signal a
NullS
select1S Int
st (a
y:-Signal a
ys) = a
y a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- Int -> Signal a -> Signal a
select1S Int
st (Int -> Signal a -> Signal a
forall a. Int -> Signal a -> Signal a
dropS (Int
stInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Signal a
ys)
-: :: Signal a -> a -> Signal a
(-:) Signal a
xs a
x = Signal a
xs Signal a -> Signal a -> Signal a
forall a. Signal a -> Signal a -> Signal a
+-+ (a
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- Signal a
forall a. Signal a
NullS)
+-+ :: Signal a -> Signal a -> Signal a
(+-+) Signal a
NullS Signal a
ys = Signal a
ys
(+-+) (a
x:-Signal a
xs) Signal a
ys = a
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- (Signal a
xs Signal a -> Signal a -> Signal a
forall a. Signal a -> Signal a -> Signal a
+-+ Signal a
ys)
lengthS :: Signal b -> Int
lengthS Signal b
NullS = Int
0
lengthS (b
_:-Signal b
xs) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Signal b -> Int
forall b. Signal b -> Int
lengthS Signal b
xs
infiniteS :: (a -> a) -> a -> Signal a
infiniteS a -> a
f a
x = a
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- (a -> a) -> a -> Signal a
forall a. (a -> a) -> a -> Signal a
infiniteS a -> a
f (a -> a
f a
x)
copyS :: a -> b -> Signal b
copyS a
0 b
_ = Signal b
forall a. Signal a
NullS
copyS a
n b
x = b
x b -> Signal b -> Signal b
forall a. a -> Signal a -> Signal a
:- a -> b -> Signal b
forall a b. (Num a, Eq a) => a -> b -> Signal b
copyS (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) b
x
fanS :: (Signal a -> Signal b)
-> (Signal a -> Signal c) -> Signal a -> (Signal b, Signal c)
fanS Signal a -> Signal b
p1 Signal a -> Signal c
p2 Signal a
xs = (Signal a -> Signal b
p1 Signal a
xs, Signal a -> Signal c
p2 Signal a
xs)
writeS :: Signal a -> String
writeS Signal a
NullS = []
writeS (a
x:-Signal a
xs) = a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Signal a -> String
forall a. Show a => Signal a -> String
writeS Signal a
xs
readS :: String -> Signal a
readS String
xs = [String] -> Signal a
forall a. Read a => [String] -> Signal a
readS' (String -> [String]
words String
xs)
where
readS' :: [String] -> Signal a
readS' [] = Signal a
forall a. Signal a
NullS
readS' (String
"\n":[String]
ys) = [String] -> Signal a
readS' [String]
ys
readS' (String
y:[String]
ys) = String -> a
forall a. Read a => String -> a
read String
y a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- [String] -> Signal a
readS' [String]
ys
foldrS :: (t -> p -> p) -> p -> Signal t -> p
foldrS t -> p -> p
k p
z = Signal t -> p
go
where
go :: Signal t -> p
go Signal t
NullS = p
z
go (t
y:-Signal t
ys) = t
y t -> p -> p
`k` Signal t -> p
go Signal t
ys
allS :: (a -> Bool) -> Signal a -> Bool
allS a -> Bool
p = (a -> Bool -> Bool) -> Bool -> Signal a -> Bool
forall t p. (t -> p -> p) -> p -> Signal t -> p
foldrS (\a
a Bool
prev -> a -> Bool
p a
a Bool -> Bool -> Bool
&& Bool
prev) Bool
True