7 -- search for definitions of things
8 -- we do this by looking for the following patterns:
9 -- data XXX = ... giving a datatype location
10 -- newtype XXX = ... giving a newtype location
11 -- bla :: ... giving a function location
13 -- by doing it this way, we avoid picking up local definitions
19 foundthings <- mapM findthings filenames
20 mapM_ (\x -> putStrLn $ dumpthing x) (concat foundthings)
22 type FileName = String
24 type ThingName = String
26 data Pos = Pos FileName Int
29 data FoundThing = FoundThing ThingName Pos
32 dumpthing :: FoundThing -> String
33 dumpthing (FoundThing name (Pos filename line)) =
34 name ++ "\t" ++ filename ++ "\t" ++ (show line)
36 data Token = Token String Pos
39 findthings :: FileName -> IO [FoundThing]
42 text <- readFile filename
43 let aslines = lines text
44 let wordlines = map words aslines
45 let nocoms = map stripslcomments wordlines
46 let tokens = concat $ zipWith (withline filename) nocoms $ ints 0
47 return $ findstuff tokens
49 withline :: FileName -> [String] -> Int -> [Token]
50 withline fname words i = map (\w -> Token w (Pos fname i)) words
52 stripslcomments :: [String] -> [String]
53 stripslcomments ("--":xs) = []
54 stripslcomments (x:xs) = x : stripslcomments xs
55 stripslcomments [] = []
58 ints i = i:(ints $ i+1)
60 findstuff :: [Token] -> [FoundThing]
61 findstuff ((Token "data" _):(Token name pos):xs) =
62 FoundThing name pos : (getcons xs) ++ (findstuff xs)
63 findstuff ((Token "type" _):(Token name pos):xs) =
64 FoundThing name pos : findstuff xs
65 findstuff ((Token name pos):(Token "::" _):xs) =
66 FoundThing name pos : findstuff xs
67 findstuff (x:xs) = findstuff xs
71 -- get the constructor definitions, knowing that a datatype has just started
73 getcons :: [Token] -> [FoundThing]
74 getcons ((Token "=" _):(Token name pos):xs) =
75 FoundThing name pos : getcons2 xs
76 getcons (x:xs) = getcons xs
80 getcons2 ((Token "=" _):xs) = []
81 getcons2 ((Token "|" _):(Token name pos):xs) =
82 FoundThing name pos : getcons2 xs
83 getcons2 (x:xs) = getcons2 xs