ghci: Load static objects in batches
[ghc.git] / compiler / ghci / Linker.hs
index dad13b7..41cc218 100644 (file)
@@ -389,8 +389,10 @@ linkCmdLineLibs' hsc_env pls =
       all_paths_env <- addEnvPaths "LD_LIBRARY_PATH" all_paths
       pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths_env
 
+      let merged_specs = mergeStaticObjects cmdline_lib_specs
       pls1 <- foldM (preloadLib hsc_env lib_paths framework_paths) pls
-                    cmdline_lib_specs
+                    merged_specs
+
       maybePutStr dflags "final link ... "
       ok <- resolveObjs hsc_env
 
@@ -402,6 +404,19 @@ linkCmdLineLibs' hsc_env pls =
 
       return pls1
 
+-- | Merge runs of consecutive of 'Objects'. This allows for resolution of
+-- cyclic symbol references when dynamically linking. Specifically, we link
+-- together all of the static objects into a single shared object, avoiding
+-- the issue we saw in #13786.
+mergeStaticObjects :: [LibrarySpec] -> [LibrarySpec]
+mergeStaticObjects specs = go [] specs
+  where
+    go :: [FilePath] -> [LibrarySpec] -> [LibrarySpec]
+    go accum (Objects objs : rest) = go (objs ++ accum) rest
+    go accum@(_:_) rest = Objects (reverse accum) : go [] rest
+    go [] (spec:rest) = spec : go [] rest
+    go [] [] = []
+
 {- Note [preload packages]
 
 Why do we need to preload packages from the command line?  This is an
@@ -429,7 +444,7 @@ users?
 
 classifyLdInput :: DynFlags -> FilePath -> IO (Maybe LibrarySpec)
 classifyLdInput dflags f
-  | isObjectFilename platform f = return (Just (Object f))
+  | isObjectFilename platform f = return (Just (Objects [f]))
   | isDynLibFilename platform f = return (Just (DLLPath f))
   | otherwise          = do
         putLogMsg dflags NoReason SevInfo noSrcSpan
@@ -444,8 +459,8 @@ preloadLib
 preloadLib hsc_env lib_paths framework_paths pls lib_spec = do
   maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
   case lib_spec of
-    Object static_ish -> do
-      (b, pls1) <- preload_static lib_paths static_ish
+    Objects static_ishs -> do
+      (b, pls1) <- preload_statics lib_paths static_ishs
       maybePutStrLn dflags (if b  then "done" else "not found")
       return pls1
 
@@ -504,13 +519,13 @@ preloadLib hsc_env lib_paths framework_paths pls lib_spec = do
                         intercalate "\n" (map ("   "++) paths)))
 
     -- Not interested in the paths in the static case.
-    preload_static _paths name
-       = do b <- doesFileExist name
+    preload_statics _paths names
+       = do b <- or <$> mapM doesFileExist names
             if not b then return (False, pls)
                      else if dynamicGhc
-                             then  do pls1 <- dynLoadObjs hsc_env pls [name]
+                             then  do pls1 <- dynLoadObjs hsc_env pls names
                                       return (True, pls1)
-                             else  do loadObj hsc_env name
+                             else  do mapM_ (loadObj hsc_env) names
                                       return (True, pls)
 
     preload_static_archive _paths name
@@ -1166,7 +1181,9 @@ unload_wkr hsc_env keep_linkables pls@PersistentLinkerState{..}  = do
   ********************************************************************* -}
 
 data LibrarySpec
-   = Object FilePath    -- Full path name of a .o file, including trailing .o
+   = Objects [FilePath] -- Full path names of set of .o files, including trailing .o
+                        -- We allow batched loading to ensure that cyclic symbol
+                        -- references can be resolved (see #13786).
                         -- For dynamic objects only, try to find the object
                         -- file in all the directories specified in
                         -- v_Library_paths before giving up.
@@ -1200,7 +1217,7 @@ partOfGHCi
                    ["base", "template-haskell", "editline"]
 
 showLS :: LibrarySpec -> String
-showLS (Object nm)    = "(static) " ++ nm
+showLS (Objects nms)  = "(static) [" ++ intercalate ", " nms ++ "]"
 showLS (Archive nm)   = "(static archive) " ++ nm
 showLS (DLL nm)       = "(dynamic) " ++ nm
 showLS (DLLPath nm)   = "(dynamic) " ++ nm
@@ -1299,7 +1316,8 @@ linkPackage hsc_env pkg
         -- Complication: all the .so's must be loaded before any of the .o's.
         let known_dlls = [ dll  | DLLPath dll    <- classifieds ]
             dlls       = [ dll  | DLL dll        <- classifieds ]
-            objs       = [ obj  | Object obj     <- classifieds ]
+            objs       = [ obj  | Objects objs    <- classifieds
+                                , obj <- objs ]
             archs      = [ arch | Archive arch   <- classifieds ]
 
         -- Add directories to library search paths
@@ -1507,8 +1525,8 @@ locateLib hsc_env is_hs lib_dirs gcc_dirs lib
                              (ArchX86_64, OSSolaris2) -> "64" </> so_name
                              _ -> so_name
 
-     findObject    = liftM (fmap Object)  $ findFile dirs obj_file
-     findDynObject = liftM (fmap Object)  $ findFile dirs dyn_obj_file
+     findObject    = liftM (fmap $ Objects . (:[]))  $ findFile dirs obj_file
+     findDynObject = liftM (fmap $ Objects . (:[]))  $ findFile dirs dyn_obj_file
      findArchive   = let local name = liftM (fmap Archive) $ findFile dirs name
                      in  apply (map local arch_files)
      findHSDll     = liftM (fmap DLLPath) $ findFile dirs hs_dyn_lib_file