From 9fca47dc861ba311524831f99676fa515c276906 Mon Sep 17 00:00:00 2001
From: sewardj <unknown>
Date: Wed, 6 Jun 2001 14:02:50 +0000
Subject: [PATCH] [project @ 2001-06-06 14:02:50 by sewardj] Haskell-side
 stuff for making -L<dir> work on the ghci command line.

---
 ghc/compiler/ghci/InteractiveUI.hs |   60 ++++++++++++++++++++++++------------
 ghc/compiler/ghci/Linker.lhs       |    6 ++--
 2 files changed, 44 insertions(+), 22 deletions(-)

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index cb5d082..2315a34 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.70 2001/05/28 12:56:35 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.71 2001/06/06 14:02:50 sewardj Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -652,7 +652,11 @@ ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
 --        e.g.    On unix     "qt"  denotes "libqt.so"
 --                On WinDoze  "burble"  denotes "burble.DLL"
 --        addDLL is platform-specific and adds the lib/.so/.DLL
---        prefixes plaform-dependently; we don't do that here.
+--        suffixes platform-dependently; we don't do that here.
+-- 
+-- For dynamic objects only, try to find the object file in all the 
+-- directories specified in v_Library_Paths before giving up.
+
 type LibrarySpec
    = Either FilePath String
 
@@ -662,30 +666,48 @@ showLS (Right nm) = "(dynamic) " ++ nm
 linkPackages :: [LibrarySpec] -> [PackageConfig] -> IO ()
 linkPackages cmdline_lib_specs pkgs
    = do sequence_ [ linkPackage (name p `elem` loaded) p | p <- reverse pkgs ]
-        mapM_ preloadLib cmdline_lib_specs
+        lib_paths <- readIORef v_Library_paths
+        mapM_ (preloadLib lib_paths) cmdline_lib_specs
      where
 	-- packages that are already linked into GHCi
 	loaded = [ "concurrent", "posix", "text", "util" ]
 
-        preloadLib lib_spec
+        preloadLib :: [String] -> LibrarySpec -> IO ()
+        preloadLib lib_paths lib_spec
            = do putStr ("Loading object " ++ showLS lib_spec ++ " ... ")
                 case lib_spec of
                    Left static_ish
-                      -> do b <- doesFileExist static_ish
-                            if    not b
-                             then do putStr "not found.\n"
-                                     croak
-                             else do loadObj static_ish
-                                     putStr "done.\n"
+                      -> do b <- preload_static lib_paths static_ish
+                            putStrLn (if b then "done" else "not found")
                    Right dll_unadorned
-                      -> do maybe_errmsg <- addDLL dll_unadorned
-                            if    maybe_errmsg == nullPtr
-                             then putStr "done.\n"
-                             else do str <- peekCString maybe_errmsg
-                                     putStr ("failed (" ++ str ++ ")\n")
-                                     croak
-
-        croak = throwDyn (CmdLineError "user specified .o/.so/.DLL could not be loaded.")
+                      -> do b <- preload_dynamic lib_paths dll_unadorned
+                            when (not b) (cantFind lib_paths lib_spec)
+                            putStrLn "done"
+
+        cantFind :: [String] -> LibrarySpec -> IO ()
+        cantFind paths spec
+           = do putStr ("failed.\nCan't find " ++ showLS spec
+                        ++ " in directories:\n"
+                        ++ unlines (map ("   "++) paths) )
+                give_up
+
+        -- not interested in the paths in the static case.
+        preload_static paths name
+           = do b <- doesFileExist name
+                if not b then return False
+                         else loadObj name >> return True
+
+        preload_dynamic [] name
+           = return False
+        preload_dynamic (path:paths) rootname
+           = do maybe_errmsg <- addDLL path rootname
+                if    maybe_errmsg /= nullPtr
+                 then preload_dynamic paths rootname
+                 else return True
+
+        give_up 
+           = (throwDyn . CmdLineError)
+                "user specified .o/.so/.DLL could not be loaded."
 
 
 linkPackage :: Bool -> PackageConfig -> IO ()
@@ -719,7 +741,7 @@ loadClassified :: LibrarySpec -> IO ()
 loadClassified (Left obj_absolute_filename)
    = do loadObj obj_absolute_filename
 loadClassified (Right dll_unadorned)
-   = do maybe_errmsg <- addDLL dll_unadorned
+   = do maybe_errmsg <- addDLL "" dll_unadorned -- doesn't seem right to me
         if    maybe_errmsg == nullPtr
          then return ()
          else do str <- peekCString maybe_errmsg
diff --git a/ghc/compiler/ghci/Linker.lhs b/ghc/compiler/ghci/Linker.lhs
index 1d3e7b7..5d16633 100644
--- a/ghc/compiler/ghci/Linker.lhs
+++ b/ghc/compiler/ghci/Linker.lhs
@@ -57,8 +57,8 @@ resolveObjs = do
 	then panic "resolveObjs: failed"
 	else return ()
 
-addDLL str = do
-   maybe_errmsg <- c_addDLL (packString str)
+addDLL path lib = do
+   maybe_errmsg <- c_addDLL (packString path) (packString lib)
    return maybe_errmsg
 
 type PackedString = ByteArray Int
@@ -79,6 +79,6 @@ foreign import "initLinker" unsafe
    initLinker :: IO ()
 
 foreign import "addDLL" unsafe 
-   c_addDLL :: PackedString -> IO (Ptr CChar)
+   c_addDLL :: PackedString -> PackedString -> IO (Ptr CChar)
 
 \end{code}
-- 
1.7.10.4