diff --git a/src/GF/System/NoSignal.hs b/src/GF/System/NoSignal.hs new file mode 100644 index 000000000..3c2fc6e29 --- /dev/null +++ b/src/GF/System/NoSignal.hs @@ -0,0 +1,21 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.System.NoSignal +-- Maintainer : Bjorn Bringert +-- Stability : (stability) +-- Portability : (portability) +-- +-- > CVS $Date: 2005/11/11 11:12:50 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.1 $ +-- +-- Dummy implementation of signal handling. +----------------------------------------------------------------------------- + +module GF.System.NoSignal where + +import Control.Exception (Exception) + +{-# NOINLINE runInterruptibly #-} +runInterruptibly :: IO a -> IO (Either Exception a) +runInterruptibly = fmap Right diff --git a/src/GF/System/Signal.hs b/src/GF/System/Signal.hs index cd5032100..3d9e6ef40 100644 --- a/src/GF/System/Signal.hs +++ b/src/GF/System/Signal.hs @@ -1,3 +1,5 @@ +{-# OPTIONS -cpp #-} + ---------------------------------------------------------------------- -- | -- Module : GF.System.Signal @@ -5,44 +7,21 @@ -- Stability : (stability) -- Portability : (portability) -- --- > CVS $Date: 2005/11/07 22:27:13 $ +-- > CVS $Date: 2005/11/11 11:12:50 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.2 $ +-- > CVS $Revision: 1.3 $ -- --- Allows SIGINT (Ctrl-C) to interrupt computations. +-- Import the right singal handling module. ----------------------------------------------------------------------------- -module GF.System.Signal where +module GF.System.Signal (runInterruptibly) where -import Control.Concurrent (myThreadId, killThread) -import Control.Exception (Exception,catch) -import Prelude hiding (catch) -import System.IO -import System.Posix.Signals +#ifdef USE_INTERRUPT --- | Run an IO action, and allow it to be interrupted --- by a SIGINT to the current process. Returns --- an exception if the process did not complete --- normally. --- NOTES: --- * This will replace any existing SIGINT --- handler during the action. After the computation --- has completed the existing handler will be restored. --- * If the IO action is lazy (e.g. using readFile, --- unsafeInterleaveIO etc.) the lazy computation will --- not be interruptible, as it will be performed --- after the signal handler has been removed. -runInterruptibly :: IO a -> IO (Either Exception a) -runInterruptibly a = - do t <- myThreadId - oldH <- installHandler sigINT (Catch (killThread t)) Nothing - x <- p `catch` h - installHandler sigINT oldH Nothing - return x - where p = a >>= \x -> return $! Right $! x - h e = return $ Left e +import GF.System.UseSignal (runInterruptibly) --- | Like 'runInterruptibly', but always returns (), whether --- the computation fails or not. -runInterruptibly_ :: IO () -> IO () -runInterruptibly_ = fmap (either (const ()) id) . runInterruptibly +#else + +import GF.System.NoSignal (runInterruptibly) + +#endif diff --git a/src/GF/System/UseSignal.hs b/src/GF/System/UseSignal.hs new file mode 100644 index 000000000..8f3874711 --- /dev/null +++ b/src/GF/System/UseSignal.hs @@ -0,0 +1,50 @@ +---------------------------------------------------------------------- +-- | +-- Module : GF.System.UseSignal +-- Maintainer : Bjorn Bringert +-- Stability : (stability) +-- Portability : (portability) +-- +-- > CVS $Date: 2005/11/11 11:12:50 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.1 $ +-- +-- Allows SIGINT (Ctrl-C) to interrupt computations. +----------------------------------------------------------------------------- + +module GF.System.UseSignal where + +import Control.Concurrent (myThreadId, killThread) +import Control.Exception (Exception,catch) +import Prelude hiding (catch) +import System.IO +import System.Posix.Signals + +{-# NOINLINE runInterruptibly #-} + +-- | Run an IO action, and allow it to be interrupted +-- by a SIGINT to the current process. Returns +-- an exception if the process did not complete +-- normally. +-- NOTES: +-- * This will replace any existing SIGINT +-- handler during the action. After the computation +-- has completed the existing handler will be restored. +-- * If the IO action is lazy (e.g. using readFile, +-- unsafeInterleaveIO etc.) the lazy computation will +-- not be interruptible, as it will be performed +-- after the signal handler has been removed. +runInterruptibly :: IO a -> IO (Either Exception a) +runInterruptibly a = + do t <- myThreadId + oldH <- installHandler sigINT (Catch (killThread t)) Nothing + x <- p `catch` h + installHandler sigINT oldH Nothing + return x + where p = a >>= \x -> return $! Right $! x + h e = return $ Left e + +-- | Like 'runInterruptibly', but always returns (), whether +-- the computation fails or not. +runInterruptibly_ :: IO () -> IO () +runInterruptibly_ = fmap (either (const ()) id) . runInterruptibly diff --git a/src/Makefile b/src/Makefile index dd2fa1b1b..d88e59dbe 100644 --- a/src/Makefile +++ b/src/Makefile @@ -46,6 +46,9 @@ ifneq ("$(LDFLAGS)","") GHCFLAGS += -optl'$(LDFLAGS)' endif +ifeq ("$(INTERRUPT)","yes") + GHCFLAGS += -DUSE_INTERRUPT +endif ifeq ("$(ENABLE_JAVA)", "yes") BUILD_JAR=jar diff --git a/src/config.mk.in b/src/config.mk.in index 9760d969a..c13563992 100644 --- a/src/config.mk.in +++ b/src/config.mk.in @@ -25,6 +25,8 @@ GHCI = "@GHCI@" READLINE = @READLINE@ +INTERRUPT = @INTERRUPT@ + ENABLE_JAVA = @ENABLE_JAVA@ JAVAC = "@JAVAC@" diff --git a/src/configure.ac b/src/configure.ac index 36fb8de8b..64e1015bc 100644 --- a/src/configure.ac +++ b/src/configure.ac @@ -4,7 +4,7 @@ AC_INIT([GF],[2.3],[aarne@cs.chalmers.se],[GF]) AC_PREREQ(2.53) -AC_REVISION($Revision: 1.25 $) +AC_REVISION($Revision: 1.26 $) AC_CONFIG_FILES([config.mk jgf gfeditor]) @@ -82,6 +82,39 @@ esac AC_SUBST(READLINE) +dnl *********************************************** +dnl command interruption +dnl *********************************************** + +AC_ARG_WITH(interrupt, + AC_HELP_STRING([--with-interrupt=], + [Choose whether to enable interruption of commands + with SIGINT (Ctrl-C) + Available alternatives are: 'yes', 'no' + (default = yes)]), + [INTERRUPT="$withval"], + [if test "$host_os" = "cygwin"; then + AC_MSG_WARN([Command interruption does not work under + Cygwin, because of missing signal handler support. + Disabling command interruption support. + Use --with-interrupt to override.]) + INTERRUPT="no" + else + INTERRUPT="yes" + fi]) + +case $INTERRUPT in + yes) + ;; + no) + ;; + *) + AC_MSG_ERROR([Bad value for --with-interrupt: $INTERRUPT]) + ;; +esac + +AC_SUBST(INTERRUPT) + dnl *********************************************** dnl java stuff dnl ***********************************************