X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=74310a340df57a03742180a38783cb0766e26fa0;hb=427f3443a432cde66da1e8dde94ef9c5351636da;hp=045cf63d5f0f064830c71edd7ff1118601331bc6;hpb=806ab6331b967d6176b8790a0b1b551ec0e8e2b6;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 045cf63..74310a3 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -103,8 +103,8 @@ type Command = (String, String -> GHCi Bool, Bool, String -> IO [String]) cmdName :: Command -> String cmdName (n,_,_,_) = n -commands :: IORef [Command] -GLOBAL_VAR(commands, builtin_commands, [Command]) +macros_ref :: IORef [Command] +GLOBAL_VAR(macros_ref, [], [Command]) builtin_commands :: [Command] builtin_commands = [ @@ -121,7 +121,8 @@ builtin_commands = [ ("continue", keepGoing continueCmd, False, completeNone), ("cmd", keepGoing cmdCmd, False, completeIdentifier), ("ctags", keepGoing createCTagsFileCmd, False, completeFilename), - ("def", keepGoing defineMacro, False, completeIdentifier), + ("def", keepGoing (defineMacro False), False, completeIdentifier), + ("def!", keepGoing (defineMacro True), False, completeIdentifier), ("delete", keepGoing deleteCmd, False, completeNone), ("e", keepGoing editFile, False, completeFilename), ("edit", keepGoing editFile, False, completeFilename), @@ -699,7 +700,8 @@ specialCommand str = do lookupCommand :: String -> IO (Maybe Command) lookupCommand str = do - cmds <- readIORef commands + macros <- readIORef macros_ref + let cmds = builtin_commands ++ macros -- look for exact match first, then the first prefix match case [ c | c <- cmds, str == cmdName c ] of c:_ -> return (Just c) @@ -796,7 +798,7 @@ addModule files = do session <- getSession io (mapM_ (GHC.addTarget session) targets) ok <- io (GHC.load session LoadAllTargets) - afterLoad ok session + afterLoad ok session Nothing changeDirectory :: String -> GHCi () changeDirectory dir = do @@ -854,18 +856,24 @@ chooseEditFile = where fromTarget (GHC.Target (GHC.TargetFile f _) _) = Just f fromTarget _ = Nothing -- when would we get a module target? -defineMacro :: String -> GHCi () -defineMacro s = do +defineMacro :: Bool{-overwrite-} -> String -> GHCi () +defineMacro overwrite s = do let (macro_name, definition) = break isSpace s - cmds <- io (readIORef commands) + macros <- io (readIORef macros_ref) + let defined = map cmdName macros if (null macro_name) - then throwDyn (CmdLineError "invalid macro name") + then if null defined + then io $ putStrLn "no macros defined" + else io $ putStr ("the following macros are defined:\n" ++ + unlines defined) else do - if (macro_name `elem` map cmdName cmds) + if (not overwrite && macro_name `elem` defined) then throwDyn (CmdLineError - ("command '" ++ macro_name ++ "' is already defined")) + ("macro '" ++ macro_name ++ "' is already defined")) else do + let filtered = [ cmd | cmd <- macros, cmdName cmd /= macro_name ] + -- give the expression a type signature, so we can be sure we're getting -- something of the right type. let new_expr = '(' : definition ++ ") :: String -> IO String" @@ -875,8 +883,8 @@ defineMacro s = do maybe_hv <- io (GHC.compileExpr cms new_expr) case maybe_hv of Nothing -> return () - Just hv -> io (writeIORef commands -- - (cmds ++ [(macro_name, runMacro hv, False, completeNone)])) + Just hv -> io (writeIORef macros_ref -- + (filtered ++ [(macro_name, runMacro hv, False, completeNone)])) runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool runMacro fun s = do @@ -885,17 +893,14 @@ runMacro fun s = do return False undefineMacro :: String -> GHCi () -undefineMacro macro_name = do - cmds <- io (readIORef commands) - if (macro_name `elem` map cmdName builtin_commands) - then throwDyn (CmdLineError - ("command '" ++ macro_name ++ "' cannot be undefined")) - else do - if (macro_name `notElem` map cmdName cmds) - then throwDyn (CmdLineError - ("command '" ++ macro_name ++ "' not defined")) - else do - io (writeIORef commands (filter ((/= macro_name) . cmdName) cmds)) +undefineMacro str = mapM_ undef (words str) + where undef macro_name = do + cmds <- io (readIORef macros_ref) + if (macro_name `notElem` map cmdName cmds) + then throwDyn (CmdLineError + ("macro '" ++ macro_name ++ "' is not defined")) + else do + io (writeIORef macros_ref (filter ((/= macro_name) . cmdName) cmds)) cmdCmd :: String -> GHCi () cmdCmd str = do @@ -936,7 +941,7 @@ loadModule' files = do -- as a ToDo for now. io (GHC.setTargets session targets) - doLoad session LoadAllTargets + doLoad session False LoadAllTargets checkModule :: String -> GHCi () checkModule m = do @@ -954,30 +959,43 @@ checkModule m = do (text "global names: " <+> ppr global) $$ (text "local names: " <+> ppr local) _ -> empty)) - afterLoad (successIf (isJust result)) session + afterLoad (successIf (isJust result)) session Nothing reloadModule :: String -> GHCi () reloadModule m = do session <- getSession - doLoad session $ if null m then LoadAllTargets - else LoadUpTo (GHC.mkModuleName m) + doLoad session True $ if null m then LoadAllTargets + else LoadUpTo (GHC.mkModuleName m) return () -doLoad :: Session -> LoadHowMuch -> GHCi SuccessFlag -doLoad session howmuch = do +doLoad :: Session -> Bool -> LoadHowMuch -> GHCi SuccessFlag +doLoad session retain_context howmuch = do -- turn off breakpoints before we load: we can't turn them off later, because -- the ModBreaks will have gone away. discardActiveBreakPoints + context <- io $ GHC.getContext session ok <- io (GHC.load session howmuch) - afterLoad ok session + afterLoad ok session (if retain_context then Just context else Nothing) return ok -afterLoad :: SuccessFlag -> Session -> GHCi () -afterLoad ok session = do +afterLoad :: SuccessFlag -> Session -> Maybe ([Module],[Module]) -> GHCi () +afterLoad ok session maybe_context = do io (revertCAFs) -- always revert CAFs on load. discardTickArrays loaded_mods <- getLoadedModules session - setContextAfterLoad session loaded_mods + + -- try to retain the old module context for :reload. This might + -- not be possible, for example if some modules have gone away, so + -- we attempt to set the same context, backing off to the default + -- context if that fails. + case maybe_context of + Nothing -> setContextAfterLoad session loaded_mods + Just (as,bs) -> do + r <- io $ Exception.try (GHC.setContext session as bs) + case r of + Left _err -> setContextAfterLoad session loaded_mods + Right _ -> return () + modulesLoadedMsg ok (map GHC.ms_mod_name loaded_mods) setContextAfterLoad :: Session -> [GHC.ModSummary] -> GHCi () @@ -1179,14 +1197,10 @@ separate :: Session -> [String] -> [Module] -> [Module] -> GHCi ([Module],[Module]) separate _ [] as bs = return (as,bs) separate session (('*':str):ms) as bs = do - m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing - b <- io $ GHC.moduleIsInterpreted session m - if b then separate session ms (m:as) bs - else throwDyn (CmdLineError ("module '" - ++ GHC.moduleNameString (GHC.moduleName m) - ++ "' is not interpreted")) + m <- wantInterpretedModule str + separate session ms (m:as) bs separate session (str:ms) as bs = do - m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing + m <- lookupModule str separate session ms as (m:bs) newContext :: [String] -> GHCi () @@ -1533,13 +1547,13 @@ completeWord w start end = do completeCmd :: String -> IO [String] completeCmd w = do - cmds <- readIORef commands - return (filter (w `isPrefixOf`) (map (':':) (map cmdName cmds))) + cmds <- readIORef macros_ref + return (filter (w `isPrefixOf`) (map (':':) + (map cmdName (builtin_commands ++ cmds)))) completeMacro w = do - cmds <- readIORef commands - let cmds' = [ cmd | cmd <- map cmdName cmds, cmd `elem` map cmdName builtin_commands ] - return (filter (w `isPrefixOf`) cmds') + cmds <- readIORef macros_ref + return (filter (w `isPrefixOf`) (map cmdName cmds)) completeIdentifier w = do s <- restoreSession