diff options
Diffstat (limited to 'compiler/utils')
| -rw-r--r-- | compiler/utils/Outputable.lhs | 66 | ||||
| -rw-r--r-- | compiler/utils/Platform.hs | 2 |
2 files changed, 34 insertions, 34 deletions
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index b71389663e..b96ae5e063 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -388,29 +388,29 @@ renderWithStyle sdoc sty = -- showSDoc, designed for when we're getting results like "Foo.bar" -- and "foo{uniq strictness}" so we don't want fancy layout anyway. showSDocOneLine :: SDoc -> String -showSDocOneLine d = - Pretty.showDocWith PageMode +showSDocOneLine d + = Pretty.showDocWith PageMode (runSDoc d (initSDocContext defaultUserStyle)) showSDocForUser :: PrintUnqualified -> SDoc -> String -showSDocForUser unqual doc = - show (runSDoc doc (initSDocContext (mkUserStyle unqual AllTheWay))) +showSDocForUser unqual doc + = show (runSDoc doc (initSDocContext (mkUserStyle unqual AllTheWay))) showSDocUnqual :: SDoc -> String -- Only used in the gruesome isOperator -showSDocUnqual d = - show (runSDoc d (initSDocContext (mkUserStyle neverQualify AllTheWay))) +showSDocUnqual d + = show (runSDoc d (initSDocContext (mkUserStyle neverQualify AllTheWay))) showsPrecSDoc :: Int -> SDoc -> ShowS showsPrecSDoc p d = showsPrec p (runSDoc d (initSDocContext defaultUserStyle)) showSDocDump :: SDoc -> String -showSDocDump d = - Pretty.showDocWith PageMode (runSDoc d (initSDocContext PprDump)) +showSDocDump d + = Pretty.showDocWith PageMode (runSDoc d (initSDocContext defaultDumpStyle)) showSDocDumpOneLine :: SDoc -> String -showSDocDumpOneLine d = - Pretty.showDocWith OneLineMode (runSDoc d (initSDocContext PprDump)) +showSDocDumpOneLine d + = Pretty.showDocWith OneLineMode (runSDoc d (initSDocContext PprDump)) showSDocDebug :: SDoc -> String showSDocDebug d = show (runSDoc d (initSDocContext PprDebug)) @@ -923,27 +923,27 @@ plural _ = char 's' pprPanic :: String -> SDoc -> a -- ^ Throw an exception saying "bug in GHC" -pprPanic = pprAndThen panic +pprPanic = pprDebugAndThen panic pprSorry :: String -> SDoc -> a -- ^ Throw an exception saying "this isn't finished yet" -pprSorry = pprAndThen sorry +pprSorry = pprDebugAndThen sorry pprPgmError :: String -> SDoc -> a -- ^ Throw an exception saying "bug in pgm being compiled" (used for unusual program errors) -pprPgmError = pprAndThen pgmError +pprPgmError = pprDebugAndThen pgmError pprTrace :: String -> SDoc -> a -> a -- ^ If debug output is on, show some 'SDoc' on the screen pprTrace str doc x | opt_NoDebugOutput = x - | otherwise = pprAndThen trace str doc x + | otherwise = pprDebugAndThen trace str doc x pprDefiniteTrace :: String -> SDoc -> a -> a -- ^ Same as pprTrace, but show even if -dno-debug-output is on -pprDefiniteTrace str doc x = pprAndThen trace str doc x +pprDefiniteTrace str doc x = pprDebugAndThen trace str doc x pprPanicFastInt :: String -> SDoc -> FastInt -- ^ Specialization of pprPanic that can be safely used with 'FastInt' @@ -952,33 +952,31 @@ pprPanicFastInt heading pretty_msg = where doc = text heading <+> pretty_msg - -pprAndThen :: (String -> a) -> String -> SDoc -> a -pprAndThen cont heading pretty_msg = - cont (show (runSDoc doc (initSDocContext PprDebug))) - where - doc = sep [text heading, nest 4 pretty_msg] - -assertPprPanic :: String -> Int -> SDoc -> a --- ^ Panic with an assertation failure, recording the given file and line number. --- Should typically be accessed with the ASSERT family of macros -assertPprPanic file line msg - = panic (show (runSDoc doc (initSDocContext PprDebug))) - where - doc = sep [hsep[text "ASSERT failed! file", - text file, - text "line", int line], - msg] - warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a -- ^ Just warn about an assertion failure, recording the given file and line number. -- Should typically be accessed with the WARN macros warnPprTrace _ _file _line _msg x | opt_NoDebugOutput = x warnPprTrace False _file _line _msg x = x warnPprTrace True file line msg x - = trace (show (runSDoc doc (initSDocContext defaultDumpStyle))) x + = pprDebugAndThen trace "WARNING:" doc x where doc = sep [hsep [text "WARNING: file", text file, text "line", int line], msg] + +assertPprPanic :: String -> Int -> SDoc -> a +-- ^ Panic with an assertation failure, recording the given file and line number. +-- Should typically be accessed with the ASSERT family of macros +assertPprPanic file line msg + = pprDebugAndThen panic "ASSERT failed!" doc + where + doc = sep [ hsep [ text "file", text file + , text "line", int line ] + , msg ] + +pprDebugAndThen :: (String -> a) -> String -> SDoc -> a +pprDebugAndThen cont heading pretty_msg + = cont (show (runSDoc doc (initSDocContext PprDebug))) + where + doc = sep [text heading, nest 4 pretty_msg] \end{code} diff --git a/compiler/utils/Platform.hs b/compiler/utils/Platform.hs index 66f51e64e6..47dd7798cd 100644 --- a/compiler/utils/Platform.hs +++ b/compiler/utils/Platform.hs @@ -58,6 +58,7 @@ data OS | OSOpenBSD | OSNetBSD | OSKFreeBSD + | OSHaiku deriving (Read, Show, Eq) -- | ARM Instruction Set Architecture and Extensions @@ -91,6 +92,7 @@ osElfTarget OSSolaris2 = True osElfTarget OSDarwin = False osElfTarget OSMinGW32 = False osElfTarget OSKFreeBSD = True +osElfTarget OSHaiku = True osElfTarget OSUnknown = False -- Defaulting to False is safe; it means don't rely on any -- ELF-specific functionality. It is important to have a default for |