Skip to content
GitLab
Commit b59837e6 authored by simonmar's avatar simonmar
Browse files

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

style nitpicking
parent ba123ed2
Hide whitespace changes
Inline Side-by-side
ghc/compiler/ghci/InteractiveUI.hs
View file @ b59837e6
-----------------------------------------------------------------------------
-- $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
View file @ b59837e6
......@@ -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
View file @ b59837e6
/* -----------------------------------------------------------------------------
* $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
View file @ b59837e6
/* -----------------------------------------------------------------------------
* $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 );
Supports Markdown
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