tools/unitCycles.hs
author nemo
Sat, 19 Mar 2011 19:41:59 -0400
changeset 5025 ac1691d35cf2
parent 4384 615a3e7bd850
permissions -rw-r--r--
Land sprayer tweaks, make land spray and mudball not end turn
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