From: simonmar Date: Tue, 13 Feb 2001 18:01:23 +0000 (+0000) Subject: [project @ 2001-02-13 18:01:22 by simonmar] X-Git-Tag: Approximately_9120_patches~2639 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=b59837e609bec1c9738448bca13a5bffd20ca584;p=ghc-hetmet.git [project @ 2001-02-13 18:01:22 by simonmar] style nitpicking --- diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs index 83061ac..be8e67b 100644 --- a/ghc/compiler/ghci/InteractiveUI.hs +++ b/ghc/compiler/ghci/InteractiveUI.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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 '") 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 diff --git a/ghc/compiler/ghci/Linker.lhs b/ghc/compiler/ghci/Linker.lhs index 72d6b89..533b6ac 100644 --- a/ghc/compiler/ghci/Linker.lhs +++ b/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} diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c index 5316f46..d6a5ef2 100644 --- a/ghc/rts/Linker.c +++ b/ghc/rts/Linker.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 */ @@ -308,6 +279,33 @@ initLinker( void ) } /* ----------------------------------------------------------------------------- + * 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 */ void * diff --git a/ghc/rts/Linker.h b/ghc/rts/Linker.h index 5ec2c01..2424f9c 100644 --- a/ghc/rts/Linker.h +++ b/ghc/rts/Linker.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 );