Relocatable GHC

GHC and the binary distribution that's produced is
not relocatable outside of Windows.  This diff tries to
address this for at least Linux and macOS.

Reviewers: austin, hvr, bgamari, erikd, goldfire, Phyx

Reviewed By: bgamari

Subscribers: duog, rwbarton, thomie, erikd

Differential Revision: https://phabricator.haskell.org/D4121

2 files changed, 32 insertions, 0 deletions

diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index 21ed03b407..860b724692 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -48,6 +48,7 @@ import Platform
 import Util
 import DynFlags
 
+import System.Environment (getExecutablePath)
 import System.FilePath
 import System.IO
 import System.Directory
@@ -530,6 +531,26 @@ type GetFinalPath = HANDLE -> LPTSTR -> DWORD -> DWORD -> IO DWORD
 
 foreign import WINDOWS_CCONV unsafe "dynamic"
   makeGetFinalPathNameByHandle :: FunPtr GetFinalPath -> GetFinalPath
+#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS)
+-- on unix, this is a bit more confusing.
+-- The layout right now is somehting like
+--
+--   /bin/ghc-X.Y.Z <- wrapper script (1)
+--   /bin/ghc       <- symlink to wrapper script (2)
+--   /lib/ghc-X.Y.Z/bin/ghc <- ghc executable (3)
+--   /lib/ghc-X.Y.Z <- $topdir (4)
+--
+-- As such, we first need to find the absolute location to the
+-- binary.
+--
+-- getExecutablePath will return (3). One takeDirectory will
+-- give use /lib/ghc-X.Y.Z/bin, and another will give us (4).
+--
+-- This of course only works due to the current layout. If
+-- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib}
+-- this would need to be changed accordingly.
+--
+getBaseDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath
 #else
 getBaseDir = return Nothing
 #endif
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 6420dd4f16..3dafffda96 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -2116,6 +2116,17 @@ getExecPath = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
 
 foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW"
   c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
+#elfi defined(darwin_HOST_OS) || defined(linux_HOST_OS)
+-- TODO: a) this is copy-pasta from SysTools.hs / getBaseDir. Why can't we reuse
+--          this here? and parameterise getBaseDir over the executable (for
+--          windows)?
+--          Answer: we can not, because if we share `getBaseDir` via `ghc-boot`,
+--                  that would add `base` as a dependency for windows.
+--       b) why is the windows getBaseDir logic, not part of getExecutablePath?
+--          it would be much wider available then and we could drop all the
+--          custom logic?
+--          Answer: yes this should happen. No one has found the time just yet.
+getLibDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath
 #else
 getLibDir :: IO (Maybe String)
 getLibDir = return Nothing