tools/unitCycles.hs
changeset 4382 935de6cd5ea3
parent 4367 f4a0ec067601
child 4384 615a3e7bd850
equal deleted inserted replaced
4381:8867bc102f05 4382:935de6cd5ea3
     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 import Data.Graph
       
     9 import Data.Maybe
     9 
    10 
    10 unident :: Identificator -> String
    11 unident :: Identificator -> String
    11 unident (Identificator s) = s
    12 unident (Identificator s) = s
    12 
    13 
    13 extractUnits :: PascalUnit -> (String, [String])
    14 extractUnits :: PascalUnit -> (String, [String])
    18 f = unlines . map showSCC . stronglyConnComp . map (\(a, b) -> (a, a, b))
    19 f = unlines . map showSCC . stronglyConnComp . map (\(a, b) -> (a, a, b))
    19     where
    20     where
    20     showSCC (AcyclicSCC v) = v
    21     showSCC (AcyclicSCC v) = v
    21     showSCC (CyclicSCC vs) = intercalate ", " vs
    22     showSCC (CyclicSCC vs) = intercalate ", " vs
    22 
    23 
       
    24 myf :: [(String, [String])] -> String
       
    25 myf d = unlines . map (findCycle . fst) $ d
       
    26     where
       
    27     findCycle :: String -> String
       
    28     findCycle searched = intercalate ", " $ fc searched [searched]
       
    29         where
       
    30         fc :: String -> [String] -> [String]
       
    31         fc curSearch visited = let uses = curSearch `lookup` d in if isNothing uses then [] else concatMap t $ fromJust uses
       
    32             where
       
    33             t u =
       
    34                 if u == searched then
       
    35                     [u]
       
    36                     else
       
    37                     if u `elem` visited then
       
    38                         []
       
    39                         else
       
    40                         let chain = fc u (u:visited) in if null chain then [] else u:chain
       
    41 
       
    42 
    23 main = do
    43 main = do
    24     fileNames <- getArgs
    44     fileNames <- getArgs
    25     files <- mapM readFile fileNames
    45     files <- mapM readFile fileNames
    26     putStrLn . f . map extractUnits . rights . map parsePascalUnit $ files
    46     putStrLn . myf . map extractUnits . rights . map parsePascalUnit $ files