-- generated by HCPN NetEdit v0.0
module Unnamed where
import SimpleHCPN
import GuiHCPN
import List (intersperse)

-- declarations
data StackM = StackM{output::String,stack::String}
  deriving Show

empty_state = StackM{output="",stack=[]}

out c (m@StackM{output=o}) = m{output=o++[c]}

push c (m@StackM{stack=s}) = m{stack=c:s}
pop (m@StackM{stack=_:s}) = m{stack=s}
top (m@StackM{stack=h:_}) = h
-- markings
data Mark = Mark {
    s2 :: [StackM]
  , s1 :: [StackM]
  , s0 :: [StackM]
  } deriving Show
-- transition actions
t12 :: Mark -> [Mark]
t12 m = 
  do
    let s1_marking = s1 m
    let s2_marking = s2 m
    (s, s1_marking) <- select $ s1_marking
    if null $ stack s
     then return m{ 
              s1 = s1_marking
            , s2 = (s) : s2_marking
            }
     else fail "guard failed"
t11_close :: Mark -> [Mark]
t11_close m = 
  do
    let s1_marking = s1 m
    (s, s1_marking) <- select $ s1_marking
    if not (null (stack s)) && top s == '('
     then return m{ 
              s1 = (out ')' $ pop s) : s1_marking
            }
     else fail "guard failed"
t11_open :: Mark -> [Mark]
t11_open m = 
  do
    let s1_marking = s1 m
    (s, s1_marking) <- select $ s1_marking
    if not $ null $ stack s
     then return m{ 
              s1 = (out '(' $ push '(' s) : s1_marking
            }
     else fail "guard failed"
t01_open :: Mark -> [Mark]
t01_open m = 
  do
    let s0_marking = s0 m
    let s1_marking = s1 m
    (s, s0_marking) <- select $ s0_marking
    if True
     then return m{ 
              s0 = s0_marking
            , s1 = (out '(' $ push '(' s) : s1_marking
            }
     else fail "guard failed"
-- transitions
net = Net{trans=[ Trans{name="t12",info=Nothing,action=t12}
                , Trans{name="t11_close",info=Nothing,action=t11_close}
                , Trans{name="t11_open",info=Nothing,action=t11_open}
                , Trans{name="t01_open",info=Nothing,action=t01_open}
                ]} 
-- initial marking
mark = Mark{ s2 = []
           , s1 = []
           , s0 = [empty_state]
           } 
-- end of net code

main = simMain "fa_stack.hcpn" showMarking net mark

showMarking pmap = let (Just nV_s2) = lookup "s2" pmap
                       (Just nV_s1) = lookup "s1" pmap
                       (Just nV_s0) = lookup "s0" pmap
                   in \setPlaceMark m-> do
                         setPlaceMark nV_s2 (concat $ intersperse "," $ map show $ s2 m)
                         setPlaceMark nV_s1 (concat $ intersperse "," $ map show $ s1 m)
                         setPlaceMark nV_s0 (concat $ intersperse "," $ map show $ s0 m)

