[project @ 2001-06-06 14:02:50 by sewardj]

Haskell-side stuff for making -L<dir> work on the ghci command line.

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index cb5d082..2315a34 100644 (file)
--- 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
 --
 --
 -- 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
 --        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
 
 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 ]
 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" ]
 
      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 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
                    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 ()
 
 
 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)
 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
         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 (file)
--- a/ghc/compiler/ghci/Linker.lhs
+++ b/ghc/compiler/ghci/Linker.lhs
@@ -57,8 +57,8 @@ resolveObjs = do
        then panic "resolveObjs: failed"
        else return ()
 
        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
    return maybe_errmsg
 
 type PackedString = ByteArray Int

@@ -79,6 +79,6 @@ foreign import "initLinker" unsafe
    initLinker :: IO ()
 
 foreign import "addDLL" unsafe 
    initLinker :: IO ()
 
 foreign import "addDLL" unsafe 

-   c_addDLL :: PackedString -> IO (Ptr CChar)
+   c_addDLL :: PackedString -> PackedString -> IO (Ptr CChar)

 
 \end{code}
 
 \end{code}