1 module Main where

     2 

     3 import PascalParser

     4 import System

     5 import Control.Monad

     6 import Data.Either

     7 import Data.List

     8 import Data.Graph

     9 import Data.Maybe

    10 

    11 unident :: Identificator -> String

    12 unident (Identificator s) = s

    13 

    14 extractUnits :: PascalUnit -> (String, [String])

    15 extractUnits (Program (Identificator name) (Implementation (Uses idents) _ _) _) = ("program " ++ name, map unident idents)

    16 extractUnits (Unit (Identificator name) (Interface (Uses idents1) _) (Implementation (Uses idents2) _ _) _ _) = (name, map unident $ idents1 ++ idents2)

    17 

    18 f :: [(String, [String])] -> String

    19 f = unlines . map showSCC . stronglyConnComp . map (\(a, b) -> (a, a, b))

    20     where

    21     showSCC (AcyclicSCC v) = v

    22     showSCC (CyclicSCC vs) = intercalate ", " vs

    23 

    24 myf :: [(String, [String])] -> String

    25 myf d = unlines . map (findCycle . fst) $ d

    26     where

    27     findCycle :: String -> String

    28     findCycle searched = searched ++ ": " ++ (intercalate ", " $ fc searched [])

    29         where

    30         fc :: String -> [String] -> [String]

    31         fc curSearch visited = let uses = curSearch `lookup` d; res = dropWhile null . map t $ fromJust uses in if isNothing uses || null res then [] else head res

    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 

    43 main = do

    44     fileNames <- getArgs

    45     files <- mapM readFile fileNames

    46     putStrLn . myf . map extractUnits . rights . map parsePascalUnit $ files