module GHC.Driver.Config.Linker
  ( initFrameworkOpts
  , initLinkerConfig
  )
where

import GHC.Prelude
import GHC.Platform
import GHC.Linker.Config

import GHC.Driver.DynFlags
import GHC.Driver.Session

import Data.List (isPrefixOf)

initFrameworkOpts :: DynFlags -> FrameworkOpts
initFrameworkOpts :: DynFlags -> FrameworkOpts
initFrameworkOpts DynFlags
dflags = FrameworkOpts
  { foFrameworkPaths :: [String]
foFrameworkPaths    = DynFlags -> [String]
frameworkPaths    DynFlags
dflags
  , foCmdlineFrameworks :: [String]
foCmdlineFrameworks = DynFlags -> [String]
cmdlineFrameworks DynFlags
dflags
  }

-- | Initialize linker configuration from DynFlags
initLinkerConfig :: DynFlags -> LinkerConfig
initLinkerConfig :: DynFlags -> LinkerConfig
initLinkerConfig DynFlags
dflags =
  let
    -- see Note [Solaris linker]
    ld_filter :: String -> String
ld_filter = case Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
                  OS
OSSolaris2 -> String -> String
sunos_ld_filter
                  OS
_          -> String -> String
forall a. a -> a
id
    sunos_ld_filter :: String -> String
    sunos_ld_filter :: String -> String
sunos_ld_filter = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
sunos_ld_filter' ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    sunos_ld_filter' :: [String] -> [String]
sunos_ld_filter' [String]
x = if ([String] -> Bool
undefined_found [String]
x Bool -> Bool -> Bool
&& [String] -> Bool
ld_warning_found [String]
x)
                          then ([String] -> [String]
ld_prefix [String]
x) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
ld_postfix [String]
x)
                          else [String]
x
    breakStartsWith :: [a] -> [[a]] -> ([[a]], [[a]])
breakStartsWith [a]
x [[a]]
y = ([a] -> Bool) -> [[a]] -> ([[a]], [[a]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
x) [[a]]
y
    ld_prefix :: [String] -> [String]
ld_prefix = ([String], [String]) -> [String]
forall a b. (a, b) -> a
fst (([String], [String]) -> [String])
-> ([String] -> ([String], [String])) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> ([String], [String])
forall {a}. Eq a => [a] -> [[a]] -> ([[a]], [[a]])
breakStartsWith String
"Undefined"
    undefined_found :: [String] -> Bool
undefined_found = Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> ([String] -> [String]) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], [String]) -> [String]
forall a b. (a, b) -> b
snd (([String], [String]) -> [String])
-> ([String] -> ([String], [String])) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> ([String], [String])
forall {a}. Eq a => [a] -> [[a]] -> ([[a]], [[a]])
breakStartsWith String
"Undefined"
    ld_warn_break :: [String] -> ([String], [String])
ld_warn_break = String -> [String] -> ([String], [String])
forall {a}. Eq a => [a] -> [[a]] -> ([[a]], [[a]])
breakStartsWith String
"ld: warning: symbol referencing errors"
    ld_postfix :: [String] -> [String]
ld_postfix = [String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], [String]) -> [String]
forall a b. (a, b) -> b
snd (([String], [String]) -> [String])
-> ([String] -> ([String], [String])) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ([String], [String])
ld_warn_break
    ld_warning_found :: [String] -> Bool
ld_warning_found = Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> ([String] -> [String]) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], [String]) -> [String]
forall a b. (a, b) -> b
snd (([String], [String]) -> [String])
-> ([String] -> ([String], [String])) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ([String], [String])
ld_warn_break

    -- program and arguments
    --
    -- `-optl` args come at the end, so that later `-l` options
    -- given there manually can fill in symbols needed by
    -- Haskell libraries coming in via `args`.
    (String
p,[Option]
pre_args) = DynFlags -> (String, [Option])
pgm_l DynFlags
dflags
    post_args :: [Option]
post_args    = (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option (DynFlags -> (DynFlags -> [String]) -> [String]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [String]
opt_l)

  in LinkerConfig
    { linkerProgram :: String
linkerProgram     = String
p
    , linkerOptionsPre :: [Option]
linkerOptionsPre  = [Option]
pre_args
    , linkerOptionsPost :: [Option]
linkerOptionsPost = [Option]
post_args
    , linkerTempDir :: TempDir
linkerTempDir     = DynFlags -> TempDir
tmpDir DynFlags
dflags
    , linkerFilter :: String -> String
linkerFilter      = String -> String
ld_filter
    }

{- Note [Solaris linker]
   ~~~~~~~~~~~~~~~~~~~~~
  SunOS/Solaris ld emits harmless warning messages about unresolved
  symbols in case of compiling into shared library when we do not
  link against all the required libs. That is the case of GHC which
  does not link against RTS library explicitly in order to be able to
  choose the library later based on binary application linking
  parameters. The warnings look like:

Undefined                       first referenced
  symbol                             in file
stg_ap_n_fast                       ./T2386_Lib.o
stg_upd_frame_info                  ./T2386_Lib.o
templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o
templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o
templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o
templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o
newCAF                              ./T2386_Lib.o
stg_bh_upd_frame_info               ./T2386_Lib.o
stg_ap_ppp_fast                     ./T2386_Lib.o
templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o
stg_ap_p_fast                       ./T2386_Lib.o
stg_ap_pp_fast                      ./T2386_Lib.o
ld: warning: symbol referencing errors

  this is actually coming from T2386 testcase. The emitting of those
  warnings is also a reason why so many TH testcases fail on Solaris.

  Following filter code is SunOS/Solaris linker specific and should
  filter out only linker warnings. Please note that the logic is a
  little bit more complex due to the simple reason that we need to preserve
  any other linker emitted messages. If there are any. Simply speaking
  if we see "Undefined" and later "ld: warning:..." then we omit all
  text between (including) the marks. Otherwise we copy the whole output.
-}