<commit_before>Patch to make Hugs output more suitable for use with hugs-hc and the
fptools testsuite:

* show less detail about pattern match failures to make output less brittle.

* print top-level exceptions in the same way as GHC-generated programs do.

--- Hugs/Prelude.hs	2004-11-17 10:39:58.000000000 +0000
+++ Hugs/Prelude.hs.new	2004-11-17 11:59:16.000000000 +0000
@@ -1633,7 +1633,7 @@
   showsPrec _ (IOException err)	  = shows err
   showsPrec _ (NoMethodError s)   = showException "undefined member" s
   showsPrec _ NonTermination	  = showString "<<loop>>"
-  showsPrec _ (PatternMatchFail s) = showException "pattern match failure" s
+  showsPrec _ (PatternMatchFail s) = showString "pattern match failure"
   showsPrec _ (RecConError s)     = showException "undefined field" s
   showsPrec _ (RecSelError s)     = showException "select of missing field" s
   showsPrec _ (RecUpdError s)     = showException "update of missing field" s
@@ -1929,11 +1929,15 @@
   exceptionHandler (ExitException ExitSuccess) = primExitWith 0
   exceptionHandler (ExitException (ExitFailure n)) = primExitWith n
   exceptionHandler err = runAndShowError $ do
-	putChar '\n'
-	putStr "Program error: "
-	putStrLn (show err)
+	hPutStr stderr "Fail: "
+	hPutStr stderr (show err)
+	hPutChar stderr '\n'
 	primExitWith 1
 
+primitive stderr      :: Handle
+primitive hPutChar      :: Handle -> Char -> IO ()
+primitive hPutStr       :: Handle -> String -> IO ()
+
 basicIORun :: IO a -> IOFinished a
 basicIORun (IO m) = loop [m hugsReturn]
 <commit_msg>mark top-level exceptions with the program name (like GHC)<commit_after>Patch to make Hugs output more suitable for use with hugs-hc and the
fptools testsuite:

* show less detail about pattern match failures to make output less brittle.

* print top-level exceptions in the same way as GHC-generated programs do.

--- Hugs/Prelude.hs	2005-04-14 12:42:12.000000000 +0100
+++ Hugs/Prelude.hs.new	2005-04-22 15:17:26.000000000 +0100
@@ -1618,7 +1618,7 @@
   showsPrec _ (IOException err)	  = shows err
   showsPrec _ (NoMethodError s)   = showException "undefined member" s
   showsPrec _ NonTermination	  = showString "<<loop>>"
-  showsPrec _ (PatternMatchFail s) = showException "pattern match failure" s
+  showsPrec _ (PatternMatchFail s) = showString "pattern match failure"
   showsPrec _ (RecConError s)     = showException "undefined field" s
   showsPrec _ (RecSelError s)     = showException "select of missing field" s
   showsPrec _ (RecUpdError s)     = showException "update of missing field" s
@@ -1914,11 +1914,20 @@
   exceptionHandler (ExitException ExitSuccess) = primExitWith 0
   exceptionHandler (ExitException (ExitFailure n)) = primExitWith n
   exceptionHandler err = runAndShowError $ do
-	putChar '\n'
-	putStr "Program error: "
-	putStrLn (show err)
+	pname <- getProgName
+	let shortName = reverse $ takeWhile (/= '/') $ tail $
+				dropWhile (/= '.') $ reverse pname
+	hPutStr stderr shortName
+	hPutStr stderr ": "
+	hPutStr stderr (show err)
+	hPutChar stderr '\n'
 	primExitWith 1
 
+primitive getProgName "primGetProgName" :: IO String
+primitive stderr        :: Handle
+primitive hPutChar      :: Handle -> Char -> IO ()
+primitive hPutStr       :: Handle -> String -> IO ()
+
 basicIORun :: IO a -> IOFinished a
 basicIORun (IO m) = loop [m hugsReturn]
 
{'fraction_non_alphanumeric': 0.1027869343721906, 'fraction_numerical': 0.04674857656577765, 'mean_word_length': 3.8028776978417267, 'pattern_counts': {'":': 1, '<': 8, '<?xml version=': 0, '>': 17, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 4, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '192174', 'n_tokens_mistral': 1208, 'n_tokens_neox': 1083, 'n_words': 355}