mirror of
https://github.com/Jaxan/ons-hs.git
synced 2025-04-27 14:47:45 +02:00
Small cleanup
This commit is contained in:
parent
3df9e273bf
commit
df645433d3
5 changed files with 25 additions and 29 deletions
|
@ -62,19 +62,21 @@ doubleWordAut n = Automaton {..} where
|
||||||
|
|
||||||
|
|
||||||
-- alphetbet for the Fifo queue example
|
-- alphetbet for the Fifo queue example
|
||||||
data Fifo = Put Atom | Get Atom
|
data FifoA = Put Atom | Get Atom
|
||||||
deriving (Eq, Ord, Show, GHC.Generic)
|
deriving (Eq, Ord, Show, GHC.Generic)
|
||||||
deriving Nominal via Generic Fifo
|
deriving Nominal via Generic FifoA
|
||||||
|
|
||||||
instance ToStr Fifo where
|
instance ToStr FifoA where
|
||||||
toStr (Put a) = "Put " ++ toStr a
|
toStr (Put a) = "Put " ++ toStr a
|
||||||
toStr (Get a) = "Get " ++ toStr a
|
toStr (Get a) = "Get " ++ toStr a
|
||||||
|
|
||||||
instance FromStr Fifo where
|
instance FromStr FifoA where
|
||||||
fromStr ('P':'u':'t':' ':a) = let (x, r) = fromStr a in (Put x, r)
|
fromStr ('P':'u':'t':' ':a) = let (x, r) = fromStr a in (Put x, r)
|
||||||
fromStr ('G':'e':'t':' ':a) = let (x, r) = fromStr a in (Get x, r)
|
fromStr ('G':'e':'t':' ':a) = let (x, r) = fromStr a in (Get x, r)
|
||||||
fromStr _ = error "Cannot parse Fifo"
|
fromStr _ = error "Cannot parse Fifo"
|
||||||
|
|
||||||
|
fifoAlph = map Put rationals <> map Get rationals
|
||||||
|
|
||||||
data FifoS = FifoS [Atom] [Atom]
|
data FifoS = FifoS [Atom] [Atom]
|
||||||
deriving (Eq, Ord, GHC.Generic)
|
deriving (Eq, Ord, GHC.Generic)
|
||||||
deriving Nominal via Generic FifoS
|
deriving Nominal via Generic FifoS
|
||||||
|
@ -82,8 +84,6 @@ data FifoS = FifoS [Atom] [Atom]
|
||||||
instance ToStr FifoS where
|
instance ToStr FifoS where
|
||||||
toStr (FifoS l1 l2) = "F " ++ toStr l1 ++ " - " ++ toStr l2
|
toStr (FifoS l1 l2) = "F " ++ toStr l1 ++ " - " ++ toStr l2
|
||||||
|
|
||||||
fifoAlph = map Put rationals <> map Get rationals
|
|
||||||
|
|
||||||
fifoAut n = Automaton {..} where
|
fifoAut n = Automaton {..} where
|
||||||
states0 = filter (\(FifoS l1 l2) -> length l1 + length l2 <= n) $ productWith (\l1 l2 -> FifoS l1 l2) (words n) (words n)
|
states0 = filter (\(FifoS l1 l2) -> length l1 + length l2 <= n) $ productWith (\l1 l2 -> FifoS l1 l2) (words n) (words n)
|
||||||
states = fromList [Nothing] <> map Just states0
|
states = fromList [Nothing] <> map Just states0
|
||||||
|
|
|
@ -28,8 +28,10 @@ import Support
|
||||||
-- Very similar to EquivariantSet, but then the map analogue. The important
|
-- Very similar to EquivariantSet, but then the map analogue. The important
|
||||||
-- thing is that we have to store which values are preserved under a map. This
|
-- thing is that we have to store which values are preserved under a map. This
|
||||||
-- is done with the list of bit vector. Otherwise, it is an orbit-wise
|
-- is done with the list of bit vector. Otherwise, it is an orbit-wise
|
||||||
-- representation, just like sets.
|
-- representation, just like sets. This action is trivial, since equivariant
|
||||||
|
-- maps are equivariant.
|
||||||
newtype EquivariantMap k v = EqMap { unEqMap :: Map (Orbit k) (Orbit v, [Bool]) }
|
newtype EquivariantMap k v = EqMap { unEqMap :: Map (Orbit k) (Orbit v, [Bool]) }
|
||||||
|
deriving Nominal via Trivial (EquivariantMap k v)
|
||||||
|
|
||||||
-- Need undecidableIntances for this
|
-- Need undecidableIntances for this
|
||||||
deriving instance (Eq (Orbit k), Eq (Orbit v)) => Eq (EquivariantMap k v)
|
deriving instance (Eq (Orbit k), Eq (Orbit v)) => Eq (EquivariantMap k v)
|
||||||
|
@ -41,9 +43,6 @@ deriving instance (Show (Orbit k), Show (Orbit v)) => Show (EquivariantMap k v)
|
||||||
deriving instance Ord (Orbit k) => Monoid (EquivariantMap k v)
|
deriving instance Ord (Orbit k) => Monoid (EquivariantMap k v)
|
||||||
deriving instance Ord (Orbit k) => Semigroup (EquivariantMap k v)
|
deriving instance Ord (Orbit k) => Semigroup (EquivariantMap k v)
|
||||||
|
|
||||||
-- This action is trivial, since equivariant maps are equivariant
|
|
||||||
deriving via (Trivial (EquivariantMap k v)) instance Nominal (EquivariantMap k v)
|
|
||||||
|
|
||||||
|
|
||||||
-- Query
|
-- Query
|
||||||
|
|
||||||
|
|
|
@ -22,8 +22,10 @@ import OrbitList (OrbitList(..))
|
||||||
-- represented. Although internally it is just a set of orbits, the interface
|
-- represented. Although internally it is just a set of orbits, the interface
|
||||||
-- will always work directly with elements. This way we model infinite sets.
|
-- will always work directly with elements. This way we model infinite sets.
|
||||||
-- Note that functions such as toList do not return an ordered list since the
|
-- Note that functions such as toList do not return an ordered list since the
|
||||||
-- representatives are chosen arbitrarily.
|
-- representatives are chosen arbitrarily. This action is trivial, since
|
||||||
|
-- equivariant sets are equivariant :-).
|
||||||
newtype EquivariantSet a = EqSet { unEqSet :: Set (Orbit a) }
|
newtype EquivariantSet a = EqSet { unEqSet :: Set (Orbit a) }
|
||||||
|
deriving Nominal via Trivial (EquivariantSet a)
|
||||||
|
|
||||||
-- Need undecidableIntances for this
|
-- Need undecidableIntances for this
|
||||||
deriving instance Eq (Orbit a) => Eq (EquivariantSet a)
|
deriving instance Eq (Orbit a) => Eq (EquivariantSet a)
|
||||||
|
@ -35,9 +37,6 @@ deriving instance Show (Orbit a) => Show (EquivariantSet a)
|
||||||
deriving instance Ord (Orbit a) => Monoid (EquivariantSet a)
|
deriving instance Ord (Orbit a) => Monoid (EquivariantSet a)
|
||||||
deriving instance Ord (Orbit a) => Semigroup (EquivariantSet a)
|
deriving instance Ord (Orbit a) => Semigroup (EquivariantSet a)
|
||||||
|
|
||||||
-- This action is trivial, since equivariant sets are equivariant
|
|
||||||
deriving via (Trivial (EquivariantSet a)) instance Nominal (EquivariantSet a)
|
|
||||||
|
|
||||||
|
|
||||||
-- Query
|
-- Query
|
||||||
|
|
||||||
|
|
|
@ -87,12 +87,12 @@ instance Nominal (Trivial a) where
|
||||||
|
|
||||||
-- We can now define trivial instances for some basic types. (Some of these
|
-- We can now define trivial instances for some basic types. (Some of these
|
||||||
-- could equivalently be derived with generics.)
|
-- could equivalently be derived with generics.)
|
||||||
deriving via (Trivial Void) instance Nominal Void
|
deriving via Trivial Void instance Nominal Void
|
||||||
deriving via (Trivial ()) instance Nominal ()
|
deriving via Trivial () instance Nominal ()
|
||||||
deriving via (Trivial Bool) instance Nominal Bool
|
deriving via Trivial Bool instance Nominal Bool
|
||||||
deriving via (Trivial Char) instance Nominal Char
|
deriving via Trivial Char instance Nominal Char
|
||||||
deriving via (Trivial Int) instance Nominal Int -- NB: Trivial instance!
|
deriving via Trivial Int instance Nominal Int -- NB: Trivial instance!
|
||||||
deriving via (Trivial Ordering) instance Nominal Ordering
|
deriving via Trivial Ordering instance Nominal Ordering
|
||||||
|
|
||||||
|
|
||||||
-- The generic instance unfolds the algebraic data type in sums and products,
|
-- The generic instance unfolds the algebraic data type in sums and products,
|
||||||
|
@ -107,14 +107,12 @@ instance (GHC.Generic a, GNominal (Rep a)) => Nominal (Generic a) where
|
||||||
|
|
||||||
|
|
||||||
-- Some instances we can derive via generics
|
-- Some instances we can derive via generics
|
||||||
deriving via (Generic (a, b)) instance (Nominal a, Nominal b) => Nominal (a, b)
|
deriving via Generic (a, b) instance (Nominal a, Nominal b) => Nominal (a, b)
|
||||||
deriving via (Generic (a, b, c)) instance (Nominal a, Nominal b, Nominal c) => Nominal (a, b, c)
|
deriving via Generic (a, b, c) instance (Nominal a, Nominal b, Nominal c) => Nominal (a, b, c)
|
||||||
deriving via (Generic (a, b, c, d)) instance (Nominal a, Nominal b, Nominal c, Nominal d) => Nominal (a, b, c, d)
|
deriving via Generic (a, b, c, d) instance (Nominal a, Nominal b, Nominal c, Nominal d) => Nominal (a, b, c, d)
|
||||||
|
deriving via Generic (Either a b) instance (Nominal a, Nominal b) => Nominal (Either a b)
|
||||||
deriving via (Generic (Either a b)) instance (Nominal a, Nominal b) => Nominal (Either a b)
|
deriving via Generic [a] instance Nominal a => Nominal [a]
|
||||||
|
deriving via Generic (Maybe a) instance Nominal a => Nominal (Maybe a)
|
||||||
deriving via (Generic [a]) instance Nominal a => Nominal [a]
|
|
||||||
deriving via (Generic (Maybe a)) instance Nominal a => Nominal (Maybe a)
|
|
||||||
|
|
||||||
|
|
||||||
-- Generic class, so that custom data types can be derived
|
-- Generic class, so that custom data types can be derived
|
||||||
|
|
|
@ -18,11 +18,11 @@ import Support (Rat(..))
|
||||||
-- Similar to EquivariantSet, but merely a list structure. It is an
|
-- Similar to EquivariantSet, but merely a list structure. It is an
|
||||||
-- equivariant data type, so the Nominal instance is trivial.
|
-- equivariant data type, so the Nominal instance is trivial.
|
||||||
newtype OrbitList a = OrbitList { unOrbitList :: [Orbit a] }
|
newtype OrbitList a = OrbitList { unOrbitList :: [Orbit a] }
|
||||||
|
deriving Nominal via Trivial (OrbitList a)
|
||||||
|
|
||||||
deriving instance Eq (Orbit a) => Eq (OrbitList a)
|
deriving instance Eq (Orbit a) => Eq (OrbitList a)
|
||||||
deriving instance Ord (Orbit a) => Ord (OrbitList a)
|
deriving instance Ord (Orbit a) => Ord (OrbitList a)
|
||||||
deriving instance Show (Orbit a) => Show (OrbitList a)
|
deriving instance Show (Orbit a) => Show (OrbitList a)
|
||||||
deriving via (Trivial (OrbitList a)) instance Nominal (OrbitList a)
|
|
||||||
|
|
||||||
-- Simply concatenation of the list
|
-- Simply concatenation of the list
|
||||||
deriving instance Semigroup (OrbitList a)
|
deriving instance Semigroup (OrbitList a)
|
||||||
|
|
Loading…
Add table
Reference in a new issue