X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2FInteractiveUI.hs;h=11a3c98f10de442b86cf1dd4b4c81c0d3cb4cfee;hb=92a5f4abbd32c0a28b75207b368d86e59515683d;hp=24079bb49bff78c23bbe83caa6394bbf3ac9e7e7;hpb=1d227d655c7391143baa7ce777be8103d5426e82;p=ghc-hetmet.git diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 24079bb..11a3c98 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -140,7 +140,7 @@ builtin_commands = [ ("kind", keepGoing' kindOfType, completeIdentifier), ("load", keepGoingPaths loadModule_, completeHomeModuleOrFile), ("list", keepGoing' listCmd, noCompletion), - ("module", keepGoing setContext, completeModule), + ("module", keepGoing setContext, completeSetModule), ("main", keepGoing runMain, completeFilename), ("print", keepGoing printCmd, completeExpression), ("quit", quit, noCompletion), @@ -827,7 +827,7 @@ info s = handleSourceError GHC.printExceptionAndWarnings $ mb_stuffs <- mapM GHC.getInfo names let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs) unqual <- GHC.getPrintUnqual - outputStrLn $ showSDocForUser unqual $ + liftIO $ putStrLn $ showSDocForUser unqual $ vcat (intersperse (text "") $ map (pprInfo pefas) filtered) @@ -894,7 +894,8 @@ changeDirectory "" = do changeDirectory dir = do graph <- GHC.getModuleGraph when (not (null graph)) $ - outputStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n" + do liftIO $ putStrLn "Warning: changing directory causes all loaded modules to be unloaded," + liftIO $ putStrLn "because the search path has changed." prev_context <- GHC.getContext GHC.setTargets [] _ <- GHC.load LoadAllTargets @@ -1049,7 +1050,7 @@ checkModule m = do prev_context <- GHC.getContext ok <- handleSourceError (\e -> GHC.printExceptionAndWarnings e >> return False) $ do r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl - outputStrLn (showSDoc ( + liftIO $ putStrLn $ showSDoc $ case GHC.moduleInfo r of cm | Just scope <- GHC.modInfoTopLevelScope cm -> let @@ -1058,7 +1059,7 @@ checkModule m = do in (text "global names: " <+> ppr global) $$ (text "local names: " <+> ppr local) - _ -> empty)) + _ -> empty return True afterLoad (successIf ok) False prev_context @@ -1161,9 +1162,9 @@ modulesLoadedMsg ok mods = do punctuate comma (map ppr mods)) <> text "." case ok of Failed -> - outputStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)) + liftIO $ putStrLn $ showSDoc (text "Failed, modules loaded: " <> mod_commas) Succeeded -> - outputStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas)) + liftIO $ putStrLn $ showSDoc (text "Ok, modules loaded: " <> mod_commas) typeOfExpr :: String -> InputT GHCi () @@ -1300,7 +1301,7 @@ browseModule bang modl exports_only = withFlattenedDynflags $ do let prettyThings = map (pretty pefas) things prettyThings' | bang = annotate $ zip modNames prettyThings | otherwise = prettyThings - outputStrLn $ showSDocForUser unqual (vcat prettyThings') + liftIO $ putStrLn $ showSDocForUser unqual (vcat prettyThings') -- ToDo: modInfoInstances currently throws an exception for -- package modules. When it works, we can do this: -- $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info)) @@ -1645,11 +1646,6 @@ showPackages = do io $ putStrLn $ showSDoc $ vcat $ text ("active package flags:"++if null pkg_flags then " none" else "") : map showFlag pkg_flags - pkg_ids <- fmap (preloadPackages . pkgState) getDynFlags - io $ putStrLn $ showSDoc $ vcat $ - text "packages currently loaded:" - : map (nest 2 . text . packageIdString) - (sortBy (compare `on` packageIdFS) pkg_ids) where showFlag (ExposePackage p) = text $ " -package " ++ p showFlag (HidePackage p) = text $ " -hide-package " ++ p showFlag (IgnorePackage p) = text $ " -ignore-package " ++ p @@ -1660,12 +1656,13 @@ showLanguages = do dflags <- getDynFlags io $ putStrLn $ showSDoc $ vcat $ text "active language flags:" : - [text (" -X" ++ str) | (str, f, _) <- DynFlags.xFlags, dopt f dflags] + [text (" -X" ++ str) | (str, f, _) <- DynFlags.xFlags, xopt f dflags] -- ----------------------------------------------------------------------------- -- Completion completeCmd, completeMacro, completeIdentifier, completeModule, + completeSetModule, completeHomeModule, completeSetOptions, completeShowOptions, completeHomeModuleOrFile, completeExpression :: CompletionFunc GHCi @@ -1711,6 +1708,18 @@ completeModule = wrapIdentCompleter $ \w -> do return $ filter (w `isPrefixOf`) $ map (showSDoc.ppr) $ loaded_mods ++ pkg_mods +completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do + modules <- case m of + Just '-' -> do + (toplevs, exports) <- GHC.getContext + return $ map GHC.moduleName (nub (map fst exports) ++ toplevs) + _ -> do + dflags <- GHC.getSessionDynFlags + let pkg_mods = allExposedModules dflags + loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules + return $ loaded_mods ++ pkg_mods + return $ filter (w `isPrefixOf`) $ map (showSDoc.ppr) modules + completeHomeModule = wrapIdentCompleter listHomeModules listHomeModules :: String -> GHCi [String] @@ -1748,6 +1757,12 @@ wrapCompleter breakChars fun = completeWord Nothing breakChars wrapIdentCompleter :: (String -> GHCi [String]) -> CompletionFunc GHCi wrapIdentCompleter = wrapCompleter word_break_chars +wrapIdentCompleterWithModifier :: String -> (Maybe Char -> String -> GHCi [String]) -> CompletionFunc GHCi +wrapIdentCompleterWithModifier modifChars fun = completeWordWithPrev Nothing word_break_chars + $ \rest -> fmap (map simpleCompletion) . fmap sort . fun (getModifier rest) + where + getModifier = find (`elem` modifChars) + allExposedModules :: DynFlags -> [ModuleName] allExposedModules dflags = concat (map exposedModules (filter exposed (eltsUFM pkg_db))) @@ -2158,7 +2173,7 @@ list2 :: [String] -> InputT GHCi () list2 [arg] | all isDigit arg = do (toplevel, _) <- GHC.getContext case toplevel of - [] -> outputStrLn "No module to list" + [] -> liftIO $ putStrLn "No module to list" (mod : _) -> listModuleLine mod (read arg) list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do mod <- wantInterpretedModule arg1 @@ -2183,7 +2198,7 @@ list2 [arg] = do noCanDo n why = printForUser $ text "cannot list source code for " <> ppr n <> text ": " <> why list2 _other = - outputStrLn "syntax: :list [ | | ]" + liftIO $ putStrLn "syntax: :list [ | | ]" listModuleLine :: Module -> Int -> InputT GHCi () listModuleLine modl line = do @@ -2224,7 +2239,7 @@ listAround span do_highlight = do let output = BS.intercalate (BS.pack "\n") prefixed utf8Decoded <- liftIO $ BS.useAsCStringLen output $ \(p,n) -> utf8DecodeString (castPtr p) n - outputStrLn utf8Decoded + liftIO $ putStrLn utf8Decoded where file = GHC.srcSpanFile span line1 = GHC.srcSpanStartLine span