3

関数を評価しようとする関数を作成しようとしていますが、特定のタイムアウト後に停止します。

を使用しようとしましたDeferred.any。これは、基になる遅延オブジェクトの 1 つが満たされると、満たされる遅延オブジェクトを返します。

type 'a output = OK of 'a | Exn of exn

let fun_test msg f eq (inp,ans) =
   let outp = wait_for (Deferred.any
     [ return (try OK (f inp) with e -> Exn e)
     ; (after (Core.Std.sec 0.0) >>| (fun () -> Exn TIMEOUT))])
   in {msg = msg;inp = inp;outp = outp;ans = ans;pass = eq outp ans}

遅延モナドから値を抽出する方法がわからなかったので、基になる値が決定されるまでスピンする関数「wait_for」を作成しました。

let rec wait_for x =
   match Deferred.peek x with
      | None -> wait_for x
      | Some done -> done;;

これはうまくいきませんでした。Real World OCaml の Async の章を読んだ後、スケジューラを起動する必要があることに気付きました。Schedule.goただし、コードのどこで呼び出すかはわかりません。go : ?raise_unhandled_exn:bool -> unit -> Core.Std.never_returns非同期コードを実際に返したいコードのどこに型が収まるかわかりません。のドキュメントには、「非同期プログラムは呼び出されるgoまで終了しない」と書かれています。shutdown

このコーネルのウェブサイトで同じ問題に対する非常によく似た解決策を見つけるまで、私は問題に対して完全に間違ったアプローチをとったのではないかと疑い始めていました

let timeout (thunk:unit -> 'a Deferred.t) (n:float) : ('a option) Deferred.t
  = Deferred.any 
    [ after (sec n) >>| (fun () -> None) ; 
      thunk () >>= (fun x -> Some x) ]

とにかく、私の使用法wait_forが正しいかどうかはよくわかりません。遅延モナドから値を抽出する標準的な方法はありますか? また、スケジューラを起動するにはどうすればよいですか?

Core.Std.Thread更新: と のみを使用してタイムアウト関数を作成しようとしましたCore.Std.Mutex。

  let rec wait_for lck ptr =
    Core.Std.Thread.delay 0.25;
    Core.Std.Mutex.lock lck;
    (match !ptr with
     | None -> Core.Std.Mutex.unlock lck; wait_for lck ptr
     | Some x -> Core.Std.Mutex.unlock lck; x);;

  let timeout t f =
    let lck = Core.Std.Mutex.create () in
    let ptr = ref None in
    let _ = Core.Std.Thread.create
      (fun () -> Core.Std.Thread.delay t;
                 Core.Std.Mutex.lock lck;
                 (match !ptr with
                  | None -> ptr := Some (Exn TIMEOUT)
                  | Some _ -> ());
                 Core.Std.Mutex.unlock lck;) () in
    let _ = Core.Std.Thread.create
      (fun () -> let x = f () in
                 Core.Std.Mutex.lock lck;
                 (match !ptr with
                  | None -> ptr := Some x
                  | Some _ -> ());
                 Core.Std.Mutex.unlock lck;) () in
    wait_for lck ptr

これはかなり実用に近いと思います。のような計算let rec loop x = print_string ".\n"; loop xでは機能しますが、 のような計算では機能しませんlet rec loop x = loop x。現在の問題は、計算f ()が無限にループする場合、そのスレッドがプリエンプトされないため、他のスレッドがタイムアウトに気付かないことだと思います。スレッドが文字列を出力するような IO を行う場合、スレッドは横取りされます。また、スレッドを強制終了する方法もわかりません。Core.Std.Thread のドキュメントでそのような関数を見つけることができませんでした。

4

1 に答える 1

3

私が思いついた解決策は

let kill pid sign = 
  try Unix.kill pid sign with
  | Unix.Unix_error (e,f,p) -> debug_print ((Unix.error_message e)^"|"^f^"|"^p)
  | e -> raise e;;


let timeout f arg time default = 
  let pipe_r,pipe_w = Unix.pipe () in
  (match Unix.fork () with
   | 0 -> let x = Some (f arg) in
          let oc = Unix.out_channel_of_descr pipe_w in
          Marshal.to_channel oc x [];
          close_out oc;
          exit 0
   | pid0 -> 
      (match Unix.fork () with
       | 0 -> Unix.sleep time;
              kill pid0 Sys.sigkill;
              let oc = Unix.out_channel_of_descr pipe_w in
              Marshal.to_channel oc default [];
              close_out oc;
              exit 0
       | pid1 -> let ic = Unix.in_channel_of_descr pipe_r in
                 let result = (Marshal.from_channel ic : 'b option) in
                 result ));;

ただし、これで2つのゾンビプロセスを作成している可能性があると思います。let rec loop x = loop xただし、を使用してコンパイルした場合に機能する唯一のソリューションですocamlopt(ここでUnix.alarm指定されたソリューションを使用してコンパイルした場合は機能しますが、を使用してコンパイルした場合は機能しません)。ocamlcocamlopt

于 2015-10-27T14:34:25.977 に答える