Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
82901986
Commit
82901986
authored
Jan 19, 2015
by
Andrey Mokhov
Browse files
Fix recursive rules error.
parent
a1819f6a
Changes
5
Hide whitespace changes
Inline
Side-by-side
src/Package/Base.hs
View file @
82901986
...
...
@@ -108,8 +108,9 @@ includeGhcArgs path dist =
pkgHsSources
::
FilePath
->
FilePath
->
Action
[
FilePath
]
pkgHsSources
path
dist
=
do
let
pathDist
=
path
</>
dist
autogen
=
pathDist
</>
"build/autogen"
dirs
<-
map
(
path
</>
)
<$>
args
(
SrcDirs
pathDist
)
findModuleFiles
pathDist
dirs
[
".hs"
,
".lhs"
]
findModuleFiles
pathDist
(
autogen
:
dirs
)
[
".hs"
,
".lhs"
]
-- TODO: look for non-{hs,c} objects too
...
...
@@ -136,11 +137,13 @@ pkgLibHsObjects path dist stage way = do
let
pathDist
=
path
</>
dist
buildDir
=
unifyPath
$
pathDist
</>
"build"
split
<-
splitObjects
stage
depObjs
<-
pkgDepHsObjects
path
dist
way
if
split
then
do
need
depObjs
-- Otherwise, split objects may not yet be available
let
suffix
=
"_"
++
osuf
way
++
"_split/*."
++
osuf
way
findModuleFiles
pathDist
[
buildDir
]
[
suffix
]
else
pkgDepHsObjects
path
dist
way
else
do
return
depObjs
findModuleFiles
::
FilePath
->
[
FilePath
]
->
[
String
]
->
Action
[
FilePath
]
findModuleFiles
pathDist
directories
suffixes
=
do
...
...
@@ -153,7 +156,6 @@ findModuleFiles pathDist directories suffixes = do
let
dir
=
takeDirectory
file
dirExists
<-
liftIO
$
S
.
doesDirectoryExist
dir
when
dirExists
$
return
file
files
<-
getDirectoryFiles
""
fileList
return
$
map
unifyPath
files
...
...
src/Package/Compile.hs
View file @
82901986
...
...
@@ -49,8 +49,10 @@ compileHaskell pkg @ (Package _ path _) todo @ (stage, dist, _) obj way = do
let
buildDir
=
unifyPath
$
path
</>
dist
</>
"build"
-- TODO: keep only vanilla dependencies in 'haskell.deps'
deps
<-
args
$
DependencyList
(
buildDir
</>
"haskell.deps"
)
obj
let
(
srcs
,
his
)
=
partition
(
"//*hs"
?==
)
deps
objs
=
map
(
-<.>
osuf
way
)
his
-- Need *.o files instead of *.hi files to avoid recursive rules
need
deps
let
srcs
=
filter
(
"//*hs"
?==
)
deps
run
(
Ghc
stage
)
$
ghcArgs
pkg
todo
way
srcs
obj
buildRule
::
Package
->
TodoItem
->
Rules
()
...
...
@@ -64,15 +66,19 @@ buildRule pkg @ (Package name path _) todo @ (stage, dist, _) =
(
buildDir
<//>
hiPattern
)
%>
\
hi
->
do
let
obj
=
hi
-<.>
osuf
way
need
[
obj
]
-- TODO: Understand why 'need [obj]' doesn't work, leading to
-- recursive rules error. Below is a workaround.
-- putColoured Yellow $ "Hi " ++ hi
compileHaskell
pkg
todo
obj
way
(
buildDir
<//>
oPattern
)
%>
\
obj
->
do
need
[
argListPath
argListDir
pkg
stage
]
let
vanillaObjName
=
takeFileName
obj
-<.>
"o"
cDeps
<-
args
$
DependencyList
cDepFile
vanillaObjName
if
null
cDeps
then
compileHaskell
pkg
todo
obj
way
else
compileC
pkg
todo
cDeps
obj
-- Finally, record the argument list
need
[
argListPath
argListDir
pkg
stage
]
argListRule
::
Package
->
TodoItem
->
Rules
()
argListRule
pkg
todo
@
(
stage
,
_
,
settings
)
=
...
...
src/Package/Data.hs
View file @
82901986
...
...
@@ -121,12 +121,14 @@ buildRule pkg @ (Package name path _) todo @ (stage, dist, settings) =
-- TODO: Is this needed? Also check out Paths_cpsa.hs.
-- , "build" </> "autogen" </> ("Paths_" ++ name) <.> "hs"
]
&%>
\
_
->
do
need
[
argListPath
argListDir
pkg
stage
,
cabal
]
need
[
cabal
]
when
(
doesFileExist
$
configure
<.>
"ac"
)
$
need
[
configure
]
run
GhcCabal
$
cabalArgs
pkg
todo
when
(
registerPackage
settings
)
$
run
(
GhcPkg
stage
)
$
ghcPkgArgs
pkg
todo
postProcessPackageData
$
pathDist
</>
"package-data.mk"
-- Finally, record the argument list
need
[
argListPath
argListDir
pkg
stage
]
argListRule
::
Package
->
TodoItem
->
Rules
()
argListRule
pkg
todo
@
(
stage
,
_
,
_
)
=
...
...
src/Package/Dependencies.hs
View file @
82901986
...
...
@@ -61,12 +61,12 @@ buildRule pkg @ (Package name path _) todo @ (stage, dist, settings) = do
let
pathDist
=
path
</>
dist
buildDir
=
pathDist
</>
"build"
(
buildDir
</>
"haskell.deps"
)
%>
\
out
->
do
need
[
argListPath
argListDir
pkg
stage
]
(
buildDir
</>
"haskell.deps"
)
%>
\
_
->
do
run
(
Ghc
stage
)
$
ghcArgs
pkg
todo
-- Finally, record the argument list
need
[
argListPath
argListDir
pkg
stage
]
(
buildDir
</>
"c.deps"
)
%>
\
out
->
do
need
[
argListPath
argListDir
pkg
stage
]
srcs
<-
args
$
CSrcs
pathDist
deps
<-
fmap
concat
$
forM
srcs
$
\
src
->
do
let
srcPath
=
path
</>
src
...
...
@@ -75,6 +75,8 @@ buildRule pkg @ (Package name path _) todo @ (stage, dist, settings) = do
liftIO
$
readFile
depFile
writeFileChanged
out
deps
liftIO
$
removeFiles
buildDir
[
"*.c.deps"
]
-- Finally, record the argument list
need
[
argListPath
argListDir
pkg
stage
]
argListRule
::
Package
->
TodoItem
->
Rules
()
argListRule
pkg
todo
@
(
stage
,
_
,
_
)
=
...
...
src/Package/Library.hs
View file @
82901986
...
...
@@ -26,13 +26,15 @@ arRule pkg @ (Package _ path _) todo @ (stage, dist, _) =
let
way
=
detectWay
$
tail
$
takeExtension
out
cObjs
<-
pkgCObjects
path
dist
way
hsObjs
<-
pkgDepHsObjects
path
dist
way
need
$
[
argListPath
argListDir
pkg
stage
]
++
cObjs
++
hsObjs
need
$
cObjs
++
hsObjs
libHsObjs
<-
pkgLibHsObjects
path
dist
stage
way
liftIO
$
removeFiles
"."
[
out
]
-- Splitting argument list into chunks as otherwise Ar chokes up
maxChunk
<-
argSizeLimit
forM_
(
chunksOfSize
maxChunk
$
cObjs
++
libHsObjs
)
$
\
objs
->
do
run
Ar
$
arArgs
objs
$
unifyPath
out
-- Finally, record the argument list
need
[
argListPath
argListDir
pkg
stage
]
ldRule
::
Package
->
TodoItem
->
Rules
()
ldRule
pkg
@
(
Package
name
path
_
)
todo
@
(
stage
,
dist
,
_
)
=
...
...
@@ -42,13 +44,15 @@ ldRule pkg @ (Package name path _) todo @ (stage, dist, _) =
priority
2
$
(
buildDir
</>
"*.o"
)
%>
\
out
->
do
cObjs
<-
pkgCObjects
path
dist
vanilla
hObjs
<-
pkgDepHsObjects
path
dist
vanilla
need
$
[
argListPath
argListDir
pkg
stage
]
++
cObjs
++
hObjs
need
$
cObjs
++
hObjs
run
Ld
$
ldArgs
stage
(
cObjs
++
hObjs
)
$
unifyPath
out
synopsis
<-
dropWhileEnd
isPunctuation
<$>
showArg
(
Synopsis
pathDist
)
putColoured
Green
$
"/--------
\n
| Successfully built package '"
++
name
++
"' (stage "
++
show
stage
++
")."
putColoured
Green
$
"| Package synopsis: "
++
synopsis
++
"."
++
"
\n\\
--------"
-- Finally, record the argument list
need
[
argListPath
argListDir
pkg
stage
]
argListRule
::
Package
->
TodoItem
->
Rules
()
argListRule
pkg
@
(
Package
_
path
_
)
todo
@
(
stage
,
dist
,
settings
)
=
...
...
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