From 3831a007f7161c35254bd539dfe42d1bb24eeeb3 Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Sun, 22 Mar 2009 15:51:43 +0000
Subject: [PATCH] Finally got round to adding a little program to qualify the
 AST tags in the TAGS file

---
 Makefile.am    |  7 +++++-
 ProcessTags.hs | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 68 insertions(+), 1 deletion(-)
 create mode 100644 ProcessTags.hs

diff --git a/Makefile.am b/Makefile.am
index bf4ccc3..edd9f9a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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
+
 
diff --git a/ProcessTags.hs b/ProcessTags.hs
new file mode 100644
index 0000000..6d01128
--- /dev/null
+++ b/ProcessTags.hs
@@ -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')