tools/unitCycles.hs
changeset 4355 4554c4df9f1a
parent 4353 671d66ba3af6
child 4367 f4a0ec067601
equal deleted inserted replaced
4353:671d66ba3af6 4355:4554c4df9f1a
     3 import PascalParser
     3 import PascalParser
     4 import System
     4 import System
     5 import Control.Monad
     5 import Control.Monad
     6 import Data.Either
     6 import Data.Either
     7 import Data.List
     7 import Data.List
       
     8 import Data.Graph
     8 
     9 
     9 unident :: Identificator -> String
    10 unident :: Identificator -> String
    10 unident (Identificator s) = s
    11 unident (Identificator s) = s
    11 
    12 
    12 extractUnits :: PascalUnit -> (String, [String])
    13 extractUnits :: PascalUnit -> (String, [String])
    13 extractUnits (Program (Identificator name) (Implementation (Uses idents) _ _) _) = ("program " ++ name, map unident idents)
    14 extractUnits (Program (Identificator name) (Implementation (Uses idents) _ _) _) = ("program " ++ name, map unident idents)
    14 extractUnits (Unit (Identificator name) (Interface (Uses idents1) _) (Implementation (Uses idents2) _ _) _ _) = (name, map unident $ idents1 ++ idents2)
    15 extractUnits (Unit (Identificator name) (Interface (Uses idents1) _) (Implementation (Uses idents2) _ _) _ _) = (name, map unident $ idents1 ++ idents2)
    15 
    16 
       
    17 -- stronglyConnComp :: Ord key => [(node, key, [key])] -> [SCC node]
       
    18 
       
    19 f :: [(String, [String])] -> String
       
    20 f = unlines . map showSCC . stronglyConnComp . map (\(a, b) -> (a, a, b))
       
    21     where
       
    22     showSCC (AcyclicSCC v) = v
       
    23     showSCC (CyclicSCC vs) = intercalate ", " vs
       
    24 
    16 main = do
    25 main = do
    17     fileNames <- getArgs
    26     fileNames <- getArgs
    18     files <- mapM readFile fileNames
    27     files <- mapM readFile fileNames
    19     mapM_ (putStrLn . show . extractUnits) . rights . map parsePascalUnit $ files
    28     putStrLn . f . map extractUnits . rights . map parsePascalUnit $ files