author  koda 
Thu, 13 Jan 2011 02:56:25 +0100  
branch  0.9.15 
changeset 4733  45b5a16c01fb 
parent 4384  615a3e7bd850 
permissions  rwrr 
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  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  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 