nom-0.1.0.1: Name-binding & alpha-equivalence

Copyright(c) Murdoch J. Gabbay 2020
LicenseGPL-3
Maintainermurdoch.gabbay@gmail.com
Stabilityexperimental
PortabilityPOSIX
Safe HaskellNone
LanguageHaskell2010

Language.Nominal.Unify

Contents

Description

Unification by permutation

Synopsis

Documentation

>>> import Data.Set as S

newtype KRen s Source #

An element of KRen is either

  1. Just an injective finite map from KAtom to KAtom (for this file, call this a renaming), or
  2. A "nomap" value (Nothing).

A KRen represents a solution to the problem

does there exist a permutation that makes x equal to y?

A type in the KUnifyPerm typeclass is structurally guaranteed to give at most one solution to such a unification problem, up to renaming irrelevant atoms. So in a nutshell: names, lists, and tuples are good here, and functions (not an equality type) and sets (may have multiple solutions) are not good.

A Just value represents a solution to this unification problem; a Nothing value represents that no such solution can be found. unifyPerm calculates these solutions.

Constructors

Ren 

Fields

Instances
Typeable s => KRestrict s (KRen s) Source #

There are two reasonable notions of restriction; filter, or default to Nothing. We choose the option that discards minimal information, i.e. the filter.

Instance details

Defined in Language.Nominal.Unify

Methods

restrict :: [KAtom s] -> KRen s -> KRen s Source #

Typeable s => KSupport s (KRen s) Source #

Support of a renaming is the set of nontrivially mapped atoms

>>> (supp (idRen :: Ren)) == S.empty
True
>>> (supp (nothingRen :: Ren)) == S.empty
True
Instance details

Defined in Language.Nominal.Unify

Methods

ksupp :: proxy s -> KRen s -> Set (KAtom s) Source #

Eq (KRen s) Source #

Elements of KRen are compared for equality on their nub renNub, meaning just that identity mappings are ignored.

>>> a = exit $ freshAtom
>>> idRen == renExtend a a idRen
True 
Instance details

Defined in Language.Nominal.Unify

Methods

(==) :: KRen s -> KRen s -> Bool #

(/=) :: KRen s -> KRen s -> Bool #

Ord (KRen s) Source #

Elements of KRen are compared on their nub renNub, meaning just that identity mappings are ignored.

Instance details

Defined in Language.Nominal.Unify

Methods

compare :: KRen s -> KRen s -> Ordering #

(<) :: KRen s -> KRen s -> Bool #

(<=) :: KRen s -> KRen s -> Bool #

(>) :: KRen s -> KRen s -> Bool #

(>=) :: KRen s -> KRen s -> Bool #

max :: KRen s -> KRen s -> KRen s #

min :: KRen s -> KRen s -> KRen s #

Show (KRen s) Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

showsPrec :: Int -> KRen s -> ShowS #

show :: KRen s -> String #

showList :: [KRen s] -> ShowS #

Generic (KRen s) Source # 
Instance details

Defined in Language.Nominal.Unify

Associated Types

type Rep (KRen s) :: Type -> Type #

Methods

from :: KRen s -> Rep (KRen s) x #

to :: Rep (KRen s) x -> KRen s #

Semigroup (KRen s) Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

(<>) :: KRen s -> KRen s -> KRen s #

sconcat :: NonEmpty (KRen s) -> KRen s #

stimes :: Integral b => b -> KRen s -> KRen s #

Monoid (KRen s) Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

mempty :: KRen s #

mappend :: KRen s -> KRen s -> KRen s #

mconcat :: [KRen s] -> KRen s #

Typeable s => Swappable (KRen s) Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kswp :: Typeable s0 => KAtom s0 -> KAtom s0 -> KRen s -> KRen s Source #

type Rep (KRen s) Source # 
Instance details

Defined in Language.Nominal.Unify

type Rep (KRen s) = D1 (MetaData "KRen" "Language.Nominal.Unify" "nom-0.1.0.1-3UtpNOnqRlSC6EhVIia7SR" True) (C1 (MetaCons "Ren" PrefixI True) (S1 (MetaSel (Just "unRen") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe (Map (KAtom s) (KAtom s))))))

type Ren = KRen Tom Source #

Renaming on a Tom instance

idRen :: KRen s Source #

The identity renaming.

nothingRen :: KRen s Source #

The Nothing renaming. If we think of KRen s as type of solutions to permutation unification problems, then nothingRen indicates no solution could be found.

isJustRen :: KRen s -> Bool Source #

Is it Just a renaming? (My unification problem can be solved, and here's the solution.)

isNothingRen :: KRen s -> Bool Source #

Is it Nothing? (Nope; no solution exists.)

renNub :: KRen s -> KRen s Source #

The parts of the map that are not identity

renExtend :: KAtom s -> KAtom s -> KRen s -> KRen s Source #

Extend a renaming m with a new pair a -> b, maintaining the property of being a partial injection. If adding a->b would destroy partial injectivity, then return Nothing.

renToList :: KRen s -> Maybe [(KAtom s, KAtom s)] Source #

Extract the graph of a KRen, Maybe.

renFromList :: [(KAtom s, KAtom s)] -> KRen s Source #

Convert a graph to a KRen.

renRemoveBlock :: [KAtom s] -> KRen s -> KRen s Source #

Given a block of atoms, remove them from the map provided that the atoms in that block only map to other atoms within it; if an atom gets mapped across the block boundary, return Nothing.

Needed for equality instance of Chunk.

Unification up to a KRen

class KSupport s a => KUnifyPerm s a where Source #

Equal-up-to-permutation. The algorithm works very simply by traversing the element looking for atoms and when it finds them, trying to match them up. If it can do so injectively then it succeeds with Just a renaming; if it fails it returns Nothing.

Question: Granted that KUnifyPerm is a subset of KSupport, why are they not equal? Because for simplicity we only consider types for which at most one unifier can be found, by an efficient structural traversal. This avoids backtracking, and makes a kunifyPerm a function to KRen. So, a key difference is that KSupport can easily calculate the support of a set (unordered list without multiplicities) whereas KUnifyPerm does not even attempt to calculate unifiers of sets; not because this would be impossible, but because it would require a significant leap in complexity that we do not seem to need (so far).

Minimal complete definition

Nothing

Methods

kunifyPerm :: proxy s -> a -> a -> KRen s Source #

This calculates a solution to a unification problem

kunifyPerm :: (Generic a, GUnifyPerm s (Rep a)) => proxy s -> a -> a -> KRen s Source #

This calculates a solution to a unification problem

ren :: KRen s -> a -> a Source #

This applies a solution to a unification problem (represented as a renaming) to an element.

Note: ren is not just swapping. It traverses the structure of its argument performing an atom-for-atom renaming. In the case that its argument solves a unification problem, its effect is the same as if a permuatation were applied.

This is checked in iprop_fresh_ren and prop_unify_ren.

ren :: (Generic a, GUnifyPerm s (Rep a)) => KRen s -> a -> a Source #

This applies a solution to a unification problem (represented as a renaming) to an element.

Note: ren is not just swapping. It traverses the structure of its argument performing an atom-for-atom renaming. In the case that its argument solves a unification problem, its effect is the same as if a permuatation were applied.

This is checked in iprop_fresh_ren and prop_unify_ren.

Instances
Typeable s => KUnifyPerm s Char Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> Char -> Char -> KRen s Source #

ren :: KRen s -> Char -> Char Source #

Typeable s => KUnifyPerm s () Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> () -> () -> KRen s Source #

ren :: KRen s -> () -> () Source #

Typeable s => KUnifyPerm s Int Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> Int -> Int -> KRen s Source #

ren :: KRen s -> Int -> Int Source #

Typeable s => KUnifyPerm s Bool Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> Bool -> Bool -> KRen s Source #

ren :: KRen s -> Bool -> Bool Source #

(Typeable s, Typeable t) => KUnifyPerm s (KAtom t) Source #

Unify atoms

Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> KAtom t -> KAtom t -> KRen s Source #

ren :: KRen s -> KAtom t -> KAtom t Source #

KUnifyPerm s a => KUnifyPerm s (Maybe a) Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> Maybe a -> Maybe a -> KRen s Source #

ren :: KRen s -> Maybe a -> Maybe a Source #

KUnifyPerm s a => KUnifyPerm s (NonEmpty a) Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> NonEmpty a -> NonEmpty a -> KRen s Source #

ren :: KRen s -> NonEmpty a -> NonEmpty a Source #

KUnifyPerm s a => KUnifyPerm s [a] Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> [a] -> [a] -> KRen s Source #

ren :: KRen s -> [a] -> [a] Source #

(Typeable s, Eq a) => KUnifyPerm s (Nameless a) Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> Nameless a -> Nameless a -> KRen s Source #

ren :: KRen s -> Nameless a -> Nameless a Source #

UnifyPerm r => KUnifyPerm Tom (Input r) Source # 
Instance details

Defined in Language.Nominal.Examples.IdealisedEUTxO

Methods

kunifyPerm :: proxy Tom -> Input r -> Input r -> KRen Tom Source #

ren :: KRen Tom -> Input r -> Input r Source #

(Typeable s, KUnifyPerm s t, KUnifyPerm s a) => KUnifyPerm s (KAbs (KName s t) a) Source #

Unify Abs name-abstraction

Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> KAbs (KName s t) a -> KAbs (KName s t) a -> KRen s Source #

ren :: KRen s -> KAbs (KName s t) a -> KAbs (KName s t) a Source #

(Typeable s, KUnifyPerm s a) => KUnifyPerm s (KNom s a) Source #

Unify KNom abstractions. Unpack, unify, clean out fresh names

Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> KNom s a -> KNom s a -> KRen s Source #

ren :: KRen s -> KNom s a -> KNom s a Source #

(Typeable s, Typeable u, KUnifyPerm s t) => KUnifyPerm s (KName u t) Source #

Unify names: they behave just an atom-label tuple

Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> KName u t -> KName u t -> KRen s Source #

ren :: KRen s -> KName u t -> KName u t Source #

(KUnifyPerm s a, KUnifyPerm s b) => KUnifyPerm s (Either a b) Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> Either a b -> Either a b -> KRen s Source #

ren :: KRen s -> Either a b -> Either a b Source #

(KUnifyPerm s a, KUnifyPerm s b) => KUnifyPerm s (a, b) Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> (a, b) -> (a, b) -> KRen s Source #

ren :: KRen s -> (a, b) -> (a, b) Source #

(UnifyPerm r, UnifyPerm d) => KUnifyPerm Tom (ValFin r d) Source # 
Instance details

Defined in Language.Nominal.Examples.IdealisedEUTxO

Methods

kunifyPerm :: proxy Tom -> ValFin r d -> ValFin r d -> KRen Tom Source #

ren :: KRen Tom -> ValFin r d -> ValFin r d Source #

KUnifyPerm Tom (ValTriv r d) Source # 
Instance details

Defined in Language.Nominal.Examples.IdealisedEUTxO

Methods

kunifyPerm :: proxy Tom -> ValTriv r d -> ValTriv r d -> KRen Tom Source #

ren :: KRen Tom -> ValTriv r d -> ValTriv r d Source #

(UnifyPerm d, UnifyPerm v) => KUnifyPerm Tom (Output d v) Source # 
Instance details

Defined in Language.Nominal.Examples.IdealisedEUTxO

Methods

kunifyPerm :: proxy Tom -> Output d v -> Output d v -> KRen Tom Source #

ren :: KRen Tom -> Output d v -> Output d v Source #

(KUnifyPerm s a, KUnifyPerm s b, KUnifyPerm s c) => KUnifyPerm s (a, b, c) Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> (a, b, c) -> (a, b, c) -> KRen s Source #

ren :: KRen s -> (a, b, c) -> (a, b, c) Source #

(KUnifyPerm s a, KUnifyPerm s b, Eq b) => KUnifyPerm s (KEvFinMap s a b) Source # 
Instance details

Defined in Language.Nominal.Equivar

Methods

kunifyPerm :: proxy s -> KEvFinMap s a b -> KEvFinMap s a b -> KRen s Source #

ren :: KRen s -> KEvFinMap s a b -> KEvFinMap s a b Source #

(UnifyPerm r, UnifyPerm d, UnifyPerm v) => KUnifyPerm Tom (Blockchain r d v) Source # 
Instance details

Defined in Language.Nominal.Examples.IdealisedEUTxO

Methods

kunifyPerm :: proxy Tom -> Blockchain r d v -> Blockchain r d v -> KRen Tom Source #

ren :: KRen Tom -> Blockchain r d v -> Blockchain r d v Source #

(UnifyPerm r, UnifyPerm d, UnifyPerm v) => KUnifyPerm Tom (Chunk r d v) Source # 
Instance details

Defined in Language.Nominal.Examples.IdealisedEUTxO

Methods

kunifyPerm :: proxy Tom -> Chunk r d v -> Chunk r d v -> KRen Tom Source #

ren :: KRen Tom -> Chunk r d v -> Chunk r d v Source #

(UnifyPerm d, UnifyPerm r, UnifyPerm v) => KUnifyPerm Tom (Context r d v) Source # 
Instance details

Defined in Language.Nominal.Examples.IdealisedEUTxO

Methods

kunifyPerm :: proxy Tom -> Context r d v -> Context r d v -> KRen Tom Source #

ren :: KRen Tom -> Context r d v -> Context r d v Source #

(UnifyPerm d, UnifyPerm r, UnifyPerm v) => KUnifyPerm Tom (Transaction r d v) Source # 
Instance details

Defined in Language.Nominal.Examples.IdealisedEUTxO

Methods

kunifyPerm :: proxy Tom -> Transaction r d v -> Transaction r d v -> KRen Tom Source #

ren :: KRen Tom -> Transaction r d v -> Transaction r d v Source #

(KUnifyPerm s a, KUnifyPerm s b, KUnifyPerm s c, KUnifyPerm s d) => KUnifyPerm s (a, b, c, d) Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> (a, b, c, d) -> (a, b, c, d) -> KRen s Source #

ren :: KRen s -> (a, b, c, d) -> (a, b, c, d) Source #

(KUnifyPerm s a, KUnifyPerm s b, KUnifyPerm s c, KUnifyPerm s d, KUnifyPerm s e) => KUnifyPerm s (a, b, c, d, e) Source # 
Instance details

Defined in Language.Nominal.Unify

Methods

kunifyPerm :: proxy s -> (a, b, c, d, e) -> (a, b, c, d, e) -> KRen s Source #

ren :: KRen s -> (a, b, c, d, e) -> (a, b, c, d, e) Source #

type UnifyPerm = KUnifyPerm Tom Source #

Tom-instance of typeclass KUnifyPerm.

unifyPerm :: UnifyPerm a => a -> a -> Ren Source #

Unify on KAtoms, thus Tom-instance of kunifyPerm.

kunifiablePerm :: KUnifyPerm s a => proxy s -> a -> a -> Bool Source #

Does an s-unifier exist?

We write proxy instead of Proxy for the user's convenience, so the user can take advantage of any type that mentions s.

unifiablePerm :: UnifyPerm a => a -> a -> Bool Source #

Does a Tom-unifier exist?

Special case: unifying prefixes of lists

kevPrefixRen :: KUnifyPerm s a => proxy s -> [a] -> [a] -> KRen s Source #

Unify a list with a prefix of the other

evPrefixRen :: UnifyPerm a => [a] -> [a] -> Ren Source #

Unify a list with a prefix of the other (at Tom version).

kevIsPrefix :: forall s proxy a. KUnifyPerm s a => proxy s -> [a] -> [a] -> Bool Source #

One list unifies with a prefix of the other

evIsPrefix :: UnifyPerm a => [a] -> [a] -> Bool Source #

One list unifies with a prefix of the other (at Tom version).

Tests

Property-based tests are in Language.Nominal.Properties.UnifySpec.