Commit b59837e6 authored by simonmar's avatar simonmar

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

style nitpicking
parent ba123ed2
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- $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 -- GHC Interactive User Interface
-- --
...@@ -254,25 +254,16 @@ doCommand expr ...@@ -254,25 +254,16 @@ doCommand expr
= do expr_expanded <- expandExpr expr = do expr_expanded <- expandExpr expr
-- io (putStrLn ( "Before: " ++ expr ++ "\nAfter: " ++ expr_expanded)) -- io (putStrLn ( "Before: " ++ expr ++ "\nAfter: " ++ expr_expanded))
expr_ok <- timeIt (do stuff <- evalExpr expr_expanded expr_ok <- timeIt (do stuff <- evalExpr expr_expanded
finishEvalExpr stuff) finishEvalExpr expr_expanded stuff)
when expr_ok (rememberExpr expr_expanded) when expr_ok (rememberExpr expr_expanded)
return False 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 -- Returned Maybe indicates whether or not the expr was successfully
-- parsed, renamed and typechecked. -- parsed, renamed and typechecked.
evalExpr :: String -> GHCi (Maybe (PrintUnqualified,Type)) evalExpr :: String -> GHCi Bool
evalExpr expr evalExpr expr
| null (filter (not.isSpace) expr) | null (filter (not.isSpace) expr)
= return Nothing = return False
| otherwise | otherwise
= do st <- getGHCiState = do st <- getGHCiState
dflags <- io (getDynFlags) dflags <- io (getDynFlags)
...@@ -280,10 +271,21 @@ evalExpr expr ...@@ -280,10 +271,21 @@ evalExpr expr
io (cmGetExpr (cmstate st) dflags True (current_module st) expr) io (cmGetExpr (cmstate st) dflags True (current_module st) expr)
setGHCiState st{cmstate = new_cmstate} setGHCiState st{cmstate = new_cmstate}
case maybe_stuff of case maybe_stuff of
Nothing -> return Nothing Nothing -> return False
Just (hv, unqual, ty) -> do io (cmRunExpr hv) Just (hv, unqual, ty) ->
flushEverything do io (cmRunExpr hv)
return (Just (unqual,ty)) 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 :: GHCi ()
flushEverything flushEverything
...@@ -322,9 +324,14 @@ setContext "" ...@@ -322,9 +324,14 @@ setContext ""
= throwDyn (OtherError "syntax: `:m <module>'") = throwDyn (OtherError "syntax: `:m <module>'")
setContext m | not (isUpper (head m)) || not (all isAlphaNum (tail m)) setContext m | not (isUpper (head m)) || not (all isAlphaNum (tail m))
= throwDyn (OtherError ("strange looking module name: `" ++ m ++ "'")) = throwDyn (OtherError ("strange looking module name: `" ++ m ++ "'"))
setContext mn setContext str
= do m <- io (moduleNameToModule (mkModuleName mn)) = do st <- getGHCiState
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) if (isHomeModule m && m `notElem` modules st)
then throwDyn (OtherError (showSDoc (quotes (ppr (moduleName m)) then throwDyn (OtherError (showSDoc (quotes (ppr (moduleName m))
<+> text "is not currently loaded, use :load"))) <+> text "is not currently loaded, use :load")))
...@@ -334,9 +341,9 @@ moduleNameToModule :: ModuleName -> IO Module ...@@ -334,9 +341,9 @@ moduleNameToModule :: ModuleName -> IO Module
moduleNameToModule mn moduleNameToModule mn
= do maybe_stuff <- findModule mn = do maybe_stuff <- findModule mn
case maybe_stuff of case maybe_stuff of
Nothing -> throwDyn (OtherError ("can't find module `" Nothing -> throwDyn (OtherError ("can't find module `"
++ moduleNameUserString mn ++ "'")) ++ moduleNameUserString mn ++ "'"))
Just (m,_) -> return m Just (m,_) -> return m
changeDirectory :: String -> GHCi () changeDirectory :: String -> GHCi ()
changeDirectory d = io (setCurrentDirectory d) changeDirectory d = io (setCurrentDirectory d)
...@@ -679,8 +686,8 @@ linkPackages cmdline_libs pkgs ...@@ -679,8 +686,8 @@ linkPackages cmdline_libs pkgs
else do loadObj static_ish else do loadObj static_ish
putStr "done.\n" putStr "done.\n"
Right dll_unadorned Right dll_unadorned
-> do dll_ok <- ocAddDLL (packString dll_unadorned) -> do dll_ok <- addDLL dll_unadorned
if dll_ok == 1 if dll_ok
then putStr "done.\n" then putStr "done.\n"
else do putStr "not found.\n" else do putStr "not found.\n"
croak croak
...@@ -732,8 +739,8 @@ loadClassified :: Either FilePath String -> IO () ...@@ -732,8 +739,8 @@ loadClassified :: Either FilePath String -> IO ()
loadClassified (Left obj_absolute_filename) loadClassified (Left obj_absolute_filename)
= do loadObj obj_absolute_filename = do loadObj obj_absolute_filename
loadClassified (Right dll_unadorned) loadClassified (Right dll_unadorned)
= do dll_ok <- ocAddDLL (packString dll_unadorned) = do dll_ok <- addDLL dll_unadorned
if dll_ok == 1 if dll_ok
then return () then return ()
else throwDyn (OtherError ("can't find .o or .so/.DLL for: " else throwDyn (OtherError ("can't find .o or .so/.DLL for: "
++ dll_unadorned)) ++ dll_unadorned))
...@@ -746,10 +753,6 @@ locateOneObj (d:ds) obj ...@@ -746,10 +753,6 @@ locateOneObj (d:ds) obj
b <- doesFileExist path b <- doesFileExist path
if b then return (Left path) else locateOneObj ds obj if b then return (Left path) else locateOneObj ds obj
type PackedString = ByteArray Int
foreign import "ocAddDLL" unsafe ocAddDLL :: PackedString -> IO Int
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- timing & statistics -- timing & statistics
......
...@@ -11,6 +11,7 @@ module Linker ( ...@@ -11,6 +11,7 @@ module Linker (
unloadObj, -- :: String -> IO () unloadObj, -- :: String -> IO ()
lookupSymbol, -- :: String -> IO (Maybe (Ptr a)) lookupSymbol, -- :: String -> IO (Maybe (Ptr a))
resolveObjs, -- :: IO () resolveObjs, -- :: IO ()
addDLL -- :: String -> IO Bool
) where ) where
import Foreign ( Ptr, nullPtr ) import Foreign ( Ptr, nullPtr )
...@@ -46,6 +47,9 @@ resolveObjs = do ...@@ -46,6 +47,9 @@ resolveObjs = do
then panic "resolveObjs: failed" then panic "resolveObjs: failed"
else return () else return ()
addDLL str = do
r <- c_addDLL (packString str)
return (r == 0)
type PackedString = ByteArray Int type PackedString = ByteArray Int
...@@ -63,4 +67,8 @@ foreign import "resolveObjs" unsafe ...@@ -63,4 +67,8 @@ foreign import "resolveObjs" unsafe
foreign import "initLinker" unsafe foreign import "initLinker" unsafe
initLinker :: IO () initLinker :: IO ()
foreign import "addDLL" unsafe
c_addDLL :: PackedString -> IO Int
\end{code} \end{code}
/* ----------------------------------------------------------------------------- /* -----------------------------------------------------------------------------
* $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 * (c) The GHC Team, 2000
* *
...@@ -47,35 +47,6 @@ static int ocGetNames_PEi386 ( ObjectCode* oc ); ...@@ -47,35 +47,6 @@ static int ocGetNames_PEi386 ( ObjectCode* oc );
static int ocResolve_PEi386 ( ObjectCode* oc ); static int ocResolve_PEi386 ( ObjectCode* oc );
#endif #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 * Built-in symbols from the RTS
*/ */
...@@ -307,6 +278,33 @@ initLinker( void ) ...@@ -307,6 +278,33 @@ initLinker( void )
dl_prog_handle = dlopen(NULL, RTLD_LAZY); 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 * lookup a symbol in the hash table
*/ */
......
/* ----------------------------------------------------------------------------- /* -----------------------------------------------------------------------------
* $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 * (c) The GHC Team, 2000
* *
...@@ -21,3 +21,6 @@ HsInt loadObj( char *path ); ...@@ -21,3 +21,6 @@ HsInt loadObj( char *path );
/* resolve all the currently unlinked objects in memory */ /* resolve all the currently unlinked objects in memory */
HsInt resolveObjs( void ); HsInt resolveObjs( void );
/* load a dynamic library */
HsInt addDLL( char *path );
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment