...
 
Commits (3)
......@@ -26,7 +26,9 @@ import Haddock.Types hiding (Version)
import Haddock.Utils hiding (out)
import GHC
import GHC.Driver.Ppr
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
import Data.Char
import Data.List
......@@ -106,14 +108,14 @@ outWith p = f . unwords . map (dropWhile isSpace) . lines . p . ppr
f [] = []
out :: Outputable a => DynFlags -> a -> String
out dflags = outWith $ showSDocUnqual dflags
out dflags = outWith $ showSDoc dflags
operator :: String -> String
operator (x:xs) | not (isAlphaNum x) && x `notElem` "_' ([{" = '(' : x:xs ++ ")"
operator x = x
commaSeparate :: Outputable a => DynFlags -> [a] -> String
commaSeparate dflags = showSDocUnqual dflags . interpp'SP
commaSeparate dflags = showSDoc dflags . interpp'SP
---------------------------------------------------------------------
-- How to print each export
......@@ -173,7 +175,7 @@ ppClass dflags decl subdocs =
ppTyFams
| null $ tcdATs decl = ""
| otherwise = (" " ++) . showSDocUnqual dflags . whereWrapper $ concat
| otherwise = (" " ++) . showSDoc dflags . whereWrapper $ concat
[ map pprTyFam (tcdATs decl)
, map (pprTyFamInstDecl NotTopLevel . unLoc) (tcdATDefs decl)
]
......
......@@ -17,7 +17,9 @@ import GHC.Parser.Lexer as Lexer
( P(..), ParseResult(..), PState(..), Token(..)
, mkPStatePure, lexer, mkParserFlags', getErrorMessages)
import GHC.Data.Bag ( bagToList )
import GHC.Utils.Outputable ( showSDoc, panic, text, ($$) )
import GHC.Utils.Outputable ( text, ($$) )
import GHC.Utils.Panic ( panic )
import GHC.Driver.Ppr ( showSDoc )
import GHC.Types.SrcLoc
import GHC.Data.StringBuffer ( StringBuffer, atEnd )
......@@ -240,7 +242,6 @@ classify tok =
ITcolumn_prag {} -> TkPragma
ITscc_prag {} -> TkPragma
ITgenerated_prag {} -> TkPragma
ITcore_prag {} -> TkPragma
ITunpack_prag {} -> TkPragma
ITnounpack_prag {} -> TkPragma
ITann_prag {} -> TkPragma
......@@ -381,7 +382,6 @@ inPragma False tok =
ITcolumn_prag {} -> True
ITscc_prag {} -> True
ITgenerated_prag {} -> True
ITcore_prag {} -> True
ITunpack_prag {} -> True
ITnounpack_prag {} -> True
ITann_prag {} -> True
......
......@@ -21,7 +21,7 @@ import GHC
import GHC.Iface.Ext.Types ( HieAST(..), HieType(..), HieArgs(..), TypeIndex, HieTypeFlat )
import GHC.Iface.Type
import GHC.Types.Name ( getOccFS, getOccString )
import GHC.Utils.Outputable( showSDoc )
import GHC.Driver.Ppr ( showSDoc )
import GHC.Types.Var ( VarBndr(..) )
import System.FilePath.Posix ((</>), (<.>))
......
......@@ -31,7 +31,7 @@ import GHC.Types.Name ( nameOccName )
import GHC.Types.Name.Reader ( rdrNameOcc )
import GHC.Core.Type ( Specificity(..) )
import GHC.Data.FastString ( unpackFS )
import GHC.Utils.Outputable ( panic)
import GHC.Utils.Panic ( panic)
import qualified Data.Map as Map
import System.Directory
......
......@@ -48,7 +48,7 @@ import GHC.Builtin.Names ( hasKey, eqTyConKey, ipClassKey, tYPETyConKey
import GHC.Types.Unique ( getUnique )
import GHC.Utils.Misc ( chkAppend, debugIsOn, dropList, equalLength
, filterByList, filterOut )
import GHC.Utils.Outputable ( assertPanic )
import GHC.Utils.Panic ( assertPanic )
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.SrcLoc
......
......@@ -25,7 +25,9 @@ import Haddock.Types( DocName, DocNameI )
import GHC.Utils.Exception
import GHC.Utils.FV as FV
import GHC.Utils.Outputable ( Outputable, panic, showPpr )
import GHC.Utils.Outputable ( Outputable )
import GHC.Utils.Panic ( panic )
import GHC.Driver.Ppr (showPpr )
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Unit.Module
......
......@@ -45,6 +45,7 @@ import qualified GHC.Types.SrcLoc as SrcLoc
import GHC.Core.ConLike (ConLike(..))
import GHC
import GHC.Driver.Types
import GHC.Driver.Ppr
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
......@@ -55,6 +56,7 @@ import GHC.Tc.Types
import GHC.Data.FastString ( unpackFS, bytesFS )
import GHC.Types.Basic ( StringLiteral(..), SourceText(..), PromotionFlag(..) )
import qualified GHC.Utils.Outputable as O
import GHC.Utils.Panic
import GHC.HsToCore.Docs hiding (mkMaps)
import GHC.Core.Multiplicity
......@@ -726,7 +728,7 @@ hiDecl dflags t = do
warnLine x = O.text "haddock-bug:" O.<+> O.text x O.<>
O.comma O.<+> O.quotes (O.ppr t) O.<+>
O.text "-- Please report this on Haddock issue tracker!"
bugWarn = O.showSDoc dflags . warnLine
bugWarn = showSDoc dflags . warnLine
-- | This function is called for top-level bindings without type signatures.
-- It gets the type signature from GHC and that means it's not going to
......@@ -888,7 +890,7 @@ extractDecl declMap name decl
([], [])
| Just (famInstDecl:_) <- M.lookup name declMap
-> extractDecl declMap name famInstDecl
_ -> O.pprPanic "extractDecl" (O.text "Ambiguous decl for" O.<+> O.ppr name O.<+> O.text "in class:"
_ -> pprPanic "extractDecl" (O.text "Ambiguous decl for" O.<+> O.ppr name O.<+> O.text "in class:"
O.$$ O.nest 4 (O.ppr d)
O.$$ O.text "Matches:"
O.$$ O.nest 4 (O.ppr matchesMethod O.<+> O.ppr matchesAssociatedType))
......@@ -931,7 +933,7 @@ extractDecl declMap name decl
in case matches of
[d0] -> extractDecl declMap name (noLoc . InstD noExtField $ DataFamInstD noExtField d0)
_ -> error "internal: extractDecl (ClsInstD)"
_ -> O.pprPanic "extractDecl" $
_ -> pprPanic "extractDecl" $
O.text "Unhandled decl for" O.<+> O.ppr name O.<> O.text ":"
O.$$ O.nest 4 (O.ppr decl)
......
......@@ -32,7 +32,7 @@ import Haddock.Interface.ParseModuleHeader
import Haddock.Parser
import Haddock.Types
import GHC.Types.Name
import GHC.Utils.Outputable ( showPpr, showSDoc )
import GHC.Driver.Ppr ( showPpr, showSDoc )
import GHC.Types.Name.Reader
import GHC.Data.EnumSet as EnumSet
import GHC.Rename.Env (dataTcOccs)
......
{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
......@@ -276,7 +277,7 @@ putName BinSymbolTable{
data BinSymbolTable = BinSymbolTable {
bin_symtab_next :: !FastMutInt, -- The next index to use
bin_symtab_map :: !(IORef (UniqFM (Int,Name)))
bin_symtab_map :: !(IORef (UniqFM Name (Int,Name)))
-- indexed by Name
}
......@@ -286,24 +287,24 @@ putFastString BinDictionary { bin_dict_next = j_r,
bin_dict_map = out_r} bh f
= do
out <- readIORef out_r
let unique = getUnique f
case lookupUFM out unique of
let !unique = getUnique f
case lookupUFM_Directly out unique of
Just (j, _) -> put_ bh (fromIntegral j :: Word32)
Nothing -> do
j <- readFastMutInt j_r
put_ bh (fromIntegral j :: Word32)
writeFastMutInt j_r (j + 1)
writeIORef out_r $! addToUFM out unique (j, f)
writeIORef out_r $! addToUFM_Directly out unique (j, f)
data BinDictionary = BinDictionary {
bin_dict_next :: !FastMutInt, -- The next index to use
bin_dict_map :: !(IORef (UniqFM (Int,FastString)))
bin_dict_map :: !(IORef (UniqFM FastString (Int,FastString)))
-- indexed by FastString
}
putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
putSymbolTable :: BinHandle -> Int -> UniqFM Name (Int,Name) -> IO ()
putSymbolTable bh next_off symtab = do
put_ bh next_off
let names = elems (array (0,next_off-1) (eltsUFM symtab))
......@@ -346,7 +347,7 @@ fromOnDiskName _ nc (pid, mod_name, occ) =
}
serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
serialiseName :: BinHandle -> Name -> UniqFM Name (Int,Name) -> IO ()
serialiseName bh name _ = do
let modu = nameModule name
put_ bh (moduleUnit modu, moduleName modu, nameOccName name)
......