Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
0ca48da7
Commit
0ca48da7
authored
Feb 21, 2010
by
Ian Lynagh
Browse files
Make "make tags" work in the new build system
parent
a4c75d1d
Changes
5
Hide whitespace changes
Inline
Side-by-side
compiler/ghc.mk
View file @
0ca48da7
...
...
@@ -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)
...
...
ghc.mk
View file @
0ca48da7
...
...
@@ -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
...
...
rules/tags-package.mk
0 → 100644
View file @
0ca48da7
# -----------------------------------------------------------------------------
#
# (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
utils/ghctags/
GhcTags
.hs
→
utils/ghctags/
Main
.hs
View file @
0ca48da7
{-#
OPTIONS_GHC -XCPP -X
PatternGuards
-X
ScopedTypeVariables
-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
utils/ghctags/Makefile
deleted
100644 → 0
View file @
a4c75d1d
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
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment