1 files changed, 26 insertions, 5 deletions
diff --git a/compiler/GHC/Linker/MacOS.hs b/compiler/GHC/Linker/MacOS.hs
index 765ea7a7b3..576b9e7feb 100644
--- a/compiler/GHC/Linker/MacOS.hs
+++ b/compiler/GHC/Linker/MacOS.hs
@@ -23,9 +23,12 @@ import GHC.Utils.Exception
 import GHC.Utils.Logger
 
 import Data.List (isPrefixOf, nub, sort, intersperse, intercalate)
-import Control.Monad (join, forM, filterM)
+import Data.Char
+import Data.Maybe
+import Control.Monad (join, forM, filterM, void)
 import System.Directory (doesFileExist, getHomeDirectory)
 import System.FilePath ((</>), (<.>))
+import Text.ParserCombinators.ReadP as Parser
 
 -- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused
 -- libraries from the dynamic library.  We do this to reduce the number of load
@@ -51,10 +54,8 @@ runInjectRPaths logger dflags lib_paths dylib = do
   -- filter the output for only the libraries. And then drop the @rpath prefix.
   let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info
   -- find any pre-existing LC_PATH items
-  info <- fmap words.lines <$> askOtool logger dflags Nothing [Option "-l", Option dylib]
-  let paths = concatMap f info
-        where f ("path":p:_) = [p]
-              f _            = []
+  info <- lines <$> askOtool logger dflags Nothing [Option "-l", Option dylib]
+  let paths = mapMaybe get_rpath info
       lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ]
   -- only find those rpaths, that aren't already in the library.
   rpaths <- nub . sort . join <$> forM libs (\f -> filterM (\l -> doesFileExist (l </> f)) lib_paths')
@@ -63,6 +64,26 @@ runInjectRPaths logger dflags lib_paths dylib = do
     [] -> return ()
     _  -> runInstallNameTool logger dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib]
 
+get_rpath :: String -> Maybe FilePath
+get_rpath l = case readP_to_S rpath_parser l of
+                [(rpath, "")] -> Just rpath
+                _ -> Nothing
+
+
+rpath_parser :: ReadP FilePath
+rpath_parser = do
+  skipSpaces
+  void $ string "path"
+  void $ many1 (satisfy isSpace)
+  rpath <- many get
+  void $ many1 (satisfy isSpace)
+  void $ string "(offset "
+  void $ munch1 isDigit
+  void $ Parser.char ')'
+  skipSpaces
+  return rpath
+
+
 getUnitFrameworkOpts :: UnitEnv -> [UnitId] -> IO [String]
 getUnitFrameworkOpts unit_env dep_packages
   | platformUsesFrameworks (ue_platform unit_env) = do