DeepDarkFantasy-0.2017.8.10: A DSL for creating neural network.

Safe HaskellSafe
LanguageHaskell2010

DDF.DBI

Documentation

class Monoid r m where Source #

Minimal complete definition

zero, plus

Methods

zero :: r h m Source #

plus :: r h (m -> m -> m) Source #

Instances

Lang repr => ProdCon (Monoid * repr) l r Source # 

Methods

prodCon :: (Monoid * repr l, Monoid * repr r) :- Monoid * repr (l, r) Source #

class DBI r where Source #

Minimal complete definition

z, s, abs, app

Methods

z :: r (a, h) a Source #

s :: r h b -> r (a, h) b Source #

abs :: r (a, h) b -> r h (a -> b) Source #

app :: r h (a -> b) -> r h a -> r h b Source #

hoas :: (r (a, h) a -> r (a, h) b) -> r h (a -> b) Source #

We use a variant of HOAS so it can be compile to DBI, which is more compositional (No Negative Occurence). It require explicit lifting of variables. Use lam to do automatic lifting of variables.

com :: r h ((b -> c) -> (a -> b) -> a -> c) Source #

flip :: r h ((a -> b -> c) -> b -> a -> c) Source #

id :: r h (a -> a) Source #

const :: r h (a -> b -> a) Source #

scomb :: r h ((a -> b -> c) -> (a -> b) -> a -> c) Source #

dup :: r h ((a -> a -> b) -> a -> b) Source #

let_ :: r h (a -> (a -> b) -> b) Source #

Instances

DBI Eval Source # 

Methods

z :: Eval (a, h) a Source #

s :: Eval h b -> Eval (a, h) b Source #

abs :: Eval (a, h) b -> Eval h (a -> b) Source #

app :: Eval h (a -> b) -> Eval h a -> Eval h b Source #

hoas :: (Eval (a, h) a -> Eval (a, h) b) -> Eval h (a -> b) Source #

com :: Eval h ((b -> c) -> (a -> b) -> a -> c) Source #

flip :: Eval h ((a -> b -> c) -> b -> a -> c) Source #

id :: Eval h (a -> a) Source #

const :: Eval h (a -> b -> a) Source #

scomb :: Eval h ((a -> b -> c) -> (a -> b) -> a -> c) Source #

dup :: Eval h ((a -> a -> b) -> a -> b) Source #

let_ :: Eval h (a -> (a -> b) -> b) Source #

DBI Show Source # 

Methods

z :: Show (a, h) a Source #

s :: Show h b -> Show (a, h) b Source #

abs :: Show (a, h) b -> Show h (a -> b) Source #

app :: Show h (a -> b) -> Show h a -> Show h b Source #

hoas :: (Show (a, h) a -> Show (a, h) b) -> Show h (a -> b) Source #

com :: Show h ((b -> c) -> (a -> b) -> a -> c) Source #

flip :: Show h ((a -> b -> c) -> b -> a -> c) Source #

id :: Show h (a -> a) Source #

const :: Show h (a -> b -> a) Source #

scomb :: Show h ((a -> b -> c) -> (a -> b) -> a -> c) Source #

dup :: Show h ((a -> a -> b) -> a -> b) Source #

let_ :: Show h (a -> (a -> b) -> b) Source #

DBI Size Source # 

Methods

z :: Size (a, h) a Source #

s :: Size h b -> Size (a, h) b Source #

abs :: Size (a, h) b -> Size h (a -> b) Source #

app :: Size h (a -> b) -> Size h a -> Size h b Source #

hoas :: (Size (a, h) a -> Size (a, h) b) -> Size h (a -> b) Source #

com :: Size h ((b -> c) -> (a -> b) -> a -> c) Source #

flip :: Size h ((a -> b -> c) -> b -> a -> c) Source #

id :: Size h (a -> a) Source #

const :: Size h (a -> b -> a) Source #

scomb :: Size h ((a -> b -> c) -> (a -> b) -> a -> c) Source #

dup :: Size h ((a -> a -> b) -> a -> b) Source #

let_ :: Size h (a -> (a -> b) -> b) Source #

DBI r => DBI (P r) Source # 

Methods

z :: P r (a, h) a Source #

s :: P r h b -> P r (a, h) b Source #

abs :: P r (a, h) b -> P r h (a -> b) Source #

app :: P r h (a -> b) -> P r h a -> P r h b Source #

hoas :: (P r (a, h) a -> P r (a, h) b) -> P r h (a -> b) Source #

com :: P r h ((b -> c) -> (a -> b) -> a -> c) Source #

flip :: P r h ((a -> b -> c) -> b -> a -> c) Source #

id :: P r h (a -> a) Source #

const :: P r h (a -> b -> a) Source #

scomb :: P r h ((a -> b -> c) -> (a -> b) -> a -> c) Source #

dup :: P r h ((a -> a -> b) -> a -> b) Source #

let_ :: P r h (a -> (a -> b) -> b) Source #

SubL c DBI => DBI (Term c) Source # 

Methods

z :: Term c (a, h) a Source #

s :: Term c h b -> Term c (a, h) b Source #

abs :: Term c (a, h) b -> Term c h (a -> b) Source #

app :: Term c h (a -> b) -> Term c h a -> Term c h b Source #

hoas :: (Term c (a, h) a -> Term c (a, h) b) -> Term c h (a -> b) Source #

com :: Term c h ((b -> c) -> (a -> b) -> a -> c) Source #

flip :: Term c h ((a -> b -> c) -> b -> a -> c) Source #

id :: Term c h (a -> a) Source #

const :: Term c h (a -> b -> a) Source #

scomb :: Term c h ((a -> b -> c) -> (a -> b) -> a -> c) Source #

dup :: Term c h ((a -> a -> b) -> a -> b) Source #

let_ :: Term c h (a -> (a -> b) -> b) Source #

DBI repr => DBI (UnHOAS repr) Source # 

Methods

z :: UnHOAS repr (a, h) a Source #

s :: UnHOAS repr h b -> UnHOAS repr (a, h) b Source #

abs :: UnHOAS repr (a, h) b -> UnHOAS repr h (a -> b) Source #

app :: UnHOAS repr h (a -> b) -> UnHOAS repr h a -> UnHOAS repr h b Source #

hoas :: (UnHOAS repr (a, h) a -> UnHOAS repr (a, h) b) -> UnHOAS repr h (a -> b) Source #

com :: UnHOAS repr h ((b -> c) -> (a -> b) -> a -> c) Source #

flip :: UnHOAS repr h ((a -> b -> c) -> b -> a -> c) Source #

id :: UnHOAS repr h (a -> a) Source #

const :: UnHOAS repr h (a -> b -> a) Source #

scomb :: UnHOAS repr h ((a -> b -> c) -> (a -> b) -> a -> c) Source #

dup :: UnHOAS repr h ((a -> a -> b) -> a -> b) Source #

let_ :: UnHOAS repr h (a -> (a -> b) -> b) Source #

Prod r => DBI (UnLiftEnv r) Source # 

Methods

z :: UnLiftEnv r (a, h) a Source #

s :: UnLiftEnv r h b -> UnLiftEnv r (a, h) b Source #

abs :: UnLiftEnv r (a, h) b -> UnLiftEnv r h (a -> b) Source #

app :: UnLiftEnv r h (a -> b) -> UnLiftEnv r h a -> UnLiftEnv r h b Source #

hoas :: (UnLiftEnv r (a, h) a -> UnLiftEnv r (a, h) b) -> UnLiftEnv r h (a -> b) Source #

com :: UnLiftEnv r h ((b -> c) -> (a -> b) -> a -> c) Source #

flip :: UnLiftEnv r h ((a -> b -> c) -> b -> a -> c) Source #

id :: UnLiftEnv r h (a -> a) Source #

const :: UnLiftEnv r h (a -> b -> a) Source #

scomb :: UnLiftEnv r h ((a -> b -> c) -> (a -> b) -> a -> c) Source #

dup :: UnLiftEnv r h ((a -> a -> b) -> a -> b) Source #

let_ :: UnLiftEnv r h (a -> (a -> b) -> b) Source #

Prod r => DBI (ImpW r) Source # 

Methods

z :: ImpW r (a, h) a Source #

s :: ImpW r h b -> ImpW r (a, h) b Source #

abs :: ImpW r (a, h) b -> ImpW r h (a -> b) Source #

app :: ImpW r h (a -> b) -> ImpW r h a -> ImpW r h b Source #

hoas :: (ImpW r (a, h) a -> ImpW r (a, h) b) -> ImpW r h (a -> b) Source #

com :: ImpW r h ((b -> c) -> (a -> b) -> a -> c) Source #

flip :: ImpW r h ((a -> b -> c) -> b -> a -> c) Source #

id :: ImpW r h (a -> a) Source #

const :: ImpW r h (a -> b -> a) Source #

scomb :: ImpW r h ((a -> b -> c) -> (a -> b) -> a -> c) Source #

dup :: ImpW r h ((a -> a -> b) -> a -> b) Source #

let_ :: ImpW r h (a -> (a -> b) -> b) Source #

type SubLC c DBI Source # 
type SubLC c DBI = ()

class LiftEnv r where Source #

Minimal complete definition

liftEnv

Methods

liftEnv :: r () a -> r h a Source #

const1 :: DBI r => r h a -> r h (b -> a) Source #

map2 :: Functor r f => r h (a -> b) -> r h (f a) -> r h (f b) Source #

return :: Applicative r a => r h (x -> a x) Source #

bind2 :: Monad r m => r h (m a) -> r h (a -> m b) -> r h (m b) Source #

map1 :: Functor r f => r h (a -> b) -> r h (f a -> f b) Source #

join1 :: Monad r m => r h (m (m a)) -> r h (m a) Source #

bimap2 :: (BiFunctor * r p, DBI r) => r h (a -> b) -> r h (c -> d) -> r h (p a c -> p b d) Source #

bimap3 :: (BiFunctor * r p, DBI r) => r h (a -> b) -> r h (c -> d) -> r h (p a c) -> r h (p b d) Source #

flip1 :: DBI r => r h (a -> b -> c) -> r h (b -> a -> c) Source #

flip2 :: DBI r => r h (a1 -> a -> c) -> r h a -> r h (a1 -> c) Source #

let_2 :: DBI r => r h a -> r h (a -> b) -> r h b Source #

class DBI r => Functor r f where Source #

Minimal complete definition

map

Methods

map :: r h ((a -> b) -> f a -> f b) Source #

Instances

Functor Eval IO Source # 

Methods

map :: Eval h ((a -> b) -> IO a -> IO b) Source #

Functor Show x Source # 

Methods

map :: Show h ((a -> b) -> x a -> x b) Source #

Functor Size x Source # 

Methods

map :: Size h ((a -> b) -> x a -> x b) Source #

SubL c IO => Functor (Term c) IO Source # 

Methods

map :: Term c h ((a -> b) -> IO a -> IO b) Source #

Functor r x => Functor (UnHOAS r) x Source # 

Methods

map :: UnHOAS r h ((a -> b) -> x a -> x b) Source #

(Prod r, Functor r m) => Functor (UnLiftEnv r) m Source # 

Methods

map :: UnLiftEnv r h ((a -> b) -> m a -> m b) Source #

(Prod r, Functor r x) => Functor (ImpW r) x Source # 

Methods

map :: ImpW r h ((a -> b) -> x a -> x b) Source #

class Functor r a => Applicative r a where Source #

Minimal complete definition

pure, ap

Methods

pure :: r h (x -> a x) Source #

ap :: r h (a (x -> y) -> a x -> a y) Source #

Instances

Applicative Eval IO Source # 

Methods

pure :: Eval h (x -> IO x) Source #

ap :: Eval h (IO (x -> y) -> IO x -> IO y) Source #

Applicative Show x Source # 

Methods

pure :: Show h (x -> x x) Source #

ap :: Show h (x (x -> y) -> x x -> x y) Source #

Applicative Size x Source # 

Methods

pure :: Size h (x -> x x) Source #

ap :: Size h (x (x -> y) -> x x -> x y) Source #

SubL c IO => Applicative (Term c) IO Source # 

Methods

pure :: Term c h (x -> IO x) Source #

ap :: Term c h (IO (x -> y) -> IO x -> IO y) Source #

Applicative r x => Applicative (UnHOAS r) x Source # 

Methods

pure :: UnHOAS r h (x -> x x) Source #

ap :: UnHOAS r h (x (x -> y) -> x x -> x y) Source #

(Prod r, Applicative r m) => Applicative (UnLiftEnv r) m Source # 

Methods

pure :: UnLiftEnv r h (x -> m x) Source #

ap :: UnLiftEnv r h (m (x -> y) -> m x -> m y) Source #

(Prod r, Applicative r x) => Applicative (ImpW r) x Source # 

Methods

pure :: ImpW r h (x -> x x) Source #

ap :: ImpW r h (x (x -> y) -> x x -> x y) Source #

class Applicative r m => Monad r m where Source #

Minimal complete definition

join | bind

Methods

bind :: r h (m a -> (a -> m b) -> m b) Source #

join :: r h (m (m a) -> m a) Source #

Instances

Monad Eval IO Source # 

Methods

bind :: Eval h (IO a -> (a -> IO b) -> IO b) Source #

join :: Eval h (IO (IO a) -> IO a) Source #

Monad Show x Source # 

Methods

bind :: Show h (x a -> (a -> x b) -> x b) Source #

join :: Show h (x (x a) -> x a) Source #

Monad Size x Source # 

Methods

bind :: Size h (x a -> (a -> x b) -> x b) Source #

join :: Size h (x (x a) -> x a) Source #

SubL c IO => Monad (Term c) IO Source # 

Methods

bind :: Term c h (IO a -> (a -> IO b) -> IO b) Source #

join :: Term c h (IO (IO a) -> IO a) Source #

Monad r x => Monad (UnHOAS r) x Source # 

Methods

bind :: UnHOAS r h (x a -> (a -> x b) -> x b) Source #

join :: UnHOAS r h (x (x a) -> x a) Source #

(Prod r, Monad r m) => Monad (UnLiftEnv r) m Source # 

Methods

bind :: UnLiftEnv r h (m a -> (a -> m b) -> m b) Source #

join :: UnLiftEnv r h (m (m a) -> m a) Source #

(Prod r, Monad r x) => Monad (ImpW r) x Source # 

Methods

bind :: ImpW r h (x a -> (a -> x b) -> x b) Source #

join :: ImpW r h (x (x a) -> x a) Source #

class BiFunctor r p where Source #

Minimal complete definition

bimap

Methods

bimap :: r h ((a -> b) -> (c -> d) -> p a c -> p b d) Source #

com2 :: DBI r => r h (b -> c) -> r h (a -> b) -> r h (a -> c) Source #

class NT repr l r where Source #

Minimal complete definition

conv

Methods

conv :: repr l t -> repr r t Source #

Instances

NT k k1 repr x x Source # 

Methods

conv :: x l t -> x r t Source #

NTS k k1 repr l r => NT k k1 repr l r Source # 

Methods

conv :: r l t -> r r t Source #

class NTS repr l r where Source #

Minimal complete definition

convS

Methods

convS :: repr l t -> repr r t Source #

Instances

(DBI repr, NT * * repr l r) => NTS * * repr l (a, r) Source # 

Methods

convS :: (a, r) l t -> (a, r) r t Source #

lam :: forall repr a b h. DBI repr => ((forall k. NT repr (a, h) k => repr k a) -> repr (a, h) b) -> repr h (a -> b) Source #

lam2 :: forall repr a b c h. DBI repr => ((forall k. NT repr (a, h) k => repr k a) -> (forall k. NT repr (b, (a, h)) k => repr k b) -> repr (b, (a, h)) c) -> repr h (a -> b -> c) Source #

lam3 :: (NT * * repr (a, (b1, (a1, h))) k, NT * * repr (b1, (a1, h)) k1, NT * * repr (a1, h) k2, DBI repr) => (repr k2 a1 -> repr k1 b1 -> repr k a -> repr (a, (b1, (a1, h))) b) -> repr h (a1 -> b1 -> a -> b) Source #

lam4 :: (NT * * repr (a, (a1, (b1, (a2, h)))) k, NT * * repr (a2, h) k3, NT * * repr (b1, (a2, h)) k2, NT * * repr (a1, (b1, (a2, h))) k1, DBI repr) => (repr k3 a2 -> repr k2 b1 -> repr k1 a1 -> repr k a -> repr (a, (a1, (b1, (a2, h)))) b) -> repr h (a2 -> b1 -> a1 -> a -> b) Source #

app2 :: DBI r => r h (a1 -> a -> b) -> r h a1 -> r h a -> r h b Source #

app3 :: DBI r => r h (a2 -> a1 -> a -> b) -> r h a2 -> r h a1 -> r h a -> r h b Source #

app4 :: DBI r => r h (a3 -> a2 -> a1 -> a -> b) -> r h a3 -> r h a2 -> r h a1 -> r h a -> r h b Source #

app5 :: DBI r => r h (a4 -> a3 -> a2 -> a1 -> a -> b) -> r h a4 -> r h a3 -> r h a2 -> r h a1 -> r h a -> r h b Source #

plus2 :: (Monoid * r b, DBI r) => r h b -> r h b -> r h b Source #

noEnv :: repr () x -> repr () x Source #

scomb2 :: DBI r => r h (a -> b -> c) -> r h (a -> b) -> r h (a -> c) Source #

plus1 :: (Monoid * r a, DBI r) => r h a -> r h (a -> a) Source #

dup1 :: DBI r => r h (a -> a -> b) -> r h (a -> b) Source #