typedKanren-0.1.0.0
Safe HaskellSafe-Inferred
LanguageHaskell2010

Kanren.GenericLogical

Description

Generic implementations of Logical methods.

As discussed in the documentation for the Logical class, method implementations are not particularly interesting and can be easily automated. This module provides such automated implementations using Generic.

This module expects that you already have a logical representation for your type, and there's already a Logic type instance. The logical type must not change the order of constructors as well as the order of fields in each constructor, but the names do not matter. Additionally, each field in the original type must be wrapped in a Term in the logical representation.

For example, consider the following type definition:

data Tree a
  = Leaf a
  | Node (Tree a) (Tree a)
  deriving (Generic)

data LogicTree a
  = LogicLeaf (Term a)
  | LogicNode (Term (Tree a)) (Term (Tree a))
  deriving (Generic)

From there, using the generic implementations is trivial:

instance (Logical a) => Logical (Tree a) where
  type Logic (Tree a) = LogicTree a
  unify = genericUnify
  subst = genericSubst
  inject = genericInject
  extract = genericExtract
Synopsis

Documentation

genericUnify :: forall a. (Generic (Logic a), GLogical (Rep a) (Rep (Logic a))) => Logic a -> Logic a -> State -> Maybe State Source #

The generic implementation of unify.

genericWalk :: forall a. (Generic (Logic a), GLogical (Rep a) (Rep (Logic a))) => State -> Logic a -> Logic a Source #

The generic implementation of walk.

genericOccursCheck :: forall a b. (Generic (Logic a), GLogical (Rep a) (Rep (Logic a))) => VarId b -> Logic a -> State -> Bool Source #

The generic implementation of walk.

genericInject :: (Generic a, Generic (Logic a), GLogical (Rep a) (Rep (Logic a))) => a -> Logic a Source #

The generic implementation of inject.

genericExtract :: (Generic a, Generic (Logic a), GLogical (Rep a) (Rep (Logic a))) => Logic a -> Maybe a Source #

The generic implementation of extract.

class GLogical f f' Source #

Minimal complete definition

gunify, gwalk, goccursCheck, ginject, gextract

Instances

Instances details
GLogical (U1 :: Type -> Type) (U1 :: Type -> Type) Source # 
Instance details

Defined in Kanren.GenericLogical

Methods

gunify :: Proxy U1 -> U1 p -> U1 p -> State -> Maybe State

gwalk :: Proxy U1 -> State -> U1 p -> U1 p

goccursCheck :: Proxy U1 -> VarId b -> U1 p -> State -> Bool

ginject :: U1 p -> U1 p

gextract :: U1 p -> Maybe (U1 p)

GLogical (V1 :: Type -> Type) (V1 :: Type -> Type) Source # 
Instance details

Defined in Kanren.GenericLogical

Methods

gunify :: Proxy V1 -> V1 p -> V1 p -> State -> Maybe State

gwalk :: Proxy V1 -> State -> V1 p -> V1 p

goccursCheck :: Proxy V1 -> VarId b -> V1 p -> State -> Bool

ginject :: V1 p -> V1 p

gextract :: V1 p -> Maybe (V1 p)

(GLogical f f', GLogical g g') => GLogical (f :*: g) (f' :*: g') Source # 
Instance details

Defined in Kanren.GenericLogical

Methods

gunify :: Proxy (f :*: g) -> (f' :*: g') p -> (f' :*: g') p -> State -> Maybe State

gwalk :: Proxy (f :*: g) -> State -> (f' :*: g') p -> (f' :*: g') p

goccursCheck :: Proxy (f :*: g) -> VarId b -> (f' :*: g') p -> State -> Bool

ginject :: (f :*: g) p -> (f' :*: g') p

gextract :: (f' :*: g') p -> Maybe ((f :*: g) p)

(GLogical f f', GLogical g g') => GLogical (f :+: g) (f' :+: g') Source # 
Instance details

Defined in Kanren.GenericLogical

Methods

gunify :: Proxy (f :+: g) -> (f' :+: g') p -> (f' :+: g') p -> State -> Maybe State

gwalk :: Proxy (f :+: g) -> State -> (f' :+: g') p -> (f' :+: g') p

goccursCheck :: Proxy (f :+: g) -> VarId b -> (f' :+: g') p -> State -> Bool

ginject :: (f :+: g) p -> (f' :+: g') p

gextract :: (f' :+: g') p -> Maybe ((f :+: g) p)

Logical c => GLogical (K1 i c :: Type -> Type) (K1 i' (Term c) :: Type -> Type) Source # 
Instance details

Defined in Kanren.GenericLogical

Methods

gunify :: Proxy (K1 i c) -> K1 i' (Term c) p -> K1 i' (Term c) p -> State -> Maybe State

gwalk :: Proxy (K1 i c) -> State -> K1 i' (Term c) p -> K1 i' (Term c) p

goccursCheck :: Proxy (K1 i c) -> VarId b -> K1 i' (Term c) p -> State -> Bool

ginject :: K1 i c p -> K1 i' (Term c) p

gextract :: K1 i' (Term c) p -> Maybe (K1 i c p)

GLogical f f' => GLogical (M1 i t f) (M1 i' t' f') Source # 
Instance details

Defined in Kanren.GenericLogical

Methods

gunify :: Proxy (M1 i t f) -> M1 i' t' f' p -> M1 i' t' f' p -> State -> Maybe State

gwalk :: Proxy (M1 i t f) -> State -> M1 i' t' f' p -> M1 i' t' f' p

goccursCheck :: Proxy (M1 i t f) -> VarId b -> M1 i' t' f' p -> State -> Bool

ginject :: M1 i t f p -> M1 i' t' f' p

gextract :: M1 i' t' f' p -> Maybe (M1 i t f p)