FGL.hs

{- |

Interface to fgl graph library (<http://hackage.haskell.org/package/fgl>).

-}

-- Copyright (c) 2009 Andy Gimblett - http://www.cs.swan.ac.uk/~csandy/
-- BSD Licence (see http://www.opensource.org/licenses/bsd-license.php)

module Data.FsmActions.FGL (
    SelfLoops(..),
    fsmToFGL,
    strongCCs,
    weakCCs
) where

import qualified Data.Map as M
import Data.Graph.Inductive.Basic (undir)
import Data.Graph.Inductive.Graph (Graph, mkGraph)
import qualified Data.Graph.Inductive.PatriciaTree as P
import qualified Data.Graph.Inductive.Tree as T 
import Data.Graph.Inductive.Query.DFS (scc)

import Data.FsmActions

-- | When converting an 'Data.FsmActions.FSM' into a graph, do we keep
-- all self-loops, or only those which are sources of nondeterminism?
data SelfLoops = Keep | Trim

-- | Turn an FSM into an fgl graph with labelled edges.
fsmToFGL :: FSM sy -> SelfLoops -> T.Gr () sy
-- Note use of T.Gr; this instance of Graph allows multiple edges
-- between the same pair of nodes, which is what we _usually_ (but not
-- always) want.
fsmToFGL = fsmToFGL'

-- Generalised FSM to graph conversion; works with any Graph instance.
fsmToFGL' :: (Graph gr) => FSM sy -> SelfLoops -> gr () sy
fsmToFGL' fsm selfs = mkGraph nodes edges
    where nodes = map (\state -> (state, ())) $ states fsm
          edges = fsmEdges selfs fsm

-- Compute an FSM's labelled edges
fsmEdges :: SelfLoops -> FSM sy -> [(State, State, sy)]
fsmEdges selfs = concatMap (symbolEdges selfs) . M.toList . unFSM

-- Given a symbol, action pair, compute the list of edges with that
-- symbol.
symbolEdges :: SelfLoops -> (sy, Action) -> [(State, State, sy)]
symbolEdges selfs (s, a) =
    concatMap (syStateEdges selfs s) $ zipWithIndex $ destinationSets a

-- Given a symbol, a start state, and a destination set, compute the
-- list of edges leading from that state with that symbol, possibly
-- taking account of a desire to trim deterministic self-loops.
syStateEdges :: SelfLoops -> sy -> (State, DestinationSet) ->
                [(State, State, sy)]
syStateEdges Keep s (src, dSet) = syStateEdges' s (src, dSet)
syStateEdges Trim s (src, dSet) =
    if destinations dSet == [src] then [] else syStateEdges' s (src, dSet)

-- Given a symbol, a start state, and a destination set, compute the
-- list of edges leading from that state with that symbol.
syStateEdges' :: sy -> (State, DestinationSet) -> [(State, State, sy)]
syStateEdges' s (src, dSet) = map (\x -> (src, x, s)) $ destinations dSet

-- Create a zip of a list with its index list.
zipWithIndex :: [a] -> [(Int, a)]
zipWithIndex xs = zip [0..(length xs-1)] xs



-- | Compute an FSM's strongly-connected components.
strongCCs :: Eq sy => FSM sy -> [[State]]
strongCCs = scc . fsmToPatriciaTree Trim

-- | Compute an FSM's weakly-connected components.
weakCCs :: Eq sy => FSM sy -> [[State]]
weakCCs = scc . undir . fsmToPatriciaTree Trim

-- | The PatriciaTree instance of Graph is faster, but not generally
-- useful to us because it doesn't allow multiple edges between the
-- same pair of nodes.  For SCC checks, however, that doesn't matter,
-- so we use it.
fsmToPatriciaTree :: SelfLoops -> FSM sy -> P.Gr () sy
fsmToPatriciaTree = flip fsmToFGL'