@@ -11,29 +11,38 @@ import Data.ArrayMultiset (ArrayMultiset)
11
11
import Statebox.Core.Execution (Path )
12
12
import Statebox.Core.Types (PID , TID )
13
13
14
- -- TODO: these types are currently duplicated from Data.Petrinet.Representation.Dict
14
+ -- ------------------------------------------------------------------------------
15
+
16
+ -- | TODO Duplicated from `Data.Petrinet.Representation.Dict` in #328.
15
17
type TransitionF p tok =
16
18
{ pre :: Array (PlaceMarkingF p tok )
17
19
, post :: Array (PlaceMarkingF p tok )
18
20
}
19
21
22
+ -- | TODO Duplicated from `Data.Petrinet.Representation.Dict` in #328.
20
23
type PlaceMarkingF p tok =
21
24
{ place :: p
22
25
, tokens :: tok
23
26
}
24
27
25
- buildTokens :: ∀ a . Ord a => ArrayMultiset a -> ArrayMultiset a -> TransitionF a Int
28
+ -- | TODO Duplicated from `Data.Petrinet.Representation.Dict` in #328.
29
+ type Tokens = Int
30
+
31
+ -- ------------------------------------------------------------------------------
32
+
33
+ buildTokens :: ∀ a . Ord a => ArrayMultiset a -> ArrayMultiset a -> TransitionF a Tokens
26
34
buildTokens pre post =
27
- { pre : buildPlaceMarkings pre
28
- , post : buildPlaceMarkings post
35
+ { pre: buildPlaceMarkings pre
36
+ , post: buildPlaceMarkings post
29
37
}
30
38
31
- buildPlaceMarkings :: ∀ a . Ord a => ArrayMultiset a -> Array (PlaceMarkingF a Int )
32
- buildPlaceMarkings multiset =
33
- let map = foldr (Map .update (Just <<< (_ + 1 ))) Map .empty multiset
34
- in foldrWithIndex (\place count -> (:) { place: place, tokens: count }) [] map
39
+ buildPlaceMarkings :: ∀ a . Ord a => ArrayMultiset a -> Array (PlaceMarkingF a Tokens )
40
+ buildPlaceMarkings netMarking =
41
+ foldrWithIndex (\place tokens -> (:) { place, tokens }) [] netMarkingDict
42
+ where
43
+ netMarkingDict = netMarking # foldr (Map .update (Just <<< (_ + 1 ))) mempty
35
44
36
- type Tokens = Int
45
+ -- ------------------------------------------------------------------------------
37
46
38
47
type Transition =
39
48
{ path :: Path
@@ -60,9 +69,9 @@ isFinal = case _ of
60
69
61
70
gluedTokens :: Glued Transition -> TransitionF PID Tokens
62
71
gluedTokens = case _ of
63
- Untouched transition -> transition.tokens
64
- Initial transition -> transition.tokens
65
- Final transition -> transition.tokens
66
- Glued transition1 transition2 -> { pre : transition1.tokens.pre
67
- , post: transition2.tokens.post
68
- }
72
+ Untouched transition -> transition.tokens
73
+ Initial transition -> transition.tokens
74
+ Final transition -> transition.tokens
75
+ Glued transition1 transition2 -> { pre: transition1.tokens.pre
76
+ , post: transition2.tokens.post
77
+ }
0 commit comments