src/Pure/ML-Systems/polyml-interrupt-timeout.ML
author webertj
Mon, 23 Jan 2006 17:29:52 +0100
changeset 18760 97aaecb84afe
child 18814 1a904aebfef0
permissions -rw-r--r--
TimeLimit replaced by interrupt_timeout
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
18760
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
     1
(*  Title:      Pure/ML-Systems/polyml-interrupt-timeout.ML
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
     2
    ID:         $Id$
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
     3
    Author:     Tjark Weber, Makarius
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
     4
    Copyright   2006
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
     5
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
     6
Bounded time execution (similar to SML/NJ's TimeLimit structure) for Poly/ML.
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
     7
*)
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
     8
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
     9
local
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    10
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    11
  val alarm_active = ref false;
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    12
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    13
  val _ = Signal.signal (Posix.Signal.alrm, Signal.SIG_HANDLE (fn _ =>
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    14
    let val active = ! alarm_active in
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    15
      alarm_active := false;
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    16
      if active then
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    17
        Process.interruptConsoleProcesses ()
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    18
      else
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    19
        ()
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    20
    end));
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    21
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    22
in
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    23
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    24
  (* Time.time -> ('a -> 'b) -> 'a -> 'b *)
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    25
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    26
  fun interrupt_timeout time f x =
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    27
  let
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    28
    fun deactivate_alarm () = (
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    29
      alarm_active := false;
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    30
      Posix.Process.alarm Time.zeroTime
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    31
    )
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    32
  in
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    33
    alarm_active := true;
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    34
    Posix.Process.alarm time;
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    35
    let val result = f x in
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    36
      deactivate_alarm ();
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    37
      result
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    38
    end handle exn => (
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    39
      deactivate_alarm ();
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    40
      raise exn
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    41
    )
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    42
  end;
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    43
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    44
end;