tools/unitCycles.hs
author Xeli
Wed, 17 Aug 2011 12:31:10 +0200
branchhedgeroid
changeset 5579 3176ee8a9d94
parent 4384 615a3e7bd850
permissions -rw-r--r--
uTouch, has cursor move, zoom and click or tap to open the ammo menu

module Main where

import PascalParser
import System
import Control.Monad
import Data.Either
import Data.List
import Data.Graph
import Data.Maybe

unident :: Identificator -> String
unident (Identificator s) = s

extractUnits :: PascalUnit -> (String, [String])
extractUnits (Program (Identificator name) (Implementation (Uses idents) _ _) _) = ("program " ++ name, map unident idents)
extractUnits (Unit (Identificator name) (Interface (Uses idents1) _) (Implementation (Uses idents2) _ _) _ _) = (name, map unident $ idents1 ++ idents2)

f :: [(String, [String])] -> String
f = unlines . map showSCC . stronglyConnComp . map (\(a, b) -> (a, a, b))
    where
    showSCC (AcyclicSCC v) = v
    showSCC (CyclicSCC vs) = intercalate ", " vs

myf :: [(String, [String])] -> String
myf d = unlines . map (findCycle . fst) $ d
    where
    findCycle :: String -> String
    findCycle searched = searched ++ ": " ++ (intercalate ", " $ fc searched [])
        where
        fc :: String -> [String] -> [String]
        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
            where
            t u =
                if u == searched then
                    [u]
                    else
                    if u `elem` visited then
                        []
                        else
                        let chain = fc u (u:visited) in if null chain then [] else u:chain


main = do
    fileNames <- getArgs
    files <- mapM readFile fileNames
    putStrLn . myf . map extractUnits . rights . map parsePascalUnit $ files