15.4.1261  src/lib/std/trap-control-c.pkg

## trap-control-c.pkg

# Compiled by:
#     src/lib/std/standard.lib


# Here we implement a simple facility to throw
# a CONTROL_C_SIGNAL exception in response to
# a unix INT signal.
#
# Example:
#
#     fun foo ()                # 'foo' must be  Void -> Void
#         =
#         {   whatever ();
#             (); 
#         };
#
#     catch_interrupt_signal foo
#     except
#         CONTROL_C_SIGNAL = print "Bang!\n";
#
# In the above, if ^C is typed at the console
# during the execution of   whatever()   then
# instead of exiting, the program will print
# "Bang!\n" and continue execution.  (Evaluation
# of 'whatever()' will however have been aborted.)
#
# This can be a useful way of letting the user
# abort unexpectedly long computations, say
# regular expression matches run wild or such.
#
#
# NB: The INT signal is typically generated by a
# user typing <CTRL>-C at the keyboard, but it
# can be rebound to different keys and also
# generated using   /bin/kill   or such.
#
#
#
# For sample production uses of this function, see
#
#     src/app/lex/export-lex-fn.pkg
#     src/app/yacc/src/export-parse-fn.pkg
#


api Trap_Control_C {

    exception CONTROL_C_SIGNAL;

    catch_interrupt_signal
        :
        (Void -> Void)
        ->
        Void;
};

stipulate
    package is  =  interprocess_signals;                        # interprocess_signals  is from   src/lib/std/src/nj/interprocess-signals.pkg
herein
    package trap_control_c {

        exception CONTROL_C_SIGNAL;

        # This function applies 'operation' to ().
        #
        # If it catches a Control-C signal 
        # it raises the exception CONTROL_C_SIGNAL.
        #
        # Example:
        #     catch_interrupt_signal foo
        #     except
        #         CONTROL_C_SIGNAL = print "Bang!\n";
        #
        fun catch_interrupt_signal
                (operation:  Void -> Void)
            =
            {   exception DONE;
                #
                old_handler =  is::get_signal_handler  is::SIGINT;

                fun reset_handler ()
                    =
                    is::set_signal_handler (is::SIGINT, old_handler);

                {   fate::call_with_current_fate
                        (\\  old_fate
                            =
                            {   is::set_signal_handler
                                    (
                                      is::SIGINT,
                                      is::HANDLER (\\ _ = old_fate)
                                    );

                                operation ();

                                raise exception DONE;
                            }
                        );

                    raise exception CONTROL_C_SIGNAL;
                }
                except
                    DONE            =>  { reset_handler ();                                  };
                    other_exception =>  { reset_handler (); raise exception other_exception; };
                end;
            };
    };
end;

## Copyright (c) 1991 Andrew W. Appel, David R. Tarditi
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.