Commit 6f2f8380 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Build fixes

parent 8685576a
...@@ -252,12 +252,14 @@ unsetOption opt ...@@ -252,12 +252,14 @@ unsetOption opt
printForUser :: GhcMonad m => SDoc -> m () printForUser :: GhcMonad m => SDoc -> m ()
printForUser doc = do printForUser doc = do
unqual <- GHC.getPrintUnqual unqual <- GHC.getPrintUnqual
MonadUtils.liftIO $ Outputable.printForUser stdout unqual doc dflags <- getDynFlags
MonadUtils.liftIO $ Outputable.printForUser dflags stdout unqual doc
printForUserPartWay :: SDoc -> GHCi () printForUserPartWay :: SDoc -> GHCi ()
printForUserPartWay doc = do printForUserPartWay doc = do
unqual <- GHC.getPrintUnqual unqual <- GHC.getPrintUnqual
liftIO $ Outputable.printForUserPartWay stdout opt_PprUserLength unqual doc dflags <- getDynFlags
liftIO $ Outputable.printForUserPartWay dflags stdout opt_PprUserLength unqual doc
-- | Run a single Haskell expression -- | Run a single Haskell expression
runStmt :: String -> GHC.SingleStep -> GHCi (Maybe GHC.RunResult) runStmt :: String -> GHC.SingleStep -> GHCi (Maybe GHC.RunResult)
......
...@@ -86,12 +86,13 @@ listModuleTags m = do ...@@ -86,12 +86,13 @@ listModuleTags m = do
case mbModInfo of case mbModInfo of
Nothing -> return [] Nothing -> return []
Just mInfo -> do Just mInfo -> do
dflags <- getDynFlags
mb_print_unqual <- GHC.mkPrintUnqualifiedForModule mInfo mb_print_unqual <- GHC.mkPrintUnqualifiedForModule mInfo
let unqual = fromMaybe GHC.alwaysQualify mb_print_unqual let unqual = fromMaybe GHC.alwaysQualify mb_print_unqual
let names = fromMaybe [] $GHC.modInfoTopLevelScope mInfo let names = fromMaybe [] $GHC.modInfoTopLevelScope mInfo
let localNames = filter ((m==) . nameModule) names let localNames = filter ((m==) . nameModule) names
mbTyThings <- mapM GHC.lookupName localNames mbTyThings <- mapM GHC.lookupName localNames
return $! [ tagInfo unqual exported kind name realLoc return $! [ tagInfo dflags unqual exported kind name realLoc
| tyThing <- catMaybes mbTyThings | tyThing <- catMaybes mbTyThings
, let name = getName tyThing , let name = getName tyThing
, let exported = GHC.modInfoIsExportedName mInfo name , let exported = GHC.modInfoIsExportedName mInfo name
...@@ -119,11 +120,12 @@ data TagInfo = TagInfo ...@@ -119,11 +120,12 @@ data TagInfo = TagInfo
-- get tag info, for later translation into Vim or Emacs style -- get tag info, for later translation into Vim or Emacs style
tagInfo :: PrintUnqualified -> Bool -> Char -> Name -> RealSrcLoc -> TagInfo tagInfo :: DynFlags -> PrintUnqualified -> Bool -> Char -> Name -> RealSrcLoc
tagInfo unqual exported kind name loc -> TagInfo
tagInfo dflags unqual exported kind name loc
= TagInfo exported kind = TagInfo exported kind
(showSDocForUser unqual $ pprOccName (nameOccName name)) (showSDocForUser dflags unqual $ pprOccName (nameOccName name))
(showSDocForUser unqual $ ftext (srcLocFile loc)) (showSDocForUser dflags unqual $ ftext (srcLocFile loc))
(srcLocLine loc) (srcLocCol loc) Nothing (srcLocLine loc) (srcLocCol loc) Nothing
......
...@@ -961,8 +961,9 @@ info :: String -> InputT GHCi () ...@@ -961,8 +961,9 @@ info :: String -> InputT GHCi ()
info "" = ghcError (CmdLineError "syntax: ':i <thing-you-want-info-about>'") info "" = ghcError (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
info s = handleSourceError GHC.printException $ do info s = handleSourceError GHC.printException $ do
unqual <- GHC.getPrintUnqual unqual <- GHC.getPrintUnqual
dflags <- getDynFlags
sdocs <- mapM infoThing (words s) sdocs <- mapM infoThing (words s)
mapM_ (liftIO . putStrLn . showSDocForUser unqual) sdocs mapM_ (liftIO . putStrLn . showSDocForUser dflags unqual) sdocs
infoThing :: GHC.GhcMonad m => String -> m SDoc infoThing :: GHC.GhcMonad m => String -> m SDoc
infoThing str = do infoThing str = do
...@@ -1589,7 +1590,7 @@ browseModule bang modl exports_only = do ...@@ -1589,7 +1590,7 @@ browseModule bang modl exports_only = do
prettyThings = map (pretty pefas) things prettyThings = map (pretty pefas) things
prettyThings' | bang = annotate $ zip modNames prettyThings prettyThings' | bang = annotate $ zip modNames prettyThings
| otherwise = prettyThings | otherwise = prettyThings
liftIO $ putStrLn $ showSDocForUser unqual (vcat prettyThings') liftIO $ putStrLn $ showSDocForUser dflags unqual (vcat prettyThings')
-- ToDo: modInfoInstances currently throws an exception for -- ToDo: modInfoInstances currently throws an exception for
-- package modules. When it works, we can do this: -- package modules. When it works, we can do this:
-- $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info)) -- $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment