{-# LANGUAGE Rank2Types #-}
module FRP.Yampa.Switches
(
switch, dSwitch
, rSwitch, drSwitch
, kSwitch, dkSwitch
, parB
, pSwitchB,dpSwitchB
, rpSwitchB,drpSwitchB
, par
, pSwitch, dpSwitch
, rpSwitch,drpSwitch
, parZ
, pSwitchZ
, dpSwitchZ
, rpSwitchZ
, drpSwitchZ
, parC
)
where
import Control.Arrow
import FRP.Yampa.Basic
import FRP.Yampa.Diagnostics
import FRP.Yampa.Event
import FRP.Yampa.InternalCore (DTime, FunDesc (..), SF (..), SF' (..), fdFun,
sfArrG, sfConst, sfTF')
switch :: SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch :: SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a (b, Event c)
tf10}) c -> SF a b
k = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a b
sfTF = a -> Transition a b
tf0}
where
tf0 :: a -> Transition a b
tf0 a
a0 =
case a -> Transition a (b, Event c)
tf10 a
a0 of
(SF' a (b, Event c)
sf1, (b
b0, Event c
NoEvent)) -> (SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
forall a b c. SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
switchAux SF' a (b, Event c)
sf1 c -> SF a b
k, b
b0)
(SF' a (b, Event c)
_, (b
_, Event c
c0)) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (c -> SF a b
k c
c0) a
a0
switchAux :: SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
switchAux :: SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
switchAux (SFArr DTime -> a -> Transition a (b, Event c)
_ (FDC (b
b, Event c
NoEvent))) c -> SF a b
_ = b -> SF' a b
forall b a. b -> SF' a b
sfConst b
b
switchAux (SFArr DTime -> a -> Transition a (b, Event c)
_ FunDesc a (b, Event c)
fd1) c -> SF a b
k = (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
forall a b c. (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
switchAuxA1 (FunDesc a (b, Event c) -> a -> (b, Event c)
forall a b. FunDesc a b -> a -> b
fdFun FunDesc a (b, Event c)
fd1) c -> SF a b
k
switchAux SF' a (b, Event c)
sf1 c -> SF a b
k = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf
where
tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
case (SF' a (b, Event c) -> DTime -> a -> Transition a (b, Event c)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a (b, Event c)
sf1) DTime
dt a
a of
(SF' a (b, Event c)
sf1', (b
b, Event c
NoEvent)) -> (SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
forall a b c. SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
switchAux SF' a (b, Event c)
sf1' c -> SF a b
k, b
b)
(SF' a (b, Event c)
_, (b
_, Event c
c)) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (c -> SF a b
k c
c) a
a
switchAuxA1 :: (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
switchAuxA1 :: (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
switchAuxA1 a -> (b, Event c)
f1 c -> SF a b
k = SF' a b
sf
where
sf :: SF' a b
sf = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf
tf :: DTime -> a -> Transition a b
tf DTime
_ a
a =
case a -> (b, Event c)
f1 a
a of
(b
b, Event c
NoEvent) -> (SF' a b
sf, b
b)
(b
_, Event c
c) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (c -> SF a b
k c
c) a
a
dSwitch :: SF a (b, Event c) -> (c -> SF a b) -> SF a b
dSwitch :: SF a (b, Event c) -> (c -> SF a b) -> SF a b
dSwitch (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a (b, Event c)
tf10}) c -> SF a b
k = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a b
sfTF = a -> Transition a b
tf0}
where
tf0 :: a -> Transition a b
tf0 a
a0 =
let (SF' a (b, Event c)
sf1, (b
b0, Event c
ec0)) = a -> Transition a (b, Event c)
tf10 a
a0
in ( case Event c
ec0 of
Event c
NoEvent -> SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
forall a b c. SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
dSwitchAux SF' a (b, Event c)
sf1 c -> SF a b
k
Event c
c0 -> Transition a b -> SF' a b
forall a b. (a, b) -> a
fst (SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (c -> SF a b
k c
c0) a
a0)
, b
b0
)
dSwitchAux :: SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
dSwitchAux :: SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
dSwitchAux (SFArr DTime -> a -> Transition a (b, Event c)
_ (FDC (b
b, Event c
NoEvent))) c -> SF a b
_ = b -> SF' a b
forall b a. b -> SF' a b
sfConst b
b
dSwitchAux (SFArr DTime -> a -> Transition a (b, Event c)
_ FunDesc a (b, Event c)
fd1) c -> SF a b
k = (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
forall a b c. (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
dSwitchAuxA1 (FunDesc a (b, Event c) -> a -> (b, Event c)
forall a b. FunDesc a b -> a -> b
fdFun FunDesc a (b, Event c)
fd1) c -> SF a b
k
dSwitchAux SF' a (b, Event c)
sf1 c -> SF a b
k = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf
where
tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
let (SF' a (b, Event c)
sf1', (b
b, Event c
ec)) = (SF' a (b, Event c) -> DTime -> a -> Transition a (b, Event c)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a (b, Event c)
sf1) DTime
dt a
a
in ( case Event c
ec of
Event c
NoEvent -> SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
forall a b c. SF' a (b, Event c) -> (c -> SF a b) -> SF' a b
dSwitchAux SF' a (b, Event c)
sf1' c -> SF a b
k
Event c
c -> Transition a b -> SF' a b
forall a b. (a, b) -> a
fst (SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (c -> SF a b
k c
c) a
a)
, b
b
)
dSwitchAuxA1 :: (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
dSwitchAuxA1 :: (a -> (b, Event c)) -> (c -> SF a b) -> SF' a b
dSwitchAuxA1 a -> (b, Event c)
f1 c -> SF a b
k = SF' a b
sf
where
sf :: SF' a b
sf = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf
tf :: DTime -> a -> Transition a b
tf DTime
_ a
a =
let (b
b, Event c
ec) = a -> (b, Event c)
f1 a
a
in ( case Event c
ec of
Event c
NoEvent -> SF' a b
sf
Event c
c -> Transition a b -> SF' a b
forall a b. (a, b) -> a
fst (SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (c -> SF a b
k c
c) a
a)
, b
b
)
rSwitch :: SF a b -> SF (a, Event (SF a b)) b
rSwitch :: SF a b -> SF (a, Event (SF a b)) b
rSwitch SF a b
sf = SF (a, Event (SF a b)) (b, Event (SF a b))
-> (SF a b -> SF (a, Event (SF a b)) b) -> SF (a, Event (SF a b)) b
forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
switch (SF a b -> SF (a, Event (SF a b)) (b, Event (SF a b))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first SF a b
sf) (((a, Event (SF a b)) -> (a, Event (SF a b))
forall a b c. (a, Event b) -> (a, Event c)
noEventSnd ((a, Event (SF a b)) -> (a, Event (SF a b)))
-> SF (a, Event (SF a b)) b -> SF (a, Event (SF a b)) b
forall a b. (a -> a) -> SF a b -> SF a b
>=-) (SF (a, Event (SF a b)) b -> SF (a, Event (SF a b)) b)
-> (SF a b -> SF (a, Event (SF a b)) b)
-> SF a b
-> SF (a, Event (SF a b)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SF a b -> SF (a, Event (SF a b)) b
forall a b. SF a b -> SF (a, Event (SF a b)) b
rSwitch)
drSwitch :: SF a b -> SF (a, Event (SF a b)) b
drSwitch :: SF a b -> SF (a, Event (SF a b)) b
drSwitch SF a b
sf = SF (a, Event (SF a b)) (b, Event (SF a b))
-> (SF a b -> SF (a, Event (SF a b)) b) -> SF (a, Event (SF a b)) b
forall a b c. SF a (b, Event c) -> (c -> SF a b) -> SF a b
dSwitch (SF a b -> SF (a, Event (SF a b)) (b, Event (SF a b))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first SF a b
sf) (((a, Event (SF a b)) -> (a, Event (SF a b))
forall a b c. (a, Event b) -> (a, Event c)
noEventSnd ((a, Event (SF a b)) -> (a, Event (SF a b)))
-> SF (a, Event (SF a b)) b -> SF (a, Event (SF a b)) b
forall a b. (a -> a) -> SF a b -> SF a b
>=-) (SF (a, Event (SF a b)) b -> SF (a, Event (SF a b)) b)
-> (SF a b -> SF (a, Event (SF a b)) b)
-> SF a b
-> SF (a, Event (SF a b)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SF a b -> SF (a, Event (SF a b)) b
forall a b. SF a b -> SF (a, Event (SF a b)) b
drSwitch)
kSwitch :: SF a b -> SF (a,b) (Event c) -> (SF a b -> c -> SF a b) -> SF a b
kSwitch :: SF a b -> SF (a, b) (Event c) -> (SF a b -> c -> SF a b) -> SF a b
kSwitch sf10 :: SF a b
sf10@(SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a b
tf10}) (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = (a, b) -> Transition (a, b) (Event c)
tfe0}) SF a b -> c -> SF a b
k = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a b
sfTF = a -> Transition a b
tf0}
where
tf0 :: a -> Transition a b
tf0 a
a0 =
let (SF' a b
sf1, b
b0) = a -> Transition a b
tf10 a
a0
in case (a, b) -> Transition (a, b) (Event c)
tfe0 (a
a0, b
b0) of
(SF' (a, b) (Event c)
sfe, Event c
NoEvent) -> (SF' a b -> SF' (a, b) (Event c) -> SF' a b
kSwitchAux SF' a b
sf1 SF' (a, b) (Event c)
sfe, b
b0)
(SF' (a, b) (Event c)
_, Event c
c0) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k SF a b
sf10 c
c0) a
a0
kSwitchAux :: SF' a b -> SF' (a, b) (Event c) -> SF' a b
kSwitchAux (SFArr DTime -> a -> Transition a b
_ (FDC b
b)) SF' (a, b) (Event c)
sfe = b -> SF' (a, b) (Event c) -> SF' a b
kSwitchAuxC1 b
b SF' (a, b) (Event c)
sfe
kSwitchAux (SFArr DTime -> a -> Transition a b
_ FunDesc a b
fd1) SF' (a, b) (Event c)
sfe = (a -> b) -> SF' (a, b) (Event c) -> SF' a b
kSwitchAuxA1 (FunDesc a b -> a -> b
forall a b. FunDesc a b -> a -> b
fdFun FunDesc a b
fd1) SF' (a, b) (Event c)
sfe
kSwitchAux SF' a b
sf1 (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ (FDC Event c
NoEvent)) = SF' a b
sf1
kSwitchAux SF' a b
sf1 (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ FunDesc (a, b) (Event c)
fde) = SF' a b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxAE SF' a b
sf1 (FunDesc (a, b) (Event c) -> (a, b) -> Event c
forall a b. FunDesc a b -> a -> b
fdFun FunDesc (a, b) (Event c)
fde)
kSwitchAux SF' a b
sf1 SF' (a, b) (Event c)
sfe = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf
where
tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
let (SF' a b
sf1', b
b) = (SF' a b -> DTime -> a -> Transition a b
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
sf1) DTime
dt a
a
in case (SF' (a, b) (Event c)
-> DTime -> (a, b) -> Transition (a, b) (Event c)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' (a, b) (Event c)
sfe) DTime
dt (a
a, b
b) of
(SF' (a, b) (Event c)
sfe', Event c
NoEvent) -> (SF' a b -> SF' (a, b) (Event c) -> SF' a b
kSwitchAux SF' a b
sf1' SF' (a, b) (Event c)
sfe', b
b)
(SF' (a, b) (Event c)
_, Event c
c) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k (SF' a b -> DTime -> SF a b
forall a b. SF' a b -> DTime -> SF a b
freeze SF' a b
sf1 DTime
dt) c
c) a
a
kSwitchAuxC1 :: b -> SF' (a, b) (Event c) -> SF' a b
kSwitchAuxC1 b
b (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ (FDC Event c
NoEvent)) = b -> SF' a b
forall b a. b -> SF' a b
sfConst b
b
kSwitchAuxC1 b
b (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ FunDesc (a, b) (Event c)
fde) = b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxC1AE b
b (FunDesc (a, b) (Event c) -> (a, b) -> Event c
forall a b. FunDesc a b -> a -> b
fdFun FunDesc (a, b) (Event c)
fde)
kSwitchAuxC1 b
b SF' (a, b) (Event c)
sfe = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf
where
tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
case (SF' (a, b) (Event c)
-> DTime -> (a, b) -> Transition (a, b) (Event c)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' (a, b) (Event c)
sfe) DTime
dt (a
a, b
b) of
(SF' (a, b) (Event c)
sfe', Event c
NoEvent) -> (b -> SF' (a, b) (Event c) -> SF' a b
kSwitchAuxC1 b
b SF' (a, b) (Event c)
sfe', b
b)
(SF' (a, b) (Event c)
_, Event c
c) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k (b -> SF a b
forall b a. b -> SF a b
constant b
b) c
c) a
a
kSwitchAuxA1 :: (a -> b) -> SF' (a, b) (Event c) -> SF' a b
kSwitchAuxA1 a -> b
f1 (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ (FDC Event c
NoEvent)) = (a -> b) -> SF' a b
forall a b. (a -> b) -> SF' a b
sfArrG a -> b
f1
kSwitchAuxA1 a -> b
f1 (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ FunDesc (a, b) (Event c)
fde) = (a -> b) -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxA1AE a -> b
f1 (FunDesc (a, b) (Event c) -> (a, b) -> Event c
forall a b. FunDesc a b -> a -> b
fdFun FunDesc (a, b) (Event c)
fde)
kSwitchAuxA1 a -> b
f1 SF' (a, b) (Event c)
sfe = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf
where
tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
let b :: b
b = a -> b
f1 a
a
in case (SF' (a, b) (Event c)
-> DTime -> (a, b) -> Transition (a, b) (Event c)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' (a, b) (Event c)
sfe) DTime
dt (a
a, b
b) of
(SF' (a, b) (Event c)
sfe', Event c
NoEvent) -> ((a -> b) -> SF' (a, b) (Event c) -> SF' a b
kSwitchAuxA1 a -> b
f1 SF' (a, b) (Event c)
sfe', b
b)
(SF' (a, b) (Event c)
_, Event c
c) -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k ((a -> b) -> SF a b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f1) c
c) a
a
kSwitchAuxAE :: SF' a b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxAE (SFArr DTime -> a -> Transition a b
_ (FDC b
b)) (a, b) -> Event c
fe = b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxC1AE b
b (a, b) -> Event c
fe
kSwitchAuxAE (SFArr DTime -> a -> Transition a b
_ FunDesc a b
fd1) (a, b) -> Event c
fe = (a -> b) -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxA1AE (FunDesc a b -> a -> b
forall a b. FunDesc a b -> a -> b
fdFun FunDesc a b
fd1) (a, b) -> Event c
fe
kSwitchAuxAE SF' a b
sf1 (a, b) -> Event c
fe = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf
where
tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
let (SF' a b
sf1', b
b) = (SF' a b -> DTime -> a -> Transition a b
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
sf1) DTime
dt a
a
in case (a, b) -> Event c
fe (a
a, b
b) of
Event c
NoEvent -> (SF' a b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxAE SF' a b
sf1' (a, b) -> Event c
fe, b
b)
Event c
c -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k (SF' a b -> DTime -> SF a b
forall a b. SF' a b -> DTime -> SF a b
freeze SF' a b
sf1 DTime
dt) c
c) a
a
kSwitchAuxC1AE :: b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxC1AE b
b (a, b) -> Event c
fe = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
forall p. p -> a -> Transition a b
tf
where
tf :: p -> a -> Transition a b
tf p
_ a
a =
case (a, b) -> Event c
fe (a
a, b
b) of
Event c
NoEvent -> (b -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxC1AE b
b (a, b) -> Event c
fe, b
b)
Event c
c -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k (b -> SF a b
forall b a. b -> SF a b
constant b
b) c
c) a
a
kSwitchAuxA1AE :: (a -> b) -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxA1AE a -> b
f1 (a, b) -> Event c
fe = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
forall p. p -> a -> Transition a b
tf
where
tf :: p -> a -> Transition a b
tf p
_ a
a =
let b :: b
b = a -> b
f1 a
a
in case (a, b) -> Event c
fe (a
a, b
b) of
Event c
NoEvent -> ((a -> b) -> ((a, b) -> Event c) -> SF' a b
kSwitchAuxA1AE a -> b
f1 (a, b) -> Event c
fe, b
b)
Event c
c -> SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k ((a -> b) -> SF a b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f1) c
c) a
a
dkSwitch :: SF a b -> SF (a,b) (Event c) -> (SF a b -> c -> SF a b) -> SF a b
dkSwitch :: SF a b -> SF (a, b) (Event c) -> (SF a b -> c -> SF a b) -> SF a b
dkSwitch sf10 :: SF a b
sf10@(SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a b
tf10}) (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = (a, b) -> Transition (a, b) (Event c)
tfe0}) SF a b -> c -> SF a b
k = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a b
sfTF = a -> Transition a b
tf0}
where
tf0 :: a -> Transition a b
tf0 a
a0 =
let (SF' a b
sf1, b
b0) = a -> Transition a b
tf10 a
a0
in ( case (a, b) -> Transition (a, b) (Event c)
tfe0 (a
a0, b
b0) of
(SF' (a, b) (Event c)
sfe, Event c
NoEvent) -> SF' a b -> SF' (a, b) (Event c) -> SF' a b
dkSwitchAux SF' a b
sf1 SF' (a, b) (Event c)
sfe
(SF' (a, b) (Event c)
_, Event c
c0) -> Transition a b -> SF' a b
forall a b. (a, b) -> a
fst (SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k SF a b
sf10 c
c0) a
a0)
, b
b0
)
dkSwitchAux :: SF' a b -> SF' (a, b) (Event c) -> SF' a b
dkSwitchAux SF' a b
sf1 (SFArr DTime -> (a, b) -> Transition (a, b) (Event c)
_ (FDC Event c
NoEvent)) = SF' a b
sf1
dkSwitchAux SF' a b
sf1 SF' (a, b) (Event c)
sfe = (DTime -> a -> Transition a b) -> SF' a b
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a b
tf
where
tf :: DTime -> a -> Transition a b
tf DTime
dt a
a =
let (SF' a b
sf1', b
b) = (SF' a b -> DTime -> a -> Transition a b
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
sf1) DTime
dt a
a
in ( case (SF' (a, b) (Event c)
-> DTime -> (a, b) -> Transition (a, b) (Event c)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' (a, b) (Event c)
sfe) DTime
dt (a
a, b
b) of
(SF' (a, b) (Event c)
sfe', Event c
NoEvent) -> SF' a b -> SF' (a, b) (Event c) -> SF' a b
dkSwitchAux SF' a b
sf1' SF' (a, b) (Event c)
sfe'
(SF' (a, b) (Event c)
_, Event c
c) -> Transition a b -> SF' a b
forall a b. (a, b) -> a
fst (SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF (SF a b -> c -> SF a b
k (SF' a b -> DTime -> SF a b
forall a b. SF' a b -> DTime -> SF a b
freeze SF' a b
sf1 DTime
dt) c
c) a
a)
, b
b
)
broadcast :: Functor col => a -> col sf -> col (a, sf)
broadcast :: a -> col sf -> col (a, sf)
broadcast a
a = (sf -> (a, sf)) -> col sf -> col (a, sf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\sf
sf -> (a
a, sf
sf))
parB :: Functor col => col (SF a b) -> SF a (col b)
parB :: col (SF a b) -> SF a (col b)
parB = (forall sf. a -> col sf -> col (a, sf))
-> col (SF a b) -> SF a (col b)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c) -> SF a (col c)
par forall sf. a -> col sf -> col (a, sf)
forall (col :: * -> *) a sf.
Functor col =>
a -> col sf -> col (a, sf)
broadcast
pSwitchB :: Functor col =>
col (SF a b) -> SF (a,col b) (Event c) -> (col (SF a b)->c-> SF a (col b))
-> SF a (col b)
pSwitchB :: col (SF a b)
-> SF (a, col b) (Event c)
-> (col (SF a b) -> c -> SF a (col b))
-> SF a (col b)
pSwitchB = (forall sf. a -> col sf -> col (a, sf))
-> col (SF a b)
-> SF (a, col b) (Event c)
-> (col (SF a b) -> c -> SF a (col b))
-> SF a (col b)
forall (col :: * -> *) a b c d.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
pSwitch forall sf. a -> col sf -> col (a, sf)
forall (col :: * -> *) a sf.
Functor col =>
a -> col sf -> col (a, sf)
broadcast
dpSwitchB :: Functor col =>
col (SF a b) -> SF (a,col b) (Event c) -> (col (SF a b)->c->SF a (col b))
-> SF a (col b)
dpSwitchB :: col (SF a b)
-> SF (a, col b) (Event c)
-> (col (SF a b) -> c -> SF a (col b))
-> SF a (col b)
dpSwitchB = (forall sf. a -> col sf -> col (a, sf))
-> col (SF a b)
-> SF (a, col b) (Event c)
-> (col (SF a b) -> c -> SF a (col b))
-> SF a (col b)
forall (col :: * -> *) a b c d.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
dpSwitch forall sf. a -> col sf -> col (a, sf)
forall (col :: * -> *) a sf.
Functor col =>
a -> col sf -> col (a, sf)
broadcast
rpSwitchB :: Functor col =>
col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
rpSwitchB :: col (SF a b)
-> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
rpSwitchB = (forall sf. a -> col sf -> col (a, sf))
-> col (SF a b)
-> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
rpSwitch forall sf. a -> col sf -> col (a, sf)
forall (col :: * -> *) a sf.
Functor col =>
a -> col sf -> col (a, sf)
broadcast
drpSwitchB :: Functor col =>
col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
drpSwitchB :: col (SF a b)
-> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
drpSwitchB = (forall sf. a -> col sf -> col (a, sf))
-> col (SF a b)
-> SF (a, Event (col (SF a b) -> col (SF a b))) (col b)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
drpSwitch forall sf. a -> col sf -> col (a, sf)
forall (col :: * -> *) a sf.
Functor col =>
a -> col sf -> col (a, sf)
broadcast
par :: Functor col
=> (forall sf . (a -> col sf -> col (b, sf)))
-> col (SF b c)
-> SF a (col c)
par :: (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c) -> SF a (col c)
par forall sf. a -> col sf -> col (b, sf)
rf col (SF b c)
sfs0 = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a (col c)
sfTF = a -> Transition a (col c)
tf0}
where
tf0 :: a -> Transition a (col c)
tf0 a
a0 =
let bsfs0 :: col (b, SF b c)
bsfs0 = a -> col (SF b c) -> col (b, SF b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a0 col (SF b c)
sfs0
sfcs0 :: col (Transition b c)
sfcs0 = ((b, SF b c) -> Transition b c)
-> col (b, SF b c) -> col (Transition b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b0, SF b c
sf0) -> (SF b c -> b -> Transition b c
forall a b. SF a b -> a -> Transition a b
sfTF SF b c
sf0) b
b0) col (b, SF b c)
bsfs0
sfs :: col (SF' b c)
sfs = (Transition b c -> SF' b c)
-> col (Transition b c) -> col (SF' b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> SF' b c
forall a b. (a, b) -> a
fst col (Transition b c)
sfcs0
cs0 :: col c
cs0 = (Transition b c -> c) -> col (Transition b c) -> col c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> c
forall a b. (a, b) -> b
snd col (Transition b c)
sfcs0
in ((forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
parAux forall sf. a -> col sf -> col (b, sf)
rf col (SF' b c)
sfs, col c
cs0)
parAux :: Functor col =>
(forall sf . (a -> col sf -> col (b, sf)))
-> col (SF' b c)
-> SF' a (col c)
parAux :: (forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
parAux forall sf. a -> col sf -> col (b, sf)
rf col (SF' b c)
sfs = (DTime -> a -> Transition a (col c)) -> SF' a (col c)
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a (col c)
tf
where
tf :: DTime -> a -> Transition a (col c)
tf DTime
dt a
a =
let bsfs :: col (b, SF' b c)
bsfs = a -> col (SF' b c) -> col (b, SF' b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a col (SF' b c)
sfs
sfcs' :: col (Transition b c)
sfcs' = ((b, SF' b c) -> Transition b c)
-> col (b, SF' b c) -> col (Transition b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b, SF' b c
sf) -> (SF' b c -> DTime -> b -> Transition b c
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' b c
sf) DTime
dt b
b) col (b, SF' b c)
bsfs
sfs' :: col (SF' b c)
sfs' = (Transition b c -> SF' b c)
-> col (Transition b c) -> col (SF' b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> SF' b c
forall a b. (a, b) -> a
fst col (Transition b c)
sfcs'
cs :: col c
cs = (Transition b c -> c) -> col (Transition b c) -> col c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> c
forall a b. (a, b) -> b
snd col (Transition b c)
sfcs'
in ((forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
parAux forall sf. a -> col sf -> col (b, sf)
rf col (SF' b c)
sfs', col c
cs)
pSwitch :: Functor col
=> (forall sf . (a -> col sf -> col (b, sf)))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
pSwitch :: (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
pSwitch forall sf. a -> col sf -> col (b, sf)
rf col (SF b c)
sfs0 SF (a, col c) (Event d)
sfe0 col (SF b c) -> d -> SF a (col c)
k = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a (col c)
sfTF = a -> Transition a (col c)
tf0}
where
tf0 :: a -> Transition a (col c)
tf0 a
a0 =
let bsfs0 :: col (b, SF b c)
bsfs0 = a -> col (SF b c) -> col (b, SF b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a0 col (SF b c)
sfs0
sfcs0 :: col (Transition b c)
sfcs0 = ((b, SF b c) -> Transition b c)
-> col (b, SF b c) -> col (Transition b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b0, SF b c
sf0) -> (SF b c -> b -> Transition b c
forall a b. SF a b -> a -> Transition a b
sfTF SF b c
sf0) b
b0) col (b, SF b c)
bsfs0
sfs :: col (SF' b c)
sfs = (Transition b c -> SF' b c)
-> col (Transition b c) -> col (SF' b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> SF' b c
forall a b. (a, b) -> a
fst col (Transition b c)
sfcs0
cs0 :: col c
cs0 = (Transition b c -> c) -> col (Transition b c) -> col c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> c
forall a b. (a, b) -> b
snd col (Transition b c)
sfcs0
in case (SF (a, col c) (Event d)
-> (a, col c) -> Transition (a, col c) (Event d)
forall a b. SF a b -> a -> Transition a b
sfTF SF (a, col c) (Event d)
sfe0) (a
a0, col c
cs0) of
(SF' (a, col c) (Event d)
sfe, Event d
NoEvent) -> (col (SF' b c) -> SF' (a, col c) (Event d) -> SF' a (col c)
pSwitchAux col (SF' b c)
sfs SF' (a, col c) (Event d)
sfe, col c
cs0)
(SF' (a, col c) (Event d)
_, Event d
d0) -> SF a (col c) -> a -> Transition a (col c)
forall a b. SF a b -> a -> Transition a b
sfTF (col (SF b c) -> d -> SF a (col c)
k col (SF b c)
sfs0 d
d0) a
a0
pSwitchAux :: col (SF' b c) -> SF' (a, col c) (Event d) -> SF' a (col c)
pSwitchAux col (SF' b c)
sfs (SFArr DTime -> (a, col c) -> Transition (a, col c) (Event d)
_ (FDC Event d
NoEvent)) = (forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
parAux forall sf. a -> col sf -> col (b, sf)
rf col (SF' b c)
sfs
pSwitchAux col (SF' b c)
sfs SF' (a, col c) (Event d)
sfe = (DTime -> a -> Transition a (col c)) -> SF' a (col c)
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a (col c)
tf
where
tf :: DTime -> a -> Transition a (col c)
tf DTime
dt a
a =
let bsfs :: col (b, SF' b c)
bsfs = a -> col (SF' b c) -> col (b, SF' b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a col (SF' b c)
sfs
sfcs' :: col (Transition b c)
sfcs' = ((b, SF' b c) -> Transition b c)
-> col (b, SF' b c) -> col (Transition b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b, SF' b c
sf) -> (SF' b c -> DTime -> b -> Transition b c
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' b c
sf) DTime
dt b
b) col (b, SF' b c)
bsfs
sfs' :: col (SF' b c)
sfs' = (Transition b c -> SF' b c)
-> col (Transition b c) -> col (SF' b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> SF' b c
forall a b. (a, b) -> a
fst col (Transition b c)
sfcs'
cs :: col c
cs = (Transition b c -> c) -> col (Transition b c) -> col c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> c
forall a b. (a, b) -> b
snd col (Transition b c)
sfcs'
in case (SF' (a, col c) (Event d)
-> DTime -> (a, col c) -> Transition (a, col c) (Event d)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' (a, col c) (Event d)
sfe) DTime
dt (a
a, col c
cs) of
(SF' (a, col c) (Event d)
sfe', Event d
NoEvent) -> (col (SF' b c) -> SF' (a, col c) (Event d) -> SF' a (col c)
pSwitchAux col (SF' b c)
sfs' SF' (a, col c) (Event d)
sfe', col c
cs)
(SF' (a, col c) (Event d)
_, Event d
d) -> SF a (col c) -> a -> Transition a (col c)
forall a b. SF a b -> a -> Transition a b
sfTF (col (SF b c) -> d -> SF a (col c)
k (col (SF' b c) -> DTime -> col (SF b c)
forall (col :: * -> *) a b.
Functor col =>
col (SF' a b) -> DTime -> col (SF a b)
freezeCol col (SF' b c)
sfs DTime
dt) d
d) a
a
dpSwitch :: Functor col
=> (forall sf . (a -> col sf -> col (b, sf)))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
dpSwitch :: (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
dpSwitch forall sf. a -> col sf -> col (b, sf)
rf col (SF b c)
sfs0 SF (a, col c) (Event d)
sfe0 col (SF b c) -> d -> SF a (col c)
k = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a (col c)
sfTF = a -> Transition a (col c)
tf0}
where
tf0 :: a -> Transition a (col c)
tf0 a
a0 =
let bsfs0 :: col (b, SF b c)
bsfs0 = a -> col (SF b c) -> col (b, SF b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a0 col (SF b c)
sfs0
sfcs0 :: col (Transition b c)
sfcs0 = ((b, SF b c) -> Transition b c)
-> col (b, SF b c) -> col (Transition b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b0, SF b c
sf0) -> (SF b c -> b -> Transition b c
forall a b. SF a b -> a -> Transition a b
sfTF SF b c
sf0) b
b0) col (b, SF b c)
bsfs0
cs0 :: col c
cs0 = (Transition b c -> c) -> col (Transition b c) -> col c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> c
forall a b. (a, b) -> b
snd col (Transition b c)
sfcs0
in ( case (SF (a, col c) (Event d)
-> (a, col c) -> Transition (a, col c) (Event d)
forall a b. SF a b -> a -> Transition a b
sfTF SF (a, col c) (Event d)
sfe0) (a
a0, col c
cs0) of
(SF' (a, col c) (Event d)
sfe, Event d
NoEvent) -> col (SF' b c) -> SF' (a, col c) (Event d) -> SF' a (col c)
dpSwitchAux ((Transition b c -> SF' b c)
-> col (Transition b c) -> col (SF' b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> SF' b c
forall a b. (a, b) -> a
fst col (Transition b c)
sfcs0) SF' (a, col c) (Event d)
sfe
(SF' (a, col c) (Event d)
_, Event d
d0) -> Transition a (col c) -> SF' a (col c)
forall a b. (a, b) -> a
fst (SF a (col c) -> a -> Transition a (col c)
forall a b. SF a b -> a -> Transition a b
sfTF (col (SF b c) -> d -> SF a (col c)
k col (SF b c)
sfs0 d
d0) a
a0)
, col c
cs0
)
dpSwitchAux :: col (SF' b c) -> SF' (a, col c) (Event d) -> SF' a (col c)
dpSwitchAux col (SF' b c)
sfs (SFArr DTime -> (a, col c) -> Transition (a, col c) (Event d)
_ (FDC Event d
NoEvent)) = (forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF' b c) -> SF' a (col c)
parAux forall sf. a -> col sf -> col (b, sf)
rf col (SF' b c)
sfs
dpSwitchAux col (SF' b c)
sfs SF' (a, col c) (Event d)
sfe = (DTime -> a -> Transition a (col c)) -> SF' a (col c)
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> a -> Transition a (col c)
tf
where
tf :: DTime -> a -> Transition a (col c)
tf DTime
dt a
a =
let bsfs :: col (b, SF' b c)
bsfs = a -> col (SF' b c) -> col (b, SF' b c)
forall sf. a -> col sf -> col (b, sf)
rf a
a col (SF' b c)
sfs
sfcs' :: col (Transition b c)
sfcs' = ((b, SF' b c) -> Transition b c)
-> col (b, SF' b c) -> col (Transition b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b, SF' b c
sf) -> (SF' b c -> DTime -> b -> Transition b c
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' b c
sf) DTime
dt b
b) col (b, SF' b c)
bsfs
cs :: col c
cs = (Transition b c -> c) -> col (Transition b c) -> col c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> c
forall a b. (a, b) -> b
snd col (Transition b c)
sfcs'
in ( case (SF' (a, col c) (Event d)
-> DTime -> (a, col c) -> Transition (a, col c) (Event d)
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' (a, col c) (Event d)
sfe) DTime
dt (a
a, col c
cs) of
(SF' (a, col c) (Event d)
sfe', Event d
NoEvent) -> col (SF' b c) -> SF' (a, col c) (Event d) -> SF' a (col c)
dpSwitchAux ((Transition b c -> SF' b c)
-> col (Transition b c) -> col (SF' b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transition b c -> SF' b c
forall a b. (a, b) -> a
fst col (Transition b c)
sfcs') SF' (a, col c) (Event d)
sfe'
(SF' (a, col c) (Event d)
_, Event d
d) -> Transition a (col c) -> SF' a (col c)
forall a b. (a, b) -> a
fst (SF a (col c) -> a -> Transition a (col c)
forall a b. SF a b -> a -> Transition a b
sfTF (col (SF b c) -> d -> SF a (col c)
k (col (SF' b c) -> DTime -> col (SF b c)
forall (col :: * -> *) a b.
Functor col =>
col (SF' a b) -> DTime -> col (SF a b)
freezeCol col (SF' b c)
sfs DTime
dt) d
d) a
a)
, col c
cs
)
rpSwitch :: Functor col
=> (forall sf . (a -> col sf -> col (b, sf)))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
rpSwitch :: (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
rpSwitch forall sf. a -> col sf -> col (b, sf)
rf col (SF b c)
sfs =
(forall sf.
(a, Event (col (SF b c) -> col (SF b c))) -> col sf -> col (b, sf))
-> col (SF b c)
-> SF
((a, Event (col (SF b c) -> col (SF b c))), col c)
(Event (col (SF b c) -> col (SF b c)))
-> (col (SF b c)
-> (col (SF b c) -> col (SF b c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall (col :: * -> *) a b c d.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
pSwitch (a -> col sf -> col (b, sf)
forall sf. a -> col sf -> col (b, sf)
rf (a -> col sf -> col (b, sf))
-> ((a, Event (col (SF b c) -> col (SF b c))) -> a)
-> (a, Event (col (SF b c) -> col (SF b c)))
-> col sf
-> col (b, sf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Event (col (SF b c) -> col (SF b c))) -> a
forall a b. (a, b) -> a
fst) col (SF b c)
sfs ((((a, Event (col (SF b c) -> col (SF b c))), col c)
-> Event (col (SF b c) -> col (SF b c)))
-> SF
((a, Event (col (SF b c) -> col (SF b c))), col c)
(Event (col (SF b c) -> col (SF b c)))
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((a, Event (col (SF b c) -> col (SF b c)))
-> Event (col (SF b c) -> col (SF b c))
forall a b. (a, b) -> b
snd ((a, Event (col (SF b c) -> col (SF b c)))
-> Event (col (SF b c) -> col (SF b c)))
-> (((a, Event (col (SF b c) -> col (SF b c))), col c)
-> (a, Event (col (SF b c) -> col (SF b c))))
-> ((a, Event (col (SF b c) -> col (SF b c))), col c)
-> Event (col (SF b c) -> col (SF b c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Event (col (SF b c) -> col (SF b c))), col c)
-> (a, Event (col (SF b c) -> col (SF b c)))
forall a b. (a, b) -> a
fst)) ((col (SF b c)
-> (col (SF b c) -> col (SF b c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> (col (SF b c)
-> (col (SF b c) -> col (SF b c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall a b. (a -> b) -> a -> b
$ \col (SF b c)
sfs' col (SF b c) -> col (SF b c)
f ->
(a, Event (col (SF b c) -> col (SF b c)))
-> (a, Event (col (SF b c) -> col (SF b c)))
forall a b c. (a, Event b) -> (a, Event c)
noEventSnd ((a, Event (col (SF b c) -> col (SF b c)))
-> (a, Event (col (SF b c) -> col (SF b c))))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall a b. (a -> a) -> SF a b -> SF a b
>=- (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
rpSwitch forall sf. a -> col sf -> col (b, sf)
rf (col (SF b c) -> col (SF b c)
f col (SF b c)
sfs')
drpSwitch :: Functor col
=> (forall sf . (a -> col sf -> col (b, sf)))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
drpSwitch :: (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
drpSwitch forall sf. a -> col sf -> col (b, sf)
rf col (SF b c)
sfs =
(forall sf.
(a, Event (col (SF b c) -> col (SF b c))) -> col sf -> col (b, sf))
-> col (SF b c)
-> SF
((a, Event (col (SF b c) -> col (SF b c))), col c)
(Event (col (SF b c) -> col (SF b c)))
-> (col (SF b c)
-> (col (SF b c) -> col (SF b c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall (col :: * -> *) a b c d.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
dpSwitch (a -> col sf -> col (b, sf)
forall sf. a -> col sf -> col (b, sf)
rf (a -> col sf -> col (b, sf))
-> ((a, Event (col (SF b c) -> col (SF b c))) -> a)
-> (a, Event (col (SF b c) -> col (SF b c)))
-> col sf
-> col (b, sf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Event (col (SF b c) -> col (SF b c))) -> a
forall a b. (a, b) -> a
fst) col (SF b c)
sfs ((((a, Event (col (SF b c) -> col (SF b c))), col c)
-> Event (col (SF b c) -> col (SF b c)))
-> SF
((a, Event (col (SF b c) -> col (SF b c))), col c)
(Event (col (SF b c) -> col (SF b c)))
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((a, Event (col (SF b c) -> col (SF b c)))
-> Event (col (SF b c) -> col (SF b c))
forall a b. (a, b) -> b
snd ((a, Event (col (SF b c) -> col (SF b c)))
-> Event (col (SF b c) -> col (SF b c)))
-> (((a, Event (col (SF b c) -> col (SF b c))), col c)
-> (a, Event (col (SF b c) -> col (SF b c))))
-> ((a, Event (col (SF b c) -> col (SF b c))), col c)
-> Event (col (SF b c) -> col (SF b c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Event (col (SF b c) -> col (SF b c))), col c)
-> (a, Event (col (SF b c) -> col (SF b c)))
forall a b. (a, b) -> a
fst)) ((col (SF b c)
-> (col (SF b c) -> col (SF b c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> (col (SF b c)
-> (col (SF b c) -> col (SF b c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall a b. (a -> b) -> a -> b
$ \col (SF b c)
sfs' col (SF b c) -> col (SF b c)
f ->
(a, Event (col (SF b c) -> col (SF b c)))
-> (a, Event (col (SF b c) -> col (SF b c)))
forall a b c. (a, Event b) -> (a, Event c)
noEventSnd ((a, Event (col (SF b c) -> col (SF b c)))
-> (a, Event (col (SF b c) -> col (SF b c))))
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall a b. (a -> a) -> SF a b -> SF a b
>=- (forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
drpSwitch forall sf. a -> col sf -> col (b, sf)
rf (col (SF b c) -> col (SF b c)
f col (SF b c)
sfs')
parZ :: [SF a b] -> SF [a] [b]
parZ :: [SF a b] -> SF [a] [b]
parZ = (forall sf. [a] -> [sf] -> [(a, sf)]) -> [SF a b] -> SF [a] [b]
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c) -> SF a (col c)
par (String -> [a] -> [sf] -> [(a, sf)]
forall a b. String -> [a] -> [b] -> [(a, b)]
safeZip String
"parZ")
pSwitchZ :: [SF a b] -> SF ([a],[b]) (Event c) -> ([SF a b] -> c -> SF [a] [b])
-> SF [a] [b]
pSwitchZ :: [SF a b]
-> SF ([a], [b]) (Event c)
-> ([SF a b] -> c -> SF [a] [b])
-> SF [a] [b]
pSwitchZ = (forall sf. [a] -> [sf] -> [(a, sf)])
-> [SF a b]
-> SF ([a], [b]) (Event c)
-> ([SF a b] -> c -> SF [a] [b])
-> SF [a] [b]
forall (col :: * -> *) a b c d.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
pSwitch (String -> [a] -> [sf] -> [(a, sf)]
forall a b. String -> [a] -> [b] -> [(a, b)]
safeZip String
"pSwitchZ")
dpSwitchZ :: [SF a b] -> SF ([a],[b]) (Event c) -> ([SF a b] -> c ->SF [a] [b])
-> SF [a] [b]
dpSwitchZ :: [SF a b]
-> SF ([a], [b]) (Event c)
-> ([SF a b] -> c -> SF [a] [b])
-> SF [a] [b]
dpSwitchZ = (forall sf. [a] -> [sf] -> [(a, sf)])
-> [SF a b]
-> SF ([a], [b]) (Event c)
-> ([SF a b] -> c -> SF [a] [b])
-> SF [a] [b]
forall (col :: * -> *) a b c d.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, col c) (Event d)
-> (col (SF b c) -> d -> SF a (col c))
-> SF a (col c)
dpSwitch (String -> [a] -> [sf] -> [(a, sf)]
forall a b. String -> [a] -> [b] -> [(a, b)]
safeZip String
"dpSwitchZ")
rpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
rpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
rpSwitchZ = (forall sf. [a] -> [sf] -> [(a, sf)])
-> [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
rpSwitch (String -> [a] -> [sf] -> [(a, sf)]
forall a b. String -> [a] -> [b] -> [(a, b)]
safeZip String
"rpSwitchZ")
drpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
drpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
drpSwitchZ = (forall sf. [a] -> [sf] -> [(a, sf)])
-> [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b]
forall (col :: * -> *) a b c.
Functor col =>
(forall sf. a -> col sf -> col (b, sf))
-> col (SF b c)
-> SF (a, Event (col (SF b c) -> col (SF b c))) (col c)
drpSwitch (String -> [a] -> [sf] -> [(a, sf)]
forall a b. String -> [a] -> [b] -> [(a, b)]
safeZip String
"drpSwitchZ")
safeZip :: String -> [a] -> [b] -> [(a,b)]
safeZip :: String -> [a] -> [b] -> [(a, b)]
safeZip String
fn [a]
l1 [b]
l2 = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
safeZip' [a]
l1 [b]
l2
where
safeZip' :: [a] -> [b] -> [(a, b)]
safeZip' :: [a] -> [b] -> [(a, b)]
safeZip' [a]
_ [] = []
safeZip' [a]
as (b
b:[b]
bs) = ([a] -> a
forall a. [a] -> a
head' [a]
as, b
b) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
safeZip' ([a] -> [a]
forall a. [a] -> [a]
tail' [a]
as) [b]
bs
head' :: [a] -> a
head' :: [a] -> a
head' [] = a
forall a. a
err
head' (a
a:[a]
_) = a
a
tail' :: [a] -> [a]
tail' :: [a] -> [a]
tail' [] = [a]
forall a. a
err
tail' (a
_:[a]
as) = [a]
as
err :: a
err :: a
err = String -> String -> String -> a
forall a. String -> String -> String -> a
usrErr String
"FRP.Yampa.Switches" String
fn String
"Input list too short."
freeze :: SF' a b -> DTime -> SF a b
freeze :: SF' a b -> DTime -> SF a b
freeze SF' a b
sf DTime
dt = SF :: forall a b. (a -> Transition a b) -> SF a b
SF {sfTF :: a -> Transition a b
sfTF = (SF' a b -> DTime -> a -> Transition a b
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
sf) DTime
dt}
freezeCol :: Functor col => col (SF' a b) -> DTime -> col (SF a b)
freezeCol :: col (SF' a b) -> DTime -> col (SF a b)
freezeCol col (SF' a b)
sfs DTime
dt = (SF' a b -> SF a b) -> col (SF' a b) -> col (SF a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SF' a b -> DTime -> SF a b
forall a b. SF' a b -> DTime -> SF a b
`freeze` DTime
dt) col (SF' a b)
sfs
parC :: SF a b -> SF [a] [b]
parC :: SF a b -> SF [a] [b]
parC SF a b
sf = ([a] -> Transition [a] [b]) -> SF [a] [b]
forall a b. (a -> Transition a b) -> SF a b
SF (([a] -> Transition [a] [b]) -> SF [a] [b])
-> ([a] -> Transition [a] [b]) -> SF [a] [b]
forall a b. (a -> b) -> a -> b
$ \[a]
as -> let os :: [Transition a b]
os = (a -> Transition a b) -> [a] -> [Transition a b]
forall a b. (a -> b) -> [a] -> [b]
map (SF a b -> a -> Transition a b
forall a b. SF a b -> a -> Transition a b
sfTF SF a b
sf) [a]
as
bs :: [b]
bs = (Transition a b -> b) -> [Transition a b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Transition a b -> b
forall a b. (a, b) -> b
snd [Transition a b]
os
sfs :: [SF' a b]
sfs = (Transition a b -> SF' a b) -> [Transition a b] -> [SF' a b]
forall a b. (a -> b) -> [a] -> [b]
map Transition a b -> SF' a b
forall a b. (a, b) -> a
fst [Transition a b]
os
in ([SF' a b] -> SF' [a] [b]
forall a b. [SF' a b] -> SF' [a] [b]
parCAux [SF' a b]
sfs, [b]
bs)
parCAux :: [SF' a b] -> SF' [a] [b]
parCAux :: [SF' a b] -> SF' [a] [b]
parCAux [SF' a b]
sfs = (DTime -> [a] -> Transition [a] [b]) -> SF' [a] [b]
forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' DTime -> [a] -> Transition [a] [b]
tf
where
tf :: DTime -> [a] -> Transition [a] [b]
tf DTime
dt [a]
as =
let os :: [Transition a b]
os = ((a, SF' a b) -> Transition a b)
-> [(a, SF' a b)] -> [Transition a b]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
a,SF' a b
sf) -> SF' a b -> DTime -> a -> Transition a b
forall a b. SF' a b -> DTime -> a -> Transition a b
sfTF' SF' a b
sf DTime
dt a
a) ([(a, SF' a b)] -> [Transition a b])
-> [(a, SF' a b)] -> [Transition a b]
forall a b. (a -> b) -> a -> b
$ String -> [a] -> [SF' a b] -> [(a, SF' a b)]
forall a b. String -> [a] -> [b] -> [(a, b)]
safeZip String
"parC" [a]
as [SF' a b]
sfs
bs :: [b]
bs = (Transition a b -> b) -> [Transition a b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Transition a b -> b
forall a b. (a, b) -> b
snd [Transition a b]
os
sfcs :: [SF' a b]
sfcs = (Transition a b -> SF' a b) -> [Transition a b] -> [SF' a b]
forall a b. (a -> b) -> [a] -> [b]
map Transition a b -> SF' a b
forall a b. (a, b) -> a
fst [Transition a b]
os
in ([SF' a b] -> [SF' a b]
forall a. [a] -> [a]
listSeq [SF' a b]
sfcs [SF' a b] -> SF' [a] [b] -> SF' [a] [b]
`seq` [SF' a b] -> SF' [a] [b]
forall a b. [SF' a b] -> SF' [a] [b]
parCAux [SF' a b]
sfcs, [b] -> [b]
forall a. [a] -> [a]
listSeq [b]
bs)
listSeq :: [a] -> [a]
listSeq :: [a] -> [a]
listSeq [a]
x = [a]
x [a] -> [a] -> [a]
`seq` ([a] -> [a]
forall a. [a] -> [a]
listSeq' [a]
x)
listSeq' :: [a] -> [a]
listSeq' :: [a] -> [a]
listSeq' [] = []
listSeq' rs :: [a]
rs@(a
a:[a]
as) = a
a a -> [a] -> [a]
`seq` [a] -> [a]
forall a. [a] -> [a]
listSeq' [a]
as [a] -> [a] -> [a]
`seq` [a]
rs