{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-|
originally from Autotool (https://gitlab.imn.htwk-leipzig.de/autotool/all0)
based on revision: ad25a990816a162fdd13941ff889653f22d6ea0a
based on file: collection/src/Petri/Type.hs
-}
module Modelling.PetriNet.Reach.Type where

import qualified Data.Map                         as M (
  filter,
  findWithDefault,
  fromList,
  lookup,
  mapKeys,
  toList,
  )
import qualified Data.Set                         as S (
  fromList,
  isSubsetOf,
  map,
  )

import Modelling.Auxiliary.Common       (parseInt, skipSpaces)

import Control.Monad                    (void)
import Data.Data                        (Data)
import Data.List                        (intercalate)
import Data.Map                         (Map)
import Data.Set                         (Set)
import Data.Typeable                    (Typeable)
import GHC.Generics                     (Generic)
import Text.ParserCombinators.Parsec (
  Parser,
  char,
  optional,
  sepBy,
  skipMany,
  space,
  )

type Connection s t = ([s], t, [s])

newtype State s = State {forall s. State s -> Map s Int
unState :: Map s Int}
  deriving ((forall x. State s -> Rep (State s) x)
-> (forall x. Rep (State s) x -> State s) -> Generic (State s)
forall x. Rep (State s) x -> State s
forall x. State s -> Rep (State s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s x. Rep (State s) x -> State s
forall s x. State s -> Rep (State s) x
$cfrom :: forall s x. State s -> Rep (State s) x
from :: forall x. State s -> Rep (State s) x
$cto :: forall s x. Rep (State s) x -> State s
to :: forall x. Rep (State s) x -> State s
Generic, Typeable, Typeable (State s)
Typeable (State s)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> State s -> c (State s))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (State s))
-> (State s -> Constr)
-> (State s -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (State s)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (State s)))
-> ((forall b. Data b => b -> b) -> State s -> State s)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> State s -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> State s -> r)
-> (forall u. (forall d. Data d => d -> u) -> State s -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> State s -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> State s -> m (State s))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> State s -> m (State s))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> State s -> m (State s))
-> Data (State s)
State s -> Constr
State s -> DataType
(forall b. Data b => b -> b) -> State s -> State s
forall {s}. (Data s, Ord s) => Typeable (State s)
forall s. (Data s, Ord s) => State s -> Constr
forall s. (Data s, Ord s) => State s -> DataType
forall s.
(Data s, Ord s) =>
(forall b. Data b => b -> b) -> State s -> State s
forall s u.
(Data s, Ord s) =>
Int -> (forall d. Data d => d -> u) -> State s -> u
forall s u.
(Data s, Ord s) =>
(forall d. Data d => d -> u) -> State s -> [u]
forall s r r'.
(Data s, Ord s) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> State s -> r
forall s r r'.
(Data s, Ord s) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> State s -> r
forall s (m :: * -> *).
(Data s, Ord s, Monad m) =>
(forall d. Data d => d -> m d) -> State s -> m (State s)
forall s (m :: * -> *).
(Data s, Ord s, MonadPlus m) =>
(forall d. Data d => d -> m d) -> State s -> m (State s)
forall s (c :: * -> *).
(Data s, Ord s) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (State s)
forall s (c :: * -> *).
(Data s, Ord s) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> State s -> c (State s)
forall s (t :: * -> *) (c :: * -> *).
(Data s, Ord s, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (State s))
forall s (t :: * -> * -> *) (c :: * -> *).
(Data s, Ord s, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (State s))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> State s -> u
forall u. (forall d. Data d => d -> u) -> State s -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> State s -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> State s -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> State s -> m (State s)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> State s -> m (State s)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (State s)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> State s -> c (State s)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (State s))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (State s))
$cgfoldl :: forall s (c :: * -> *).
(Data s, Ord s) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> State s -> c (State s)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> State s -> c (State s)
$cgunfold :: forall s (c :: * -> *).
(Data s, Ord s) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (State s)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (State s)
$ctoConstr :: forall s. (Data s, Ord s) => State s -> Constr
toConstr :: State s -> Constr
$cdataTypeOf :: forall s. (Data s, Ord s) => State s -> DataType
dataTypeOf :: State s -> DataType
$cdataCast1 :: forall s (t :: * -> *) (c :: * -> *).
(Data s, Ord s, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (State s))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (State s))
$cdataCast2 :: forall s (t :: * -> * -> *) (c :: * -> *).
(Data s, Ord s, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (State s))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (State s))
$cgmapT :: forall s.
(Data s, Ord s) =>
(forall b. Data b => b -> b) -> State s -> State s
gmapT :: (forall b. Data b => b -> b) -> State s -> State s
$cgmapQl :: forall s r r'.
(Data s, Ord s) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> State s -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> State s -> r
$cgmapQr :: forall s r r'.
(Data s, Ord s) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> State s -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> State s -> r
$cgmapQ :: forall s u.
(Data s, Ord s) =>
(forall d. Data d => d -> u) -> State s -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> State s -> [u]
$cgmapQi :: forall s u.
(Data s, Ord s) =>
Int -> (forall d. Data d => d -> u) -> State s -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> State s -> u
$cgmapM :: forall s (m :: * -> *).
(Data s, Ord s, Monad m) =>
(forall d. Data d => d -> m d) -> State s -> m (State s)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> State s -> m (State s)
$cgmapMp :: forall s (m :: * -> *).
(Data s, Ord s, MonadPlus m) =>
(forall d. Data d => d -> m d) -> State s -> m (State s)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> State s -> m (State s)
$cgmapMo :: forall s (m :: * -> *).
(Data s, Ord s, MonadPlus m) =>
(forall d. Data d => d -> m d) -> State s -> m (State s)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> State s -> m (State s)
Data)

mapState :: Ord b => (a -> b) -> State a -> State b
mapState :: forall b a. Ord b => (a -> b) -> State a -> State b
mapState a -> b
f (State Map a Int
x) = State { unState :: Map b Int
unState = (a -> b) -> Map a Int -> Map b Int
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys a -> b
f Map a Int
x }

instance Ord s => Eq (State s) where
  State Map s Int
f == :: State s -> State s -> Bool
== State Map s Int
g = (Int -> Bool) -> Map s Int -> Map s Int
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) Map s Int
f Map s Int -> Map s Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int -> Bool) -> Map s Int -> Map s Int
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) Map s Int
g

instance Ord s => Ord (State s) where
  compare :: State s -> State s -> Ordering
compare (State Map s Int
f) (State Map s Int
g) =
    Map s Int -> Map s Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Int -> Bool) -> Map s Int -> Map s Int
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) Map s Int
f) ((Int -> Bool) -> Map s Int -> Map s Int
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) Map s Int
g)

instance Show s => Show (State s) where
  show :: State s -> String
show = [(s, Int)] -> String
forall a. Show a => a -> String
show ([(s, Int)] -> String)
-> (State s -> [(s, Int)]) -> State s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map s Int -> [(s, Int)]
forall k a. Map k a -> [(k, a)]
M.toList (Map s Int -> [(s, Int)])
-> (State s -> Map s Int) -> State s -> [(s, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State s -> Map s Int
forall s. State s -> Map s Int
unState

instance (Ord s, Read s) => Read (State s) where
  readsPrec :: Int -> ReadS (State s)
readsPrec Int
p String
xs = do
    ([(s, Int)]
s, String
ys) <- Int -> ReadS [(s, Int)]
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
xs
    (State s, String) -> [(State s, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Map s Int -> State s
forall s. Map s Int -> State s
State (Map s Int -> State s)
-> ([(s, Int)] -> Map s Int) -> [(s, Int)] -> State s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(s, Int)] -> Map s Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(s, Int)] -> State s) -> [(s, Int)] -> State s
forall a b. (a -> b) -> a -> b
$ [(s, Int)]
s, String
ys)

mark :: Ord s => State s -> s -> Int
mark :: forall s. Ord s => State s -> s -> Int
mark (State Map s Int
f) s
s = Int -> s -> Map s Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Int
0 s
s Map s Int
f

data Capacity s
  = Unbounded
  | AllBounded Int
  | Bounded (Map s Int)
  deriving (Capacity s -> Capacity s -> Bool
(Capacity s -> Capacity s -> Bool)
-> (Capacity s -> Capacity s -> Bool) -> Eq (Capacity s)
forall s. Eq s => Capacity s -> Capacity s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall s. Eq s => Capacity s -> Capacity s -> Bool
== :: Capacity s -> Capacity s -> Bool
$c/= :: forall s. Eq s => Capacity s -> Capacity s -> Bool
/= :: Capacity s -> Capacity s -> Bool
Eq, (forall x. Capacity s -> Rep (Capacity s) x)
-> (forall x. Rep (Capacity s) x -> Capacity s)
-> Generic (Capacity s)
forall x. Rep (Capacity s) x -> Capacity s
forall x. Capacity s -> Rep (Capacity s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s x. Rep (Capacity s) x -> Capacity s
forall s x. Capacity s -> Rep (Capacity s) x
$cfrom :: forall s x. Capacity s -> Rep (Capacity s) x
from :: forall x. Capacity s -> Rep (Capacity s) x
$cto :: forall s x. Rep (Capacity s) x -> Capacity s
to :: forall x. Rep (Capacity s) x -> Capacity s
Generic, Eq (Capacity s)
Eq (Capacity s)
-> (Capacity s -> Capacity s -> Ordering)
-> (Capacity s -> Capacity s -> Bool)
-> (Capacity s -> Capacity s -> Bool)
-> (Capacity s -> Capacity s -> Bool)
-> (Capacity s -> Capacity s -> Bool)
-> (Capacity s -> Capacity s -> Capacity s)
-> (Capacity s -> Capacity s -> Capacity s)
-> Ord (Capacity s)
Capacity s -> Capacity s -> Bool
Capacity s -> Capacity s -> Ordering
Capacity s -> Capacity s -> Capacity s
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {s}. Ord s => Eq (Capacity s)
forall s. Ord s => Capacity s -> Capacity s -> Bool
forall s. Ord s => Capacity s -> Capacity s -> Ordering
forall s. Ord s => Capacity s -> Capacity s -> Capacity s
$ccompare :: forall s. Ord s => Capacity s -> Capacity s -> Ordering
compare :: Capacity s -> Capacity s -> Ordering
$c< :: forall s. Ord s => Capacity s -> Capacity s -> Bool
< :: Capacity s -> Capacity s -> Bool
$c<= :: forall s. Ord s => Capacity s -> Capacity s -> Bool
<= :: Capacity s -> Capacity s -> Bool
$c> :: forall s. Ord s => Capacity s -> Capacity s -> Bool
> :: Capacity s -> Capacity s -> Bool
$c>= :: forall s. Ord s => Capacity s -> Capacity s -> Bool
>= :: Capacity s -> Capacity s -> Bool
$cmax :: forall s. Ord s => Capacity s -> Capacity s -> Capacity s
max :: Capacity s -> Capacity s -> Capacity s
$cmin :: forall s. Ord s => Capacity s -> Capacity s -> Capacity s
min :: Capacity s -> Capacity s -> Capacity s
Ord, ReadPrec [Capacity s]
ReadPrec (Capacity s)
Int -> ReadS (Capacity s)
ReadS [Capacity s]
(Int -> ReadS (Capacity s))
-> ReadS [Capacity s]
-> ReadPrec (Capacity s)
-> ReadPrec [Capacity s]
-> Read (Capacity s)
forall s. (Ord s, Read s) => ReadPrec [Capacity s]
forall s. (Ord s, Read s) => ReadPrec (Capacity s)
forall s. (Ord s, Read s) => Int -> ReadS (Capacity s)
forall s. (Ord s, Read s) => ReadS [Capacity s]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall s. (Ord s, Read s) => Int -> ReadS (Capacity s)
readsPrec :: Int -> ReadS (Capacity s)
$creadList :: forall s. (Ord s, Read s) => ReadS [Capacity s]
readList :: ReadS [Capacity s]
$creadPrec :: forall s. (Ord s, Read s) => ReadPrec (Capacity s)
readPrec :: ReadPrec (Capacity s)
$creadListPrec :: forall s. (Ord s, Read s) => ReadPrec [Capacity s]
readListPrec :: ReadPrec [Capacity s]
Read, Int -> Capacity s -> ShowS
[Capacity s] -> ShowS
Capacity s -> String
(Int -> Capacity s -> ShowS)
-> (Capacity s -> String)
-> ([Capacity s] -> ShowS)
-> Show (Capacity s)
forall s. Show s => Int -> Capacity s -> ShowS
forall s. Show s => [Capacity s] -> ShowS
forall s. Show s => Capacity s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Show s => Int -> Capacity s -> ShowS
showsPrec :: Int -> Capacity s -> ShowS
$cshow :: forall s. Show s => Capacity s -> String
show :: Capacity s -> String
$cshowList :: forall s. Show s => [Capacity s] -> ShowS
showList :: [Capacity s] -> ShowS
Show, Typeable, Typeable (Capacity s)
Typeable (Capacity s)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Capacity s -> c (Capacity s))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Capacity s))
-> (Capacity s -> Constr)
-> (Capacity s -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Capacity s)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Capacity s)))
-> ((forall b. Data b => b -> b) -> Capacity s -> Capacity s)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Capacity s -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Capacity s -> r)
-> (forall u. (forall d. Data d => d -> u) -> Capacity s -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Capacity s -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Capacity s -> m (Capacity s))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Capacity s -> m (Capacity s))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Capacity s -> m (Capacity s))
-> Data (Capacity s)
Capacity s -> Constr
Capacity s -> DataType
(forall b. Data b => b -> b) -> Capacity s -> Capacity s
forall {s}. (Data s, Ord s) => Typeable (Capacity s)
forall s. (Data s, Ord s) => Capacity s -> Constr
forall s. (Data s, Ord s) => Capacity s -> DataType
forall s.
(Data s, Ord s) =>
(forall b. Data b => b -> b) -> Capacity s -> Capacity s
forall s u.
(Data s, Ord s) =>
Int -> (forall d. Data d => d -> u) -> Capacity s -> u
forall s u.
(Data s, Ord s) =>
(forall d. Data d => d -> u) -> Capacity s -> [u]
forall s r r'.
(Data s, Ord s) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Capacity s -> r
forall s r r'.
(Data s, Ord s) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Capacity s -> r
forall s (m :: * -> *).
(Data s, Ord s, Monad m) =>
(forall d. Data d => d -> m d) -> Capacity s -> m (Capacity s)
forall s (m :: * -> *).
(Data s, Ord s, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Capacity s -> m (Capacity s)
forall s (c :: * -> *).
(Data s, Ord s) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Capacity s)
forall s (c :: * -> *).
(Data s, Ord s) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Capacity s -> c (Capacity s)
forall s (t :: * -> *) (c :: * -> *).
(Data s, Ord s, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Capacity s))
forall s (t :: * -> * -> *) (c :: * -> *).
(Data s, Ord s, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Capacity s))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Capacity s -> u
forall u. (forall d. Data d => d -> u) -> Capacity s -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Capacity s -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Capacity s -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Capacity s -> m (Capacity s)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Capacity s -> m (Capacity s)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Capacity s)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Capacity s -> c (Capacity s)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Capacity s))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Capacity s))
$cgfoldl :: forall s (c :: * -> *).
(Data s, Ord s) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Capacity s -> c (Capacity s)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Capacity s -> c (Capacity s)
$cgunfold :: forall s (c :: * -> *).
(Data s, Ord s) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Capacity s)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Capacity s)
$ctoConstr :: forall s. (Data s, Ord s) => Capacity s -> Constr
toConstr :: Capacity s -> Constr
$cdataTypeOf :: forall s. (Data s, Ord s) => Capacity s -> DataType
dataTypeOf :: Capacity s -> DataType
$cdataCast1 :: forall s (t :: * -> *) (c :: * -> *).
(Data s, Ord s, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Capacity s))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Capacity s))
$cdataCast2 :: forall s (t :: * -> * -> *) (c :: * -> *).
(Data s, Ord s, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Capacity s))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Capacity s))
$cgmapT :: forall s.
(Data s, Ord s) =>
(forall b. Data b => b -> b) -> Capacity s -> Capacity s
gmapT :: (forall b. Data b => b -> b) -> Capacity s -> Capacity s
$cgmapQl :: forall s r r'.
(Data s, Ord s) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Capacity s -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Capacity s -> r
$cgmapQr :: forall s r r'.
(Data s, Ord s) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Capacity s -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Capacity s -> r
$cgmapQ :: forall s u.
(Data s, Ord s) =>
(forall d. Data d => d -> u) -> Capacity s -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Capacity s -> [u]
$cgmapQi :: forall s u.
(Data s, Ord s) =>
Int -> (forall d. Data d => d -> u) -> Capacity s -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Capacity s -> u
$cgmapM :: forall s (m :: * -> *).
(Data s, Ord s, Monad m) =>
(forall d. Data d => d -> m d) -> Capacity s -> m (Capacity s)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Capacity s -> m (Capacity s)
$cgmapMp :: forall s (m :: * -> *).
(Data s, Ord s, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Capacity s -> m (Capacity s)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Capacity s -> m (Capacity s)
$cgmapMo :: forall s (m :: * -> *).
(Data s, Ord s, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Capacity s -> m (Capacity s)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Capacity s -> m (Capacity s)
Data)

mapCapacity :: Ord a => (s -> a) -> Capacity s -> Capacity a
mapCapacity :: forall a s. Ord a => (s -> a) -> Capacity s -> Capacity a
mapCapacity s -> a
_ Capacity s
Unbounded      = Capacity a
forall s. Capacity s
Unbounded
mapCapacity s -> a
_ (AllBounded Int
x) = Int -> Capacity a
forall s. Int -> Capacity s
AllBounded Int
x
mapCapacity s -> a
f (Bounded Map s Int
m)    = Map a Int -> Capacity a
forall s. Map s Int -> Capacity s
Bounded (Map a Int -> Capacity a) -> Map a Int -> Capacity a
forall a b. (a -> b) -> a -> b
$ (s -> a) -> Map s Int -> Map a Int
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys s -> a
f Map s Int
m

data Net s t = Net {
  forall s t. Net s t -> Set s
places :: Set s,
  forall s t. Net s t -> Set t
transitions :: Set t,
  forall s t. Net s t -> [Connection s t]
connections :: [Connection s t],
  forall s t. Net s t -> Capacity s
capacity :: Capacity s,
  forall s t. Net s t -> State s
start :: State s
  }
  deriving (Net s t -> Net s t -> Bool
(Net s t -> Net s t -> Bool)
-> (Net s t -> Net s t -> Bool) -> Eq (Net s t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s t. (Eq t, Ord s) => Net s t -> Net s t -> Bool
$c== :: forall s t. (Eq t, Ord s) => Net s t -> Net s t -> Bool
== :: Net s t -> Net s t -> Bool
$c/= :: forall s t. (Eq t, Ord s) => Net s t -> Net s t -> Bool
/= :: Net s t -> Net s t -> Bool
Eq, (forall x. Net s t -> Rep (Net s t) x)
-> (forall x. Rep (Net s t) x -> Net s t) -> Generic (Net s t)
forall x. Rep (Net s t) x -> Net s t
forall x. Net s t -> Rep (Net s t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s t x. Rep (Net s t) x -> Net s t
forall s t x. Net s t -> Rep (Net s t) x
$cfrom :: forall s t x. Net s t -> Rep (Net s t) x
from :: forall x. Net s t -> Rep (Net s t) x
$cto :: forall s t x. Rep (Net s t) x -> Net s t
to :: forall x. Rep (Net s t) x -> Net s t
Generic, Eq (Net s t)
Eq (Net s t)
-> (Net s t -> Net s t -> Ordering)
-> (Net s t -> Net s t -> Bool)
-> (Net s t -> Net s t -> Bool)
-> (Net s t -> Net s t -> Bool)
-> (Net s t -> Net s t -> Bool)
-> (Net s t -> Net s t -> Net s t)
-> (Net s t -> Net s t -> Net s t)
-> Ord (Net s t)
Net s t -> Net s t -> Bool
Net s t -> Net s t -> Ordering
Net s t -> Net s t -> Net s t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {s} {t}. (Ord s, Ord t) => Eq (Net s t)
forall s t. (Ord s, Ord t) => Net s t -> Net s t -> Bool
forall s t. (Ord s, Ord t) => Net s t -> Net s t -> Ordering
forall s t. (Ord s, Ord t) => Net s t -> Net s t -> Net s t
$ccompare :: forall s t. (Ord s, Ord t) => Net s t -> Net s t -> Ordering
compare :: Net s t -> Net s t -> Ordering
$c< :: forall s t. (Ord s, Ord t) => Net s t -> Net s t -> Bool
< :: Net s t -> Net s t -> Bool
$c<= :: forall s t. (Ord s, Ord t) => Net s t -> Net s t -> Bool
<= :: Net s t -> Net s t -> Bool
$c> :: forall s t. (Ord s, Ord t) => Net s t -> Net s t -> Bool
> :: Net s t -> Net s t -> Bool
$c>= :: forall s t. (Ord s, Ord t) => Net s t -> Net s t -> Bool
>= :: Net s t -> Net s t -> Bool
$cmax :: forall s t. (Ord s, Ord t) => Net s t -> Net s t -> Net s t
max :: Net s t -> Net s t -> Net s t
$cmin :: forall s t. (Ord s, Ord t) => Net s t -> Net s t -> Net s t
min :: Net s t -> Net s t -> Net s t
Ord, ReadPrec [Net s t]
ReadPrec (Net s t)
Int -> ReadS (Net s t)
ReadS [Net s t]
(Int -> ReadS (Net s t))
-> ReadS [Net s t]
-> ReadPrec (Net s t)
-> ReadPrec [Net s t]
-> Read (Net s t)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall s t. (Read s, Read t, Ord s, Ord t) => ReadPrec [Net s t]
forall s t. (Read s, Read t, Ord s, Ord t) => ReadPrec (Net s t)
forall s t.
(Read s, Read t, Ord s, Ord t) =>
Int -> ReadS (Net s t)
forall s t. (Read s, Read t, Ord s, Ord t) => ReadS [Net s t]
$creadsPrec :: forall s t.
(Read s, Read t, Ord s, Ord t) =>
Int -> ReadS (Net s t)
readsPrec :: Int -> ReadS (Net s t)
$creadList :: forall s t. (Read s, Read t, Ord s, Ord t) => ReadS [Net s t]
readList :: ReadS [Net s t]
$creadPrec :: forall s t. (Read s, Read t, Ord s, Ord t) => ReadPrec (Net s t)
readPrec :: ReadPrec (Net s t)
$creadListPrec :: forall s t. (Read s, Read t, Ord s, Ord t) => ReadPrec [Net s t]
readListPrec :: ReadPrec [Net s t]
Read, Int -> Net s t -> ShowS
[Net s t] -> ShowS
Net s t -> String
(Int -> Net s t -> ShowS)
-> (Net s t -> String) -> ([Net s t] -> ShowS) -> Show (Net s t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s t. (Show s, Show t) => Int -> Net s t -> ShowS
forall s t. (Show s, Show t) => [Net s t] -> ShowS
forall s t. (Show s, Show t) => Net s t -> String
$cshowsPrec :: forall s t. (Show s, Show t) => Int -> Net s t -> ShowS
showsPrec :: Int -> Net s t -> ShowS
$cshow :: forall s t. (Show s, Show t) => Net s t -> String
show :: Net s t -> String
$cshowList :: forall s t. (Show s, Show t) => [Net s t] -> ShowS
showList :: [Net s t] -> ShowS
Show, Typeable, Typeable (Net s t)
Typeable (Net s t)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Net s t -> c (Net s t))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Net s t))
-> (Net s t -> Constr)
-> (Net s t -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Net s t)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Net s t)))
-> ((forall b. Data b => b -> b) -> Net s t -> Net s t)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Net s t -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Net s t -> r)
-> (forall u. (forall d. Data d => d -> u) -> Net s t -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Net s t -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Net s t -> m (Net s t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Net s t -> m (Net s t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Net s t -> m (Net s t))
-> Data (Net s t)
Net s t -> Constr
Net s t -> DataType
(forall b. Data b => b -> b) -> Net s t -> Net s t
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Net s t -> u
forall u. (forall d. Data d => d -> u) -> Net s t -> [u]
forall {s} {t}.
(Data s, Data t, Ord s, Ord t) =>
Typeable (Net s t)
forall s t. (Data s, Data t, Ord s, Ord t) => Net s t -> Constr
forall s t. (Data s, Data t, Ord s, Ord t) => Net s t -> DataType
forall s t.
(Data s, Data t, Ord s, Ord t) =>
(forall b. Data b => b -> b) -> Net s t -> Net s t
forall s t u.
(Data s, Data t, Ord s, Ord t) =>
Int -> (forall d. Data d => d -> u) -> Net s t -> u
forall s t u.
(Data s, Data t, Ord s, Ord t) =>
(forall d. Data d => d -> u) -> Net s t -> [u]
forall s t r r'.
(Data s, Data t, Ord s, Ord t) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Net s t -> r
forall s t r r'.
(Data s, Data t, Ord s, Ord t) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Net s t -> r
forall s t (m :: * -> *).
(Data s, Data t, Ord s, Ord t, Monad m) =>
(forall d. Data d => d -> m d) -> Net s t -> m (Net s t)
forall s t (m :: * -> *).
(Data s, Data t, Ord s, Ord t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Net s t -> m (Net s t)
forall s t (c :: * -> *).
(Data s, Data t, Ord s, Ord t) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Net s t)
forall s t (c :: * -> *).
(Data s, Data t, Ord s, Ord t) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Net s t -> c (Net s t)
forall s t (t :: * -> *) (c :: * -> *).
(Data s, Data t, Ord s, Ord t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Net s t))
forall s t (t :: * -> * -> *) (c :: * -> *).
(Data s, Data t, Ord s, Ord t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Net s t))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Net s t -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Net s t -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Net s t -> m (Net s t)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Net s t -> m (Net s t)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Net s t)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Net s t -> c (Net s t)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Net s t))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Net s t))
$cgfoldl :: forall s t (c :: * -> *).
(Data s, Data t, Ord s, Ord t) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Net s t -> c (Net s t)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Net s t -> c (Net s t)
$cgunfold :: forall s t (c :: * -> *).
(Data s, Data t, Ord s, Ord t) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Net s t)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Net s t)
$ctoConstr :: forall s t. (Data s, Data t, Ord s, Ord t) => Net s t -> Constr
toConstr :: Net s t -> Constr
$cdataTypeOf :: forall s t. (Data s, Data t, Ord s, Ord t) => Net s t -> DataType
dataTypeOf :: Net s t -> DataType
$cdataCast1 :: forall s t (t :: * -> *) (c :: * -> *).
(Data s, Data t, Ord s, Ord t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Net s t))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Net s t))
$cdataCast2 :: forall s t (t :: * -> * -> *) (c :: * -> *).
(Data s, Data t, Ord s, Ord t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Net s t))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Net s t))
$cgmapT :: forall s t.
(Data s, Data t, Ord s, Ord t) =>
(forall b. Data b => b -> b) -> Net s t -> Net s t
gmapT :: (forall b. Data b => b -> b) -> Net s t -> Net s t
$cgmapQl :: forall s t r r'.
(Data s, Data t, Ord s, Ord t) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Net s t -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Net s t -> r
$cgmapQr :: forall s t r r'.
(Data s, Data t, Ord s, Ord t) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Net s t -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Net s t -> r
$cgmapQ :: forall s t u.
(Data s, Data t, Ord s, Ord t) =>
(forall d. Data d => d -> u) -> Net s t -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Net s t -> [u]
$cgmapQi :: forall s t u.
(Data s, Data t, Ord s, Ord t) =>
Int -> (forall d. Data d => d -> u) -> Net s t -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Net s t -> u
$cgmapM :: forall s t (m :: * -> *).
(Data s, Data t, Ord s, Ord t, Monad m) =>
(forall d. Data d => d -> m d) -> Net s t -> m (Net s t)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Net s t -> m (Net s t)
$cgmapMp :: forall s t (m :: * -> *).
(Data s, Data t, Ord s, Ord t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Net s t -> m (Net s t)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Net s t -> m (Net s t)
$cgmapMo :: forall s t (m :: * -> *).
(Data s, Data t, Ord s, Ord t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Net s t -> m (Net s t)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Net s t -> m (Net s t)
Data)

bimapNet :: (Ord a, Ord b) => (s -> a) -> (t -> b) -> Net s t -> Net a b
bimapNet :: forall a b s t.
(Ord a, Ord b) =>
(s -> a) -> (t -> b) -> Net s t -> Net a b
bimapNet s -> a
f t -> b
g Net s t
x = Net {
  places :: Set a
places      = (s -> a) -> Set s -> Set a
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map s -> a
f (Net s t -> Set s
forall s t. Net s t -> Set s
places Net s t
x),
  transitions :: Set b
transitions = (t -> b) -> Set t -> Set b
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map t -> b
g (Net s t -> Set t
forall s t. Net s t -> Set t
transitions Net s t
x),
  connections :: [Connection a b]
connections = (([s], t, [s]) -> Connection a b)
-> [([s], t, [s])] -> [Connection a b]
forall a b. (a -> b) -> [a] -> [b]
map ([s], t, [s]) -> Connection a b
forall {f :: * -> *} {f :: * -> *}.
(Functor f, Functor f) =>
(f s, t, f s) -> (f a, b, f a)
bimapConnection ([([s], t, [s])] -> [Connection a b])
-> [([s], t, [s])] -> [Connection a b]
forall a b. (a -> b) -> a -> b
$ Net s t -> [([s], t, [s])]
forall s t. Net s t -> [Connection s t]
connections Net s t
x,
  capacity :: Capacity a
capacity    = (s -> a) -> Capacity s -> Capacity a
forall a s. Ord a => (s -> a) -> Capacity s -> Capacity a
mapCapacity s -> a
f (Capacity s -> Capacity a) -> Capacity s -> Capacity a
forall a b. (a -> b) -> a -> b
$ Net s t -> Capacity s
forall s t. Net s t -> Capacity s
capacity Net s t
x,
  start :: State a
start       = (s -> a) -> State s -> State a
forall b a. Ord b => (a -> b) -> State a -> State b
mapState s -> a
f (State s -> State a) -> State s -> State a
forall a b. (a -> b) -> a -> b
$ Net s t -> State s
forall s t. Net s t -> State s
start Net s t
x
  }
  where
    bimapConnection :: (f s, t, f s) -> (f a, b, f a)
bimapConnection (f s
w, t
y, f s
z) = (s -> a
f (s -> a) -> f s -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f s
w, t -> b
g t
y, s -> a
f (s -> a) -> f s -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f s
z)

allNonNegative :: State a -> Bool
allNonNegative :: forall a. State a -> Bool
allNonNegative (State Map a Int
z) =
  ((a, Int) -> Bool) -> [(a, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(a
_, Int
v) -> Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (Map a Int -> [(a, Int)]
forall k a. Map k a -> [(k, a)]
M.toList Map a Int
z)

conforms :: Ord k => Capacity k -> State k -> Bool
conforms :: forall k. Ord k => Capacity k -> State k -> Bool
conforms Capacity k
cap (State Map k Int
z) = case Capacity k
cap of
  Capacity k
Unbounded -> Bool
True
  AllBounded Int
b ->
    ((k, Int) -> Bool) -> [(k, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(k
_, Int
v) -> Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
b) (Map k Int -> [(k, Int)]
forall k a. Map k a -> [(k, a)]
M.toList Map k Int
z)
  Bounded Map k Int
f -> ((k, Int) -> Bool) -> [(k, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
    (\(k
k, Int
v) -> case k -> Map k Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k Int
f of
        Maybe Int
Nothing -> Bool
True
        Just Int
b -> Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
b
    )
    (Map k Int -> [(k, Int)]
forall k a. Map k a -> [(k, a)]
M.toList Map k Int
z)

newtype Place = Place Int
  deriving (Int -> Place
Place -> Int
Place -> [Place]
Place -> Place
Place -> Place -> [Place]
Place -> Place -> Place -> [Place]
(Place -> Place)
-> (Place -> Place)
-> (Int -> Place)
-> (Place -> Int)
-> (Place -> [Place])
-> (Place -> Place -> [Place])
-> (Place -> Place -> [Place])
-> (Place -> Place -> Place -> [Place])
-> Enum Place
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Place -> Place
succ :: Place -> Place
$cpred :: Place -> Place
pred :: Place -> Place
$ctoEnum :: Int -> Place
toEnum :: Int -> Place
$cfromEnum :: Place -> Int
fromEnum :: Place -> Int
$cenumFrom :: Place -> [Place]
enumFrom :: Place -> [Place]
$cenumFromThen :: Place -> Place -> [Place]
enumFromThen :: Place -> Place -> [Place]
$cenumFromTo :: Place -> Place -> [Place]
enumFromTo :: Place -> Place -> [Place]
$cenumFromThenTo :: Place -> Place -> Place -> [Place]
enumFromThenTo :: Place -> Place -> Place -> [Place]
Enum, Place -> Place -> Bool
(Place -> Place -> Bool) -> (Place -> Place -> Bool) -> Eq Place
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Place -> Place -> Bool
== :: Place -> Place -> Bool
$c/= :: Place -> Place -> Bool
/= :: Place -> Place -> Bool
Eq, (forall x. Place -> Rep Place x)
-> (forall x. Rep Place x -> Place) -> Generic Place
forall x. Rep Place x -> Place
forall x. Place -> Rep Place x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Place -> Rep Place x
from :: forall x. Place -> Rep Place x
$cto :: forall x. Rep Place x -> Place
to :: forall x. Rep Place x -> Place
Generic, Eq Place
Eq Place
-> (Place -> Place -> Ordering)
-> (Place -> Place -> Bool)
-> (Place -> Place -> Bool)
-> (Place -> Place -> Bool)
-> (Place -> Place -> Bool)
-> (Place -> Place -> Place)
-> (Place -> Place -> Place)
-> Ord Place
Place -> Place -> Bool
Place -> Place -> Ordering
Place -> Place -> Place
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Place -> Place -> Ordering
compare :: Place -> Place -> Ordering
$c< :: Place -> Place -> Bool
< :: Place -> Place -> Bool
$c<= :: Place -> Place -> Bool
<= :: Place -> Place -> Bool
$c> :: Place -> Place -> Bool
> :: Place -> Place -> Bool
$c>= :: Place -> Place -> Bool
>= :: Place -> Place -> Bool
$cmax :: Place -> Place -> Place
max :: Place -> Place -> Place
$cmin :: Place -> Place -> Place
min :: Place -> Place -> Place
Ord, ReadPrec [Place]
ReadPrec Place
Int -> ReadS Place
ReadS [Place]
(Int -> ReadS Place)
-> ReadS [Place]
-> ReadPrec Place
-> ReadPrec [Place]
-> Read Place
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Place
readsPrec :: Int -> ReadS Place
$creadList :: ReadS [Place]
readList :: ReadS [Place]
$creadPrec :: ReadPrec Place
readPrec :: ReadPrec Place
$creadListPrec :: ReadPrec [Place]
readListPrec :: ReadPrec [Place]
Read, Int -> Place -> ShowS
[Place] -> ShowS
Place -> String
(Int -> Place -> ShowS)
-> (Place -> String) -> ([Place] -> ShowS) -> Show Place
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Place -> ShowS
showsPrec :: Int -> Place -> ShowS
$cshow :: Place -> String
show :: Place -> String
$cshowList :: [Place] -> ShowS
showList :: [Place] -> ShowS
Show, Typeable, Typeable Place
Typeable Place
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Place -> c Place)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Place)
-> (Place -> Constr)
-> (Place -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Place))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Place))
-> ((forall b. Data b => b -> b) -> Place -> Place)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r)
-> (forall u. (forall d. Data d => d -> u) -> Place -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Place -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Place -> m Place)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Place -> m Place)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Place -> m Place)
-> Data Place
Place -> Constr
Place -> DataType
(forall b. Data b => b -> b) -> Place -> Place
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Place -> u
forall u. (forall d. Data d => d -> u) -> Place -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Place -> m Place
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Place -> m Place
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Place
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Place -> c Place
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Place)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Place)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Place -> c Place
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Place -> c Place
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Place
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Place
$ctoConstr :: Place -> Constr
toConstr :: Place -> Constr
$cdataTypeOf :: Place -> DataType
dataTypeOf :: Place -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Place)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Place)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Place)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Place)
$cgmapT :: (forall b. Data b => b -> b) -> Place -> Place
gmapT :: (forall b. Data b => b -> b) -> Place -> Place
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Place -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Place -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Place -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Place -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Place -> m Place
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Place -> m Place
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Place -> m Place
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Place -> m Place
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Place -> m Place
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Place -> m Place
Data)

newtype ShowPlace = ShowPlace Place
  deriving (ShowPlace -> ShowPlace -> Bool
(ShowPlace -> ShowPlace -> Bool)
-> (ShowPlace -> ShowPlace -> Bool) -> Eq ShowPlace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShowPlace -> ShowPlace -> Bool
== :: ShowPlace -> ShowPlace -> Bool
$c/= :: ShowPlace -> ShowPlace -> Bool
/= :: ShowPlace -> ShowPlace -> Bool
Eq, Eq ShowPlace
Eq ShowPlace
-> (ShowPlace -> ShowPlace -> Ordering)
-> (ShowPlace -> ShowPlace -> Bool)
-> (ShowPlace -> ShowPlace -> Bool)
-> (ShowPlace -> ShowPlace -> Bool)
-> (ShowPlace -> ShowPlace -> Bool)
-> (ShowPlace -> ShowPlace -> ShowPlace)
-> (ShowPlace -> ShowPlace -> ShowPlace)
-> Ord ShowPlace
ShowPlace -> ShowPlace -> Bool
ShowPlace -> ShowPlace -> Ordering
ShowPlace -> ShowPlace -> ShowPlace
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ShowPlace -> ShowPlace -> Ordering
compare :: ShowPlace -> ShowPlace -> Ordering
$c< :: ShowPlace -> ShowPlace -> Bool
< :: ShowPlace -> ShowPlace -> Bool
$c<= :: ShowPlace -> ShowPlace -> Bool
<= :: ShowPlace -> ShowPlace -> Bool
$c> :: ShowPlace -> ShowPlace -> Bool
> :: ShowPlace -> ShowPlace -> Bool
$c>= :: ShowPlace -> ShowPlace -> Bool
>= :: ShowPlace -> ShowPlace -> Bool
$cmax :: ShowPlace -> ShowPlace -> ShowPlace
max :: ShowPlace -> ShowPlace -> ShowPlace
$cmin :: ShowPlace -> ShowPlace -> ShowPlace
min :: ShowPlace -> ShowPlace -> ShowPlace
Ord)

instance Show ShowPlace where
  show :: ShowPlace -> String
show (ShowPlace (Place Int
p)) = String
"s" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
p

showPlace :: Place -> String
showPlace :: Place -> String
showPlace = ShowPlace -> String
forall a. Show a => a -> String
show (ShowPlace -> String) -> (Place -> ShowPlace) -> Place -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Place -> ShowPlace
ShowPlace

parsePlacePrec :: Int -> Parser Place
parsePlacePrec :: Int -> Parser Place
parsePlacePrec Int
_ = do
  ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
  ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
's'
  Int -> Place
Place (Int -> Place) -> ParsecT String () Identity Int -> Parser Place
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Int
parseInt Parser Place -> ParsecT String () Identity () -> Parser Place
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space

newtype Transition = Transition Int
  deriving (Int -> Transition
Transition -> Int
Transition -> [Transition]
Transition -> Transition
Transition -> Transition -> [Transition]
Transition -> Transition -> Transition -> [Transition]
(Transition -> Transition)
-> (Transition -> Transition)
-> (Int -> Transition)
-> (Transition -> Int)
-> (Transition -> [Transition])
-> (Transition -> Transition -> [Transition])
-> (Transition -> Transition -> [Transition])
-> (Transition -> Transition -> Transition -> [Transition])
-> Enum Transition
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Transition -> Transition
succ :: Transition -> Transition
$cpred :: Transition -> Transition
pred :: Transition -> Transition
$ctoEnum :: Int -> Transition
toEnum :: Int -> Transition
$cfromEnum :: Transition -> Int
fromEnum :: Transition -> Int
$cenumFrom :: Transition -> [Transition]
enumFrom :: Transition -> [Transition]
$cenumFromThen :: Transition -> Transition -> [Transition]
enumFromThen :: Transition -> Transition -> [Transition]
$cenumFromTo :: Transition -> Transition -> [Transition]
enumFromTo :: Transition -> Transition -> [Transition]
$cenumFromThenTo :: Transition -> Transition -> Transition -> [Transition]
enumFromThenTo :: Transition -> Transition -> Transition -> [Transition]
Enum, Transition -> Transition -> Bool
(Transition -> Transition -> Bool)
-> (Transition -> Transition -> Bool) -> Eq Transition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Transition -> Transition -> Bool
== :: Transition -> Transition -> Bool
$c/= :: Transition -> Transition -> Bool
/= :: Transition -> Transition -> Bool
Eq, (forall x. Transition -> Rep Transition x)
-> (forall x. Rep Transition x -> Transition) -> Generic Transition
forall x. Rep Transition x -> Transition
forall x. Transition -> Rep Transition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Transition -> Rep Transition x
from :: forall x. Transition -> Rep Transition x
$cto :: forall x. Rep Transition x -> Transition
to :: forall x. Rep Transition x -> Transition
Generic, Eq Transition
Eq Transition
-> (Transition -> Transition -> Ordering)
-> (Transition -> Transition -> Bool)
-> (Transition -> Transition -> Bool)
-> (Transition -> Transition -> Bool)
-> (Transition -> Transition -> Bool)
-> (Transition -> Transition -> Transition)
-> (Transition -> Transition -> Transition)
-> Ord Transition
Transition -> Transition -> Bool
Transition -> Transition -> Ordering
Transition -> Transition -> Transition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Transition -> Transition -> Ordering
compare :: Transition -> Transition -> Ordering
$c< :: Transition -> Transition -> Bool
< :: Transition -> Transition -> Bool
$c<= :: Transition -> Transition -> Bool
<= :: Transition -> Transition -> Bool
$c> :: Transition -> Transition -> Bool
> :: Transition -> Transition -> Bool
$c>= :: Transition -> Transition -> Bool
>= :: Transition -> Transition -> Bool
$cmax :: Transition -> Transition -> Transition
max :: Transition -> Transition -> Transition
$cmin :: Transition -> Transition -> Transition
min :: Transition -> Transition -> Transition
Ord, ReadPrec [Transition]
ReadPrec Transition
Int -> ReadS Transition
ReadS [Transition]
(Int -> ReadS Transition)
-> ReadS [Transition]
-> ReadPrec Transition
-> ReadPrec [Transition]
-> Read Transition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Transition
readsPrec :: Int -> ReadS Transition
$creadList :: ReadS [Transition]
readList :: ReadS [Transition]
$creadPrec :: ReadPrec Transition
readPrec :: ReadPrec Transition
$creadListPrec :: ReadPrec [Transition]
readListPrec :: ReadPrec [Transition]
Read, Int -> Transition -> ShowS
[Transition] -> ShowS
Transition -> String
(Int -> Transition -> ShowS)
-> (Transition -> String)
-> ([Transition] -> ShowS)
-> Show Transition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Transition -> ShowS
showsPrec :: Int -> Transition -> ShowS
$cshow :: Transition -> String
show :: Transition -> String
$cshowList :: [Transition] -> ShowS
showList :: [Transition] -> ShowS
Show, Typeable, Typeable Transition
Typeable Transition
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Transition -> c Transition)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Transition)
-> (Transition -> Constr)
-> (Transition -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Transition))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Transition))
-> ((forall b. Data b => b -> b) -> Transition -> Transition)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Transition -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Transition -> r)
-> (forall u. (forall d. Data d => d -> u) -> Transition -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Transition -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Transition -> m Transition)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Transition -> m Transition)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Transition -> m Transition)
-> Data Transition
Transition -> Constr
Transition -> DataType
(forall b. Data b => b -> b) -> Transition -> Transition
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Transition -> u
forall u. (forall d. Data d => d -> u) -> Transition -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Transition -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Transition -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Transition -> m Transition
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Transition -> m Transition
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Transition
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Transition -> c Transition
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Transition)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Transition)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Transition -> c Transition
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Transition -> c Transition
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Transition
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Transition
$ctoConstr :: Transition -> Constr
toConstr :: Transition -> Constr
$cdataTypeOf :: Transition -> DataType
dataTypeOf :: Transition -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Transition)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Transition)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Transition)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Transition)
$cgmapT :: (forall b. Data b => b -> b) -> Transition -> Transition
gmapT :: (forall b. Data b => b -> b) -> Transition -> Transition
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Transition -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Transition -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Transition -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Transition -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Transition -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Transition -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Transition -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Transition -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Transition -> m Transition
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Transition -> m Transition
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Transition -> m Transition
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Transition -> m Transition
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Transition -> m Transition
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Transition -> m Transition
Data)

newtype ShowTransition = ShowTransition Transition
  deriving (ShowTransition -> ShowTransition -> Bool
(ShowTransition -> ShowTransition -> Bool)
-> (ShowTransition -> ShowTransition -> Bool) -> Eq ShowTransition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShowTransition -> ShowTransition -> Bool
== :: ShowTransition -> ShowTransition -> Bool
$c/= :: ShowTransition -> ShowTransition -> Bool
/= :: ShowTransition -> ShowTransition -> Bool
Eq, Eq ShowTransition
Eq ShowTransition
-> (ShowTransition -> ShowTransition -> Ordering)
-> (ShowTransition -> ShowTransition -> Bool)
-> (ShowTransition -> ShowTransition -> Bool)
-> (ShowTransition -> ShowTransition -> Bool)
-> (ShowTransition -> ShowTransition -> Bool)
-> (ShowTransition -> ShowTransition -> ShowTransition)
-> (ShowTransition -> ShowTransition -> ShowTransition)
-> Ord ShowTransition
ShowTransition -> ShowTransition -> Bool
ShowTransition -> ShowTransition -> Ordering
ShowTransition -> ShowTransition -> ShowTransition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ShowTransition -> ShowTransition -> Ordering
compare :: ShowTransition -> ShowTransition -> Ordering
$c< :: ShowTransition -> ShowTransition -> Bool
< :: ShowTransition -> ShowTransition -> Bool
$c<= :: ShowTransition -> ShowTransition -> Bool
<= :: ShowTransition -> ShowTransition -> Bool
$c> :: ShowTransition -> ShowTransition -> Bool
> :: ShowTransition -> ShowTransition -> Bool
$c>= :: ShowTransition -> ShowTransition -> Bool
>= :: ShowTransition -> ShowTransition -> Bool
$cmax :: ShowTransition -> ShowTransition -> ShowTransition
max :: ShowTransition -> ShowTransition -> ShowTransition
$cmin :: ShowTransition -> ShowTransition -> ShowTransition
min :: ShowTransition -> ShowTransition -> ShowTransition
Ord)

instance Show ShowTransition where
  show :: ShowTransition -> String
show (ShowTransition (Transition Int
t)) = String
"t" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
t

showTransition :: Transition -> String
showTransition :: Transition -> String
showTransition = ShowTransition -> String
forall a. Show a => a -> String
show (ShowTransition -> String)
-> (Transition -> ShowTransition) -> Transition -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition -> ShowTransition
ShowTransition

parseTransitionPrec :: Int -> Parser Transition
parseTransitionPrec :: Int -> Parser Transition
parseTransitionPrec Int
_ = do
  ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
  ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
't'
  Int -> Transition
Transition (Int -> Transition)
-> ParsecT String () Identity Int -> Parser Transition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Int
parseInt Parser Transition
-> ParsecT String () Identity () -> Parser Transition
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space

newtype TransitionsList = TransitionsList {
  TransitionsList -> [Transition]
transitionsList :: [Transition]
  }
  deriving (forall x. TransitionsList -> Rep TransitionsList x)
-> (forall x. Rep TransitionsList x -> TransitionsList)
-> Generic TransitionsList
forall x. Rep TransitionsList x -> TransitionsList
forall x. TransitionsList -> Rep TransitionsList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TransitionsList -> Rep TransitionsList x
from :: forall x. TransitionsList -> Rep TransitionsList x
$cto :: forall x. Rep TransitionsList x -> TransitionsList
to :: forall x. Rep TransitionsList x -> TransitionsList
Generic

instance Show TransitionsList where
  show :: TransitionsList -> String
show (TransitionsList [Transition]
ts) =
    Char
'['
    Char -> ShowS
forall a. a -> [a] -> [a]
: String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Transition -> String) -> [Transition] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Transition -> String
showTransition [Transition]
ts)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

parseTransitionsListPrec :: Int -> Parser TransitionsList
parseTransitionsListPrec :: Int -> Parser TransitionsList
parseTransitionsListPrec Int
_ = do
  ParsecT String () Identity ()
skipSpaces
  ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
  [Transition]
ts <- Int -> Parser Transition
parseTransitionPrec Int
0 Parser Transition
-> ParsecT String () Identity ()
-> ParsecT String () Identity [Transition]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')
  ParsecT String () Identity ()
skipSpaces
  ParsecT String () Identity () -> ParsecT String () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT String () Identity () -> ParsecT String () Identity ())
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']' ParsecT String () Identity Char
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity ()
skipSpaces
  TransitionsList -> Parser TransitionsList
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TransitionsList -> Parser TransitionsList)
-> TransitionsList -> Parser TransitionsList
forall a b. (a -> b) -> a -> b
$ [Transition] -> TransitionsList
TransitionsList [Transition]
ts

example :: (Net Place Transition, State Place)
example :: (Net Place Transition, State Place)
example =
  (Net {
    places :: Set Place
places = [Place] -> Set Place
forall a. Ord a => [a] -> Set a
S.fromList [Int -> Place
Place Int
1, Int -> Place
Place Int
2, Int -> Place
Place Int
3, Int -> Place
Place Int
4],
    transitions :: Set Transition
transitions = [Transition] -> Set Transition
forall a. Ord a => [a] -> Set a
S.fromList [Int -> Transition
Transition Int
1, Int -> Transition
Transition Int
2, Int -> Transition
Transition Int
3, Int -> Transition
Transition Int
4],
    connections :: [Connection Place Transition]
connections = [
        ([Int -> Place
Place Int
3, Int -> Place
Place Int
4], Int -> Transition
Transition Int
1, [Int -> Place
Place Int
2]),
        ([Int -> Place
Place Int
4], Int -> Transition
Transition Int
2, [Int -> Place
Place Int
3]),
        ([Int -> Place
Place Int
1], Int -> Transition
Transition Int
3, [Int -> Place
Place Int
4]),
        ([Int -> Place
Place Int
2], Int -> Transition
Transition Int
4, [Int -> Place
Place Int
1])
    ],
    capacity :: Capacity Place
capacity = Capacity Place
forall s. Capacity s
Unbounded,
    start :: State Place
start = Map Place Int -> State Place
forall s. Map s Int -> State s
State (Map Place Int -> State Place) -> Map Place Int -> State Place
forall a b. (a -> b) -> a -> b
$ [(Place, Int)] -> Map Place Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
      [(Int -> Place
Place Int
1, Int
3), (Int -> Place
Place Int
2, Int
0), (Int -> Place
Place Int
3, Int
0), (Int -> Place
Place Int
4, Int
0)]
    },
   Map Place Int -> State Place
forall s. Map s Int -> State s
State (Map Place Int -> State Place) -> Map Place Int -> State Place
forall a b. (a -> b) -> a -> b
$ [(Place, Int)] -> Map Place Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Int -> Place
Place Int
1, Int
0), (Int -> Place
Place Int
2, Int
0), (Int -> Place
Place Int
3, Int
1), (Int -> Place
Place Int
4, Int
0)]
  )

-- | Check if a net has any isolated nodes (nodes with no connections)
hasIsolatedNodes :: (Ord s, Ord t) => Net s t -> Bool
hasIsolatedNodes :: forall s t. (Ord s, Ord t) => Net s t -> Bool
hasIsolatedNodes (Net Set s
ps Set t
ts [Connection s t]
cs Capacity s
_ State s
_) =
  let connectedPlaces :: Set s
connectedPlaces = [s] -> Set s
forall a. Ord a => [a] -> Set a
S.fromList ([s] -> Set s) -> [s] -> Set s
forall a b. (a -> b) -> a -> b
$ (Connection s t -> [s]) -> [Connection s t] -> [s]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([s]
pre, t
_, [s]
post) -> [s]
pre [s] -> [s] -> [s]
forall a. [a] -> [a] -> [a]
++ [s]
post) [Connection s t]
cs
      connectedTransitions :: Set t
connectedTransitions = [t] -> Set t
forall a. Ord a => [a] -> Set a
S.fromList ([t] -> Set t) -> [t] -> Set t
forall a b. (a -> b) -> a -> b
$ (Connection s t -> t) -> [Connection s t] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (\([s]
_, t
t, [s]
_) -> t
t) [Connection s t]
cs
  in Bool -> Bool
not (Set s -> Set s -> Bool
forall a. Ord a => Set a -> Set a -> Bool
S.isSubsetOf Set s
ps Set s
connectedPlaces Bool -> Bool -> Bool
&& Set t -> Set t -> Bool
forall a. Ord a => Set a -> Set a -> Bool
S.isSubsetOf Set t
ts Set t
connectedTransitions)