[project @ 2001-02-13 18:01:22 by simonmar]

style nitpicking

ghc/compiler/ghci/InteractiveUI.hs

 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.47 2001/02/13 17:13:39 sewardj Exp $
+-- $Id: InteractiveUI.hs,v 1.48 2001/02/13 18:01:23 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -254,25 +254,16 @@ doCommand expr
    = do expr_expanded <- expandExpr expr
         -- io (putStrLn ( "Before: " ++ expr ++ "\nAfter:  " ++ expr_expanded))
         expr_ok <- timeIt (do stuff <- evalExpr expr_expanded
-			      finishEvalExpr stuff)
+			      finishEvalExpr expr_expanded stuff)
         when expr_ok (rememberExpr expr_expanded)
         return False
 
--- possibly print the type and revert CAFs after evaluating an expression
-finishEvalExpr Nothing = return False
-finishEvalExpr (Just (unqual,ty))
- = do b <- isOptionSet ShowType
-      io (when b (printForUser stdout unqual (text "::" <+> ppr ty)))
-      b <- isOptionSet RevertCAFs
-      io (when b revertCAFs)
-      return True
-
 -- Returned Maybe indicates whether or not the expr was successfully
 -- parsed, renamed and typechecked.
-evalExpr :: String -> GHCi (Maybe (PrintUnqualified,Type))
+evalExpr :: String -> GHCi Bool
 evalExpr expr
  | null (filter (not.isSpace) expr)
- = return Nothing
+ = return False
  | otherwise
  = do st <- getGHCiState
       dflags <- io (getDynFlags)
@@ -280,10 +271,21 @@ evalExpr expr
       	 io (cmGetExpr (cmstate st) dflags True (current_module st) expr)
       setGHCiState st{cmstate = new_cmstate}
       case maybe_stuff of
-      	 Nothing -> return Nothing
-      	 Just (hv, unqual, ty) -> do io (cmRunExpr hv)
-		 		     flushEverything
-		 		     return (Just (unqual,ty))
+      	 Nothing -> return False
+      	 Just (hv, unqual, ty) -> 
+		do io (cmRunExpr hv)
+		   return True
+
+-- possibly print the type and revert CAFs after evaluating an expression
+finishEvalExpr _ False = return False
+finishEvalExpr expr True
+ = do b <- isOptionSet ShowType
+	-- re-typecheck, don't wrap with print this time
+      when b (io (putStr ":: ") >> typeOfExpr expr)
+      b <- isOptionSet RevertCAFs
+      io (when b revertCAFs)
+      flushEverything
+      return True
 
 flushEverything :: GHCi ()
 flushEverything
@@ -322,9 +324,14 @@ setContext ""
   = throwDyn (OtherError "syntax: `:m <module>'")
 setContext m | not (isUpper (head m)) || not (all isAlphaNum (tail m))
   = throwDyn (OtherError ("strange looking module name: `" ++ m ++ "'"))
-setContext mn
-  = do m <- io (moduleNameToModule (mkModuleName mn))
-       st <- getGHCiState
+setContext str
+  = do st <- getGHCiState
+
+       let mn = mkModuleName str
+       m <- case [ m | m <- modules st, moduleName m == mn ] of
+		(m:_) -> return m
+		[]    -> io (moduleNameToModule mn)
+
        if (isHomeModule m && m `notElem` modules st)
 	  then throwDyn (OtherError (showSDoc (quotes (ppr (moduleName m))
 				<+> text "is not currently loaded, use :load")))
@@ -334,9 +341,9 @@ moduleNameToModule :: ModuleName -> IO Module
 moduleNameToModule mn
  = do maybe_stuff <- findModule mn
       case maybe_stuff of
-	 Nothing -> throwDyn (OtherError ("can't find module `"
-					    ++ moduleNameUserString mn ++ "'"))
-   	 Just (m,_) -> return m
+	Nothing -> throwDyn (OtherError ("can't find module `"
+				    ++ moduleNameUserString mn ++ "'"))
+	Just (m,_) -> return m
 
 changeDirectory :: String -> GHCi ()
 changeDirectory d = io (setCurrentDirectory d)
@@ -679,8 +686,8 @@ linkPackages cmdline_libs pkgs
                              else do loadObj static_ish
                                      putStr "done.\n"
                    Right dll_unadorned
-                      -> do dll_ok <- ocAddDLL (packString dll_unadorned)
-                            if    dll_ok == 1
+                      -> do dll_ok <- addDLL dll_unadorned
+                            if    dll_ok
                              then putStr "done.\n"
                              else do putStr "not found.\n"
                                      croak
@@ -732,8 +739,8 @@ loadClassified :: Either FilePath String -> IO ()
 loadClassified (Left obj_absolute_filename)
    = do loadObj obj_absolute_filename
 loadClassified (Right dll_unadorned)
-   = do dll_ok <- ocAddDLL (packString dll_unadorned)
-        if    dll_ok == 1
+   = do dll_ok <- addDLL dll_unadorned
+        if dll_ok
          then return ()
          else throwDyn (OtherError ("can't find .o or .so/.DLL for: " 
                                     ++ dll_unadorned))
@@ -746,10 +753,6 @@ locateOneObj (d:ds) obj
         b <- doesFileExist path
         if b then return (Left path) else locateOneObj ds obj
 
-
-type PackedString = ByteArray Int
-foreign import "ocAddDLL" unsafe ocAddDLL :: PackedString -> IO Int
-
 -----------------------------------------------------------------------------
 -- timing & statistics
 

ghc/compiler/ghci/Linker.lhs

@@ -11,6 +11,7 @@ module Linker (
    unloadObj,    -- :: String -> IO ()
    lookupSymbol, -- :: String -> IO (Maybe (Ptr a))
    resolveObjs,  -- :: IO ()
+   addDLL	 -- :: String -> IO Bool
   )  where
 
 import Foreign		( Ptr, nullPtr )
@@ -46,6 +47,9 @@ resolveObjs = do
 	then panic "resolveObjs: failed"
 	else return ()
 
+addDLL str = do
+   r <- c_addDLL (packString str)
+   return (r == 0)
 
 type PackedString = ByteArray Int
 
@@ -63,4 +67,8 @@ foreign import "resolveObjs" unsafe
 
 foreign import "initLinker" unsafe
    initLinker :: IO ()
+
+foreign import "addDLL" unsafe 
+   c_addDLL :: PackedString -> IO Int
+
 \end{code}

ghc/rts/Linker.c

 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.27 2001/02/13 13:11:07 sewardj Exp $
+ * $Id: Linker.c,v 1.28 2001/02/13 18:01:22 simonmar Exp $
  *
  * (c) The GHC Team, 2000
  *
@@ -47,35 +47,6 @@ static int ocGetNames_PEi386    ( ObjectCode* oc );
 static int ocResolve_PEi386     ( ObjectCode* oc );
 #endif
 
-int ocAddDLL ( char* dll_name );
-
-
-/* -----------------------------------------------------------------------------
- * Add a DLL from which symbols may be found.  In the ELF case, just
- * do RTLD_GLOBAL-style add, so no further messing around needs to
- * happen in order that symbols in the loaded .so are findable --
- * lookupSymbol() will subsequently see them by dlsym on the program's
- * dl-handle.  Returns 0 if fail, 1 if success.
- */
-int ocAddDLL ( char* dll_name )
-{
-#  if defined(OBJFORMAT_ELF)
-   void* hdl;
-   char  buf[100];
-   if (strlen(dll_name) > 50)
-      barf("ocAddDLL: excessively long .so/.DLL name `%s'", dll_name);
-   sprintf(buf, "lib%s.so", dll_name);
-   hdl = dlopen(buf, RTLD_NOW | RTLD_GLOBAL);
-   return (hdl == NULL) ? 0 : 1;
-#  elif defined(OBJFORMAT_PEi386)
-   barf("ocAddDLL: not implemented on PEi386 yet");
-   return 0;
-#  else
-   barf("ocAddDLL: not implemented on this platform");
-#  endif
-}
-
-
 /* -----------------------------------------------------------------------------
  * Built-in symbols from the RTS
  */
@@ -307,6 +278,33 @@ initLinker( void )
     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
 }
 
+/* -----------------------------------------------------------------------------
+ * Add a DLL from which symbols may be found.  In the ELF case, just
+ * do RTLD_GLOBAL-style add, so no further messing around needs to
+ * happen in order that symbols in the loaded .so are findable --
+ * lookupSymbol() will subsequently see them by dlsym on the program's
+ * dl-handle.  Returns 0 if fail, 1 if success.
+ */
+int
+addDLL ( char* dll_name )
+{
+#  if defined(OBJFORMAT_ELF)
+   void *hdl;
+   char *buf;
+
+   buf = stgMallocBytes(strlen(dll_name) + 10, "addDll");
+   sprintf(buf, "lib%s.so", dll_name);
+   hdl = dlopen(buf, RTLD_NOW | RTLD_GLOBAL);
+   free(buf);
+   return (hdl == NULL) ? 0 : 1;
+#  elif defined(OBJFORMAT_PEi386)
+   barf("addDLL: not implemented on PEi386 yet");
+   return 0;
+#  else
+   barf("addDLL: not implemented on this platform");
+#  endif
+}
+
 /* -----------------------------------------------------------------------------
  * lookup a symbol in the hash table
  */  

ghc/rts/Linker.h

 /* -----------------------------------------------------------------------------
- * $Id: Linker.h,v 1.2 2001/01/24 15:39:50 simonmar Exp $
+ * $Id: Linker.h,v 1.3 2001/02/13 18:01:22 simonmar Exp $
  *
  * (c) The GHC Team, 2000
  *
@@ -21,3 +21,6 @@ HsInt loadObj( char *path );
 
 /* resolve all the currently unlinked objects in memory */
 HsInt resolveObjs( void );
+
+/* load a dynamic library */
+HsInt addDLL( char *path );