{-
 ██████╗██╗██████╗  ██████╗██╗   ██╗██╗████████╗███████╗
██╔════╝██║██╔══██╗██╔════╝██║   ██║██║╚══██╔══╝██╔════╝
██║     ██║██████╔╝██║     ██║   ██║██║   ██║   ███████╗
██║     ██║██╔══██╗██║     ██║   ██║██║   ██║   ╚════██║
╚██████╗██║██║  ██║╚██████╗╚██████╔╝██║   ██║   ███████║
 ╚═════╝╚═╝╚═╝  ╚═╝ ╚═════╝ ╚═════╝ ╚═╝   ╚═╝   ╚══════╝
  (C) 2020, Christopher Chalmers

This file contains the 'Circuit' type, that the notation describes.
-}

{-# LANGUAGE CPP                    #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE DeriveFunctor          #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE NoImplicitPrelude      #-}
{-# LANGUAGE PatternSynonyms        #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE ViewPatterns           #-}

module Circuit where

import           Clash.Prelude

#if __GLASGOW_HASKELL__ > 900
-- | Unsafe version of ':>'. Will fail if applied to empty vectors. This is used to
-- workaround spurious incomplete pattern match warnings generated in newer GHC
-- versions.
pattern (:>!) :: a -> Vec n a -> Vec (n + 1) a
pattern $m:>! :: forall {r} {a} {n :: Nat}.
Vec (n + 1) a -> (a -> Vec n a -> r) -> ((# #) -> r) -> r
(:>!) x xs <- (\Vec (n + 1) a
ys -> (Vec (n + 1) a -> a
forall (n :: Nat) a. Vec (n + 1) a -> a
head Vec (n + 1) a
ys, Vec (n + 1) a -> Vec n a
forall (n :: Nat) a. Vec (n + 1) a -> Vec n a
tail Vec (n + 1) a
ys) -> (x,xs))
{-# COMPLETE (:>!) #-}
infixr 5 :>!
#endif

type family Fwd a
type family Bwd a

infixr 0 :->
-- | A type to symbolise arguments going to results of a circuit.
data (a :-> b) = a :-> b
  deriving (Int -> (a :-> b) -> ShowS
[a :-> b] -> ShowS
(a :-> b) -> String
(Int -> (a :-> b) -> ShowS)
-> ((a :-> b) -> String) -> ([a :-> b] -> ShowS) -> Show (a :-> b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> (a :-> b) -> ShowS
forall a b. (Show a, Show b) => [a :-> b] -> ShowS
forall a b. (Show a, Show b) => (a :-> b) -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> (a :-> b) -> ShowS
showsPrec :: Int -> (a :-> b) -> ShowS
$cshow :: forall a b. (Show a, Show b) => (a :-> b) -> String
show :: (a :-> b) -> String
$cshowList :: forall a b. (Show a, Show b) => [a :-> b] -> ShowS
showList :: [a :-> b] -> ShowS
Show, (a :-> b) -> (a :-> b) -> Bool
((a :-> b) -> (a :-> b) -> Bool)
-> ((a :-> b) -> (a :-> b) -> Bool) -> Eq (a :-> b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => (a :-> b) -> (a :-> b) -> Bool
$c== :: forall a b. (Eq a, Eq b) => (a :-> b) -> (a :-> b) -> Bool
== :: (a :-> b) -> (a :-> b) -> Bool
$c/= :: forall a b. (Eq a, Eq b) => (a :-> b) -> (a :-> b) -> Bool
/= :: (a :-> b) -> (a :-> b) -> Bool
Eq)

-- | The identity circuit.
idC :: Circuit a a
idC :: forall a. Circuit a a
idC = CircuitT a a -> Circuit a a
forall a b. CircuitT a b -> Circuit a b
Circuit (CircuitT a a -> Circuit a a) -> CircuitT a a -> Circuit a a
forall a b. (a -> b) -> a -> b
$ \(Fwd a
aFwd :-> Bwd a
aBwd) -> Bwd a
aBwd Bwd a -> Fwd a -> Bwd a :-> Fwd a
forall a b. a -> b -> a :-> b
:-> Fwd a
aFwd

data DF (dom :: Domain)  a
data DFM2S a = DFM2S Bool a
newtype DFS2M = DFS2M Bool

instance Default (DFM2S a) where
  def :: DFM2S a
def = Bool -> a -> DFM2S a
forall a. Bool -> a -> DFM2S a
DFM2S Bool
False (String -> a
forall a. HasCallStack => String -> a
error String
"error default")
instance Default DFS2M where
  def :: DFS2M
def = Bool -> DFS2M
DFS2M Bool
True

type instance Fwd (DF dom a) = Signal dom (DFM2S a)
type instance Bwd (DF dom a) = Signal dom DFS2M

type instance Fwd (Vec n a) = Vec n (Fwd a)
type instance Bwd (Vec n a) = Vec n (Bwd a)

type instance Fwd [a] = [Fwd a]
type instance Bwd [a] = [Bwd a]

type instance Fwd () = ()
type instance Bwd () = ()

type instance Fwd (a,b) = (Fwd a, Fwd b)
type instance Bwd (a,b) = (Bwd a, Bwd b)

type instance Fwd (a,b,c) = (Fwd a, Fwd b, Fwd c)
type instance Bwd (a,b,c) = (Bwd a, Bwd b, Bwd c)

type instance Fwd (Signal dom a) = Signal dom a
type instance Bwd (Signal dom a) = ()

-- | Circuit type.
newtype Circuit a b = Circuit { forall a b. Circuit a b -> CircuitT a b
runCircuit :: CircuitT a b }
type CircuitT a b = (Fwd a :-> Bwd b) -> (Bwd a :-> Fwd b)


type TagCircuitT a b = (BusTag a (Fwd a) :-> BusTag b (Bwd b)) -> (BusTag a (Bwd a) :-> BusTag b (Fwd b))

newtype BusTag t b = BusTag {forall t b. BusTag t b -> b
unBusTag :: b}

mkTagCircuit :: TagCircuitT a b -> Circuit a b
mkTagCircuit :: forall a b. TagCircuitT a b -> Circuit a b
mkTagCircuit TagCircuitT a b
f = CircuitT a b -> Circuit a b
forall a b. CircuitT a b -> Circuit a b
Circuit (CircuitT a b -> Circuit a b) -> CircuitT a b -> Circuit a b
forall a b. (a -> b) -> a -> b
$ \ (Fwd a
aFwd :-> Bwd b
bBwd) -> let
    (BusTag Bwd a
aBwd :-> BusTag Fwd b
bFwd) = TagCircuitT a b
f (Fwd a -> BusTag a (Fwd a)
forall t b. b -> BusTag t b
BusTag Fwd a
aFwd BusTag a (Fwd a)
-> BusTag b (Bwd b) -> BusTag a (Fwd a) :-> BusTag b (Bwd b)
forall a b. a -> b -> a :-> b
:-> Bwd b -> BusTag b (Bwd b)
forall t b. b -> BusTag t b
BusTag Bwd b
bBwd)
  in (Bwd a
aBwd Bwd a -> Fwd b -> Bwd a :-> Fwd b
forall a b. a -> b -> a :-> b
:-> Fwd b
bFwd)

runTagCircuit :: Circuit a b -> TagCircuitT a b
runTagCircuit :: forall a b. Circuit a b -> TagCircuitT a b
runTagCircuit (Circuit CircuitT a b
c) (BusTag a (Fwd a)
aFwd :-> BusTag b (Bwd b)
bBwd) = let
    (Bwd a
aBwd :-> Fwd b
bFwd) = CircuitT a b
c (BusTag a (Fwd a) -> Fwd a
forall t b. BusTag t b -> b
unBusTag BusTag a (Fwd a)
aFwd Fwd a -> Bwd b -> Fwd a :-> Bwd b
forall a b. a -> b -> a :-> b
:-> BusTag b (Bwd b) -> Bwd b
forall t b. BusTag t b -> b
unBusTag BusTag b (Bwd b)
bBwd)
  in (Bwd a -> BusTag a (Bwd a)
forall t b. b -> BusTag t b
BusTag Bwd a
aBwd BusTag a (Bwd a)
-> BusTag b (Fwd b) -> BusTag a (Bwd a) :-> BusTag b (Fwd b)
forall a b. a -> b -> a :-> b
:-> Fwd b -> BusTag b (Fwd b)
forall t b. b -> BusTag t b
BusTag Fwd b
bFwd)

pattern TagCircuit :: TagCircuitT a b -> Circuit a b
pattern $mTagCircuit :: forall {r} {a} {b}.
Circuit a b -> (TagCircuitT a b -> r) -> ((# #) -> r) -> r
$bTagCircuit :: forall a b. TagCircuitT a b -> Circuit a b
TagCircuit f <- (runTagCircuit -> f) where
  TagCircuit TagCircuitT a b
f = TagCircuitT a b -> Circuit a b
forall a b. TagCircuitT a b -> Circuit a b
mkTagCircuit TagCircuitT a b
f


class TrivialBwd a where
  unitBwd :: a

instance TrivialBwd () where
  unitBwd :: ()
unitBwd = ()

instance (TrivialBwd a) => TrivialBwd (Signal dom a) where
  unitBwd :: Signal dom a
unitBwd = a -> Signal dom a
forall a. a -> Signal dom a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. TrivialBwd a => a
unitBwd

instance (TrivialBwd a, KnownNat n) => TrivialBwd (Vec n a) where
  unitBwd :: Vec n a
unitBwd = a -> Vec n a
forall (n :: Nat) a. KnownNat n => a -> Vec n a
repeat a
forall a. TrivialBwd a => a
unitBwd

instance (TrivialBwd a, TrivialBwd b) => TrivialBwd (a,b) where
  unitBwd :: (a, b)
unitBwd = (a
forall a. TrivialBwd a => a
unitBwd, b
forall a. TrivialBwd a => a
unitBwd)

instance (TrivialBwd a, TrivialBwd b, TrivialBwd c) => TrivialBwd (a,b,c) where
  unitBwd :: (a, b, c)
unitBwd = (a
forall a. TrivialBwd a => a
unitBwd, b
forall a. TrivialBwd a => a
unitBwd, c
forall a. TrivialBwd a => a
unitBwd)

instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d) => TrivialBwd (a,b,c,d) where
  unitBwd :: (a, b, c, d)
unitBwd = (a
forall a. TrivialBwd a => a
unitBwd, b
forall a. TrivialBwd a => a
unitBwd, c
forall a. TrivialBwd a => a
unitBwd, d
forall a. TrivialBwd a => a
unitBwd)

instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d, TrivialBwd e) => TrivialBwd (a,b,c,d,e) where
  unitBwd :: (a, b, c, d, e)
unitBwd = (a
forall a. TrivialBwd a => a
unitBwd, b
forall a. TrivialBwd a => a
unitBwd, c
forall a. TrivialBwd a => a
unitBwd, d
forall a. TrivialBwd a => a
unitBwd, e
forall a. TrivialBwd a => a
unitBwd)

instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d, TrivialBwd e, TrivialBwd f) => TrivialBwd (a,b,c,d,e,f) where
  unitBwd :: (a, b, c, d, e, f)
unitBwd = (a
forall a. TrivialBwd a => a
unitBwd, b
forall a. TrivialBwd a => a
unitBwd, c
forall a. TrivialBwd a => a
unitBwd, d
forall a. TrivialBwd a => a
unitBwd, e
forall a. TrivialBwd a => a
unitBwd, f
forall a. TrivialBwd a => a
unitBwd)

instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d, TrivialBwd e, TrivialBwd f, TrivialBwd g) => TrivialBwd (a,b,c,d,e,f,g) where
  unitBwd :: (a, b, c, d, e, f, g)
unitBwd = (a
forall a. TrivialBwd a => a
unitBwd, b
forall a. TrivialBwd a => a
unitBwd, c
forall a. TrivialBwd a => a
unitBwd, d
forall a. TrivialBwd a => a
unitBwd, e
forall a. TrivialBwd a => a
unitBwd, f
forall a. TrivialBwd a => a
unitBwd, g
forall a. TrivialBwd a => a
unitBwd)

instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d, TrivialBwd e, TrivialBwd f, TrivialBwd g, TrivialBwd h) => TrivialBwd (a,b,c,d,e,f,g,h) where
  unitBwd :: (a, b, c, d, e, f, g, h)
unitBwd = (a
forall a. TrivialBwd a => a
unitBwd, b
forall a. TrivialBwd a => a
unitBwd, c
forall a. TrivialBwd a => a
unitBwd, d
forall a. TrivialBwd a => a
unitBwd, e
forall a. TrivialBwd a => a
unitBwd, f
forall a. TrivialBwd a => a
unitBwd, g
forall a. TrivialBwd a => a
unitBwd, h
forall a. TrivialBwd a => a
unitBwd)

instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d, TrivialBwd e, TrivialBwd f, TrivialBwd g, TrivialBwd h, TrivialBwd i) => TrivialBwd (a,b,c,d,e,f,g,h,i) where
  unitBwd :: (a, b, c, d, e, f, g, h, i)
unitBwd = (a
forall a. TrivialBwd a => a
unitBwd, b
forall a. TrivialBwd a => a
unitBwd, c
forall a. TrivialBwd a => a
unitBwd, d
forall a. TrivialBwd a => a
unitBwd, e
forall a. TrivialBwd a => a
unitBwd, f
forall a. TrivialBwd a => a
unitBwd, g
forall a. TrivialBwd a => a
unitBwd, h
forall a. TrivialBwd a => a
unitBwd, i
forall a. TrivialBwd a => a
unitBwd)

instance (TrivialBwd a, TrivialBwd b, TrivialBwd c, TrivialBwd d, TrivialBwd e, TrivialBwd f, TrivialBwd g, TrivialBwd h, TrivialBwd i, TrivialBwd j) => TrivialBwd (a,b,c,d,e,f,g,h,i,j) where
  unitBwd :: (a, b, c, d, e, f, g, h, i, j)
unitBwd = (a
forall a. TrivialBwd a => a
unitBwd, b
forall a. TrivialBwd a => a
unitBwd, c
forall a. TrivialBwd a => a
unitBwd, d
forall a. TrivialBwd a => a
unitBwd, e
forall a. TrivialBwd a => a
unitBwd, f
forall a. TrivialBwd a => a
unitBwd, g
forall a. TrivialBwd a => a
unitBwd, h
forall a. TrivialBwd a => a
unitBwd, i
forall a. TrivialBwd a => a
unitBwd, j
forall a. TrivialBwd a => a
unitBwd)

instance TrivialBwd a => TrivialBwd (BusTag t a) where
  unitBwd :: BusTag t a
unitBwd = a -> BusTag t a
forall t b. b -> BusTag t b
BusTag a
forall a. TrivialBwd a => a
unitBwd

class BusTagBundle t a where
  type BusTagUnbundled t a = res | res -> t a
  taggedBundle :: BusTagUnbundled t a -> BusTag t a
  taggedUnbundle :: BusTag t a -> BusTagUnbundled t a

instance BusTagBundle () () where
  type BusTagUnbundled () () = ()
  taggedBundle :: BusTagUnbundled () () -> BusTag () ()
taggedBundle = () -> BusTag () ()
BusTagUnbundled () () -> BusTag () ()
forall t b. b -> BusTag t b
BusTag
  taggedUnbundle :: BusTag () () -> BusTagUnbundled () ()
taggedUnbundle = BusTag () () -> ()
BusTag () () -> BusTagUnbundled () ()
forall t b. BusTag t b -> b
unBusTag

instance BusTagBundle (ta, tb) (a, b) where
  type BusTagUnbundled (ta, tb) (a, b) = (BusTag ta a, BusTag tb b)
  taggedBundle :: BusTagUnbundled (ta, tb) (a, b) -> BusTag (ta, tb) (a, b)
taggedBundle (BusTag a
a, BusTag b
b) = (a, b) -> BusTag (ta, tb) (a, b)
forall t b. b -> BusTag t b
BusTag (a
a, b
b)
  taggedUnbundle :: BusTag (ta, tb) (a, b) -> BusTagUnbundled (ta, tb) (a, b)
taggedUnbundle (BusTag (a
a, b
b)) =  (a -> BusTag ta a
forall t b. b -> BusTag t b
BusTag a
a, b -> BusTag tb b
forall t b. b -> BusTag t b
BusTag b
b)

instance BusTagBundle (ta, tb, tc) (a, b, c) where
  type BusTagUnbundled (ta, tb, tc) (a, b, c) = (BusTag ta a, BusTag tb b, BusTag tc c)
  taggedBundle :: BusTagUnbundled (ta, tb, tc) (a, b, c)
-> BusTag (ta, tb, tc) (a, b, c)
taggedBundle (BusTag a
a, BusTag b
b, BusTag c
c) = (a, b, c) -> BusTag (ta, tb, tc) (a, b, c)
forall t b. b -> BusTag t b
BusTag (a
a, b
b, c
c)
  taggedUnbundle :: BusTag (ta, tb, tc) (a, b, c)
-> BusTagUnbundled (ta, tb, tc) (a, b, c)
taggedUnbundle (BusTag (a
a, b
b, c
c)) =  (a -> BusTag ta a
forall t b. b -> BusTag t b
BusTag a
a, b -> BusTag tb b
forall t b. b -> BusTag t b
BusTag b
b, c -> BusTag tc c
forall t b. b -> BusTag t b
BusTag c
c)

instance BusTagBundle (ta, tb, tc, td) (a, b, c, d) where
  type BusTagUnbundled (ta, tb, tc, td) (a, b, c, d) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d)
  taggedBundle :: BusTagUnbundled (ta, tb, tc, td) (a, b, c, d)
-> BusTag (ta, tb, tc, td) (a, b, c, d)
taggedBundle (BusTag a
a, BusTag b
b, BusTag c
c, BusTag d
d) = (a, b, c, d) -> BusTag (ta, tb, tc, td) (a, b, c, d)
forall t b. b -> BusTag t b
BusTag (a
a, b
b, c
c, d
d)
  taggedUnbundle :: BusTag (ta, tb, tc, td) (a, b, c, d)
-> BusTagUnbundled (ta, tb, tc, td) (a, b, c, d)
taggedUnbundle (BusTag (a
a, b
b, c
c, d
d)) =  (a -> BusTag ta a
forall t b. b -> BusTag t b
BusTag a
a, b -> BusTag tb b
forall t b. b -> BusTag t b
BusTag b
b, c -> BusTag tc c
forall t b. b -> BusTag t b
BusTag c
c, d -> BusTag td d
forall t b. b -> BusTag t b
BusTag d
d)

instance BusTagBundle (ta, tb, tc, td, te) (a, b, c, d, e) where
  type BusTagUnbundled (ta, tb, tc, td, te) (a, b, c, d, e) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d, BusTag te e)
  taggedBundle :: BusTagUnbundled (ta, tb, tc, td, te) (a, b, c, d, e)
-> BusTag (ta, tb, tc, td, te) (a, b, c, d, e)
taggedBundle (BusTag a
a, BusTag b
b, BusTag c
c, BusTag d
d, BusTag e
e) = (a, b, c, d, e) -> BusTag (ta, tb, tc, td, te) (a, b, c, d, e)
forall t b. b -> BusTag t b
BusTag (a
a, b
b, c
c, d
d, e
e)
  taggedUnbundle :: BusTag (ta, tb, tc, td, te) (a, b, c, d, e)
-> BusTagUnbundled (ta, tb, tc, td, te) (a, b, c, d, e)
taggedUnbundle (BusTag (a
a, b
b, c
c, d
d, e
e)) =  (a -> BusTag ta a
forall t b. b -> BusTag t b
BusTag a
a, b -> BusTag tb b
forall t b. b -> BusTag t b
BusTag b
b, c -> BusTag tc c
forall t b. b -> BusTag t b
BusTag c
c, d -> BusTag td d
forall t b. b -> BusTag t b
BusTag d
d, e -> BusTag te e
forall t b. b -> BusTag t b
BusTag e
e)

instance BusTagBundle (ta, tb, tc, td, te, tf) (a, b, c, d, e, f) where
  type BusTagUnbundled (ta, tb, tc, td, te, tf) (a, b, c, d, e, f) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d, BusTag te e, BusTag tf f)
  taggedBundle :: BusTagUnbundled (ta, tb, tc, td, te, tf) (a, b, c, d, e, f)
-> BusTag (ta, tb, tc, td, te, tf) (a, b, c, d, e, f)
taggedBundle (BusTag a
a, BusTag b
b, BusTag c
c, BusTag d
d, BusTag e
e, BusTag f
f) = (a, b, c, d, e, f)
-> BusTag (ta, tb, tc, td, te, tf) (a, b, c, d, e, f)
forall t b. b -> BusTag t b
BusTag (a
a, b
b, c
c, d
d, e
e, f
f)
  taggedUnbundle :: BusTag (ta, tb, tc, td, te, tf) (a, b, c, d, e, f)
-> BusTagUnbundled (ta, tb, tc, td, te, tf) (a, b, c, d, e, f)
taggedUnbundle (BusTag (a
a, b
b, c
c, d
d, e
e, f
f)) =  (a -> BusTag ta a
forall t b. b -> BusTag t b
BusTag a
a, b -> BusTag tb b
forall t b. b -> BusTag t b
BusTag b
b, c -> BusTag tc c
forall t b. b -> BusTag t b
BusTag c
c, d -> BusTag td d
forall t b. b -> BusTag t b
BusTag d
d, e -> BusTag te e
forall t b. b -> BusTag t b
BusTag e
e, f -> BusTag tf f
forall t b. b -> BusTag t b
BusTag f
f)

instance BusTagBundle (ta, tb, tc, td, te, tf, tg) (a, b, c, d, e, f, g) where
  type BusTagUnbundled (ta, tb, tc, td, te, tf, tg) (a, b, c, d, e, f, g) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d, BusTag te e, BusTag tf f, BusTag tg g)
  taggedBundle :: BusTagUnbundled (ta, tb, tc, td, te, tf, tg) (a, b, c, d, e, f, g)
-> BusTag (ta, tb, tc, td, te, tf, tg) (a, b, c, d, e, f, g)
taggedBundle (BusTag a
a, BusTag b
b, BusTag c
c, BusTag d
d, BusTag e
e, BusTag f
f, BusTag g
g) = (a, b, c, d, e, f, g)
-> BusTag (ta, tb, tc, td, te, tf, tg) (a, b, c, d, e, f, g)
forall t b. b -> BusTag t b
BusTag (a
a, b
b, c
c, d
d, e
e, f
f, g
g)
  taggedUnbundle :: BusTag (ta, tb, tc, td, te, tf, tg) (a, b, c, d, e, f, g)
-> BusTagUnbundled
     (ta, tb, tc, td, te, tf, tg) (a, b, c, d, e, f, g)
taggedUnbundle (BusTag (a
a, b
b, c
c, d
d, e
e, f
f, g
g)) =  (a -> BusTag ta a
forall t b. b -> BusTag t b
BusTag a
a, b -> BusTag tb b
forall t b. b -> BusTag t b
BusTag b
b, c -> BusTag tc c
forall t b. b -> BusTag t b
BusTag c
c, d -> BusTag td d
forall t b. b -> BusTag t b
BusTag d
d, e -> BusTag te e
forall t b. b -> BusTag t b
BusTag e
e, f -> BusTag tf f
forall t b. b -> BusTag t b
BusTag f
f, g -> BusTag tg g
forall t b. b -> BusTag t b
BusTag g
g)

instance BusTagBundle (ta, tb, tc, td, te, tf, tg, th) (a, b, c, d, e, f, g, h) where
  type BusTagUnbundled (ta, tb, tc, td, te, tf, tg, th) (a, b, c, d, e, f, g, h) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d, BusTag te e, BusTag tf f, BusTag tg g, BusTag th h)
  taggedBundle :: BusTagUnbundled
  (ta, tb, tc, td, te, tf, tg, th) (a, b, c, d, e, f, g, h)
-> BusTag (ta, tb, tc, td, te, tf, tg, th) (a, b, c, d, e, f, g, h)
taggedBundle (BusTag a
a, BusTag b
b, BusTag c
c, BusTag d
d, BusTag e
e, BusTag f
f, BusTag g
g, BusTag h
h) = (a, b, c, d, e, f, g, h)
-> BusTag (ta, tb, tc, td, te, tf, tg, th) (a, b, c, d, e, f, g, h)
forall t b. b -> BusTag t b
BusTag (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h)
  taggedUnbundle :: BusTag (ta, tb, tc, td, te, tf, tg, th) (a, b, c, d, e, f, g, h)
-> BusTagUnbundled
     (ta, tb, tc, td, te, tf, tg, th) (a, b, c, d, e, f, g, h)
taggedUnbundle (BusTag (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h)) =  (a -> BusTag ta a
forall t b. b -> BusTag t b
BusTag a
a, b -> BusTag tb b
forall t b. b -> BusTag t b
BusTag b
b, c -> BusTag tc c
forall t b. b -> BusTag t b
BusTag c
c, d -> BusTag td d
forall t b. b -> BusTag t b
BusTag d
d, e -> BusTag te e
forall t b. b -> BusTag t b
BusTag e
e, f -> BusTag tf f
forall t b. b -> BusTag t b
BusTag f
f, g -> BusTag tg g
forall t b. b -> BusTag t b
BusTag g
g, h -> BusTag th h
forall t b. b -> BusTag t b
BusTag h
h)

instance BusTagBundle (ta, tb, tc, td, te, tf, tg, th, ti) (a, b, c, d, e, f, g, h, i) where
  type BusTagUnbundled (ta, tb, tc, td, te, tf, tg, th, ti) (a, b, c, d, e, f, g, h, i) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d, BusTag te e, BusTag tf f, BusTag tg g, BusTag th h, BusTag ti i)
  taggedBundle :: BusTagUnbundled
  (ta, tb, tc, td, te, tf, tg, th, ti) (a, b, c, d, e, f, g, h, i)
-> BusTag
     (ta, tb, tc, td, te, tf, tg, th, ti) (a, b, c, d, e, f, g, h, i)
taggedBundle (BusTag a
a, BusTag b
b, BusTag c
c, BusTag d
d, BusTag e
e, BusTag f
f, BusTag g
g, BusTag h
h, BusTag i
i) = (a, b, c, d, e, f, g, h, i)
-> BusTag
     (ta, tb, tc, td, te, tf, tg, th, ti) (a, b, c, d, e, f, g, h, i)
forall t b. b -> BusTag t b
BusTag (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i)
  taggedUnbundle :: BusTag
  (ta, tb, tc, td, te, tf, tg, th, ti) (a, b, c, d, e, f, g, h, i)
-> BusTagUnbundled
     (ta, tb, tc, td, te, tf, tg, th, ti) (a, b, c, d, e, f, g, h, i)
taggedUnbundle (BusTag (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i)) =  (a -> BusTag ta a
forall t b. b -> BusTag t b
BusTag a
a, b -> BusTag tb b
forall t b. b -> BusTag t b
BusTag b
b, c -> BusTag tc c
forall t b. b -> BusTag t b
BusTag c
c, d -> BusTag td d
forall t b. b -> BusTag t b
BusTag d
d, e -> BusTag te e
forall t b. b -> BusTag t b
BusTag e
e, f -> BusTag tf f
forall t b. b -> BusTag t b
BusTag f
f, g -> BusTag tg g
forall t b. b -> BusTag t b
BusTag g
g, h -> BusTag th h
forall t b. b -> BusTag t b
BusTag h
h, i -> BusTag ti i
forall t b. b -> BusTag t b
BusTag i
i)

instance BusTagBundle (ta, tb, tc, td, te, tf, tg, th, ti, tj) (a, b, c, d, e, f, g, h, i, j) where
  type BusTagUnbundled (ta, tb, tc, td, te, tf, tg, th, ti, tj) (a, b, c, d, e, f, g, h, i, j) = (BusTag ta a, BusTag tb b, BusTag tc c, BusTag td d, BusTag te e, BusTag tf f, BusTag tg g, BusTag th h, BusTag ti i, BusTag tj j)
  taggedBundle :: BusTagUnbundled
  (ta, tb, tc, td, te, tf, tg, th, ti, tj)
  (a, b, c, d, e, f, g, h, i, j)
-> BusTag
     (ta, tb, tc, td, te, tf, tg, th, ti, tj)
     (a, b, c, d, e, f, g, h, i, j)
taggedBundle (BusTag a
a, BusTag b
b, BusTag c
c, BusTag d
d, BusTag e
e, BusTag f
f, BusTag g
g, BusTag h
h, BusTag i
i, BusTag j
j) = (a, b, c, d, e, f, g, h, i, j)
-> BusTag
     (ta, tb, tc, td, te, tf, tg, th, ti, tj)
     (a, b, c, d, e, f, g, h, i, j)
forall t b. b -> BusTag t b
BusTag (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j)
  taggedUnbundle :: BusTag
  (ta, tb, tc, td, te, tf, tg, th, ti, tj)
  (a, b, c, d, e, f, g, h, i, j)
-> BusTagUnbundled
     (ta, tb, tc, td, te, tf, tg, th, ti, tj)
     (a, b, c, d, e, f, g, h, i, j)
taggedUnbundle (BusTag (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j)) =  (a -> BusTag ta a
forall t b. b -> BusTag t b
BusTag a
a, b -> BusTag tb b
forall t b. b -> BusTag t b
BusTag b
b, c -> BusTag tc c
forall t b. b -> BusTag t b
BusTag c
c, d -> BusTag td d
forall t b. b -> BusTag t b
BusTag d
d, e -> BusTag te e
forall t b. b -> BusTag t b
BusTag e
e, f -> BusTag tf f
forall t b. b -> BusTag t b
BusTag f
f, g -> BusTag tg g
forall t b. b -> BusTag t b
BusTag g
g, h -> BusTag th h
forall t b. b -> BusTag t b
BusTag h
h, i -> BusTag ti i
forall t b. b -> BusTag t b
BusTag i
i, j -> BusTag tj j
forall t b. b -> BusTag t b
BusTag j
j)

instance BusTagBundle (Vec n t) (Vec n a) where
  type BusTagUnbundled (Vec n t) (Vec n a) = Vec n (BusTag t a)
  taggedBundle :: BusTagUnbundled (Vec n t) (Vec n a) -> BusTag (Vec n t) (Vec n a)
taggedBundle = Vec n a -> BusTag (Vec n t) (Vec n a)
forall t b. b -> BusTag t b
BusTag (Vec n a -> BusTag (Vec n t) (Vec n a))
-> (Vec n (BusTag t a) -> Vec n a)
-> Vec n (BusTag t a)
-> BusTag (Vec n t) (Vec n a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BusTag t a -> a) -> Vec n (BusTag t a) -> Vec n a
forall a b. (a -> b) -> Vec n a -> Vec n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BusTag t a -> a
forall t b. BusTag t b -> b
unBusTag
  taggedUnbundle :: BusTag (Vec n t) (Vec n a) -> BusTagUnbundled (Vec n t) (Vec n a)
taggedUnbundle = (a -> BusTag t a) -> Vec n a -> Vec n (BusTag t a)
forall a b. (a -> b) -> Vec n a -> Vec n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> BusTag t a
forall t b. b -> BusTag t b
BusTag (Vec n a -> Vec n (BusTag t a))
-> (BusTag (Vec n t) (Vec n a) -> Vec n a)
-> BusTag (Vec n t) (Vec n a)
-> Vec n (BusTag t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BusTag (Vec n t) (Vec n a) -> Vec n a
forall t b. BusTag t b -> b
unBusTag

pattern BusTagBundle :: BusTagBundle t a => BusTagUnbundled t a -> BusTag t a
pattern $mBusTagBundle :: forall {r} {t} {a}.
BusTagBundle t a =>
BusTag t a -> (BusTagUnbundled t a -> r) -> ((# #) -> r) -> r
$bBusTagBundle :: forall t a. BusTagBundle t a => BusTagUnbundled t a -> BusTag t a
BusTagBundle a <- (taggedUnbundle -> a) where
  BusTagBundle BusTagUnbundled t a
a = BusTagUnbundled t a -> BusTag t a
forall t a. BusTagBundle t a => BusTagUnbundled t a -> BusTag t a
taggedBundle BusTagUnbundled t a
a
{-# COMPLETE BusTagBundle #-}