module Numeric.AD.Internal.Types
( AD(..)
, UU, UF, FU, FF
) where
import Data.Data (Data(..), mkDataType, DataType, mkConstr, Constr, constrIndex, Fixity(..))
import Data.Typeable (Typeable1(..), Typeable(..), TyCon, mkTyCon, mkTyConApp, gcast1)
import Language.Haskell.TH
import Numeric.AD.Internal.Classes
newtype AD f a = AD { runAD :: f a } deriving (Iso (f a), Lifted, Mode, Primal)
let f = varT (mkName "f") in
deriveNumeric
(classP ''Lifted [f]:)
(conT ''AD `appT` f)
type UU a = forall s. Mode s => AD s a -> AD s a
type UF f a = forall s. Mode s => AD s a -> f (AD s a)
type FU f a = forall s. Mode s => f (AD s a) -> AD s a
type FF f g a = forall s. Mode s => f (AD s a) -> g (AD s a)
instance Typeable1 f => Typeable1 (AD f) where
typeOf1 tfa = mkTyConApp adTyCon [typeOf1 (undefined `asArgsType` tfa)]
where asArgsType :: f a -> t f a -> f a
asArgsType = const
adTyCon :: TyCon
adTyCon = mkTyCon "Numeric.AD.Internal.Types.AD"
adConstr :: Constr
adConstr = mkConstr adDataType "AD" [] Prefix
adDataType :: DataType
adDataType = mkDataType "Numeric.AD.Internal.Types.AD" [adConstr]
instance (Typeable1 f, Typeable a, Data (f a), Data a) => Data (AD f a) where
gfoldl f z (AD a) = z AD `f` a
toConstr _ = adConstr
gunfold k z c = case constrIndex c of
1 -> k (z AD)
_ -> error "gunfold"
dataTypeOf _ = adDataType
dataCast1 f = gcast1 f