import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..),
Type, Module, ModuleName, TyThing(..), Phase,
BreakIndex, SrcSpan, Resume, SingleStep )
+import PprTyThing
import DynFlags
import Packages
import PackageConfig
import UniqFM
import HscTypes ( implicitTyThings )
-import PprTyThing
import Outputable hiding (printForUser)
import Module -- for ModuleEnv
import Name
let namesSorted = sortBy compareNames names
tythings <- catMaybes `liftM`
io (mapM (GHC.lookupName session) namesSorted)
- docs_ty <- mapM showTyThing tythings
- terms <- mapM (io . GHC.obtainTermB session 10 False)
- [ id | (AnId id, Just _) <- zip tythings docs_ty]
+ let ids = [id | AnId id <- tythings]
+ terms <- mapM (io . GHC.obtainTermB session 10 False) ids
docs_terms <- mapM (io . showTerm session) terms
- printForUser $ vcat $ zipWith (\ty cts -> ty <> text " = " <> cts)
- (catMaybes docs_ty)
+ dflags <- getDynFlags
+ let pefas = dopt Opt_PrintExplicitForalls dflags
+ printForUser $ vcat $ zipWith (\ty cts -> ty <+> equals <+> cts)
+ (map (pprTyThing pefas . AnId) ids)
docs_terms
runBreakCmd :: GHC.BreakInfo -> GHCi ()
maybe_ty <- io (GHC.exprType cms str)
case maybe_ty of
Nothing -> return ()
- Just ty -> do ty' <- cleanType ty
- printForUser $ text str <> text " :: " <> ppr ty'
+ Just ty -> do dflags <- getDynFlags
+ let pefas = dopt Opt_PrintExplicitForalls dflags
+ printForUser $ text str <+> dcolon
+ <+> pprTypeForUser pefas ty
kindOfType :: String -> GHCi ()
kindOfType str
maybe_ty <- io (GHC.typeKind cms str)
case maybe_ty of
Nothing -> return ()
- Just ty -> printForUser $ text str <> text " :: " <> ppr ty
+ Just ty -> printForUser $ text str <+> dcolon <+> ppr ty
quit :: String -> GHCi Bool
quit _ = return True
compareTyThings :: TyThing -> TyThing -> Ordering
t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2
-showTyThing :: TyThing -> GHCi (Maybe SDoc)
-showTyThing (AnId id) = do
- ty' <- cleanType (GHC.idType id)
- return $ Just $ ppr id <> text " :: " <> ppr ty'
-showTyThing _ = return Nothing
-
printTyThing :: TyThing -> GHCi ()
-printTyThing tyth = do
- mb_x <- showTyThing tyth
- case mb_x of
- Just x -> printForUser x
- Nothing -> return ()
-
--- if -fglasgow-exts is on we show the foralls, otherwise we don't.
-cleanType :: Type -> GHCi Type
-cleanType ty = do
- dflags <- getDynFlags
- if dopt Opt_PrintExplicitForalls dflags
- then return ty
- else return $! GHC.dropForAlls ty
+printTyThing tyth = do dflags <- getDynFlags
+ let pefas = dopt Opt_PrintExplicitForalls dflags
+ printForUser (pprTyThing pefas tyth)
showBkptTable :: GHCi ()
showBkptTable = do
line_nos = [ fst_line .. ]
highlighted | do_highlight = zipWith highlight line_nos these_lines
- | otherwise = these_lines
+ | otherwise = [\p -> BS.concat[p,l] | l <- these_lines]
bs_line_nos = [ BS.pack (show l ++ " ") | l <- line_nos ]
- prefixed = zipWith BS.append bs_line_nos highlighted
+ prefixed = zipWith ($) highlighted bs_line_nos
--
BS.putStrLn (BS.join (BS.pack "\n") prefixed)
where
highlight | do_bold = highlight_bold
| otherwise = highlight_carets
- highlight_bold no line
+ highlight_bold no line prefix
| no == line1 && no == line2
= let (a,r) = BS.splitAt col1 line
(b,c) = BS.splitAt (col2-col1) r
in
- BS.concat [a,BS.pack start_bold,b,BS.pack end_bold,c]
+ BS.concat [prefix, a,BS.pack start_bold,b,BS.pack end_bold,c]
| no == line1
= let (a,b) = BS.splitAt col1 line in
- BS.concat [a, BS.pack start_bold, b]
+ BS.concat [prefix, a, BS.pack start_bold, b]
| no == line2
= let (a,b) = BS.splitAt col2 line in
- BS.concat [a, BS.pack end_bold, b]
- | otherwise = line
+ BS.concat [prefix, a, BS.pack end_bold, b]
+ | otherwise = BS.concat [prefix, line]
- highlight_carets no line
+ highlight_carets no line prefix
| no == line1 && no == line2
- = BS.concat [line, nl, indent, BS.replicate col1 ' ',
+ = BS.concat [prefix, line, nl, indent, BS.replicate col1 ' ',
BS.replicate (col2-col1) '^']
| no == line1
- = BS.concat [line, nl, indent, BS.replicate col1 ' ',
- BS.replicate (BS.length line-col1) '^']
+ = BS.concat [indent, BS.replicate (col1 - 2) ' ', BS.pack "vv", nl,
+ prefix, line]
| no == line2
- = BS.concat [line, nl, indent, BS.replicate col2 '^']
- | otherwise = line
+ = BS.concat [prefix, line, nl, indent, BS.replicate col2 ' ',
+ BS.pack "^^"]
+ | otherwise = BS.concat [prefix, line]
where
- indent = BS.pack " "
+ indent = BS.pack (" " ++ replicate (length (show no)) ' ')
nl = BS.singleton '\n'
-- --------------------------------------------------------------------------