X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FInteractiveUI.hs;h=d2a96fcd2e4a99afd9168a2a3ec8bb53e67fbc2c;hb=8008273439be481134e43f48e1c252f3b7a8c550;hp=11d41c7ab576980f5de4487a9ee0e8405cd18bb5;hpb=92cdc09e48d3410182581f5bd687d1ee7cbe476b;p=ghc-hetmet.git

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 11d41c7..d2a96fc 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,13 +1,17 @@
 {-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-}
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.109 2002/01/23 16:50:49 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.123 2002/05/01 15:48:48 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
 -- (c) The GHC Team 2000
 --
 -----------------------------------------------------------------------------
-module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
+module InteractiveUI ( 
+	interactiveUI,  -- :: CmState -> [FilePath] -> [LibrarySpec] -> IO ()
+	LibrarySpec(..),
+	ghciWelcomeMsg
+   ) where
 
 #include "../includes/config.h"
 #include "HsVersions.h"
@@ -19,6 +23,7 @@ import CmTypes		( Linkable, isObjectLinkable, ModSummary(..) )
 import CmLink		( findModuleLinkable_maybe )
 
 import HscTypes		( TyThing(..), showModMsg, InteractiveContext(..) )
+import HsSyn		( TyClDecl(..), ConDecl(..), Sig(..) )
 import MkIface		( ifaceTyThing )
 import DriverFlags
 import DriverState
@@ -27,9 +32,9 @@ import Linker
 import Finder		( flushPackageCache )
 import Util
 import Id		( isRecordSelector, recordSelectorFieldLabel, 
-			  isDataConWrapId, idName )
+			  isDataConWrapId, isDataConId, idName )
 import Class		( className )
-import TyCon		( tyConName, tyConClass_maybe, isPrimTyCon )
+import TyCon		( tyConName, tyConClass_maybe, isPrimTyCon, DataConDetails(..) )
 import FieldLabel	( fieldLabelTyCon )
 import SrcLoc		( isGoodSrcLoc )
 import Module		( moduleName )
@@ -39,7 +44,7 @@ import Name		( Name, isHomePackageName, nameSrcLoc, nameOccName,
 import OccName		( isSymOcc )
 import BasicTypes	( defaultFixity )
 import Outputable
-import CmdLineOpts	( DynFlag(..), getDynFlags, saveDynFlags,
+import CmdLineOpts	( DynFlag(..), DynFlags(..), getDynFlags, saveDynFlags,
 			  restoreDynFlags, dopt_unset )
 import Panic		( GhcException(..), showGhcException )
 import Config
@@ -66,9 +71,10 @@ import IO
 import Char
 import Monad
 
-import PrelGHC 		( unsafeCoerce# )
+import GlaExts		( unsafeCoerce# )
+
 import Foreign		( nullPtr )
-import CString		( peekCString )
+import CString		( CString, peekCString, withCString )
 
 -----------------------------------------------------------------------------
 
@@ -84,6 +90,7 @@ GLOBAL_VAR(commands, builtin_commands, [(String, String -> GHCi Bool)])
 builtin_commands :: [(String, String -> GHCi Bool)]
 builtin_commands = [
   ("add",	keepGoing addModule),
+  ("browse",    keepGoing browseCmd),
   ("cd",    	keepGoing changeDirectory),
   ("def",	keepGoing defineMacro),
   ("help",	keepGoing help),
@@ -105,34 +112,36 @@ keepGoing a str = a str >> return False
 
 shortHelpText = "use :? for help.\n"
 
+-- NOTE: spaces at the end of each line to workaround CPP/string gap bug.
 helpText = "\ 
 \ Commands available from the prompt:\n\ 
-\\
-\   <stmt>		   evaluate/run <stmt>\n\ 
-\   :add <filename> ...    add module(s) to the current target set\n\ 
-\   :cd <dir>		   change directory to <dir>\n\ 
-\   :def <cmd> <expr>      define a command :<cmd>\n\ 
-\   :help, :?		   display this list of commands\n\ 
-\   :info [<name> ...]     display information about the given names\n\ 
-\   :load <filename> ...   load module(s) and their dependents\n\ 
-\   :module <mod>	   set the context for expression evaluation to <mod>\n\ 
-\   :reload		   reload the current module set\n\ 
 \\n\ 
-\   :set <option> ...	   set options\n\ 
-\   :set args <arg> ...	   set the arguments returned by System.getArgs\n\ 
-\   :set prog <progname>   set the value returned by System.getProgName\n\ 
+\   <stmt>		       evaluate/run <stmt>\n\ 
+\   :add <filename> ...        add module(s) to the current target set\n\ 
+\   :browse [*]<module>	       display the names defined by <module>\n\ 
+\   :cd <dir>		       change directory to <dir>\n\ 
+\   :def <cmd> <expr>          define a command :<cmd>\n\ 
+\   :help, :?		       display this list of commands\n\ 
+\   :info [<name> ...]         display information about the given names\n\ 
+\   :load <filename> ...       load module(s) and their dependents\n\ 
+\   :module [+/-] [*]<mod> ... set the context for expression evaluation\n\ 
+\   :reload		       reload the current module set\n\ 
+\\n\ 
+\   :set <option> ...	       set options\n\ 
+\   :set args <arg> ...	       set the arguments returned by System.getArgs\n\ 
+\   :set prog <progname>       set the value returned by System.getProgName\n\ 
+\\n\ 
+\   :show modules	       show the currently loaded modules\n\ 
+\   :show bindings	       show the current bindings made at the prompt\n\ 
 \\n\ 
-\   :show modules	   show the currently loaded modules\n\ 
-\   :show bindings	   show the current bindings made at the prompt\n\ 
+\   :type <expr>	       show the type of <expr>\n\ 
+\   :undef <cmd> 	       undefine user-defined command :<cmd>\n\ 
+\   :unset <option> ...	       unset options\n\ 
+\   :quit		       exit GHCi\n\ 
+\   :!<command>		       run the shell command <command>\n\ 
 \\n\ 
-\   :type <expr>	   show the type of <expr>\n\ 
-\   :undef <cmd> 	   undefine user-defined command :<cmd>\n\ 
-\   :unset <option> ...	   unset options\n\ 
-\   :quit		   exit GHCi\n\ 
-\   :!<command>		   run the shell command <command>\n\ 
-\\ 
 \ Options for `:set' and `:unset':\n\ 
-\\ 
+\\n\ 
 \    +r			revert top-level expressions after each evaluation\n\ 
 \    +s                 print timing/memory stats after each evaluation\n\ 
 \    +t			print type after evaluation\n\ 
@@ -145,12 +154,12 @@ interactiveUI cmstate paths cmdline_libs = do
    hFlush stdout
    hSetBuffering stdout NoBuffering
 
+   dflags <- getDynFlags
+
    -- link in the available packages
    pkgs <- getPackageInfo
    initLinker
-   linkPackages cmdline_libs pkgs
-
-   dflags <- getDynFlags
+   linkPackages dflags cmdline_libs pkgs
 
    (cmstate, maybe_hval) 
 	<- cmCompileExpr cmstate dflags "IO.hSetBuffering IO.stdout IO.NoBuffering Prelude.>> IO.hSetBuffering IO.stderr IO.NoBuffering"
@@ -159,17 +168,21 @@ interactiveUI cmstate paths cmdline_libs = do
 	_ -> panic "interactiveUI:buffering"
 
    (cmstate, maybe_hval)
-	<- cmCompileExpr cmstate dflags "IO.hFlush PrelHandle.stderr"
+	<- cmCompileExpr cmstate dflags "IO.hFlush IO.stderr"
    case maybe_hval of
 	Just hval -> writeIORef flush_stderr (unsafeCoerce# hval :: IO ())
 	_ -> panic "interactiveUI:stderr"
 
    (cmstate, maybe_hval) 
-	<- cmCompileExpr cmstate dflags "IO.hFlush PrelHandle.stdout"
+	<- cmCompileExpr cmstate dflags "IO.hFlush IO.stdout"
    case maybe_hval of
 	Just hval -> writeIORef flush_stdout (unsafeCoerce# hval :: IO ())
 	_ -> panic "interactiveUI:stdout"
 
+	-- We don't want the cmd line to buffer any input that might be
+	-- intended for the program, so unbuffer stdin.
+   hSetBuffering stdin  NoBuffering
+
 	-- initial context is just the Prelude
    cmstate <- cmSetContext cmstate dflags [] ["Prelude"]
 
@@ -177,7 +190,7 @@ interactiveUI cmstate paths cmdline_libs = do
    Readline.initialize
 #endif
 
-   startGHCi (runGHCi paths) 
+   startGHCi (runGHCi paths dflags) 
 	GHCiState{ progname = "<interactive>",
 		   args = [],
 		   targets = paths,
@@ -191,8 +204,8 @@ interactiveUI cmstate paths cmdline_libs = do
    return ()
 
 
-runGHCi :: [FilePath] -> GHCi ()
-runGHCi paths = do
+runGHCi :: [FilePath] -> DynFlags -> GHCi ()
+runGHCi paths dflags = do
   read_dot_files <- io (readIORef v_Read_DotGHCi)
 
   when (read_dot_files) $ do
@@ -230,20 +243,24 @@ runGHCi paths = do
 	loadModule (unwords paths)
 
   -- enter the interactive loop
-  interactiveLoop
+  is_tty <- io (hIsTerminalDevice stdin)
+  interactiveLoop is_tty
 
   -- and finally, exit
-  io $ do putStrLn "Leaving GHCi."
+  io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
 
 
-interactiveLoop = do
+interactiveLoop is_tty = do
   -- ignore ^C exceptions caught here
-  ghciHandleDyn (\e -> case e of Interrupted -> ghciUnblock interactiveLoop
-			         _other      -> return ()) $ do
+  ghciHandleDyn (\e -> case e of 
+			Interrupted -> ghciUnblock (interactiveLoop is_tty)
+			_other      -> return ()) $ do
 
   -- read commands from stdin
 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
-  readlineLoop
+  if (is_tty) 
+	then readlineLoop
+	else fileLoop stdin False  -- turn off prompt for non-TTY input
 #else
   fileLoop stdin True
 #endif
@@ -260,10 +277,10 @@ interactiveLoop = do
 
 checkPerms :: String -> IO Bool
 checkPerms name =
-  handle (\_ -> return False) $ do
 #ifdef mingw32_TARGET_OS
-     doesFileExist name
+  return True
 #else
+  DriverUtil.handle (\_ -> return False) $ do
      st <- getFileStatus name
      me <- getRealUserID
      if fileOwner st /= me then do
@@ -304,7 +321,7 @@ stringLoop (s:ss) = do
                  if quit then return () else stringLoop ss
 
 mkPrompt toplevs exports
-   = concat (intersperse " " (toplevs ++ map ('*':) exports)) ++ "> "
+   = concat (intersperse " " (map ('*':) toplevs ++ exports)) ++ "> "
 
 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
 readlineLoop :: GHCi ()
@@ -484,7 +501,7 @@ addModule str = do
   (cmstate1, ok, mods) <- io (cmLoadModules (cmstate state) dflags graph)
   setGHCiState state{ cmstate = cmstate1, targets = new_targets }
   setContextAfterLoad mods
-  modulesLoadedMsg ok mods
+  modulesLoadedMsg ok mods dflags
 
 changeDirectory :: String -> GHCi ()
 changeDirectory ('~':d) = do
@@ -558,7 +575,7 @@ loadModule' str = do
   setGHCiState state{ cmstate = cmstate2, targets = files }
 
   setContextAfterLoad mods
-  modulesLoadedMsg ok mods
+  modulesLoadedMsg ok mods dflags
 
 
 reloadModule :: String -> GHCi ()
@@ -577,7 +594,7 @@ reloadModule "" = do
 		<- io (cmLoadModules (cmstate state) dflags graph)
         setGHCiState state{ cmstate=cmstate1 }
 	setContextAfterLoad mods
-	modulesLoadedMsg ok mods
+	modulesLoadedMsg ok mods dflags
 
 reloadModule _ = noArgs ":reload"
 
@@ -585,17 +602,18 @@ setContextAfterLoad [] = setContext prel
 setContextAfterLoad (m:_) = do
   cmstate <- getCmState
   b <- io (cmModuleIsInterpreted cmstate m)
-  if b then setContext m else setContext ('*':m)
+  if b then setContext ('*':m) else setContext m
 
-modulesLoadedMsg ok mods = do
-  let mod_commas 
+modulesLoadedMsg ok mods dflags =
+  when (verbosity dflags > 0) $ do
+   let mod_commas 
 	| null mods = text "none."
 	| otherwise = hsep (
 	    punctuate comma (map text mods)) <> text "."
-  case ok of
-    False -> 
+   case ok of
+    False ->
        io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)))
-    True  -> 
+    True  ->
        io (putStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas)))
 
 
@@ -616,6 +634,70 @@ shellEscape :: String -> GHCi Bool
 shellEscape str = io (system str >> return False)
 
 -----------------------------------------------------------------------------
+-- Browing a module's contents
+
+browseCmd :: String -> GHCi ()
+browseCmd m = 
+  case words m of
+    ['*':m] | looksLikeModuleName m -> browseModule m False
+    [m]     | looksLikeModuleName m -> browseModule m True
+    _ -> throwDyn (CmdLineError "syntax:  :browse <module>")
+
+browseModule m exports_only = do
+  cms <- getCmState
+  dflags <- io getDynFlags
+
+  is_interpreted <- io (cmModuleIsInterpreted cms m)
+  when (not is_interpreted && not exports_only) $
+	throwDyn (CmdLineError ("module `" ++ m ++ "' is not interpreted"))
+
+  -- temporarily set the context to the module we're interested in,
+  -- just so we can get an appropriate PrintUnqualified
+  (as,bs) <- io (cmGetContext cms)
+  cms1 <- io (if exports_only then cmSetContext cms dflags [] [prel,m]
+			      else cmSetContext cms dflags [m] [])
+  cms2 <- io (cmSetContext cms1 dflags as bs)
+
+  (cms3, things) <- io (cmBrowseModule cms2 dflags m exports_only)
+
+  setCmState cms3
+
+  let unqual = cmGetPrintUnqual cms1 -- NOTE: cms1 with the new context
+
+      things' = filter wantToSee things
+
+      wantToSee (AnId id) = not (isDataConId id || isDataConWrapId id)
+      wantToSee _ = True
+
+      thing_names = map getName things
+
+      thingDecl thing@(AnId id)  = ifaceTyThing thing
+
+      thingDecl thing@(AClass c) =
+        let rn_decl = ifaceTyThing thing in
+	case rn_decl of
+	  ClassDecl { tcdSigs = cons } -> 
+		rn_decl{ tcdSigs = filter methodIsVisible cons }
+	  other -> other
+        where
+           methodIsVisible (ClassOpSig n _ _ _) = n `elem` thing_names
+
+      thingDecl thing@(ATyCon t) =
+        let rn_decl = ifaceTyThing thing in
+	case rn_decl of
+	  TyData { tcdCons = DataCons cons } -> 
+		rn_decl{ tcdCons = DataCons (filter conIsVisible cons) }
+	  other -> other
+        where
+	  conIsVisible (ConDecl n _ _ _ _ _) = n `elem` thing_names
+
+  io (putStrLn (showSDocForUser unqual (
+   	 vcat (map (ppr . thingDecl) things')))
+   )
+
+  where
+
+-----------------------------------------------------------------------------
 -- Setting the module context
 
 setContext str
@@ -627,9 +709,8 @@ setContext str
 			'-':stuff -> (removeFromContext, words stuff)
 			stuff     -> (newContext,        words stuff) 
 
-    sensible ('*':c:cs) = isUpper c && all isAlphaNumEx cs
-    sensible (c:cs)     = isUpper c && all isAlphaNumEx cs
-    isAlphaNumEx c = isAlphaNum c || c == '_'
+    sensible ('*':m) = looksLikeModuleName m
+    sensible m       = looksLikeModuleName m
 
 newContext mods = do
   cms <- getCmState
@@ -640,12 +721,12 @@ newContext mods = do
   setCmState cms'
 
 separate cmstate []           as bs = return (as,bs)
-separate cmstate (('*':m):ms) as bs = separate cmstate ms as (m:bs)
-separate cmstate (m:ms)       as bs = do 
+separate cmstate (('*':m):ms) as bs = do
    b <- io (cmModuleIsInterpreted cmstate m)
    if b then separate cmstate ms (m:as) bs
    	else throwDyn (CmdLineError ("module `" ++ m ++ "' is not interpreted"))
-	
+separate cmstate (m:ms)       as bs = separate cmstate ms as (m:bs)
+
 prel = "Prelude"
 
 
@@ -795,7 +876,7 @@ newPackages new_pkgs = do
     flushPackageCache pkgs
    
     new_pkg_info <- getPackageDetails new_pkgs
-    mapM_ linkPackage (reverse new_pkg_info)
+    mapM_ (linkPackage dflags) (reverse new_pkg_info)
 
 -----------------------------------------------------------------------------
 -- code for `:show'
@@ -916,46 +997,62 @@ ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
 -- 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
+data LibrarySpec = Object FilePath | DLL String
+
+-- Packages that don't need loading, because the compiler shares them with
+-- the interpreted program.
+dont_load_these = [ "rts" ]
+
+-- Packages that are already linked into GHCi.  For mingw32, we only
+-- skip gmp and rts, since std and after need to load the msvcrt.dll
+-- library which std depends on.
+loaded_in_ghci
+#          ifndef mingw32_TARGET_OS
+           = [ "std", "concurrent", "posix", "text", "util" ]
+#          else
+	   = [ ]
+#          endif
 
-showLS (Left nm)  = "(static) " ++ nm
-showLS (Right nm) = "(dynamic) " ++ nm
+showLS (Object nm)  = "(static) " ++ nm
+showLS (DLL nm) = "(dynamic) " ++ nm
 
-linkPackages :: [LibrarySpec] -> [PackageConfig] -> IO ()
-linkPackages cmdline_lib_specs pkgs
-   = do mapM_ linkPackage (reverse pkgs)
+linkPackages :: DynFlags -> [LibrarySpec] -> [PackageConfig] -> IO ()
+linkPackages dflags cmdline_lib_specs pkgs
+   = do mapM_ (linkPackage dflags) (reverse pkgs)
         lib_paths <- readIORef v_Library_paths
-        mapM_ (preloadLib lib_paths) cmdline_lib_specs
+        mapM_ (preloadLib dflags lib_paths) cmdline_lib_specs
 	if (null cmdline_lib_specs)
 	   then return ()
-	   else do putStr "final link ... "
+	   else do maybePutStr dflags "final link ... "
+
 		   ok <- resolveObjs
-		   if ok then putStrLn "done."
+		   if ok then maybePutStrLn dflags "done."
 	      		 else throwDyn (InstallationError 
                                           "linking extra libraries/objects failed")
      where
-        preloadLib :: [String] -> LibrarySpec -> IO ()
-        preloadLib lib_paths lib_spec
-           = do putStr ("Loading object " ++ showLS lib_spec ++ " ... ")
+        preloadLib :: DynFlags -> [String] -> LibrarySpec -> IO ()
+        preloadLib dflags lib_paths lib_spec
+           = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
                 case lib_spec of
-                   Left static_ish
+                   Object static_ish
                       -> do b <- preload_static lib_paths static_ish
-                            putStrLn (if b then "done." else "not found")
-                   Right dll_unadorned
+                            maybePutStrLn dflags (if b  then "done." 
+							else "not found")
+                   DLL dll_unadorned
                       -> -- We add "" to the set of paths to try, so that
                          -- if none of the real paths match, we force addDLL
                          -- to look in the default dynamic-link search paths.
-                         do maybe_errstr <- preload_dynamic (lib_paths++[""]) 
+                         do maybe_errstr <- loadDynamic (lib_paths++[""]) 
                                                             dll_unadorned
                             case maybe_errstr of
                                Nothing -> return ()
                                Just mm -> preloadFailed mm lib_paths lib_spec
-                            putStrLn "done"
+                            maybePutStrLn dflags "done"
 
         preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
         preloadFailed sys_errmsg paths spec
-           = do putStr ("failed.\nDynamic linker error message was:\n   " 
+           = do maybePutStr dflags
+		       ("failed.\nDynamic linker error message was:\n   " 
                         ++ sys_errmsg  ++ "\nWhilst trying to load:  " 
                         ++ showLS spec ++ "\nDirectories to search are:\n"
                         ++ unlines (map ("   "++) paths) )
@@ -967,80 +1064,92 @@ linkPackages cmdline_lib_specs pkgs
                 if not b then return False
                          else loadObj name >> return True
 
-        -- return Nothing == success, else Just error message from addDLL
-        preload_dynamic [] name
-           = return Nothing
-        preload_dynamic (path:paths) rootname
-           = do -- addDLL returns NULL on success
-                maybe_errmsg <- addDLL path rootname
-                if    maybe_errmsg == nullPtr
-                 then preload_dynamic paths rootname
-                 else do str <- peekCString maybe_errmsg
-                         return (Just str)
-
         give_up 
            = (throwDyn . CmdLineError)
                 "user specified .o/.so/.DLL could not be loaded."
 
--- Packages that don't need loading, because the compiler shares them with
--- the interpreted program.
-dont_load_these = [ "gmp", "rts" ]
-
--- Packages that are already linked into GHCi.  For mingw32, we only
--- skip gmp and rts, since std and after need to load the msvcrt.dll
--- library which std depends on.
-loaded_in_ghci
-#          ifndef mingw32_TARGET_OS
-           = [ "std", "concurrent", "posix", "text", "util" ]
-#          else
-	   = [ ]
-#          endif
-
-linkPackage :: PackageConfig -> IO ()
-linkPackage pkg
+linkPackage :: DynFlags -> PackageConfig -> IO ()
+linkPackage dflags pkg
    | name pkg `elem` dont_load_these = return ()
    | otherwise
    = do 
-        -- For each obj, try obj.o and if that fails, obj.so.
-        -- Complication: all the .so's must be loaded before any of the .o's.  
         let dirs      =  library_dirs pkg
-        let objs      =  hs_libraries pkg ++ extra_libraries pkg
-        classifieds   <- mapM (locateOneObj dirs) objs
-
-	-- Don't load the .so libs if this is a package GHCi is already
-	-- linked against, because we'll already have the .so linked in.
-	let (so_libs, obj_libs) = partition isRight classifieds
-        let sos_first | name pkg `elem` loaded_in_ghci = obj_libs
-		      | otherwise      		       = so_libs ++ obj_libs
-
-	putStr ("Loading package " ++ name pkg ++ " ... ")
-        mapM loadClassified sos_first
-        putStr "linking ... "
+        let libs      =  hs_libraries pkg ++ extra_libraries pkg
+        classifieds   <- mapM (locateOneObj dirs) libs
+
+        -- Complication: all the .so's must be loaded before any of the .o's.  
+	let dlls = [ dll | DLL dll <- classifieds ]
+	    objs = [ obj | Object obj <- classifieds ]
+
+	maybePutStr dflags ("Loading package " ++ name pkg ++ " ... ")
+
+	-- If this package is already part of the GHCi binary, we'll already
+	-- have the right DLLs for this package loaded, so don't try to
+	-- load them again.
+	when (name pkg `notElem` loaded_in_ghci) $
+	    loadDynamics dirs dlls
+	
+	-- After loading all the DLLs, we can load the static objects.
+	mapM loadObj objs
+
+        maybePutStr dflags "linking ... "
         ok <- resolveObjs
-	if ok then putStrLn "done."
+	if ok then maybePutStrLn dflags "done."
 	      else panic ("can't load package `" ++ name pkg ++ "'")
-     where
-        isRight (Right _) = True
-        isRight (Left _)  = False
-
-loadClassified :: LibrarySpec -> IO ()
-loadClassified (Left obj_absolute_filename)
-   = do loadObj obj_absolute_filename
-loadClassified (Right 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
-                 throwDyn (CmdLineError ("can't load .so/.DLL for: " 
-                                       ++ dll_unadorned ++ " (" ++ str ++ ")" ))
 
+loadDynamics dirs [] = return ()
+loadDynamics dirs (dll:dlls) = do
+  r <- loadDynamic dirs dll
+  case r of
+    Nothing  -> loadDynamics dirs dlls
+    Just err -> throwDyn (CmdLineError ("can't load .so/.DLL for: " 
+                                       ++ dll ++ " (" ++ err ++ ")" ))
+
+-- Try to find an object file for a given library in the given paths.
+-- If it isn't present, we assume it's a dynamic library.
 locateOneObj :: [FilePath] -> String -> IO LibrarySpec
-locateOneObj []     obj 
-   = return (Right obj) -- we assume
-locateOneObj (d:ds) obj 
-   = do let path = d ++ '/':obj ++ ".o"
+locateOneObj [] lib
+   = return (DLL lib) -- we assume
+locateOneObj (d:ds) lib
+   = do let path = d ++ '/':lib ++ ".o"
         b <- doesFileExist path
-        if b then return (Left path) else locateOneObj ds obj
+        if b then return (Object path) else locateOneObj ds lib
+
+-- ----------------------------------------------------------------------------
+-- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
+
+#ifdef mingw32_TARGET_OS
+loadDynamic paths rootname = addDLL rootname
+  -- ignore paths on windows (why? --SDM)
+
+#else
+
+-- return Nothing == success, else Just error message from dlopen
+loadDynamic (path:paths) rootname = do
+  let dll = path ++ '/':mkSOName rootname
+  b <- doesFileExist dll
+  if not b
+     then loadDynamic paths rootname
+     else addDLL dll
+loadDynamic [] rootname = do
+	-- tried all our known library paths, let dlopen() search its
+	-- own builtin paths now.
+   addDLL (mkSOName rootname)
+
+mkSOName root = "lib" ++ root ++ ".so"
+
+#endif
+
+addDLL :: String -> IO (Maybe String)
+addDLL str = do
+  maybe_errmsg <- withCString str $ \dll -> c_addDLL dll
+  if maybe_errmsg == nullPtr
+	then return Nothing
+	else do str <- peekCString maybe_errmsg
+		return (Just str)
+
+foreign import ccall "addDLL" unsafe  
+  c_addDLL :: CString -> IO CString
 
 -----------------------------------------------------------------------------
 -- timing & statistics
@@ -1069,6 +1178,20 @@ printTimes allocs psecs
 			 int allocs <+> text "bytes")))
 
 -----------------------------------------------------------------------------
+-- utils
+
+looksLikeModuleName [] = False
+looksLikeModuleName (c:cs) = isUpper c && all isAlphaNumEx cs
+
+isAlphaNumEx c = isAlphaNum c || c == '_' || c == '.'
+
+maybePutStr dflags s | verbosity dflags > 0 = putStr s
+		     | otherwise	    = return ()
+
+maybePutStrLn dflags s | verbosity dflags > 0 = putStrLn s
+		       | otherwise	      = return ()
+
+-----------------------------------------------------------------------------
 -- reverting CAFs
 	
 foreign import revertCAFs :: IO ()	-- make it "safe", just in case