15.4.988  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 rs  =  runtime_signals;                     # runtime_signals       is from   src/lib/std/src/nj/runtime-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  );

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

                                  timer_off ();

                                  raise exception TIME_OUT;
                              }
                        );

                fun handler _
                    =
                    throw_fate;

                rs::set_signal_handler
                    (rs::alarm_signal, rs::HANDLER handler);

                timer_on ();

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

    };                                                          #  package time_limit 
end;

## COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file for details.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2012,
## released under Gnu Public Licence version 3.