Copyright | (c) Murdoch J. Gabbay 2020 |
---|---|
License | GPL-3 |
Maintainer | murdoch.gabbay@gmail.com |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Language | Haskell2010 |
Unification by permutation
Synopsis
- newtype KRen s = Ren {}
- type Ren = KRen Tom
- idRen :: KRen s
- nothingRen :: KRen s
- isJustRen :: KRen s -> Bool
- isNothingRen :: KRen s -> Bool
- renNub :: KRen s -> KRen s
- renExtend :: KAtom s -> KAtom s -> KRen s -> KRen s
- renToList :: KRen s -> Maybe [(KAtom s, KAtom s)]
- renFromList :: [(KAtom s, KAtom s)] -> KRen s
- renRemoveBlock :: [KAtom s] -> KRen s -> KRen s
- class KSupport s a => KUnifyPerm s a where
- kunifyPerm :: proxy s -> a -> a -> KRen s
- ren :: KRen s -> a -> a
- type UnifyPerm = KUnifyPerm Tom
- unifyPerm :: UnifyPerm a => a -> a -> Ren
- kunifiablePerm :: KUnifyPerm s a => proxy s -> a -> a -> Bool
- unifiablePerm :: UnifyPerm a => a -> a -> Bool
- kevPrefixRen :: KUnifyPerm s a => proxy s -> [a] -> [a] -> KRen s
- evPrefixRen :: UnifyPerm a => [a] -> [a] -> Ren
- kevIsPrefix :: forall s proxy a. KUnifyPerm s a => proxy s -> [a] -> [a] -> Bool
- evIsPrefix :: UnifyPerm a => [a] -> [a] -> Bool
Documentation
>>>
import Data.Set as S
An element of KRen
is either
Just
an injective finite map fromKAtom
toKAtom
(for this file, call this a renaming), or- 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
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.KUnifyPerm
A Just
value represents a solution to this unification problem; a Nothing
value represents that no such solution can be found.
calculates these solutions. unifyPerm
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. |
Typeable s => KSupport s (KRen s) Source # | Support of a renaming is the set of nontrivially mapped atoms
|
Eq (KRen s) Source # | Elements of
|
Ord (KRen s) Source # | Elements of |
Show (KRen s) Source # | |
Generic (KRen s) Source # | |
Semigroup (KRen s) Source # | |
Monoid (KRen s) Source # | |
Typeable s => Swappable (KRen s) Source # | |
type Rep (KRen s) Source # | |
nothingRen :: KRen s Source #
The Nothing renaming. If we think of
as type of solutions to permutation unification problems, then KRen
s
indicates no solution could be found. nothingRen
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.)
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
.
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
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
a renaming; if it fails it returns Just
. 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).
Nothing
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:
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.ren
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:
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.ren
This is checked in iprop_fresh_ren
and prop_unify_ren
.
Instances
type UnifyPerm = KUnifyPerm Tom Source #
Tom
-instance of typeclass 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
.
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
version). Tom
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
version). Tom
Tests
Property-based tests are in Language.Nominal.Properties.UnifySpec.