Ticket #1407: fix_1407.patch

File fix_1407.patch, 5.1 KB (added by archblob, 5 years ago)
  • compiler/ghci/Linker.lhs

    From 7a026c75acd957e0b783fa471ab7d2079fc4eea7 Mon Sep 17 00:00:00 2001
    From: archblob <fcsernik@gmail.com>
    Date: Fri, 13 Jun 2014 19:17:14 +0300
    Subject: [PATCH] Add the ability to :set -l{foo} in ghci, fix #1407.
    
    ---
     compiler/ghci/Linker.lhs | 79 +++++++++++++++++++++++++++---------------------
     ghc/InteractiveUI.hs     | 11 +++++++
     2 files changed, 56 insertions(+), 34 deletions(-)
    
    diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
    index 162c349..89b4e14 100644
    a b module Linker ( getHValue, showLinkerState, 
    1717                extendLinkEnv, deleteFromLinkEnv,
    1818                extendLoadedPkgs,
    1919                linkPackages,initDynLinker,linkModule,
     20                linkCmdLineLibs,
    2021
    2122                -- Saving/restoring globals
    2223                PersistentLinkerState, saveLinkerGlobals, restoreLinkerGlobals
    reallyInitDynLinker dflags = 
    295296          -- (b) Load packages from the command-line (Note [preload packages])
    296297        ; pls <- linkPackages' dflags (preloadPackages (pkgState dflags)) pls0
    297298
    298           -- (c) Link libraries from the command-line
    299         ; let cmdline_ld_inputs = ldInputs dflags
    300         ; let minus_ls = [ lib | Option ('-':'l':lib) <- cmdline_ld_inputs ]
    301         ; let lib_paths = libraryPaths dflags
    302         ; libspecs <- mapM (locateLib dflags False lib_paths) minus_ls
    303 
    304           -- (d) Link .o files from the command-line
    305         ; classified_ld_inputs <- mapM (classifyLdInput dflags)
    306                                     [ f | FileOption _ f <- cmdline_ld_inputs ]
    307 
    308           -- (e) Link any MacOS frameworks
    309         ; let platform = targetPlatform dflags
    310         ; let framework_paths = if platformUsesFrameworks platform
    311                                 then frameworkPaths dflags
    312                                 else []
    313         ; let frameworks = if platformUsesFrameworks platform
    314                            then cmdlineFrameworks dflags
    315                            else []
    316           -- Finally do (c),(d),(e)
    317         ; let cmdline_lib_specs = [ l | Just l <- classified_ld_inputs ]
    318                                ++ libspecs
    319                                ++ map Framework frameworks
    320         ; if null cmdline_lib_specs then return pls
    321                                     else do
    322 
    323         { pls1 <- foldM (preloadLib dflags lib_paths framework_paths) pls cmdline_lib_specs
    324         ; maybePutStr dflags "final link ... "
    325         ; ok <- resolveObjs
    326 
    327         ; if succeeded ok then maybePutStrLn dflags "done"
    328           else throwGhcExceptionIO (ProgramError "linking extra libraries/objects failed")
    329 
    330         ; return pls1
    331         }}
     299        -- steps (c), (d) and (e)
     300        ; linkCmdLineLibs' dflags pls
     301        }
    332302
     303linkCmdLineLibs :: DynFlags -> IO ()
     304linkCmdLineLibs dflags = do
     305  initDynLinker dflags
     306  modifyPLS_ $ \pls -> do
     307    linkCmdLineLibs' dflags pls
     308
     309linkCmdLineLibs' :: DynFlags -> PersistentLinkerState -> IO PersistentLinkerState
     310linkCmdLineLibs' dflags@(DynFlags { ldInputs       = cmdline_ld_inputs
     311                                  , libraryPaths   = lib_paths }) pls = do
     312  -- (c) Link libraries from the command-line
     313  let minus_ls = [ lib | Option ('-':'l':lib) <- cmdline_ld_inputs ]
     314  libspecs <- mapM (locateLib dflags False lib_paths) minus_ls
     315
     316  -- (d) Link .o files from the command-line
     317  classified_ld_inputs <- mapM (classifyLdInput dflags)
     318                            [ f | FileOption _ f <- cmdline_ld_inputs]
     319
     320  -- (e) Link any MacOS frameworks
     321  let platform  = targetPlatform dflags
     322      (framework_paths, frameworks) =
     323        if platformUsesFrameworks platform
     324        then (frameworkPaths dflags, cmdlineFrameworks dflags)
     325        else ([], [])
     326
     327  -- Finally do (c),(d),(e)
     328  let cmdline_lib_specs = [ l | Just l <- classified_ld_inputs ]
     329                        ++ libspecs
     330                        ++ map Framework frameworks
     331
     332  if null cmdline_lib_specs then return pls
     333  else do
     334    pls1 <- foldM (preloadLib dflags lib_paths framework_paths)
     335                    pls cmdline_lib_specs
     336    maybePutStr dflags "final link ... "
     337
     338    ok <- resolveObjs
     339
     340    if succeeded ok then maybePutStrLn dflags "done"
     341    else throwGhcExceptionIO (ProgramError "linking extra libraries/objects failed")
     342
     343    return pls1
    333344
    334345{- Note [preload packages]
    335346
  • ghc/InteractiveUI.hs

    diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
    index 0a56799..eb43e18 100644
    a b newDynFlags interactive_only minus_opts = do 
    21502150                     , pkgDatabase = pkgDatabase dflags2
    21512151                     , packageFlags = packageFlags dflags2 }
    21522152
     2153        let ld0length   = length $ ldInputs dflags0
     2154            fmrk0length = length $ cmdlineFrameworks dflags0
     2155
     2156            newLdInputs     = drop ld0length (ldInputs dflags2)
     2157            newCLFrameworks = drop fmrk0length (cmdlineFrameworks dflags2)
     2158
     2159        when (not (null newLdInputs && null newCLFrameworks)) $
     2160          liftIO $ linkCmdLineLibs $
     2161            dflags2 { ldInputs = newLdInputs
     2162                    , cmdlineFrameworks = newCLFrameworks }
     2163
    21532164      return ()
    21542165
    21552166