Finally got round to adding a little program to qualify the AST tags in the TAGS file
This commit is contained in:
parent
68161bdfea
commit
3831a007f7
|
@ -240,6 +240,11 @@ haddock:
|
|||
cat docextra/tock-docs.m4 $$x | m4 -P >$${x}_ && mv $${x}_ $$x; \
|
||||
done
|
||||
|
||||
TAGS: $(tocktest_SOURCES)
|
||||
TAGS: $(tocktest_SOURCES) ProcessTags.hs
|
||||
ghc -o postprocesstags ProcessTags.hs -odir obj -hidir obj
|
||||
hasktags -e $(tocktest_SOURCES)
|
||||
mv TAGS TAGSorig
|
||||
./postprocesstags < TAGSorig > TAGS
|
||||
rm TAGSorig
|
||||
|
||||
|
||||
|
|
62
ProcessTags.hs
Normal file
62
ProcessTags.hs
Normal file
|
@ -0,0 +1,62 @@
|
|||
import Control.Monad
|
||||
import Data.List
|
||||
|
||||
data Section = Section String [String]
|
||||
|
||||
instance Show Section where
|
||||
show (Section fileName lines)
|
||||
= unlines ["\x0c", fileName ++ "," ++ show (length ls)]
|
||||
++ ls
|
||||
where
|
||||
ls = unlines lines
|
||||
|
||||
splitIntoSections :: [String] -> [Section]
|
||||
splitIntoSections ("\x0c" : fileLine : rest)
|
||||
= (Section (takeWhile (/= ',') fileLine) this)
|
||||
: splitIntoSections next
|
||||
where
|
||||
(this, next) = span (/= "\x0c") rest
|
||||
splitIntoSections [] = []
|
||||
splitIntoSections (l:_) = error $ "Unexpected line: " ++ l
|
||||
|
||||
getPrefix :: [String] -> String -> (String, String)
|
||||
getPrefix ps s = head $ [ (p, drop (length p) s)
|
||||
| p <- ps, p `isPrefixOf` s]
|
||||
++ [([], s)] -- default option
|
||||
|
||||
data LinePart = WhiteSpacePunctuation String | Keyword String | Identifier String
|
||||
|
||||
lineParts :: String -> [LinePart]
|
||||
lineParts [] = []
|
||||
lineParts s = case filter (not . null . fst . fst) $
|
||||
[(span (`notElem` wordChars) s, WhiteSpacePunctuation)
|
||||
,(getPrefix keywords s, Keyword)
|
||||
,(span (`elem` wordChars) s, Identifier)] of
|
||||
(((pre, post), f):_) -> f pre : lineParts post
|
||||
_ -> error $ "Could not parse line: " ++ s
|
||||
where
|
||||
wordChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ ['\'','_']
|
||||
keywords = ["let","data","type","newtype"]
|
||||
|
||||
qualify :: String -> String -> String
|
||||
qualify modName line
|
||||
= concat [case lp of
|
||||
WhiteSpacePunctuation s -> s
|
||||
Keyword k -> k
|
||||
Identifier s -> s
|
||||
| lp <- lineParts lineStart]
|
||||
++ "\x7f"
|
||||
++ concat [prefix s ++ "\x01" | Identifier s <- lineParts lineStart]
|
||||
++ tail lineEnd
|
||||
where
|
||||
prefix = ((modName ++ ".") ++)
|
||||
(lineStart, lineEnd) = span (/= '\x7f') line
|
||||
|
||||
main :: IO ()
|
||||
main = do ls <- liftM lines $ getContents
|
||||
let lsSplit = splitIntoSections ls
|
||||
lsSplit' = [ if fileName == "data/AST.hs"
|
||||
then Section fileName $ map (qualify "A") lines
|
||||
else Section fileName lines
|
||||
| Section fileName lines <- lsSplit]
|
||||
putStr (concatMap show lsSplit')
|
Loading…
Reference in New Issue
Block a user