tools/unitCycles.hs
author nemo
Fri, 23 Mar 2012 18:20:59 -0400
changeset 6810 5337f554480e
parent 4384 615a3e7bd850
permissions -rw-r--r--
This has bugged me for a while. Since we are missing the source SVGs for this theme, removed the leaves crudely in GIMP. Also added some basic roots. Someone more artistic is encouraged to try and improve it.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4353
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
     1
module Main where
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
     2
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
     3
import PascalParser
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
     4
import System
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
     5
import Control.Monad
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
     6
import Data.Either
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
     7
import Data.List
4355
4554c4df9f1a A program which finds a cycles in units dependencies
unC0Rr
parents: 4353
diff changeset
     8
import Data.Graph
4382
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
     9
import Data.Maybe
4353
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
    10
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
    11
unident :: Identificator -> String
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
    12
unident (Identificator s) = s
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
    13
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
    14
extractUnits :: PascalUnit -> (String, [String])
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
    15
extractUnits (Program (Identificator name) (Implementation (Uses idents) _ _) _) = ("program " ++ name, map unident idents)
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
    16
extractUnits (Unit (Identificator name) (Interface (Uses idents1) _) (Implementation (Uses idents2) _ _) _ _) = (name, map unident $ idents1 ++ idents2)
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
    17
4355
4554c4df9f1a A program which finds a cycles in units dependencies
unC0Rr
parents: 4353
diff changeset
    18
f :: [(String, [String])] -> String
4554c4df9f1a A program which finds a cycles in units dependencies
unC0Rr
parents: 4353
diff changeset
    19
f = unlines . map showSCC . stronglyConnComp . map (\(a, b) -> (a, a, b))
4554c4df9f1a A program which finds a cycles in units dependencies
unC0Rr
parents: 4353
diff changeset
    20
    where
4554c4df9f1a A program which finds a cycles in units dependencies
unC0Rr
parents: 4353
diff changeset
    21
    showSCC (AcyclicSCC v) = v
4554c4df9f1a A program which finds a cycles in units dependencies
unC0Rr
parents: 4353
diff changeset
    22
    showSCC (CyclicSCC vs) = intercalate ", " vs
4554c4df9f1a A program which finds a cycles in units dependencies
unC0Rr
parents: 4353
diff changeset
    23
4382
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    24
myf :: [(String, [String])] -> String
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    25
myf d = unlines . map (findCycle . fst) $ d
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    26
    where
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    27
    findCycle :: String -> String
4384
615a3e7bd850 It works, though wastes too much of CPU
unc0rr
parents: 4382
diff changeset
    28
    findCycle searched = searched ++ ": " ++ (intercalate ", " $ fc searched [])
4382
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    29
        where
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    30
        fc :: String -> [String] -> [String]
4384
615a3e7bd850 It works, though wastes too much of CPU
unc0rr
parents: 4382
diff changeset
    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
4382
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    32
            where
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    33
            t u =
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    34
                if u == searched then
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    35
                    [u]
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    36
                    else
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    37
                    if u `elem` visited then
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    38
                        []
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    39
                        else
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    40
                        let chain = fc u (u:visited) in if null chain then [] else u:chain
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    41
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    42
4353
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
    43
main = do
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
    44
    fileNames <- getArgs
671d66ba3af6 Dumb parser of pascal, and a program which lists unit dependencies
unC0Rr
parents:
diff changeset
    45
    files <- mapM readFile fileNames
4382
935de6cd5ea3 New version of cycles searcher, doesn't work for some reason (shouldn't use O(n) lookup?)
unC0Rr
parents: 4367
diff changeset
    46
    putStrLn . myf . map extractUnits . rights . map parsePascalUnit $ files