Building GHC with hadrian on FreeBSD
[ghc.git] / compiler / main / SysTools / BaseDir.hs
1 {-# LANGUAGE CPP #-}
2 {-# LANGUAGE ScopedTypeVariables #-}
3
4 {-
5 -----------------------------------------------------------------------------
6 --
7 -- (c) The University of Glasgow 2001-2017
8 --
9 -- Finding the compiler's base directory.
10 --
11 -----------------------------------------------------------------------------
12 -}
13
14 module SysTools.BaseDir
15 ( expandTopDir, expandToolDir
16 , findTopDir, findToolDir
17 ) where
18
19 #include "HsVersions.h"
20
21 import GhcPrelude
22
23 import Panic
24
25 import System.Environment (lookupEnv)
26 import System.FilePath
27 import Data.List
28
29 -- POSIX
30 #if defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
31 import System.Environment (getExecutablePath)
32 #endif
33
34 -- Windows
35 #if defined(mingw32_HOST_OS)
36 import System.Environment (getExecutablePath)
37 import System.Directory (doesDirectoryExist)
38 #endif
39
40 #if defined(mingw32_HOST_OS)
41 # if defined(i386_HOST_ARCH)
42 # define WINDOWS_CCONV stdcall
43 # elif defined(x86_64_HOST_ARCH)
44 # define WINDOWS_CCONV ccall
45 # else
46 # error Unknown mingw32 arch
47 # endif
48 #endif
49
50 {-
51 Note [topdir: How GHC finds its files]
52 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
53
54 GHC needs various support files (library packages, RTS etc), plus
55 various auxiliary programs (cp, gcc, etc). It starts by finding topdir,
56 the root of GHC's support files
57
58 On Unix:
59 - ghc always has a shell wrapper that passes a -B<dir> option
60
61 On Windows:
62 - ghc never has a shell wrapper.
63 - we can find the location of the ghc binary, which is
64 $topdir/<foo>/<something>.exe
65 where <something> may be "ghc", "ghc-stage2", or similar
66 - we strip off the "<foo>/<something>.exe" to leave $topdir.
67
68 from topdir we can find package.conf, ghc-asm, etc.
69
70
71 Note [tooldir: How GHC finds mingw and perl on Windows]
72
73 GHC has some custom logic on Windows for finding the mingw
74 toolchain and perl. Depending on whether GHC is built
75 with the make build system or Hadrian, and on whether we're
76 running a bindist, we might find the mingw toolchain and perl
77 either under $topdir/../{mingw, perl}/ or
78 $topdir/../../{mingw, perl}/.
79
80 -}
81
82 -- | Expand occurrences of the @$topdir@ interpolation in a string.
83 expandTopDir :: FilePath -> String -> String
84 expandTopDir = expandPathVar "topdir"
85
86 -- | Expand occurrences of the @$tooldir@ interpolation in a string
87 -- on Windows, leave the string untouched otherwise.
88 expandToolDir :: Maybe FilePath -> String -> String
89 #if defined(mingw32_HOST_OS)
90 expandToolDir (Just tool_dir) s = expandPathVar "tooldir" tool_dir s
91 expandToolDir Nothing _ = panic "Could not determine $tooldir"
92 #else
93 expandToolDir _ s = s
94 #endif
95
96 -- | @expandPathVar var value str@
97 --
98 -- replaces occurences of variable @$var@ with @value@ in str.
99 expandPathVar :: String -> FilePath -> String -> String
100 expandPathVar var value str
101 | Just str' <- stripPrefix ('$':var) str
102 , null str' || isPathSeparator (head str')
103 = value ++ expandPathVar var value str'
104 expandPathVar var value (x:xs) = x : expandPathVar var value xs
105 expandPathVar _ _ [] = []
106
107 -- | Returns a Unix-format path pointing to TopDir.
108 findTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix).
109 -> IO String -- TopDir (in Unix format '/' separated)
110 findTopDir (Just minusb) = return (normalise minusb)
111 findTopDir Nothing
112 = do -- The _GHC_TOP_DIR environment variable can be used to specify
113 -- the top dir when the -B argument is not specified. It is not
114 -- intended for use by users, it was added specifically for the
115 -- purpose of running GHC within GHCi.
116 maybe_env_top_dir <- lookupEnv "_GHC_TOP_DIR"
117 case maybe_env_top_dir of
118 Just env_top_dir -> return env_top_dir
119 Nothing -> do
120 -- Get directory of executable
121 maybe_exec_dir <- getBaseDir
122 case maybe_exec_dir of
123 -- "Just" on Windows, "Nothing" on unix
124 Nothing -> throwGhcExceptionIO $
125 InstallationError "missing -B<dir> option"
126 Just dir -> return dir
127
128 getBaseDir :: IO (Maybe String)
129
130 #if defined(mingw32_HOST_OS)
131
132 -- locate the "base dir" when given the path
133 -- to the real ghc executable (as opposed to symlink)
134 -- that is running this function.
135 rootDir :: FilePath -> FilePath
136 rootDir = takeDirectory . takeDirectory . normalise
137
138 getBaseDir = Just . (\p -> p </> "lib") . rootDir <$> getExecutablePath
139 #elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
140 -- on unix, this is a bit more confusing.
141 -- The layout right now is something like
142 --
143 -- /bin/ghc-X.Y.Z <- wrapper script (1)
144 -- /bin/ghc <- symlink to wrapper script (2)
145 -- /lib/ghc-X.Y.Z/bin/ghc <- ghc executable (3)
146 -- /lib/ghc-X.Y.Z <- $topdir (4)
147 --
148 -- As such, we first need to find the absolute location to the
149 -- binary.
150 --
151 -- getExecutablePath will return (3). One takeDirectory will
152 -- give use /lib/ghc-X.Y.Z/bin, and another will give us (4).
153 --
154 -- This of course only works due to the current layout. If
155 -- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib}
156 -- this would need to be changed accordingly.
157 --
158 getBaseDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath
159 #else
160 getBaseDir = return Nothing
161 #endif
162
163 -- See Note [tooldir: How GHC finds mingw and perl on Windows]
164 -- Returns @Nothing@ when not on Windows.
165 -- When called on Windows, it either throws an error when the
166 -- tooldir can't be located, or returns @Just tooldirpath@.
167 findToolDir
168 :: FilePath -- ^ topdir
169 -> IO (Maybe FilePath)
170 #if defined(mingw32_HOST_OS)
171 findToolDir top_dir = go 0 (top_dir </> "..")
172 where maxDepth = 3
173 go :: Int -> FilePath -> IO (Maybe FilePath)
174 go k path
175 | k == maxDepth = throwGhcExceptionIO $
176 InstallationError "could not detect mingw toolchain"
177 | otherwise = do
178 oneLevel <- doesDirectoryExist (path </> "mingw")
179 if oneLevel
180 then return (Just path)
181 else go (k+1) (path </> "..")
182 #else
183 findToolDir _ = return Nothing
184 #endif