{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Numeric.Backprop.Class (
Backprop(..)
, zeroNum, addNum, oneNum
, zeroVec, addVec, oneVec, zeroVecNum, oneVecNum
, zeroFunctor, addIsList, addAsList, oneFunctor
, genericZero, genericAdd, genericOne
, ABP(..), NumBP(..), NumVec(..)
, GZero, GAdd, GOne
) where
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Data.Coerce
import Data.Complex
import Data.Data
import Data.Foldable hiding (toList)
import Data.Functor.Compose
import Data.Functor.Identity
import Data.List.NonEmpty (NonEmpty(..))
import Data.Monoid
import Data.Ratio
import Data.Vinyl
import Data.Vinyl.ARec
import Data.Vinyl.TypeLevel
import Data.Void
import Data.Word
import GHC.Exts
import GHC.Generics
import Numeric.Natural
import qualified Control.Arrow as Arr
import qualified Data.Functor.Product as DFP
import qualified Data.IntMap as IM
import qualified Data.Map as M
import qualified Data.Semigroup as SG
import qualified Data.Sequence as Seq
import qualified Data.Vector as V
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vinyl.Functor as V
import qualified Data.Vinyl.XRec as V
class Backprop a where
zero :: a -> a
add :: a -> a -> a
one :: a -> a
default zero :: (Generic a, GZero (Rep a)) => a -> a
zero = genericZero
{-# INLINE zero #-}
default add :: (Generic a, GAdd (Rep a)) => a -> a -> a
add = genericAdd
{-# INLINE add #-}
default one :: (Generic a, GOne (Rep a)) => a -> a
one = genericOne
{-# INLINE one #-}
genericZero :: (Generic a, GZero (Rep a)) => a -> a
genericZero = to . gzero . from
{-# INLINE genericZero #-}
genericAdd :: (Generic a, GAdd (Rep a)) => a -> a -> a
genericAdd x y = to $ gadd (from x) (from y)
{-# INLINE genericAdd #-}
genericOne :: (Generic a, GOne (Rep a)) => a -> a
genericOne = to . gone . from
{-# INLINE genericOne #-}
zeroNum :: Num a => a -> a
zeroNum _ = 0
{-# INLINE zeroNum #-}
addNum :: Num a => a -> a -> a
addNum = (+)
{-# INLINE addNum #-}
oneNum :: Num a => a -> a
oneNum _ = 1
{-# INLINE oneNum #-}
zeroVec :: (VG.Vector v a, Backprop a) => v a -> v a
zeroVec = VG.map zero
{-# INLINE zeroVec #-}
addVec :: (VG.Vector v a, Backprop a) => v a -> v a -> v a
addVec x y = case compare lX lY of
LT -> let (y1,y2) = VG.splitAt (lY - lX) y
in VG.zipWith add x y1 VG.++ y2
EQ -> VG.zipWith add x y
GT -> let (x1,x2) = VG.splitAt (lX - lY) x
in VG.zipWith add x1 y VG.++ x2
where
lX = VG.length x
lY = VG.length y
oneVec :: (VG.Vector v a, Backprop a) => v a -> v a
oneVec = VG.map one
{-# INLINE oneVec #-}
zeroVecNum :: (VG.Vector v a, Num a) => v a -> v a
zeroVecNum = flip VG.replicate 0 . VG.length
{-# INLINE zeroVecNum #-}
oneVecNum :: (VG.Vector v a, Num a) => v a -> v a
oneVecNum = flip VG.replicate 1 . VG.length
{-# INLINE oneVecNum #-}
zeroFunctor :: (Functor f, Backprop a) => f a -> f a
zeroFunctor = fmap zero
{-# INLINE zeroFunctor #-}
addIsList :: (IsList a, Backprop (Item a)) => a -> a -> a
addIsList = addAsList toList fromList
{-# INLINE addIsList #-}
addAsList
:: Backprop b
=> (a -> [b])
-> ([b] -> a)
-> a
-> a
-> a
addAsList f g x y = g $ go (f x) (f y)
where
go = \case
[] -> id
o@(x':xs) -> \case
[] -> o
y':ys -> add x' y' : go xs ys
oneFunctor :: (Functor f, Backprop a) => f a -> f a
oneFunctor = fmap one
{-# INLINE oneFunctor #-}
newtype NumBP a = NumBP { runNumBP :: a }
deriving (Show, Read, Eq, Ord, Typeable, Data, Generic, Functor, Foldable, Traversable, Num, Fractional, Floating)
instance NFData a => NFData (NumBP a)
instance Applicative NumBP where
pure = NumBP
{-# INLINE pure #-}
f <*> x = NumBP $ (runNumBP f) (runNumBP x)
{-# INLINE (<*>) #-}
instance Monad NumBP where
return = NumBP
{-# INLINE return #-}
x >>= f = f (runNumBP x)
{-# INLINE (>>=) #-}
instance Num a => Backprop (NumBP a) where
zero = coerce (zeroNum :: a -> a)
{-# INLINE zero #-}
add = coerce (addNum :: a -> a -> a)
{-# INLINE add #-}
one = coerce (oneNum :: a -> a)
{-# INLINE one #-}
newtype NumVec v a = NumVec { runNumVec :: v a }
deriving (Show, Read, Eq, Ord, Typeable, Data, Generic, Functor, Applicative, Monad, Alternative, MonadPlus, Foldable, Traversable)
instance NFData (v a) => NFData (NumVec v a)
instance (VG.Vector v a, Num a) => Backprop (NumVec v a) where
zero = coerce $ zeroVecNum @v @a
add (NumVec x) (NumVec y) = NumVec $ case compare lX lY of
LT -> let (y1,y2) = VG.splitAt (lY - lX) y
in VG.zipWith (+) x y1 VG.++ y2
EQ -> VG.zipWith (+) x y
GT -> let (x1,x2) = VG.splitAt (lX - lY) x
in VG.zipWith (+) x1 y VG.++ x2
where
lX = VG.length x
lY = VG.length y
one = coerce $ oneVecNum @v @a
newtype ABP f a = ABP { runABP :: f a }
deriving (Show, Read, Eq, Ord, Typeable, Data, Generic, Functor, Applicative, Monad, Alternative, MonadPlus, Foldable, Traversable)
instance NFData (f a) => NFData (ABP f a)
instance (Applicative f, Backprop a) => Backprop (ABP f a) where
zero = fmap zero
{-# INLINE zero #-}
add = liftA2 add
{-# INLINE add #-}
one = fmap one
{-# INLINE one #-}
instance (Applicative f, Num a) => Num (ABP f a) where
(+) = liftA2 (+)
{-# INLINE (+) #-}
(-) = liftA2 (-)
{-# INLINE (-) #-}
(*) = liftA2 (*)
{-# INLINE (*) #-}
negate = fmap negate
{-# INLINE negate #-}
abs = fmap abs
{-# INLINE abs #-}
signum = fmap signum
{-# INLINE signum #-}
fromInteger = pure . fromInteger
{-# INLINE fromInteger #-}
instance (Applicative f, Fractional a) => Fractional (ABP f a) where
(/) = liftA2 (/)
{-# INLINE (/) #-}
recip = fmap recip
{-# INLINE recip #-}
fromRational = pure . fromRational
{-# INLINE fromRational #-}
instance (Applicative f, Floating a) => Floating (ABP f a) where
pi = pure pi
{-# INLINE pi #-}
exp = fmap exp
{-# INLINE exp #-}
log = fmap log
{-# INLINE log #-}
sqrt = fmap sqrt
{-# INLINE sqrt #-}
(**) = liftA2 (**)
{-# INLINE (**) #-}
logBase = liftA2 logBase
{-# INLINE logBase #-}
sin = fmap sin
{-# INLINE sin #-}
cos = fmap cos
{-# INLINE cos #-}
tan = fmap tan
{-# INLINE tan #-}
asin = fmap asin
{-# INLINE asin #-}
acos = fmap acos
{-# INLINE acos #-}
atan = fmap atan
{-# INLINE atan #-}
sinh = fmap sinh
{-# INLINE sinh #-}
cosh = fmap cosh
{-# INLINE cosh #-}
tanh = fmap tanh
{-# INLINE tanh #-}
asinh = fmap asinh
{-# INLINE asinh #-}
acosh = fmap acosh
{-# INLINE acosh #-}
atanh = fmap atanh
{-# INLINE atanh #-}
class GZero f where
gzero :: f t -> f t
instance Backprop a => GZero (K1 i a) where
gzero (K1 x) = K1 (zero x)
{-# INLINE gzero #-}
instance (GZero f, GZero g) => GZero (f :*: g) where
gzero (x :*: y) = gzero x :*: gzero y
{-# INLINE gzero #-}
instance (GZero f, GZero g) => GZero (f :+: g) where
gzero (L1 x) = L1 (gzero x)
gzero (R1 x) = R1 (gzero x)
{-# INLINE gzero #-}
instance GZero V1 where
gzero = \case {}
{-# INLINE gzero #-}
instance GZero U1 where
gzero _ = U1
{-# INLINE gzero #-}
instance GZero f => GZero (M1 i c f) where
gzero (M1 x) = M1 (gzero x)
{-# INLINE gzero #-}
instance GZero f => GZero (f :.: g) where
gzero (Comp1 x) = Comp1 (gzero x)
{-# INLINE gzero #-}
class GAdd f where
gadd :: f t -> f t -> f t
instance Backprop a => GAdd (K1 i a) where
gadd (K1 x) (K1 y) = K1 (add x y)
{-# INLINE gadd #-}
instance (GAdd f, GAdd g) => GAdd (f :*: g) where
gadd (x1 :*: y1) (x2 :*: y2) = x3 :*: y3
where
!x3 = gadd x1 x2
!y3 = gadd y1 y2
{-# INLINE gadd #-}
instance GAdd V1 where
gadd = \case {}
{-# INLINE gadd #-}
instance GAdd U1 where
gadd _ _ = U1
{-# INLINE gadd #-}
instance GAdd f => GAdd (M1 i c f) where
gadd (M1 x) (M1 y) = M1 (gadd x y)
{-# INLINE gadd #-}
instance GAdd f => GAdd (f :.: g) where
gadd (Comp1 x) (Comp1 y) = Comp1 (gadd x y)
{-# INLINE gadd #-}
class GOne f where
gone :: f t -> f t
instance Backprop a => GOne (K1 i a) where
gone (K1 x) = K1 (one x)
{-# INLINE gone #-}
instance (GOne f, GOne g) => GOne (f :*: g) where
gone (x :*: y) = gone x :*: gone y
{-# INLINE gone #-}
instance (GOne f, GOne g) => GOne (f :+: g) where
gone (L1 x) = L1 (gone x)
gone (R1 x) = R1 (gone x)
{-# INLINE gone #-}
instance GOne V1 where
gone = \case {}
{-# INLINE gone #-}
instance GOne U1 where
gone _ = U1
{-# INLINE gone #-}
instance GOne f => GOne (M1 i c f) where
gone (M1 x) = M1 (gone x)
{-# INLINE gone #-}
instance GOne f => GOne (f :.: g) where
gone (Comp1 x) = Comp1 (gone x)
{-# INLINE gone #-}
instance Backprop Int where
zero = zeroNum
{-# INLINE zero #-}
add = addNum
{-# INLINE add #-}
one = oneNum
{-# INLINE one #-}
instance Backprop Integer where
zero = zeroNum
{-# INLINE zero #-}
add = addNum
{-# INLINE add #-}
one = oneNum
{-# INLINE one #-}
instance Backprop Natural where
zero = zeroNum
{-# INLINE zero #-}
add = addNum
{-# INLINE add #-}
one = oneNum
{-# INLINE one #-}
instance Backprop Word8 where
zero = zeroNum
{-# INLINE zero #-}
add = addNum
{-# INLINE add #-}
one = oneNum
{-# INLINE one #-}
instance Backprop Word where
zero = zeroNum
{-# INLINE zero #-}
add = addNum
{-# INLINE add #-}
one = oneNum
{-# INLINE one #-}
instance Backprop Word16 where
zero = zeroNum
{-# INLINE zero #-}
add = addNum
{-# INLINE add #-}
one = oneNum
{-# INLINE one #-}
instance Backprop Word32 where
zero = zeroNum
{-# INLINE zero #-}
add = addNum
{-# INLINE add #-}
one = oneNum
{-# INLINE one #-}
instance Backprop Word64 where
zero = zeroNum
{-# INLINE zero #-}
add = addNum
{-# INLINE add #-}
one = oneNum
{-# INLINE one #-}
instance Integral a => Backprop (Ratio a) where
zero = zeroNum
{-# INLINE zero #-}
add = addNum
{-# INLINE add #-}
one = oneNum
{-# INLINE one #-}
instance RealFloat a => Backprop (Complex a) where
zero = zeroNum
{-# INLINE zero #-}
add = addNum
{-# INLINE add #-}
one = oneNum
{-# INLINE one #-}
instance Backprop Float where
zero = zeroNum
{-# INLINE zero #-}
add = addNum
{-# INLINE add #-}
one = oneNum
{-# INLINE one #-}
instance Backprop Double where
zero = zeroNum
{-# INLINE zero #-}
add = addNum
{-# INLINE add #-}
one = oneNum
{-# INLINE one #-}
instance Backprop a => Backprop (V.Vector a) where
zero = zeroVec
{-# INLINE zero #-}
add = addVec
{-# INLINE add #-}
one = oneVec
{-# INLINE one #-}
instance (VU.Unbox a, Backprop a) => Backprop (VU.Vector a) where
zero = zeroVec
{-# INLINE zero #-}
add = addVec
{-# INLINE add #-}
one = oneVec
{-# INLINE one #-}
instance (VS.Storable a, Backprop a) => Backprop (VS.Vector a) where
zero = zeroVec
{-# INLINE zero #-}
add = addVec
{-# INLINE add #-}
one = oneVec
{-# INLINE one #-}
instance (VP.Prim a, Backprop a) => Backprop (VP.Vector a) where
zero = zeroVec
{-# INLINE zero #-}
add = addVec
{-# INLINE add #-}
one = oneVec
{-# INLINE one #-}
instance Backprop a => Backprop [a] where
zero = zeroFunctor
{-# INLINE zero #-}
add = addIsList
{-# INLINE add #-}
one = oneFunctor
{-# INLINE one #-}
instance Backprop a => Backprop (NonEmpty a) where
zero = zeroFunctor
{-# INLINE zero #-}
add = addIsList
{-# INLINE add #-}
one = oneFunctor
{-# INLINE one #-}
instance Backprop a => Backprop (Seq.Seq a) where
zero = zeroFunctor
{-# INLINE zero #-}
add = addIsList
{-# INLINE add #-}
one = oneFunctor
{-# INLINE one #-}
instance Backprop a => Backprop (Maybe a) where
zero = zeroFunctor
{-# INLINE zero #-}
add x y = asum [ add <$> x <*> y
, x
, y
]
{-# INLINE add #-}
one = oneFunctor
{-# INLINE one #-}
instance Backprop () where
zero _ = ()
add () () = ()
one _ = ()
instance (Backprop a, Backprop b) => Backprop (a, b) where
zero (x, y) = (zero x, zero y)
{-# INLINE zero #-}
add (x1, y1) (x2, y2) = (x3, y3)
where
!x3 = add x1 x2
!y3 = add y1 y2
{-# INLINE add #-}
one (x, y) = (one x, one y)
{-# INLINE one #-}
instance (Backprop a, Backprop b, Backprop c) => Backprop (a, b, c) where
zero (x, y, z) = (zero x, zero y, zero z)
{-# INLINE zero #-}
add (x1, y1, z1) (x2, y2, z2) = (x3, y3, z3)
where
!x3 = add x1 x2
!y3 = add y1 y2
!z3 = add z1 z2
{-# INLINE add #-}
one (x, y, z) = (one x, one y, one z)
{-# INLINE one #-}
instance (Backprop a, Backprop b, Backprop c, Backprop d) => Backprop (a, b, c, d) where
zero (x, y, z, w) = (zero x, zero y, zero z, zero w)
{-# INLINE zero #-}
add (x1, y1, z1, w1) (x2, y2, z2, w2) = (x3, y3, z3, w3)
where
!x3 = add x1 x2
!y3 = add y1 y2
!z3 = add z1 z2
!w3 = add w1 w2
{-# INLINE add #-}
one (x, y, z, w) = (one x, one y, one z, one w)
{-# INLINE one #-}
instance (Backprop a, Backprop b, Backprop c, Backprop d, Backprop e) => Backprop (a, b, c, d, e) where
zero (x, y, z, w, v) = (zero x, zero y, zero z, zero w, zero v)
{-# INLINE zero #-}
add (x1, y1, z1, w1, v1) (x2, y2, z2, w2, v2) = (x3, y3, z3, w3, v3)
where
!x3 = add x1 x2
!y3 = add y1 y2
!z3 = add z1 z2
!w3 = add w1 w2
!v3 = add v1 v2
{-# INLINE add #-}
one (x, y, z, w, v) = (one x, one y, one z, one w, one v)
{-# INLINE one #-}
instance Backprop a => Backprop (Identity a) where
zero = coerce (zero @a)
add = coerce (add @a)
one = coerce (one @a)
instance Backprop (Proxy a) where
zero _ = Proxy
{-# INLINE zero #-}
add _ _ = Proxy
{-# INLINE add #-}
one _ = Proxy
{-# INLINE one #-}
instance Backprop w => Backprop (Const w a) where
zero = coerce (zero @w)
add = coerce (add @w)
one = coerce (one @w)
instance Backprop Void where
zero = \case {}
{-# INLINE zero #-}
add = \case {}
{-# INLINE add #-}
one = \case {}
{-# INLINE one #-}
instance (Backprop a, Ord k) => Backprop (M.Map k a) where
zero = zeroFunctor
{-# INLINE zero #-}
add = M.unionWith add
{-# INLINE add #-}
one = oneFunctor
{-# INLINE one #-}
instance (Backprop a) => Backprop (IM.IntMap a) where
zero = zeroFunctor
{-# INLINE zero #-}
add = IM.unionWith add
{-# INLINE add #-}
one = oneFunctor
{-# INLINE one #-}
instance Backprop a => Backprop (K1 i a p) where
zero = coerce (zero @a)
add = coerce (add @a)
one = coerce (one @a)
instance Backprop (f p) => Backprop (M1 i c f p) where
zero = coerce (zero @(f p))
add = coerce (add @(f p))
one = coerce (one @(f p))
instance (Backprop (f p), Backprop (g p)) => Backprop ((f :*: g) p)
instance (Backprop (f (g a))) => Backprop ((f :.: g) a) where
zero = coerce (zero @(f (g a)))
add = coerce (add @(f (g a)))
one = coerce (one @(f (g a)))
instance Backprop (V1 p)
instance Backprop (U1 p)
instance Backprop a => Backprop (Sum a) where
zero = coerce (zero @a)
add = coerce (add @a)
one = coerce (one @a)
instance Backprop a => Backprop (Product a) where
zero = coerce (zero @a)
add = coerce (add @a)
one = coerce (one @a)
instance Backprop a => Backprop (SG.Option a) where
zero = coerce (zero @(Maybe a))
add = coerce (add @(Maybe a))
one = coerce (one @(Maybe a))
instance Backprop a => Backprop (SG.First a) where
zero = coerce (zero @a)
add = coerce (add @a)
one = coerce (one @a)
instance Backprop a => Backprop (SG.Last a) where
zero = coerce (zero @a)
add = coerce (add @a)
one = coerce (one @a)
instance Backprop a => Backprop (First a) where
zero = coerce (zero @(Maybe a))
add = coerce (add @(Maybe a))
one = coerce (one @(Maybe a))
instance Backprop a => Backprop (Data.Monoid.Last a) where
zero = coerce (zero @(Maybe a))
add = coerce (add @(Maybe a))
one = coerce (one @(Maybe a))
instance Backprop a => Backprop (Dual a) where
zero = coerce (zero @a)
add = coerce (add @a)
one = coerce (one @a)
instance (Backprop a, Backprop b) => Backprop (SG.Arg a b)
instance (Backprop (f a), Backprop (g a)) => Backprop (DFP.Product f g a)
instance Backprop (f (g a)) => Backprop (Compose f g a) where
zero = coerce (zero @(f (g a)))
add = coerce (add @(f (g a)))
one = coerce (one @(f (g a)))
instance Backprop a => Backprop (r -> a) where
zero = zeroFunctor
{-# INLINE zero #-}
add = liftA2 add
{-# INLINE add #-}
one = oneFunctor
{-# INLINE one #-}
instance (Backprop a, Applicative m) => Backprop (Arr.Kleisli m r a) where
zero (Arr.Kleisli f) = Arr.Kleisli ((fmap . fmap) zero f)
{-# INLINE zero #-}
add (Arr.Kleisli f) (Arr.Kleisli g) = Arr.Kleisli $ \x ->
add <$> f x <*> g x
{-# INLINE add #-}
one (Arr.Kleisli f) = Arr.Kleisli ((fmap . fmap) one f)
{-# INLINE one #-}
instance (ReifyConstraint Backprop f rs, RMap rs, RApply rs) => Backprop (Rec f rs) where
zero = rmap (\case V.Compose (Dict x) -> zero x)
. reifyConstraint @Backprop
{-# INLINE zero #-}
add xs = rzipWith (\x -> \case V.Compose (Dict y) -> add x y) xs
. reifyConstraint @Backprop
{-# INLINE add #-}
one = rmap (\case V.Compose (Dict x) -> one x)
. reifyConstraint @Backprop
{-# INLINE one #-}
instance (ReifyConstraint Backprop f rs, RMap rs, RApply rs, RecApplicative rs, NatToInt (RLength rs), RPureConstrained (IndexableField rs) rs)
=> Backprop (ARec f rs) where
zero = toARec . zero . fromARec
{-# INLINE zero #-}
add xs ys = toARec $ add (fromARec xs) (fromARec ys)
{-# INLINE add #-}
one = toARec . zero . fromARec
{-# INLINE one #-}
instance (ReifyConstraint Backprop f rs, RMap rs, RApply rs, VS.Storable (Rec f rs))
=> Backprop (SRec f rs) where
zero = toSRec . zero . fromSRec
{-# INLINE zero #-}
add xs ys = toSRec $ add (fromSRec xs) (fromSRec ys)
{-# INLINE add #-}
one = toSRec . zero . fromSRec
{-# INLINE one #-}
instance (ReifyConstraint Backprop f rs, RMap rs, RApply rs, IsoXRec f rs)
=> Backprop (XRec f rs) where
zero = toXRec . zero . fromXRec
{-# INLINE zero #-}
add xs ys = toXRec $ add (fromXRec xs) (fromXRec ys)
{-# INLINE add #-}
one = toXRec . zero . fromXRec
{-# INLINE one #-}
instance Backprop a => Backprop (V.Identity a) where
zero = coerce (zero @a)
add = coerce (add @a)
one = coerce (one @a)
instance Backprop a => Backprop (V.Thunk a) where
zero (V.Thunk x) = V.Thunk (zero x)
add (V.Thunk x) (V.Thunk y) = V.Thunk (add x y)
one (V.Thunk x) = V.Thunk (one x)
instance Backprop (op (f a) (g a)) => Backprop (V.Lift op f g a) where
zero = coerce (zero @(op (f a) (g a)))
add = coerce (add @(op (f a) (g a)))
one = coerce (one @(op (f a) (g a)))
instance Backprop t => Backprop (V.ElField '(s, t)) where
zero (V.Field x) = V.Field (zero x)
add (V.Field x) (V.Field y) = V.Field (add x y)
one (V.Field x) = V.Field (one x)
instance Backprop (f (g a)) => Backprop (V.Compose f g a) where
zero = coerce (zero @(f (g a)))
add = coerce (add @(f (g a)))
one = coerce (one @(f (g a)))
instance Backprop w => Backprop (V.Const w a) where
zero = coerce (zero @w)
add = coerce (add @w)
one = coerce (one @w)
instance Backprop (V.HKD t a) => Backprop (V.XData t a) where
zero = coerce (zero @(V.HKD t a))
add = coerce (add @(V.HKD t a))
one = coerce (one @(V.HKD t a))
instance Backprop (SField field) where
zero _ = SField
add _ _ = SField
one _ = SField
instance Backprop (Label field) where
zero _ = Label
add _ _ = Label
one _ = Label