tools/unitCycles.hs
author nemo
Mon, 22 Oct 2012 22:30:03 -0400
changeset 7791 b937274608ba
parent 4384 615a3e7bd850
permissions -rw-r--r--
Completely arbitrary tweaking of tunnel values (avoids a nil) - still needs smooth curves (probably a target dx/dy to aim for, and slow alterations) and taking less CPU. Also disable unused function in Highlander

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