X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FInteractiveUI.hs;h=f4193fcf0fef6a918df8845839e4bfe218b84c3b;hb=292c077de7dbe98eb44911648f16e243b40db2ac;hp=fd7f5422120a1069008c2e3f2a63826af3d35c78;hpb=8894fd8508fc5ac3b793187c323e4732a73b4a24;p=ghc-hetmet.git diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs index fd7f542..f4193fc 100644 --- a/ghc/compiler/ghci/InteractiveUI.hs +++ b/ghc/compiler/ghci/InteractiveUI.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: InteractiveUI.hs,v 1.1 2000/11/16 10:48:22 simonmar Exp $ +-- $Id: InteractiveUI.hs,v 1.2 2000/11/16 11:39:37 simonmar Exp $ -- -- GHC Interactive User Interface -- @@ -7,14 +7,20 @@ -- ----------------------------------------------------------------------------- -module InteractiveUI where +module InteractiveUI (interactiveUI) where import CompManager +import CmStaticInfo +import DriverUtil +import DriverState +import Linker import Module import Panic import Util +import Exception import Readline +import IOExts import System import Directory @@ -61,9 +67,14 @@ helpText = "\ interactiveUI :: CmState -> IO () interactiveUI st = do - hPutStr stdout ghciWelcomeMsg + hPutStrLn stdout ghciWelcomeMsg hFlush stdout hSetBuffering stdout NoBuffering + + -- link in the available packages + pkgs <- getPackageInfo + linkPackages (reverse pkgs) + #ifndef NO_READLINE Readline.initialize #endif @@ -108,7 +119,7 @@ specialCommand str = do " matches multiple commands (" ++ foldr1 (\a b -> a ++ ',':b) (map fst cs) ++ ")") -noArgs c = io (hPutStr stdout ("command `:" ++ c ++ "' takes no arguments")) +noArgs c = io (hPutStrLn stdout ("command `:" ++ c ++ "' takes no arguments")) ----------------------------------------------------------------------------- -- Commands @@ -131,7 +142,7 @@ reloadModule :: String -> GHCi () reloadModule "" = do state <- getGHCiState case target state of - Nothing -> io (hPutStr stdout "no current target") + Nothing -> io (putStr "no current target\n") Just path -> do (new_cmstate, mod) <- io (cmLoadModule (cmstate state) (mkModuleName path)) setGHCiState state{cmstate=new_cmstate} reloadModule _ = noArgs ":reload" @@ -169,4 +180,34 @@ setGHCiState s = GHCi $ \_ -> return (s,()) io m = GHCi $ \s -> m >>= \a -> return (s,a) -myCatch (GHCi m) h = GHCi $ \s -> catch (m s) (\e -> unGHCi (h e) s) +myCatch (GHCi m) h = GHCi $ \s -> Exception.catch (m s) (\e -> unGHCi (h e) s) + +----------------------------------------------------------------------------- +-- package loader + +linkPackages :: [Package] -> IO () +linkPackages pkgs = mapM_ linkPackage pkgs + +linkPackage :: Package -> IO () +-- ignore rts and gmp for now (ToDo; better?) +linkPackage pkg | name pkg `elem` ["rts", "gmp"] = return () +linkPackage pkg = do + putStr ("Loading package " ++ name pkg ++ " ... ") + let dirs = library_dirs pkg + let objs = map (++".o") (hs_libraries pkg ++ extra_libraries pkg) + mapM (linkOneObj dirs) objs + putStr "resolving ... " + resolveObjs + putStrLn "done." + +linkOneObj dirs obj = do + filename <- findFile dirs obj + loadObj filename + +findFile [] obj = throwDyn (OtherError ("can't find " ++ obj)) +findFile (d:ds) obj = do + let path = d ++ '/':obj + b <- doesFileExist path + if b then return path else findFile ds obj + +