module Synthesizer.Dimensional.Arrow where
import qualified Synthesizer.Dimensional.Map as Map
import Data.Tuple.HT (mapFst, mapSnd, mapPair, )
import qualified Prelude as P
import Prelude hiding (map, id, fst, snd, )
class C arrow where
map ::
Map.T amp0 amp1 yv0 yv1 ->
arrow amp0 amp1 yv0 yv1
(>>>) ::
arrow amp0 amp1 yv0 yv1 ->
arrow amp1 amp2 yv1 yv2 ->
arrow amp0 amp2 yv0 yv2
first ::
arrow amp0 amp1 yv0 yv1 ->
arrow (amp0, amp) (amp1, amp) (yv0, yv) (yv1, yv)
second ::
arrow amp0 amp1 yv0 yv1 ->
arrow (amp, amp0) (amp, amp1) (yv, yv0) (yv, yv1)
(***) ::
arrow amp0 amp1 yv0 yv1 ->
arrow amp2 amp3 yv2 yv3 ->
arrow (amp0, amp2) (amp1, amp3) (yv0, yv2) (yv1, yv3)
(&&&) ::
arrow amp amp0 yv yv0 ->
arrow amp amp1 yv yv1 ->
arrow amp (amp0, amp1) yv (yv0, yv1)
second arr = Map.swap ^<< first arr <<^ Map.swap
f *** g = first f <<< second g
f &&& g = f***g <<^ Map.double
instance C Map.T where
map = P.id
(Map.Cons f) >>> (Map.Cons g) =
Map.Cons $ \x ->
let (y, h) = f x
(z, k) = g y
in (z, k . h)
first (Map.Cons f) =
Map.Cons $ \(x,z) ->
let (y, g) = f x
in ((y,z), mapFst g)
second (Map.Cons f) =
Map.Cons $ \(z,x) ->
let (y, g) = f x
in ((z,y), mapSnd g)
(Map.Cons f) *** (Map.Cons g) =
Map.Cons $ \(x,y) ->
let (z, h) = f x
(w, k) = g y
in ((z,w), mapPair (h,k))
(Map.Cons f) &&& (Map.Cons g) =
Map.Cons $ \x ->
let (y, h) = f x
(z, k) = g x
in ((y,z), \s -> (h s, k s))
infixr 3 ***
infixr 3 &&&
infixr 1 >>>, ^>>, >>^
infixr 1 <<<, ^<<, <<^
compose :: (C arrow) =>
arrow amp0 amp1 yv0 yv1 ->
arrow amp1 amp2 yv1 yv2 ->
arrow amp0 amp2 yv0 yv2
compose = (>>>)
(<<<) :: (C arrow) =>
arrow amp1 amp2 yv1 yv2 ->
arrow amp0 amp1 yv0 yv1 ->
arrow amp0 amp2 yv0 yv2
(<<<) = flip (>>>)
split :: (C arrow) =>
arrow amp0 amp1 yv0 yv1 ->
arrow amp2 amp3 yv2 yv3 ->
arrow (amp0, amp2) (amp1, amp3) (yv0, yv2) (yv1, yv3)
split = (***)
fanout :: (C arrow) =>
arrow amp amp0 yv yv0 ->
arrow amp amp1 yv yv1 ->
arrow amp (amp0, amp1) yv (yv0, yv1)
fanout = (&&&)
(^>>) :: (C arrow) =>
Map.T amp0 amp1 yv0 yv1 ->
arrow amp1 amp2 yv1 yv2 ->
arrow amp0 amp2 yv0 yv2
f ^>> a = map f >>> a
(>>^) :: (C arrow) =>
arrow amp0 amp1 yv0 yv1 ->
Map.T amp1 amp2 yv1 yv2 ->
arrow amp0 amp2 yv0 yv2
a >>^ f = a >>> map f
(<<^) :: (C arrow) =>
arrow amp1 amp2 yv1 yv2 ->
Map.T amp0 amp1 yv0 yv1 ->
arrow amp0 amp2 yv0 yv2
a <<^ f = a <<< map f
(^<<) :: (C arrow) =>
Map.T amp1 amp2 yv1 yv2 ->
arrow amp0 amp1 yv0 yv1 ->
arrow amp0 amp2 yv0 yv2
f ^<< a = map f <<< a