src/Pure/ML-Systems/polyml-interrupt-timeout.ML
author webertj
Fri, 27 Jan 2006 20:17:24 +0100
changeset 18814 1a904aebfef0
parent 18760 97aaecb84afe
child 21266 288a504c24d6
permissions -rw-r--r--
interrupt_timeout for Poly replaced by stub
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
18814
1a904aebfef0 interrupt_timeout for Poly replaced by stub
webertj
parents: 18760
diff changeset
     9
(* FIXME: this code appears to disable signal handling in child databases altogether (?)
18760
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    10
local
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    11
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    12
  val alarm_active = ref false;
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    13
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    14
  val _ = Signal.signal (Posix.Signal.alrm, Signal.SIG_HANDLE (fn _ =>
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    15
    let val active = ! alarm_active in
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    16
      alarm_active := false;
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    17
      if active then
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    18
        Process.interruptConsoleProcesses ()
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    19
      else
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    20
        ()
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    21
    end));
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    22
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    23
in
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    24
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    25
  fun interrupt_timeout time f x =
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    26
  let
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    27
    fun deactivate_alarm () = (
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    28
      alarm_active := false;
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    29
      Posix.Process.alarm Time.zeroTime
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    30
    )
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    31
  in
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    32
    alarm_active := true;
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    33
    Posix.Process.alarm time;
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    34
    let val result = f x in
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    35
      deactivate_alarm ();
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    36
      result
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    37
    end handle exn => (
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    38
      deactivate_alarm ();
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    39
      raise exn
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    40
    )
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    41
  end;
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    42
97aaecb84afe TimeLimit replaced by interrupt_timeout
webertj
parents:
diff changeset
    43
end;
18814
1a904aebfef0 interrupt_timeout for Poly replaced by stub
webertj
parents: 18760
diff changeset
    44
*)
1a904aebfef0 interrupt_timeout for Poly replaced by stub
webertj
parents: 18760
diff changeset
    45
1a904aebfef0 interrupt_timeout for Poly replaced by stub
webertj
parents: 18760
diff changeset
    46
fun interrupt_timeout time f x =
1a904aebfef0 interrupt_timeout for Poly replaced by stub
webertj
parents: 18760
diff changeset
    47
  f x;