Copyright | (c) Murdoch J. Gabbay 2020 |
---|---|
License | GPL-3 |
Maintainer | murdoch.gabbay@gmail.com |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Language | Haskell2010 |
Synopsis
- class (Typeable s, Swappable a) => KSupport s a where
- type Support a = KSupport Tom a
- supp :: Support a => a -> Set Atom
- kapart :: (KSupport s a, KSupport s b) => proxy s -> a -> b -> Bool
- apart :: (Support a, Support b) => a -> b -> Bool
- atomPoint :: (Foldable f, KSupport s a) => KAtom s -> f a -> NonEmpty a
- namePoint :: (Foldable f, KSupport s a) => KName s t -> f a -> NonEmpty a
- class (Typeable s, Swappable a) => KRestrict s a where
- type Restrict = KRestrict Tom
- restrictN :: KRestrict s a => [KName s t] -> a -> a
Support and apartness
class (Typeable s, Swappable a) => KSupport s a where Source #
A typeclass for elements for which a supporting set of atoms can be computed in an efficient, structural, type-directed manner.
So: lists, sets, and name-abstractions yes, and function-types no. See instances for full details.
Note: This gives KSupport
a strictly more specific and structure-directed meaning than the motivating mathematical notion of support, which does work e.g. on function-types.
Nothing
ksupp :: proxy s -> a -> Set (KAtom s) Source #
ksupp :: (Generic a, GSupport s (Rep a)) => proxy s -> a -> Set (KAtom s) Source #
Instances
Typeable s => KSupport s Int Source # | |
Typeable s => KSupport s Char Source # | |
Typeable s => KSupport s Bool Source # | |
Typeable s => KSupport s () Source # | |
(Ord a, KSupport s a) => KSupport s (Set a) Source # | |
KSupport s a => KSupport s (NonEmpty a) Source # | |
KSupport s a => KSupport s [a] Source # | |
KSupport s a => KSupport s (Maybe a) Source # | |
(Typeable s, Typeable t) => KSupport s (KAtom t) Source # | |
Typeable s => KSupport s (Nameless a) Source # | |
(Binder ctxbody ctx body s, KSupport s ctx, KSupport s body) => KSupport s (BinderSupp ctxbody) Source # | |
Defined in Language.Nominal.Binder | |
Typeable s => KSupport s (KRen s) Source # | Support of a renaming is the set of nontrivially mapped atoms
|
Support r => KSupport Tom (Input r) Source # | |
(KSupport s a, KSupport s b) => KSupport s (Either a b) Source # | |
(KSupport s a, KSupport s b) => KSupport s (a, b) Source # | |
(Typeable s, Typeable u, KSupport s t) => KSupport s (KName u t) Source # | |
(KSupport t a, Typeable s) => KSupport t (KNom s a) Source # | |
(KSupport s a, KSupport s t) => KSupport s (KAbs (KName s t) a) Source # | Support of a :@> x is the support of x minus a |
KSupport Tom (ValFin r d) Source # | |
KSupport Tom (Val r d) Source # | |
KSupport Tom (ValTriv r d) Source # | |
(Support d, Support v) => KSupport Tom (Output d v) Source # | |
(KSupport s a, KSupport s b, KSupport s c) => KSupport s (a, b, c) Source # | |
(Typeable s, Swappable a, Swappable b) => KSupport s (KEvFinMap s a b) Source # | We insist Operationally, we don't care: if see something of type |
(Typeable s, Swappable a, Swappable b) => KSupport s (KEvFun s a b) Source # | |
(Support r, Support d, Support v) => KSupport Tom (Blockchain r d v) Source # | |
Defined in Language.Nominal.Examples.IdealisedEUTxO | |
(Support r, Support d, Support v) => KSupport Tom (Chunk r d v) Source # | |
(Support d, Support r, Support v) => KSupport Tom (Context r d v) Source # | |
(Support d, Support r, Support v) => KSupport Tom (Transaction r d v) Source # | |
Defined in Language.Nominal.Examples.IdealisedEUTxO | |
(KSupport s a, KSupport s b, KSupport s c, KSupport s d) => KSupport s (a, b, c, d) Source # | |
(KSupport s a, KSupport s b, KSupport s c, KSupport s d, KSupport s e) => KSupport s (a, b, c, d, e) Source # | |
apart :: (Support a, Support b) => a -> b -> Bool Source #
a
and b
are apart
when they are supported by disjoint sets of atoms.
Identifying list elements by name or atom
atomPoint :: (Foldable f, KSupport s a) => KAtom s -> f a -> NonEmpty a Source #
Bring the first element of a list-like structure that an atom points to (by being mentioned in the support), and put it at the head of the nonempty list. Raises error if no such element exists.
Restriction
class (Typeable s, Swappable a) => KRestrict s a where Source #
Class for types that support a remove these atoms from my support, please operation. Should satisfy e.g.:
restrict atms $ restrict atms x == restrict atms x
atms `apart` x ==> restrict atms x == x
The canonical instance of
is KRestrict
.
The Nom
constraint is not necessary for the code to run, but in practice wherever we use Swappable
we expect the type to have a swapping action.KRestrict
Note for experts: We may want
without KRestrict
, for example to work with KSupport
Nom (Atom -> Atom)
.
Note for experts: Restriction is familiar in general terms (e.g. pi-calculus restriction). In a nominal context, the original paper is nominal rewriting with name-generation (author's pdf), and this has a for-us highly pertinent emphasis on unification and rewriting.
Instances
Typeable s => KRestrict s Char Source # | |
Typeable s => KRestrict s () Source # | |
Defined in Language.Nominal.NameSet | |
Typeable s => KRestrict s Int Source # | |
Typeable s => KRestrict s Bool Source # | |
(Ord a, KSupport s a) => KRestrict s (Set a) Source # | Eliminate elements for which any of the |
KSupport s a => KRestrict s [a] Source # | On lists, Restrict traverses the list and eliminate elements for which any of the A alternative is to assume restriction on the underlying elements and restrict pointwise. The elimination choice seems more useful in practice. |
Defined in Language.Nominal.NameSet | |
KRestrict s a => KRestrict s (Maybe a) Source # | Restriction is monadic on Maybe |
Typeable s => KRestrict s (Nameless a) Source # | Restriction is trivial on elements of nameless types |
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, Swappable a, KRestrict t a) => KRestrict t (KNom s a) Source # | |
(Typeable s, Swappable a) => KRestrict s (KNom s a) Source # | |
KRestrict Tom (ValFin r d) Source # | |
KRestrict Tom (Val r d) Source # | |
(Swappable r, Swappable d, Swappable v) => KRestrict Tom (Chunk r d v) Source # | Restrict atoms in a |
restrictN :: KRestrict s a => [KName s t] -> a -> a Source #
Form of restriction that takes names instead of atoms. Just discards name labels and calls
.restrict
Tests
Property-based tests are in Language.Nominal.Properties.NameSetSpec.