X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fghc-cabal%2Fghc-cabal.hs;h=c3a478908919c87c6a264ddb7efbe67c5894dbe3;hb=ae968f8b673c6328db2172ad0e00733d3eb69de4;hp=1b06cf4ba8de46610f5f55b7b34cf11b9bfac1f1;hpb=da8ca5158b9421c67df854f9e66ad8ae09b3ec66;p=ghc-hetmet.git diff --git a/utils/ghc-cabal/ghc-cabal.hs b/utils/ghc-cabal/ghc-cabal.hs index 1b06cf4..c3a4789 100644 --- a/utils/ghc-cabal/ghc-cabal.hs +++ b/utils/ghc-cabal/ghc-cabal.hs @@ -34,10 +34,12 @@ main = do args <- getArgs runHaddock distDir dir args' "check" : dir : [] -> doCheck dir - "install" : ghc : ghcpkg : topdir : directory : distDir - : myDestDir : myPrefix : myLibdir : myDocdir : args' -> - doInstall ghc ghcpkg topdir directory distDir - myDestDir myPrefix myLibdir myDocdir args' + "install" : ghc : ghcpkg : strip : topdir : directory : distDir + : myDestDir : myPrefix : myLibdir : myDocdir + : relocatableBuild : args' -> + doInstall ghc ghcpkg strip topdir directory distDir + myDestDir myPrefix myLibdir myDocdir + relocatableBuild args' "configure" : args' -> case break (== "--") args' of (config_args, "--" : distdir : directories) -> mapM_ (generate config_args distdir) directories @@ -52,7 +54,7 @@ syntax_error = " ghc-cabal install ...", " ghc-cabal haddock ..."] -die :: [String] -> IO () +die :: [String] -> IO a die errs = do mapM_ (hPutStrLn stderr) errs exitWith (ExitFailure 1) @@ -137,21 +139,37 @@ runHaddock distdir directory args = f pd lbi us flags doInstall :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath - -> FilePath -> FilePath -> FilePath -> FilePath -> [String] + -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath + -> String -> [String] -> IO () -doInstall ghc ghcpkg topdir directory distDir myDestDir myPrefix myLibdir myDocdir args +doInstall ghc ghcpkg strip topdir directory distDir + myDestDir myPrefix myLibdir myDocdir + relocatableBuildStr args = withCurrentDirectory directory $ do - defaultMainWithHooksArgs hooks (["copy", "--builddir", distDir] - ++ (if null myDestDir then [] - else ["--destdir", myDestDir]) - ++ args) - defaultMainWithHooksArgs hooks ("register" : "--builddir" : distDir : args) - where - hooks = userHooks { - copyHook = noGhcPrimHook (modHook (copyHook userHooks)), - regHook = modHook (regHook userHooks) - } + relocatableBuild <- case relocatableBuildStr of + "YES" -> return True + "NO" -> return False + _ -> die ["Bad relocatableBuildStr: " ++ + show relocatableBuildStr] + let copyArgs = ["copy", "--builddir", distDir] + ++ (if null myDestDir + then [] + else ["--destdir", myDestDir]) + ++ args + regArgs = "register" : "--builddir" : distDir : args + copyHooks = userHooks { + copyHook = noGhcPrimHook + $ modHook False + $ copyHook userHooks + } + regHooks = userHooks { + regHook = modHook relocatableBuild + $ regHook userHooks + } + defaultMainWithHooksArgs copyHooks copyArgs + defaultMainWithHooksArgs regHooks regArgs + where noGhcPrimHook f pd lbi us flags = let pd' | packageName pd == PackageName "ghc-prim" = @@ -165,44 +183,66 @@ doInstall ghc ghcpkg topdir directory distDir myDestDir myPrefix myLibdir myDocd error "Expected a library, but none found" | otherwise = pd in f pd' lbi us flags - modHook f pd lbi us flags + modHook relocatableBuild f pd lbi us flags = do let verbosity = normal idts = installDirTemplates lbi - idts' = idts { prefix = toPathTemplate myPrefix, - libdir = toPathTemplate myLibdir, - libsubdir = toPathTemplate "$pkgid", - docdir = toPathTemplate (myDocdir "$pkg"), - htmldir = toPathTemplate "$docdir" } + idts' = idts { + prefix = toPathTemplate $ + if relocatableBuild + then "$topdir" + else myPrefix, + libdir = toPathTemplate $ + if relocatableBuild + then "$topdir" + else myLibdir, + libsubdir = toPathTemplate "$pkgid", + docdir = toPathTemplate $ + if relocatableBuild + then "$topdir/$pkgid" + else (myDocdir "$pkgid"), + htmldir = toPathTemplate "$docdir" + } progs = withPrograms lbi ghcProg = ConfiguredProgram { programId = programName ghcProgram, programVersion = Nothing, - programArgs = ["-B" ++ topdir], + programDefaultArgs = ["-B" ++ topdir], + programOverrideArgs = [], programLocation = UserSpecified ghc } ghcpkgconf = topdir "package.conf.d" ghcPkgProg = ConfiguredProgram { programId = programName ghcPkgProgram, programVersion = Nothing, - programArgs = ["--global-conf", - ghcpkgconf] + programDefaultArgs = ["--global-conf", + ghcpkgconf] ++ if not (null myDestDir) then ["--force"] else [], + programOverrideArgs = [], programLocation = UserSpecified ghcpkg } + stripProg = ConfiguredProgram { + programId = programName stripProgram, + programVersion = Nothing, + programDefaultArgs = [], + programOverrideArgs = [], + programLocation = UserSpecified strip + } progs' = updateProgram ghcProg - $ updateProgram ghcPkgProg progs + $ updateProgram ghcPkgProg + $ updateProgram stripProg + progs instInfos <- dump verbosity ghcPkgProg GlobalPackageDB - let installedPkgs' = PackageIndex.listToInstalledPackageIndex - instInfos + let installedPkgs' = PackageIndex.fromList instInfos let mlc = libraryConfig lbi mlc' = case mlc of Just lc -> - let cipds = componentInstalledPackageDeps lc - cipds' = map (fixupPackageId instInfos) cipds + let cipds = componentPackageDeps lc + cipds' = [ (fixupPackageId instInfos ipid, pid) + | (ipid,pid) <- cipds ] in Just $ lc { - componentInstalledPackageDeps = cipds' + componentPackageDeps = cipds' } Nothing -> Nothing lbi' = lbi { @@ -273,7 +313,10 @@ generate config_args distdir directory let ipid = InstalledPackageId (display (packageId pd) ++ "-inplace") let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir pd lib lbi clbi - final_ipi = installedPkgInfo{ Installed.installedPackageId = ipid } + final_ipi = installedPkgInfo { + Installed.installedPackageId = ipid, + Installed.haddockHTMLs = ["../" ++ display (packageId pd)] + } content = Installed.showInstalledPackageInfo final_ipi ++ "\n" writeFileAtomic (distdir "inplace-pkg-config") content _ -> error "Inconsistent lib components; can't happen?" @@ -306,12 +349,11 @@ generate config_args distdir directory -- stricter than gnu ld). Thus we remove the ldOptions for -- GHC's rts package: hackRtsPackage index = - case PackageIndex.lookupInstalledPackageByName index (PackageName "rts") of - [rts] -> PackageIndex.addToInstalledPackageIndex rts { Installed.ldOptions = [] } index + case PackageIndex.lookupPackageName index (PackageName "rts") of + [(_,[rts])] -> PackageIndex.insert rts{ Installed.ldOptions = [] } index _ -> error "No (or multiple) ghc rts package is registered!!" - dep_ids = map (packageId.getLocalPackageInfo lbi) $ - externalPackageDeps lbi + dep_ids = map snd (externalPackageDeps lbi) let variablePrefix = directory ++ '_':distdir let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)), @@ -328,19 +370,20 @@ generate config_args distdir directory variablePrefix ++ "_CMM_SRCS = $(addprefix cbits/,$(notdir $(wildcard " ++ directory ++ "/cbits/*.cmm)))", -- XXX This includes things it shouldn't, like: -- -odir dist-bootstrapping/build - variablePrefix ++ "_HC_OPTS = " ++ escape (unwords - (programArgs ghcProg + variablePrefix ++ "_HC_OPTS = " ++ escape (unwords + ( programDefaultArgs ghcProg ++ hcOptions GHC bi - ++ extensionsToFlags (compiler lbi) (extensions bi))), + ++ extensionsToFlags (compiler lbi) (extensions bi) + ++ programOverrideArgs ghcProg)), variablePrefix ++ "_CC_OPTS = " ++ unwords (ccOptions bi), variablePrefix ++ "_CPP_OPTS = " ++ unwords (cppOptions bi), variablePrefix ++ "_LD_OPTS = " ++ unwords (ldOptions bi), - variablePrefix ++ "_DEP_INCLUDE_DIRS = " ++ unwords (forDeps Installed.includeDirs), + variablePrefix ++ "_DEP_INCLUDE_DIRS = " ++ unwords (wrap $ forDeps Installed.includeDirs), variablePrefix ++ "_DEP_CC_OPTS = " ++ unwords (forDeps Installed.ccOptions), - variablePrefix ++ "_DEP_LIB_DIRS = " ++ unwords (forDeps Installed.libraryDirs), + variablePrefix ++ "_DEP_LIB_DIRS = " ++ unwords (wrap $ forDeps Installed.libraryDirs), variablePrefix ++ "_DEP_EXTRA_LIBS = " ++ unwords (forDeps Installed.extraLibraries), variablePrefix ++ "_DEP_LD_OPTS = " ++ unwords (forDeps Installed.ldOptions)] writeFile (distdir ++ "/package-data.mk") $ unlines xs where escape = foldr (\c xs -> if c == '#' then '\\':'#':xs else c:xs) [] - + wrap = map (\s -> "\'" ++ s ++ "\'")