tools/unitCycles.hs
branch0.9.19
changeset 8857 0bdeea9d388e
parent 8791 6e3308fc2a1d
parent 8854 31133afaa025
child 8861 74d2a632c9a6
--- a/tools/unitCycles.hs	Thu Apr 04 14:01:54 2013 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,46 +0,0 @@
-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