Commit 0ca48da7 authored by Ian Lynagh's avatar Ian Lynagh

Make "make tags" work in the new build system

parent a4c75d1d
......@@ -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)
......
......@@ -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
......
# -----------------------------------------------------------------------------
#
# (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
{-# 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
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
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment