- /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
- if (prog_argv != NULL && prog_name != NULL) {
- fprintf(stderr, "%s: ", prog_name);
- }
- vfprintf(stderr, s, ap);
- fprintf(stderr, "\n");
+#if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
+ if (isGUIApp())
+ {
+ char title[BUFSIZE], message[BUFSIZE];
+
+ snprintf(title, BUFSIZE, "%s: internal error", prog_name);
+ vsnprintf(message, BUFSIZE, s, ap);
+
+ MessageBox(NULL /* hWnd */,
+ message,
+ title,
+ MB_OK | MB_ICONERROR | MB_TASKMODAL
+ );
+ }
+ else
+#endif
+ {
+ /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
+ if (prog_argv != NULL && prog_name != NULL) {
+ fprintf(stderr, "%s: internal error: ", prog_name);
+ } else {
+ fprintf(stderr, "internal error: ");
+ }
+ vfprintf(stderr, s, ap);
+ fprintf(stderr, "\n");
+ fprintf(stderr, " (GHC version %s for %s)\n", ProjectVersion, xstr(HostPlatform_TYPE));
+ fprintf(stderr, " Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n");
+ fflush(stderr);
+ }
+
+ abort();
+ // stg_exit(EXIT_INTERNAL_ERROR);