Reorganisation of the source tree

Most of the other users of the fptools build system have migrated to
Cabal, and with the move to darcs we can now flatten the source tree
without losing history, so here goes.

The main change is that the ghc/ subdir is gone, and most of what it
contained is now at the top level.  The build system now makes no
pretense at being multi-project, it is just the GHC build system.

No doubt this will break many things, and there will be a period of
instability while we fix the dependencies.  A straightforward build
should work, but I haven't yet fixed binary/source distributions.
Changes to the Building Guide will follow, too.

1 files changed, 250 insertions, 0 deletions

diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs
new file mode 100644
index 0000000000..1a74d5db32
--- /dev/null
+++ b/compiler/utils/Panic.lhs
@@ -0,0 +1,250 @@
+%
+% (c) The GRASP Project, Glasgow University, 1992-2000
+%
+\section{Panic error messages}
+
+Defines basic funtions for printing error messages.
+
+It's hard to put these functions anywhere else without causing
+some unnecessary loops in the module dependency graph.
+
+\begin{code}
+module Panic  
+   ( 
+     GhcException(..), showGhcException, ghcError, progName, 
+     pgmError,
+
+     panic, panic#, assertPanic, trace,
+     
+     Exception.Exception(..), showException, try, tryJust, tryMost, tryUser,
+     catchJust, ioErrors, throwTo,
+
+     installSignalHandlers, interruptTargetThread
+   ) where
+
+#include "HsVersions.h"
+
+import Config
+import FastTypes
+
+#ifndef mingw32_HOST_OS
+# if __GLASGOW_HASKELL__ > 504
+import System.Posix.Signals
+# else
+import Posix		( Handler(Catch), installHandler, sigINT, sigQUIT )
+# endif /* GHC > 504 */
+#endif /* mingw32_HOST_OS */
+
+#if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 603
+import GHC.ConsoleHandler
+#endif
+
+# if __GLASGOW_HASKELL__ < 500
+import EXCEPTION        ( raiseInThread )
+# else
+import EXCEPTION	( throwTo )
+# endif /* GHC < 500 */
+
+#if __GLASGOW_HASKELL__ > 408
+import EXCEPTION	( catchJust, tryJust, ioErrors )
+#endif
+
+import CONCURRENT	( myThreadId, MVar, ThreadId, withMVar, newEmptyMVar )
+import DYNAMIC
+import qualified EXCEPTION as Exception
+import TRACE		( trace )
+import UNSAFE_IO	( unsafePerformIO )
+import IO		( isUserError )
+
+import System
+\end{code}
+
+GHC's own exception type.
+
+\begin{code}
+ghcError :: GhcException -> a
+ghcError e = Exception.throwDyn e
+
+-- error messages all take the form
+--
+--	<location>: <error>
+--
+-- If the location is on the command line, or in GHC itself, then 
+-- <location>="ghc".  All of the error types below correspond to 
+-- a <location> of "ghc", except for ProgramError (where the string is
+-- assumed to contain a location already, so we don't print one).
+
+data GhcException
+  = PhaseFailed String		-- name of phase 
+  		ExitCode	-- an external phase (eg. cpp) failed
+  | Interrupted			-- someone pressed ^C
+  | UsageError String		-- prints the short usage msg after the error
+  | CmdLineError String		-- cmdline prob, but doesn't print usage
+  | Panic String		-- the `impossible' happened
+  | InstallationError String	-- an installation problem
+  | ProgramError String		-- error in the user's code, probably
+  deriving Eq
+
+progName = unsafePerformIO (getProgName)
+{-# NOINLINE progName #-}
+
+short_usage = "Usage: For basic information, try the `--help' option."
+   
+showException :: Exception.Exception -> String
+-- Show expected dynamic exceptions specially
+showException (Exception.DynException d) | Just e <- fromDynamic d 
+					 = show (e::GhcException)
+showException other_exn	       	 	 = show other_exn
+
+instance Show GhcException where
+  showsPrec _ e@(ProgramError _) = showGhcException e
+  showsPrec _ e = showString progName . showString ": " . showGhcException e
+
+showGhcException (UsageError str)
+   = showString str . showChar '\n' . showString short_usage
+showGhcException (PhaseFailed phase code)
+   = showString "phase `" . showString phase . 
+     showString "' failed (exitcode = " . shows int_code . 
+     showString ")"
+  where
+    int_code = 
+      case code of
+        ExitSuccess   -> (0::Int)
+	ExitFailure x -> x
+showGhcException (CmdLineError str)
+   = showString str
+showGhcException (ProgramError str)
+   = showString str
+showGhcException (InstallationError str)
+   = showString str
+showGhcException (Interrupted)
+   = showString "interrupted"
+showGhcException (Panic s)
+   = showString ("panic! (the 'impossible' happened)\n"
+		 ++ "  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
+	         ++ s ++ "\n\n"
+	         ++ "Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n")
+
+#if __GLASGOW_HASKELL__ < 603
+myMkTyConApp = mkAppTy
+#else 
+myMkTyConApp = mkTyConApp
+#endif
+
+ghcExceptionTc = mkTyCon "GhcException"
+{-# NOINLINE ghcExceptionTc #-}
+instance Typeable GhcException where
+  typeOf _ = myMkTyConApp ghcExceptionTc []
+\end{code}
+
+Panics and asserts.
+
+\begin{code}
+panic, pgmError :: String -> a
+panic    x = Exception.throwDyn (Panic x)
+pgmError x = Exception.throwDyn (ProgramError x)
+
+--  #-versions because panic can't return an unboxed int, and that's
+-- what TAG_ is with GHC at the moment.  Ugh. (Simon)
+-- No, man -- Too Beautiful! (Will)
+
+panic# :: String -> FastInt
+panic# s = case (panic s) of () -> _ILIT 0
+
+assertPanic :: String -> Int -> a
+assertPanic file line = 
+  Exception.throw (Exception.AssertionFailed 
+           ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
+\end{code}
+
+\begin{code}
+-- | tryMost is like try, but passes through Interrupted and Panic
+-- exceptions.  Used when we want soft failures when reading interface
+-- files, for example.
+
+tryMost :: IO a -> IO (Either Exception.Exception a)
+tryMost action = do r <- try action; filter r
+  where
+   filter (Left e@(Exception.DynException d))
+	    | Just ghc_ex <- fromDynamic d
+		= case ghc_ex of
+		    Interrupted -> Exception.throw e
+		    Panic _     -> Exception.throw e
+		    _other      -> return (Left e)
+   filter other 
+     = return other
+
+-- | tryUser is like try, but catches only UserErrors.
+-- These are the ones that are thrown by the TcRn monad 
+-- to signal an error in the program being compiled
+tryUser :: IO a -> IO (Either Exception.Exception a)
+tryUser action = tryJust tc_errors action
+  where 
+#if __GLASGOW_HASKELL__ > 504 || __GLASGOW_HASKELL__ < 500
+	tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
+#elif __GLASGOW_HASKELL__ == 502
+	tc_errors e@(UserError _) = Just e
+#else 
+	tc_errors e@(Exception.IOException ioe) | isUserError e = Just e
+#endif
+	tc_errors _other = Nothing
+\end{code}	
+
+Compatibility stuff:
+
+\begin{code}
+#if __GLASGOW_HASKELL__ <= 408
+try = Exception.tryAllIO
+#else
+try = Exception.try
+#endif
+
+#if __GLASGOW_HASKELL__ <= 408
+catchJust = Exception.catchIO
+tryJust   = Exception.tryIO
+ioErrors  = Exception.justIoErrors
+throwTo   = Exception.raiseInThread
+#endif
+\end{code}
+
+Standard signal handlers for catching ^C, which just throw an
+exception in the target thread.  The current target thread is
+the thread at the head of the list in the MVar passed to
+installSignalHandlers.
+
+\begin{code}
+installSignalHandlers :: IO ()
+installSignalHandlers = do
+  let
+      interrupt_exn = Exception.DynException (toDyn Interrupted)
+
+      interrupt = do
+	withMVar interruptTargetThread $ \targets ->
+	  case targets of
+	   [] -> return ()
+	   (thread:_) -> throwTo thread interrupt_exn
+  --
+#if !defined(mingw32_HOST_OS)
+  installHandler sigQUIT (Catch interrupt) Nothing 
+  installHandler sigINT  (Catch interrupt) Nothing
+  return ()
+#elif __GLASGOW_HASKELL__ >= 603
+  -- GHC 6.3+ has support for console events on Windows
+  -- NOTE: running GHCi under a bash shell for some reason requires
+  -- you to press Ctrl-Break rather than Ctrl-C to provoke
+  -- an interrupt.  Ctrl-C is getting blocked somewhere, I don't know
+  -- why --SDM 17/12/2004
+  let sig_handler ControlC = interrupt
+      sig_handler Break    = interrupt
+      sig_handler _        = return ()
+
+  installHandler (Catch sig_handler)
+  return ()
+#else
+  return () -- nothing
+#endif
+
+{-# NOINLINE interruptTargetThread #-}
+interruptTargetThread :: MVar [ThreadId]
+interruptTargetThread = unsafePerformIO newEmptyMVar
+\end{code}