Merge pull request #2 from bgamari/master

Various fixes

build.sh

+#!/bin/bash -e
+
+root=`dirname $0`
+mkdir -p $root/_shake
+ghc --make -Wall $root/src/Main.hs -i$root/src -rtsopts -with-rtsopts=-I0 -outputdir=$root/_shake -o $root/_shake/build
+$root/_shake/build --lint --directory $root/.. $@

cfg/system.config.in

@@ -45,12 +45,12 @@ ar-supports-at-file = @ArSupportsAtFile@
 # Build options:
 #===============
 
-supports-package-key = @SUPPORTS_PACKAGE_KEY@
-solaris-broken-shld  = @SOLARIS_BROKEN_SHLD@
-split-objects-broken = @SplitObjsBroken@
-ghc-unregisterised   = @Unregisterised@
-ghc-source-path      = @hardtop@
-leading-underscore   = @LeadingUnderscore@
+supports-component-id = @SUPPORTS_COMPONENT_ID@
+solaris-broken-shld   = @SOLARIS_BROKEN_SHLD@
+split-objects-broken  = @SplitObjsBroken@
+ghc-unregisterised    = @Unregisterised@
+ghc-source-path       = @hardtop@
+leading-underscore    = @LeadingUnderscore@
 
 # Information about build, host and target systems:
 #==================================================
@@ -116,3 +116,9 @@ iconv-lib-dirs     = @ICONV_LIB_DIRS@
 
 gmp-include-dirs   = @GMP_INCLUDE_DIRS@
 gmp-lib-dirs       = @GMP_LIB_DIRS@
+
+
+# Optional Dependencies:
+#=======================
+
+with-libdw         = @HaveLibdw@

src/Builder.hs

@@ -111,3 +111,4 @@ fixAbsolutePathOnWindows path = do
 -- Instances for storing in the Shake database
 instance Binary Builder
 instance Hashable Builder
+instance NFData Builder

src/GHC.hs

 module GHC (
-    array, base, binPackageDb, binary, bytestring, cabal, compiler, containers,
+    array, base, ghcBoot, binary, bytestring, cabal, compiler, containers,
     compareSizes, deepseq, deriveConstants, directory, dllSplit, filepath,
-    genapply, genprimopcode, ghc, ghcCabal, ghcPkg, ghcPrim, ghcPwd, ghcTags,
+    genapply, genprimopcode, ghc, ghcCabal, ghci, ghcPkg, ghcPrim, ghcPwd, ghcTags,
     haddock, haskeline, hsc2hs, hoopl, hp2ps, hpc, hpcBin, integerGmp,
-    integerSimple, mkUserGuidePart, parallel, pretty, primitive, process,
+    integerSimple, iservBin, mkUserGuidePart, parallel, pretty, primitive, process,
     runghc, stm, templateHaskell, terminfo, time, transformers, unix, win32, xhtml,
 
     defaultKnownPackages, defaultTargetDirectory, defaultProgramPath
@@ -20,16 +20,16 @@ import Stage
 -- which can be overridden in Settings/User.hs.
 defaultKnownPackages :: [Package]
 defaultKnownPackages =
-    [ array, base, binPackageDb, binary, bytestring, cabal, compiler
+    [ array, base, ghcBoot, binary, bytestring, cabal, compiler
     , containers, compareSizes, deepseq, deriveConstants, directory, dllSplit
-    , filepath, genapply, genprimopcode, ghc, ghcCabal, ghcPkg, ghcPrim
+    , filepath, genapply, genprimopcode, ghc, ghcCabal, ghci, ghcPkg, ghcPrim
     , ghcPwd, ghcTags, haddock, haskeline, hsc2hs, hoopl, hp2ps, hpc, hpcBin
-    , integerGmp, integerSimple, mkUserGuidePart, parallel, pretty, primitive
-    , process, runghc, stm, templateHaskell, terminfo, time, transformers, unix
-    , win32, xhtml ]
+    , integerGmp, integerSimple, iservBin, mkUserGuidePart, parallel, pretty
+    , primitive , process, runghc, stm, templateHaskell, terminfo, time
+    , transformers, unix, win32, xhtml ]
 
 -- Package definitions (see Package.hs)
-array, base, binPackageDb, binary, bytestring, cabal, compiler, containers,
+array, base, ghcBoot, binary, bytestring, cabal, compiler, containers,
     compareSizes, deepseq, deriveConstants, directory, dllSplit, filepath,
     genapply, genprimopcode, ghc, ghcCabal, ghcPkg, ghcPrim, ghcPwd,
     ghcTags, haddock, haskeline, hsc2hs, hoopl, hp2ps, hpc, hpcBin, integerGmp,
@@ -38,7 +38,7 @@ array, base, binPackageDb, binary, bytestring, cabal, compiler, containers,
 
 array           = library  "array"
 base            = library  "base"
-binPackageDb    = library  "bin-package-db"
+ghcBoot         = library  "ghc-boot"
 binary          = library  "binary"
 bytestring      = library  "bytestring"
 cabal           = library  "Cabal"          `setPath` "libraries/Cabal/Cabal"
@@ -54,6 +54,7 @@ genapply        = utility  "genapply"
 genprimopcode   = utility  "genprimopcode"
 ghc             = topLevel "ghc-bin"        `setPath` "ghc"
 ghcCabal        = utility  "ghc-cabal"
+ghci            = library  "ghci"           `setPath` "libraries/ghci"
 ghcPkg          = utility  "ghc-pkg"
 ghcPrim         = library  "ghc-prim"
 ghcPwd          = utility  "ghc-pwd"
@@ -67,6 +68,7 @@ hpc             = library  "hpc"
 hpcBin          = utility  "hpc-bin"        `setPath` "utils/hpc"
 integerGmp      = library  "integer-gmp"
 integerSimple   = library  "integer-simple"
+iservBin        = topLevel "iserv-bin"      `setPath` "iserv"
 mkUserGuidePart = utility  "mkUserGuidePart"
 parallel        = library  "parallel"
 pretty          = library  "pretty"

src/Oracles/Config/Flag.hs

@@ -16,7 +16,8 @@ data Flag = ArSupportsAtFile
           | LeadingUnderscore
           | SolarisBrokenShld
           | SplitObjectsBroken
-          | SupportsPackageKey
+          | SupportsComponentId
+          | WithLibdw
 
 -- Note, if a flag is set to empty string we treat it as set to NO. This seems
 -- fragile, but some flags do behave like this, e.g. GccIsClang.
@@ -31,7 +32,8 @@ flag f = do
         LeadingUnderscore  -> "leading-underscore"
         SolarisBrokenShld  -> "solaris-broken-shld"
         SplitObjectsBroken -> "split-objects-broken"
-        SupportsPackageKey -> "supports-package-key"
+        SupportsComponentId -> "supports-component-id"
+        WithLibdw          -> "with-libdw"
     value <- askConfigWithDefault key . putError
         $ "\nFlag '" ++ key ++ "' not set in configuration files."
     unless (value == "YES" || value == "NO" || value == "") . putError

src/Oracles/Dependencies.hs

@@ -2,6 +2,7 @@
 module Oracles.Dependencies (dependencies, dependenciesOracle) where
 
 import Base
+import Control.Monad.Trans.Maybe
 import qualified Data.HashMap.Strict as Map
 
 newtype DependenciesKey = DependenciesKey (FilePath, FilePath)
@@ -16,12 +17,11 @@ newtype DependenciesKey = DependenciesKey (FilePath, FilePath)
 dependencies :: FilePath -> FilePath -> Action (FilePath, [FilePath])
 dependencies path obj = do
     let depFile = path -/- ".dependencies"
-    res1 <- askOracle $ DependenciesKey (depFile, obj)
-    -- if no dependencies found attempt to drop the way prefix (for *.c sources)
-    res2 <- case res1 of
-        Nothing -> askOracle $ DependenciesKey (depFile, obj -<.> "o")
-        _       -> return res1
-    case res2 of
+    -- if no dependencies found then attempt to drop the way prefix (for *.c sources)
+    res <- runMaybeT $ msum
+           $ map (\obj' -> MaybeT $ askOracle $ DependenciesKey (depFile, obj'))
+                 [obj, obj -<.> "o"]
+    case res of
         Nothing -> putError $ "No dependencies found for '" ++ obj ++ "'."
         Just [] -> putError $ "Empty dependency list for '" ++ obj ++ "'."
         Just (src:depFiles) -> return (src, depFiles)

src/Oracles/PackageData.hs

@@ -16,8 +16,7 @@ import qualified Data.HashMap.Strict as Map
 -- such as 'path_MODULES = Data.Array Data.Array.Base ...'.
 -- pkgListData Modules therefore returns ["Data.Array", "Data.Array.Base", ...]
 data PackageData = BuildGhciLib FilePath
-                 | LibName      FilePath
-                 | PackageKey   FilePath
+                 | ComponentId  FilePath
                  | Synopsis     FilePath
                  | Version      FilePath
 
@@ -55,8 +54,7 @@ askPackageData path key = do
 pkgData :: PackageData -> Action String
 pkgData packageData = case packageData of
     BuildGhciLib path -> askPackageData path "BUILD_GHCI_LIB"
-    LibName      path -> askPackageData path "LIB_NAME"
-    PackageKey   path -> askPackageData path "PACKAGE_KEY"
+    ComponentId  path -> askPackageData path "COMPONENT_ID"
     Synopsis     path -> askPackageData path "SYNOPSIS"
     Version      path -> askPackageData path "VERSION"
 

src/Package.hs

@@ -49,3 +49,4 @@ instance Ord Package where
 instance Binary Package
 instance Hashable Package where
     hashWithSalt salt = hashWithSalt salt . show
+instance NFData Package

src/Rules.hs

@@ -16,15 +16,15 @@ generateTargets = action $ do
         libTargets <- fmap concat . forM libPkgs $ \pkg -> do
             let target    = PartialTarget stage pkg
                 buildPath = targetPath stage pkg -/- "build"
-            libName     <- interpretPartial target $ getPkgData LibName
+            compId      <- interpretPartial target $ getPkgData ComponentId
             needGhciLib <- interpretPartial target $ getPkgData BuildGhciLib
             needHaddock <- interpretPartial target buildHaddock
             ways        <- interpretPartial target getWays
-            let ghciLib = buildPath -/- "HS" ++ libName <.> "o"
+            let ghciLib = buildPath -/- "HS" ++ compId <.> "o"
                 haddock = pkgHaddockFile pkg
             libs <- fmap concat . forM ways $ \way -> do
                 extension <- libsuf way
-                let name = buildPath -/- "libHS" ++ libName
+                let name = buildPath -/- "libHS" ++ compId
                 dll0 <- needDll0 stage pkg
                 return $ [ name <.> extension ]
                       ++ [ name ++ "-0" <.> extension | dll0 ]

src/Rules/Compile.hs

@@ -28,16 +28,6 @@ compilePackage _ target @ (PartialTarget stage pkg) = do
             build $ fullTargetWithWay target (Ghc stage) way [src] [obj]
 
     -- TODO: get rid of these special cases
-    priority 2.0 $ buildPath -/- "DeriveConstants.o" %> \obj -> do
-        let src = pkgPath pkg -/- "DeriveConstants.hs"
-        need [src]
-        build $ fullTargetWithWay target (Ghc stage) vanilla [src] [obj]
-
-    priority 2.0 $ buildPath -/- "GenApply.o" %> \obj -> do
-        let src = pkgPath pkg -/- "GenApply.hs"
-        need [src]
-        build $ fullTargetWithWay target (Ghc stage) vanilla [src] [obj]
-
     matchBuildResult buildPath "o-boot" ?> \obj -> do
         (src, deps) <- dependencies buildPath obj
         need $ src : deps

src/Rules/Data.hs

 module Rules.Data (buildPackageData) where
 
 import Expression
-import GHC (deriveConstants, genapply, genprimopcode, hp2ps)
+import GHC (hp2ps)
 import Oracles
 import Predicates (registerPackage)
 import Rules.Actions
@@ -47,40 +47,6 @@ buildPackageData rs target @ (PartialTarget stage pkg) = do
 
             postProcessPackageData $ path -/- "package-data.mk"
 
-    -- TODO: Track dependency on this generated file
-    -- TODO: Use a cabal file instead of manual hacks?
-    priority 2.0 $
-        when (pkg == deriveConstants) $ path -/- "package-data.mk" %> \mk -> do
-        let contents = unlines
-                [ "utils_deriveConstants_dist-boot_MODULES = DeriveConstants"
-                , "utils_deriveConstants_dist-boot_PROGNAME = deriveConstants"
-                , "utils_deriveConstants_dist-boot_HS_SRC_DIRS = ."
-                , "utils_deriveConstants_dist-boot_INSTALL_INPLACE = YES"
-                , "utils_deriveConstants_dist-boot_HC_OPTS = -package process -package containers" ]
-        writeFileChanged mk contents
-
-    priority 2.0 $
-        when (pkg == genapply) $ path -/- "package-data.mk" %> \mk -> do
-        ghcUnreg <- flag GhcUnregisterised
-        let hcOpts = "-package pretty" ++ if ghcUnreg then " -DNO_REGS" else ""
-            contents = unlines
-                [ "utils_genapply_dist-boot_MODULES = GenApply"
-                , "utils_genapply_dist-boot_PROGNAME = genapply"
-                , "utils_genapply_dist-boot_HS_SRC_DIRS = ."
-                , "utils_genapply_dist-boot_INSTALL_INPLACE = YES"
-                , "utils_genapply_dist-boot_HC_OPTS = " ++ hcOpts ]
-        writeFileChanged mk contents
-
-    priority 2.0 $
-        when (pkg == genprimopcode) $ path -/- "package-data.mk" %> \mk -> do
-        let contents = unlines
-                [ "utils_genprimopcode_dist-boot_MODULES = Lexer Main ParserM Parser Syntax"
-                , "utils_genprimopcode_dist-boot_PROGNAME = genprimopcode"
-                , "utils_genprimopcode_dist-boot_HS_SRC_DIRS = ."
-                , "utils_genprimopcode_dist-boot_INSTALL_INPLACE = YES"
-                , "utils_genprimopcode_dist-boot_HC_OPTS = -package array" ]
-        writeFileChanged mk contents
-
     -- TODO: PROGNAME was $(CrossCompilePrefix)hp2ps
     -- TODO: code duplication around ghcIncludeDirs
     -- TODO: now using DEP_EXTRA_LIBS instead of EXTRA_LIBRARIES

src/Rules/Generate.hs

@@ -106,6 +106,7 @@ generateConfigHs = do
     cGHC_SPLIT_PGM             <- fmap takeBaseName $ getBuilderPath GhcSplit
     cLibFFI                    <- lift useLibFFIForAdjustors
     rtsWays                    <- getRtsWays
+    cGhcRtsWithLibdw           <- getFlag WithLibdw
     let cGhcRTSWays = unwords $ map show rtsWays
     return $ unlines
         [ "{-# LANGUAGE CPP #-}"
@@ -169,7 +170,9 @@ generateConfigHs = do
         , "cGhcThreaded :: Bool"
         , "cGhcThreaded = " ++ show (threaded `elem` rtsWays)
         , "cGhcDebugged :: Bool"
-        , "cGhcDebugged = " ++ show ghcDebugged ]
+        , "cGhcDebugged = " ++ show ghcDebugged
+        , "cGhcRtsWithLibdw :: Bool"
+        , "cGhcRtsWithLibdw = " ++ show cGhcRtsWithLibdw ]
 
 generatePlatformH :: Expr String
 generatePlatformH = do

src/Settings/Builders/Ghc.hs

@@ -91,11 +91,11 @@ wayGhcArgs = do
 -- TODO: Improve handling of "-hide-all-packages"
 packageGhcArgs :: Args
 packageGhcArgs = do
-    stage              <- getStage
-    pkg                <- getPackage
-    supportsPackageKey <- getFlag SupportsPackageKey
-    pkgKey             <- getPkgData PackageKey
-    pkgDepIds          <- getPkgDataList DepIds
+    stage               <- getStage
+    pkg                 <- getPackage
+    supportsComponentId <- getFlag SupportsComponentId
+    compId              <- getPkgData ComponentId
+    pkgDepIds           <- getPkgDataList DepIds
     mconcat
         [ not (pkg == deriveConstants || pkg == genapply
             || pkg == genprimopcode   || pkg == hp2ps) ?
@@ -103,9 +103,9 @@ packageGhcArgs = do
         , arg "-no-user-package-db"
         , stage0 ? arg "-package-db libraries/bootstrapping.conf"
         , isLibrary pkg ?
-          if supportsPackageKey || stage /= Stage0
-          then arg $ "-this-package-key " ++ pkgKey
-          else arg $ "-package-name "     ++ pkgKey
+          if supportsComponentId || stage /= Stage0
+          then arg $ "-this-package-key " ++ compId
+          else arg $ "-package-name "     ++ compId
         , append $ map ("-package-id " ++) pkgDepIds ]
 
 -- TODO: Improve handling of "cabal_macros.h"

src/Settings/Packages.hs

@@ -18,7 +18,7 @@ defaultPackages = mconcat
 
 packagesStage0 :: Packages
 packagesStage0 = mconcat
-    [ append [ binPackageDb, binary, cabal, compiler, ghc, ghcCabal, ghcPkg
+    [ append [ ghcBoot, binary, cabal, compiler, ghc, ghcCabal, ghcPkg
              , hsc2hs, hoopl, hpc, templateHaskell, transformers ]
     , stage0 ? append [deriveConstants, genapply, genprimopcode, hp2ps]
     , notM windowsHost ? notM (anyHostOs ["ios"]) ? append [terminfo] ]
@@ -29,10 +29,11 @@ packagesStage1 = mconcat
     [ packagesStage0
     , append [ array, base, bytestring, containers, compareSizes, deepseq
              , directory, dllSplit, filepath
-             , ghcPrim, ghcPwd, haskeline, hpcBin, integerLibrary
+             , ghci, ghcPrim, ghcPwd, haskeline, hpcBin, integerLibrary
              , mkUserGuidePart, pretty, process, runghc, time ]
     , windowsHost      ? append [win32]
     , notM windowsHost ? append [unix]
+    , notM windowsHost ? append [iservBin]
     , buildHaddock     ? append [xhtml] ]
 
 packagesStage2 :: Packages

src/Stage.hs

@@ -13,3 +13,4 @@ instance Show Stage where
 -- Instances for storing in the Shake database
 instance Binary Stage
 instance Hashable Stage
+instance NFData Stage

src/Way.hs

@@ -169,3 +169,6 @@ instance Binary Way where
 
 instance Hashable Way where
     hashWithSalt salt = hashWithSalt salt . show
+
+instance NFData Way where
+    rnf (Way s) = s `seq` ()