15.4.1014  src/lib/src/time-limit.pkg

## time-limit.pkg -- run a computation under a time limit.

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



###                   "You will never find time for anything.
###                    If you want time you must make it."
###
###                                    -- Charles Buxton


stipulate
    package is  =  interprocess_signals;                                                                # interprocess_signals  is from   src/lib/std/src/nj/interprocess-signals.pkg
herein
    package time_limit: (weak)
    api {
        exception TIME_OUT;
        time_limit:  time::Time -> (X -> Y) -> X -> Y;
    }
    {
        exception TIME_OUT;

        fun time_limit t f x
            =
            {   set_sigalrm_frequency =   set_sigalrm_frequency::set_sigalrm_frequency;
                #
                fun timer_on  () =  ignore (set_sigalrm_frequency (THE t));
                fun timer_off () =  ignore (set_sigalrm_frequency  NULL  );

                switch_to_control_fate                                                          # Was called "escape_fate"; was that a better name? -- 2011-11-17 CrT, doing global escape_fate -> switch_to_control_fate transform.
                    =
                    fate::call_with_current_fate
                        (\\ fate =
                              {   fate::call_with_current_fate
                                      (\\ fate' =  (fate::switch_to_fate fate fate'));          # 

                                  timer_off ();

                                  raise exception TIME_OUT;
                              }
                        );

                fun handler _
                    =
                    switch_to_control_fate;

                is::set_signal_handler  (is::SIGALRM, is::HANDLER handler);

                timer_on ();

                ( (f x)
                  except
                      ex = { timer_off ();
                             raise exception ex;
                           }
                )
                then
                    timer_off ();
            };

    };                                                          #  package time_limit 
end;

## COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See SMLNJ-COPYRIGHT file for details.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.