|
From: <sv...@va...> - 2005-06-25 14:43:17
|
Author: sewardj
Date: 2005-06-25 15:42:34 +0100 (Sat, 25 Jun 2005)
New Revision: 4016
Log:
A small program to read .dot files created by auxprogs/gen-mdg and
compute the strongly connected components in them.
Added:
trunk/auxprogs/DotToScc.hs
Added: trunk/auxprogs/DotToScc.hs
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
--- trunk/auxprogs/DotToScc.hs 2005-06-24 22:17:38 UTC (rev 4015)
+++ trunk/auxprogs/DotToScc.hs 2005-06-25 14:42:34 UTC (rev 4016)
@@ -0,0 +1,271 @@
+
+-- A program for extracting strongly connected components from a .dot
+-- file created by auxprogs/gen-mdg.
+
+-- How to use: one of the following:
+
+-- compile to an exe: ghc -o dottoscc DotToScc.hs
+-- and then ./dottoscc name_of_file.dot
+
+-- or interpret with runhugs:
+-- runhugs DotToScc.hs name_of_file.dot
+
+-- or run within hugs:
+-- hugs DotToScc.hs
+-- Main> imain "name_of_file.dot"
+
+
+module Main where
+
+import System
+import List ( sort, nub )
+
+usage :: IO ()
+usage =3D putStrLn "usage: dottoscc <name_of_file.dot>"
+
+main :: IO ()
+main =3D do args <- getArgs
+ if length args /=3D 1
+ then usage
+ else imain (head args)
+
+imain :: String -> IO ()
+imain dot_file_name
+ =3D do edges <- read_dot_file dot_file_name
+ let sccs =3D gen_sccs edges
+ let pretty =3D showPrettily sccs
+ putStrLn pretty
+ where
+ showPrettily :: [[String]] -> String
+ showPrettily =3D unlines . concatMap showScc
+
+ showScc elems
+ =3D let n =3D length elems=20
+ in
+ [""]
+ ++ (if n > 1 then [" -- "=20
+ ++ show n ++ " modules in cycle"]=20
+ else [])
+ ++ map (" " ++) elems
+
+
+-- Read a .dot file and return a list of edges
+read_dot_file :: String{-filename-} -> IO [(String,String)]
+read_dot_file dot_file_name
+ =3D do bytes <- readFile dot_file_name
+ let linez =3D lines bytes
+ let edges =3D [(s,d) | Just (s,d) <- map maybe_mk_edge linez]
+ return edges
+ where
+ -- identify lines of the form "text1 -> text2" and return
+ -- text1 and text2
+ maybe_mk_edge :: String -> Maybe (String, String)
+ maybe_mk_edge str
+ =3D case words str of
+ [text1, "->", text2] -> Just (text1, text2)
+ other -> Nothing
+
+
+-- Take the list of edges and return a topologically sorted list of
+-- sccs
+gen_sccs :: [(String,String)] -> [[String]]
+gen_sccs raw_edges
+ =3D let clean_edges =3D sort (nub raw_edges)
+ nodes =3D nub (concatMap (\(s,d) -> [s,d]) clean_edges)
+ ins v =3D [u | (u,w) <- clean_edges, v=3D=3Dw]
+ outs v =3D [w | (u,w) <- clean_edges, v=3D=3Du]
+ components =3D map (sort.utSetToList) (deScc ins outs nodes)
+ in
+ components
+
+
+--------------------------------------------------------------------
+--------------------------------------------------------------------
+--------------------------------------------------------------------
+
+-- Graph-theoretic stuff that does the interesting stuff.
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+deScc :: (Ord a) =3D>
+ (a -> [a]) -> -- The "ins" map
+ (a -> [a]) -> -- The "outs" map
+ [a] -> -- The root vertices
+ [Set a] -- The topologically sorted components
+
+deScc ins outs
+ =3D spanning . depthFirst
+ where depthFirst =3D snd . deDepthFirstSearch outs (utSetEmpty, [])
+ spanning =3D snd . deSpanningSearch ins (utSetEmpty, [])
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+deDepthFirstSearch :: (Ord a) =3D>
+ (a -> [a]) -> -- The map,
+ (Set a, [a]) -> -- state: visited set,
+ -- current sequence of vertic=
es
+ [a] -> -- input vertices sequence
+ (Set a, [a]) -- final state
+
+deDepthFirstSearch
+ =3D foldl . search
+ where
+ search relation (visited, sequence) vertex
+ | utSetElementOf vertex visited =3D (visited, sequence =
)
+ | otherwise =3D (visited', vertex: sequence'=
)
+ where
+ (visited', sequence')
+ =3D deDepthFirstSearch relation
+ (utSetUnion visited (utSetSingleton vertex), =
sequence)
+ (relation vertex)
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+deSpanningSearch :: (Ord a) =3D>
+ (a -> [a]) -> -- The map
+ (Set a, [Set a]) -> -- Current state: visited set,
+ -- current sequence of vertic=
e sets
+ [a] -> -- Input sequence of vertices
+ (Set a, [Set a]) -- Final state
+
+deSpanningSearch
+ =3D foldl . search
+ where
+ search relation (visited, utSetSequence) vertex
+ | utSetElementOf vertex visited =3D (visited, utSetSequ=
ence )
+ | otherwise =3D (visited', utSetFromList (vertex: sequence): utSet=
Sequence)
+ where
+ (visited', sequence)
+ =3D deDepthFirstSearch relation
+ (utSetUnion visited (utSetSingleton vertex), [=
])
+ (relation vertex)
+
+
+
+
+
+--------------------------------------------------------------------
+--------------------------------------------------------------------
+--------------------------------------------------------------------
+-- Most of this set stuff isn't needed.
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+-- =3D=3D=3D set =3D=3D=3D--
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+
+data Set e =3D MkSet [e]
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+unMkSet :: (Ord a) =3D> Set a -> [a]
+
+unMkSet (MkSet s) =3D s
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+utSetEmpty :: (Ord a) =3D> Set a
+
+utSetEmpty =3D MkSet []
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+utSetIsEmpty :: (Ord a) =3D> Set a -> Bool
+
+utSetIsEmpty (MkSet s) =3D s =3D=3D []
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+utSetSingleton :: (Ord a) =3D> a -> Set a
+
+utSetSingleton x =3D MkSet [x]
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+utSetFromList :: (Ord a) =3D> [a] -> Set a
+
+utSetFromList x =3D (MkSet . rmdup . sort) x
+ where rmdup [] =3D []
+ rmdup [x] =3D [x]
+ rmdup (x:y:xs) | x=3D=3Dy =3D rmdup (y:xs)
+ | otherwise =3D x: rmdup (y:xs)
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+utSetToList :: (Ord a) =3D> Set a -> [a]
+
+utSetToList (MkSet xs) =3D xs
+
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+utSetUnion :: (Ord a) =3D> Set a -> Set a -> Set a
+
+utSetUnion (MkSet []) (MkSet []) =3D (MkSet [])
+utSetUnion (MkSet []) (MkSet (b:bs)) =3D (MkSet (b:bs))
+utSetUnion (MkSet (a:as)) (MkSet []) =3D (MkSet (a:as))
+utSetUnion (MkSet (a:as)) (MkSet (b:bs))
+ | a < b =3D MkSet (a: (unMkSet (utSetUnion (MkSet as) (MkSet (b:bs=
)))))
+ | a =3D=3D b =3D MkSet (a: (unMkSet (utSetUnion (MkSet as) (MkSet b=
s))))
+ | a > b =3D MkSet (b: (unMkSet (utSetUnion (MkSet (a:as)) (MkSet b=
s))))
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+utSetIntersection :: (Ord a) =3D> Set a -> Set a -> Set a
+
+utSetIntersection (MkSet []) (MkSet []) =3D (MkSet [])
+utSetIntersection (MkSet []) (MkSet (b:bs)) =3D (MkSet [])
+utSetIntersection (MkSet (a:as)) (MkSet []) =3D (MkSet [])
+utSetIntersection (MkSet (a:as)) (MkSet (b:bs))
+ | a < b =3D utSetIntersection (MkSet as) (MkSet (b:bs))
+ | a =3D=3D b =3D MkSet (a: (unMkSet (utSetIntersection (MkSet as) (=
MkSet bs))))
+ | a > b =3D utSetIntersection (MkSet (a:as)) (MkSet bs)
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+utSetSubtraction :: (Ord a) =3D> Set a -> Set a -> Set a
+
+utSetSubtraction (MkSet []) (MkSet []) =3D (MkSet [])
+utSetSubtraction (MkSet []) (MkSet (b:bs)) =3D (MkSet [])
+utSetSubtraction (MkSet (a:as)) (MkSet []) =3D (MkSet (a:as))
+utSetSubtraction (MkSet (a:as)) (MkSet (b:bs))
+ | a < b =3D MkSet (a: (unMkSet (utSetSubtraction (MkSet as) (MkSet=
(b:bs)))))
+ | a =3D=3D b =3D utSetSubtraction (MkSet as) (MkSet bs)
+ | a > b =3D utSetSubtraction (MkSet (a:as)) (MkSet bs)
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+utSetElementOf :: (Ord a) =3D> a -> Set a -> Bool
+
+utSetElementOf x (MkSet []) =3D False
+utSetElementOf x (MkSet (y:ys)) =3D x=3D=3Dy || (x>y && utSetElementOf=
x (MkSet ys))
+
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+utSetSubsetOf :: (Ord a) =3D> Set a -> Set a -> Bool
+
+utSetSubsetOf (MkSet []) (MkSet bs) =3D True
+utSetSubsetOf (MkSet (a:as)) (MkSet bs)
+ =3D utSetElementOf a (MkSet bs) && utSetSubsetOf (MkSet as) (MkSet b=
s)
+
+
+-- =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D--
+--
+utSetUnionList :: (Ord a) =3D> [Set a] -> Set a
+
+utSetUnionList setList =3D foldl utSetUnion utSetEmpty setList
+
+
|