Make "make tags" work in the new build system

5 files changed, 77 insertions, 109 deletions

diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index b33117a61b..03971be82a 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -468,6 +468,9 @@ ifeq "$(stage)" "3"
 $(eval $(call build-package,compiler,stage3,2))
 endif
 
+compiler_stage2_TAGS_HC_OPTS = -package ghc
+$(eval $(call tags-package,compiler,stage2))
+
 $(compiler_stage1_depfile_haskell) : compiler/stage1/$(PLATFORM_H)
 $(compiler_stage2_depfile_haskell) : compiler/stage2/$(PLATFORM_H)
 $(compiler_stage3_depfile_haskell) : compiler/stage3/$(PLATFORM_H)
diff --git a/ghc.mk b/ghc.mk
index a5828a6703..768ff156a4 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -269,6 +269,7 @@ include rules/build-perl.mk
 include rules/build-package.mk
 include rules/build-package-way.mk
 include rules/haddock.mk
+include rules/tags-package.mk
 
 # -----------------------------------------------------------------------------
 # Registering hand-written package descriptions (used in libffi and rts)
@@ -547,6 +548,7 @@ BUILD_DIRS += \
    compiler \
    $(GHC_HSC2HS_DIR) \
    $(GHC_PKG_DIR) \
+   utils/ghctags \
    utils/hpc \
    utils/runghc \
    ghc
@@ -597,6 +599,7 @@ ifneq "$(findstring $(phase),0 1 2 3)" ""
 # In phases 0-3, we disable stage2-3, the full libraries and haddock
 utils/haddock_dist_DISABLE = YES
 utils/runghc_dist_DISABLE = YES
+utils/ghctags_dist_DISABLE = YES
 utils/hpc_dist_DISABLE = YES
 utils/hsc2hs_dist-install_DISABLE = YES
 utils/ghc-pkg_dist-install_DISABLE = YES
@@ -745,6 +748,9 @@ libraries/ghc-prim/dist-install/build/autogen/GHC/PrimopWrappers.hs: \
                           | $$(dir $$@)/.
 	"$(GENPRIMOP_INPLACE)" --make-haskell-wrappers < $< > $@
 
+.PHONY: tags
+tags: tags_compiler
+
 # -----------------------------------------------------------------------------
 # Installation
 
diff --git a/rules/tags-package.mk b/rules/tags-package.mk
new file mode 100644
index 0000000000..e5d572da62
--- /dev/null
+++ b/rules/tags-package.mk
@@ -0,0 +1,29 @@
+# -----------------------------------------------------------------------------
+#
+# (c) 2009 The University of Glasgow
+#
+# This file is part of the GHC build system.
+#
+# To understand how the build system works and how to modify it, see
+#      http://hackage.haskell.org/trac/ghc/wiki/Building/Architecture
+#      http://hackage.haskell.org/trac/ghc/wiki/Building/Modifying
+#
+# -----------------------------------------------------------------------------
+
+
+# Build the tags files for a package. Use like this:
+#
+# $(eval $(call tags-package,compiler,stage2))
+#
+# Uses the same metadata as build-package.
+
+define tags-package
+# $1 = dir
+# $2 = distdir
+
+.PHONY: tags_$1
+tags_$1:
+	inplace/bin/ghctags --topdir $$(TOP)/inplace/lib -b --use-cabal-config $1/$2 -- $$($1_$2_TAGS_HC_OPTS) $$($1_$2_v_ALL_HC_OPTS) -- $$($1_$2_HS_SRCS)
+
+endef
+
diff --git a/utils/ghctags/GhcTags.hs b/utils/ghctags/Main.hs
index e74b2d1801..9017bd045b 100644
--- a/utils/ghctags/GhcTags.hs
+++ b/utils/ghctags/Main.hs
@@ -1,20 +1,18 @@
-{-# OPTIONS_GHC -XCPP -XPatternGuards -XScopedTypeVariables -Wall #-}
+{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
 module Main where
 
 import Prelude hiding ( mod, id, mapM )
 import GHC hiding (flags)
 --import Packages
 import HscTypes         ( isBootSummary )
-import BasicTypes
 import Digraph          ( flattenSCCs )
 import DriverPhases     ( isHaskellSrcFilename )
 import HscTypes         ( msHsFilePath )
 import Name             ( getOccString )
 --import ErrUtils         ( printBagOfErrors )
 import DynFlags         ( defaultDynFlags )
-import SrcLoc
 import Bag
-import Exception --        ( ghandle )
+import Exception
 import FastString
 import MonadUtils       ( liftIO )
 
@@ -22,16 +20,14 @@ import MonadUtils       ( liftIO )
 import Distribution.Simple.GHC ( ghcOptions )
 import Distribution.Simple.Configure ( getPersistBuildConfig )
 import Distribution.PackageDescription ( library, libBuildInfo )
-import Distribution.Simple.LocalBuildInfo ( localPkgDescr, buildDir )
+import Distribution.Simple.LocalBuildInfo ( localPkgDescr, buildDir, libraryConfig )
 
 import Control.Monad hiding (mapM)
 import System.Environment
 import System.Console.GetOpt
 import System.Exit
-import Data.Char
 import System.IO
 import Data.List as List hiding ( group )
-import Data.Maybe
 import Data.Traversable (mapM)
 import Data.Map ( Map )
 import qualified Data.Map as M
@@ -87,7 +83,7 @@ main = do
   ghcArgs <- case [ d | FlagUseCabalConfig d <- flags ] of
                [distPref] -> do
                   cabalOpts <- flagsFromCabal distPref
-                  return (ghcArgs' ++ cabalOpts)
+                  return (cabalOpts ++ ghcArgs')
                [] ->
                   return ghcArgs'
                _ -> error "Too many --use-cabal-config flags"
@@ -95,8 +91,8 @@ main = do
 
   let modes = getMode flags
   let openFileMode = if elem FlagAppend flags
-  	     then AppendMode
-  	     else WriteMode
+                     then AppendMode
+                     else WriteMode
   ctags_hdl <-  if CTags `elem` modes
                      then Just `liftM` openFile "tags" openFileMode
                      else return Nothing
@@ -116,11 +112,11 @@ main = do
       let dflags2 = pflags { hscTarget = HscNothing } -- don't generate anything
       -- liftIO $ print ("pkgDB", case (pkgDatabase dflags2) of Nothing -> 0
       --                                                        Just m -> sizeUFM m)
-      setSessionDynFlags dflags2
+      _ <- setSessionDynFlags dflags2
       --liftIO $ print (length pkgs)
 
       GHC.defaultCleanupHandler dflags2 $ do
-  
+
         targetsAtOneGo hsfiles (ctags_hdl,etags_hdl)
         mapM_ (mapM (liftIO . hClose)) [ctags_hdl, etags_hdl]
 
@@ -161,34 +157,34 @@ splitArgs args0 = split [] [] False args0
 
 options :: [OptDescr Flag]
 -- supports getopt
-options = [ Option "" ["topdir"] 
+options = [ Option "" ["topdir"]
             (ReqArg FlagTopDir "DIR") "root of GHC installation (optional)"
           , Option "c" ["ctags"]
-	    (NoArg FlagCTags) "generate CTAGS file (ctags)"
-	  , Option "e" ["etags"]
-	    (NoArg FlagETags) "generate ETAGS file (etags)"
-	  , Option "b" ["both"]
-	    (NoArg FlagBoth) ("generate both CTAGS and ETAGS")
-	  , Option "a" ["append"]
-	    (NoArg FlagAppend) ("append to existing CTAGS and/or ETAGS file(s)")
+            (NoArg FlagCTags) "generate CTAGS file (ctags)"
+          , Option "e" ["etags"]
+            (NoArg FlagETags) "generate ETAGS file (etags)"
+          , Option "b" ["both"]
+            (NoArg FlagBoth) ("generate both CTAGS and ETAGS")
+          , Option "a" ["append"]
+            (NoArg FlagAppend) ("append to existing CTAGS and/or ETAGS file(s)")
           , Option "" ["use-cabal-config"]
             (ReqArg FlagUseCabalConfig "DIR") "use local cabal configuration from dist dir"
           , Option "" ["files-from-cabal"]
             (NoArg FlagFilesFromCabal) "use files from cabal"
-	  , Option "h" ["help"] (NoArg FlagHelp) "This help"
-	  ]
+          , Option "h" ["help"] (NoArg FlagHelp) "This help"
+          ]
 
 flagsFromCabal :: FilePath -> IO [String]
 flagsFromCabal distPref = do
   lbi <- getPersistBuildConfig distPref
   let pd = localPkgDescr lbi
-  case library pd of
-    Nothing -> error "no library"
-    Just lib ->
+  case (library pd, libraryConfig lbi) of
+    (Just lib, Just clbi) ->
       let bi = libBuildInfo lib
           odir = buildDir lbi
-          opts = ghcOptions lbi bi odir
+          opts = ghcOptions lbi bi clbi odir
       in return opts
+    _ -> error "no library"
 
 ----------------------------------------------------------------
 --- LOADING HASKELL SOURCE
@@ -237,16 +233,16 @@ graphData graph handles = do
                          liftIO $ exitWith (ExitFailure 1)
 
 fileData :: FileName -> ModuleName -> RenamedSource -> IO FileData
-fileData filename modname (group, _imports, _lie, _doc, _haddock) = do
+fileData filename modname (group, _imports, _lie, _doc) = do
     -- lie is related to type checking and so is irrelevant
     -- imports contains import declarations and no definitions
     -- doc and haddock seem haddock-related; let's hope to ignore them
     ls <- lines `fmap` readFile filename
     let line_map = M.fromAscList $ zip [1..] ls
-    evaluate line_map
-    return $ FileData filename (boundValues modname group) line_map
+    line_map' <- evaluate line_map
+    return $ FileData filename (boundValues modname group) line_map'
 
-boundValues :: ModuleName -> HsGroup Name -> [FoundThing]    
+boundValues :: ModuleName -> HsGroup Name -> [FoundThing]
 -- ^Finds all the top-level definitions in a module
 boundValues mod group =
   let vals = case hs_valds group of
@@ -262,9 +258,7 @@ boundValues mod group =
                                       ForeignImport n _ _ -> [found n]
                                       ForeignExport { } -> []
   in vals ++ tys ++ fors
-  where dataNames tycon cons = found tycon : map conName cons
-        conName td = found $ con_name $ unLoc td
-        found = foundOfLName mod
+  where found = foundOfLName mod
 
 startOfLocated :: Located a -> SrcLoc
 startOfLocated lHs = srcSpanStart $ getLoc lHs
@@ -273,7 +267,7 @@ foundOfLName :: ModuleName -> Located Name -> FoundThing
 foundOfLName mod id = FoundThing mod (getOccString $ unLoc id) (startOfLocated id)
 
 boundThings :: ModuleName -> LHsBind Name -> [FoundThing]
-boundThings modname lbinding = 
+boundThings modname lbinding =
   case unLoc lbinding of
     FunBind { fun_id = id } -> [thing id]
     PatBind { pat_lhs = lhs } -> patThings lhs []
@@ -297,18 +291,14 @@ boundThings modname lbinding =
                ConPatIn _ conargs -> conArgs conargs tl
                ConPatOut _ _ _ _ conargs _ -> conArgs conargs tl
                LitPat _ -> tl
-#if __GLASGOW_HASKELL__ > 608
                NPat _ _ _ -> tl -- form of literal pattern?
-#else
-               NPat _ _ _ _ -> tl -- form of literal pattern?
-#endif
                NPlusKPat id _ _ _ -> thing id : tl
                TypePat _ -> tl -- XXX need help here
                SigPatIn p _ -> patThings p tl
                SigPatOut p _ -> patThings p tl
                _ -> error "boundThings"
         conArgs (PrefixCon ps) tl = foldr patThings tl ps
-        conArgs (RecCon (HsRecFields { rec_flds = flds })) tl 
+        conArgs (RecCon (HsRecFields { rec_flds = flds })) tl
              = foldr (\f tl' -> patThings (hsRecFieldArg f) tl') tl flds
         conArgs (InfixCon p1 p2) tl = patThings p1 $ patThings p2 tl
 
@@ -316,22 +306,22 @@ boundThings modname lbinding =
 -- stuff for dealing with ctags output format
 
 writeTagsData :: (Maybe Handle, Maybe Handle) -> FileData -> IO ()
-writeTagsData (mb_ctags_hdl, mb_etags_hdl) fd = do 
+writeTagsData (mb_ctags_hdl, mb_etags_hdl) fd = do
   maybe (return ()) (\hdl -> writectagsfile hdl fd) mb_ctags_hdl
   maybe (return ()) (\hdl -> writeetagsfile hdl fd) mb_etags_hdl
 
 writectagsfile :: Handle -> FileData -> IO ()
 writectagsfile ctagsfile filedata = do
-	let things = getfoundthings filedata
-	mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing False x) things
-	mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing True  x) things
+        let things = getfoundthings filedata
+        mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing False x) things
+        mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing True  x) things
 
 getfoundthings :: FileData -> [FoundThing]
 getfoundthings (FileData _filename things _src_lines) = things
 
 dumpthing :: Bool -> FoundThing -> String
 dumpthing showmod (FoundThing modname name loc) =
-	fullname ++ "\t" ++ filename ++ "\t" ++ (show line)
+        fullname ++ "\t" ++ filename ++ "\t" ++ (show line)
     where line = srcLocLine loc
           filename = unpackFS $ srcLocFile loc
           fullname = if showmod then moduleNameString modname ++ "." ++ name
@@ -344,10 +334,10 @@ writeetagsfile etagsfile = hPutStr etagsfile . e_dumpfiledata
 
 e_dumpfiledata :: FileData -> String
 e_dumpfiledata (FileData filename things line_map) =
-	"\x0c\n" ++ filename ++ "," ++ (show thingslength) ++ "\n" ++ thingsdump
-	where 
-		thingsdump = concat $ map (e_dumpthing line_map) things
-		thingslength = length thingsdump
+        "\x0c\n" ++ filename ++ "," ++ (show thingslength) ++ "\n" ++ thingsdump
+        where
+                thingsdump = concat $ map (e_dumpthing line_map) things
+                thingslength = length thingsdump
 
 e_dumpthing :: Map Int String -> FoundThing -> String
 e_dumpthing src_lines (FoundThing modname name loc) =
@@ -359,5 +349,5 @@ e_dumpthing src_lines (FoundThing modname name loc) =
           column = srcLocCol loc
           src_code = case M.lookup line src_lines of
                        Just l -> take (column + length name) l
-                       Nothing -> --trace (show ("not found: ", moduleNameString modname, name, line, column)) 
+                       Nothing -> --trace (show ("not found: ", moduleNameString modname, name, line, column))
                                   name
diff --git a/utils/ghctags/Makefile b/utils/ghctags/Makefile
deleted file mode 100644
index d3a59ffcf0..0000000000
--- a/utils/ghctags/Makefile
+++ /dev/null
@@ -1,60 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-SRC_HC_OPTS += -package ghc
-
-HC=$(GHC_STAGE1)
-
-# On Windows, ghc-pkg is a standalone program
-# ($bindir/ghc-pkg.exe), whereas on Unix it needs a wrapper script
-# to pass the appropriate flag to the real binary
-# ($libexecdir/ghc-pkg.bin) so that it can find package.conf.
-ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-HS_PROG           = ghctags.exe
-INSTALL_PROGS    += $(HS_PROG)
-else
-HS_PROG           = ghctags.bin
-INSTALL_LIBEXECS += $(HS_PROG)
-endif
-
-# -----------------------------------------------------------------------------
-# ghctags and ghctags-inplace scripts
-
-# See commentary in ../ghc-pkg/Makefile
-
-INPLACE_HS=ghctags-inplace.hs
-INPLACE_PROG=ghctags-inplace
-EXCLUDED_SRCS+=$(INPLACE_HS)
-
-$(INPLACE_HS): Makefile $(FPTOOLS_TOP)/mk/config.mk
-	echo "import System.Cmd; import System.Environment; import System.Exit" > $@
-	echo "main = do args <- getArgs; rawSystem \"$(FPTOOLS_TOP_ABS)/$(GHC_GHCTAGS_DIR_REL)/$(HS_PROG)\" (\"--topdir\":\"$(FPTOOLS_TOP_ABS)\":args) >>= exitWith" >> $@
-
-$(INPLACE_PROG): $(INPLACE_HS)
-	$(HC) --make $< -o $@
-
-all :: $(INPLACE_PROG)
-
-CLEAN_FILES += $(INPLACE_HS) $(INPLACE_PROG)
-
-ifneq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-LINK = ghctags
-LINK_TARGET = $(LINK)-$(ProjectVersion)
-INSTALLED_SCRIPT=$(DESTDIR)$(bindir)/$(LINK_TARGET)
-install::
-	$(INSTALL_DIR) $(DESTDIR)$(bindir)
-	$(RM) -f $(INSTALLED_SCRIPT)
-	echo "#!$(SHELL)"                                      >> $(INSTALLED_SCRIPT)
-	echo "GHCTAGSBIN=$(libexecdir)/$(HS_PROG)"             >> $(INSTALLED_SCRIPT)
-	echo "TOPDIR=$(libdir)"                  	       >> $(INSTALLED_SCRIPT)
-	echo 'exec $$GHCTAGSBIN --topdir $$TOPDIR $${1+"$$@"}' >> $(INSTALLED_SCRIPT)
-	$(EXECUTABLE_FILE) $(INSTALLED_SCRIPT)
-endif
-
-binary-dist:
-	$(INSTALL_DIR)                $(BIN_DIST_DIR)/utils/ghctags
-	$(INSTALL_DATA)    Makefile   $(BIN_DIST_DIR)/utils/ghctags/
-	$(INSTALL_PROGRAM) $(HS_PROG) $(BIN_DIST_DIR)/utils/ghctags/
-
-include $(TOP)/mk/target.mk
-