fork(1) download
copy 
  1. type request = string * string * string
  2. ;;
  3. let code (c,_,_) = c
  4.  
  5. type quote = { price:int; }
  6. ;;
  7.  
  8. type response = {
  9.     req: request;
  10.     body: quote;
  11.     seq:int;
  12.     total:int;
  13.   }
  14. ;;
  15.  
  16. (* 再送信要求のレスポンスは送信idと紐付けられていない(!)ため、
  17.   一度に多くのリクエストを投げた後は、レスポンスを整列させる必要がある。 *)
  18.  
  19. module M = Map.Make (
  20.     struct 
  21.       type t = request
  22.       let compare = Pervasives.compare
  23.     end)
  24. ;;
  25.  
  26. (* メッセージを整列させつつ格納するバッファ。
  27.    (通貨ペア, 問い合わせfrom, to) をキーとして
  28.    (受信した数, メッセージの配列) のリストで管理する。
  29.    リストになっているのは、重複するキーを持つレスポンスに対応するためである。
  30. *)
  31. let buf : (int * quote option array) list M.t ref = ref M.empty
  32. ;;
  33.  
  34. (* 株価のリストをデータベースに保存する. ダミーで画面への出力関数にしてある *)
  35. let save (code:string) (quotes:quote option list) : unit = 
  36.   print_string (code ^ " ");
  37.   List.iter begin function
  38.   | Some q -> Printf.printf "%d;" q.price
  39.   | None -> failwith "impossible"
  40.   end quotes;
  41.   print_newline ()
  42. ;;
  43.  
  44. (*
  45.    メッセージrをバッファに格納する。 レスポンス全体が得られたら、saveで保存する。
  46. *)
  47. let receive_quote (r:response) : unit  =
  48.   if r.total=1 then save (code r.req) [Some r.body] (* 総レコードが1件のみであればすぐに保存 *) 
  49.   else begin
  50.     let map = !buf in
  51.     (* このリクエストに対するレスポンスのリスト(更新前) *)
  52.     let all = try M.find r.req map with Not_found -> [] in
  53.  
  54.     (* バッファに新しいレスポンスを追加 *)
  55.     let newentry () =
  56.       let arr = Array.make r.total None in
  57.       arr.(r.seq) <- Some r.body;
  58.       buf := M.add r.req ((1, arr)::all) map
  59.     in
  60.  
  61.     (* レスポンスのリストを走査し適切な位置に格納 / レスポンス全体が満たされたら保存 *)
  62.     let rec addentry rest = function
  63.       | [] -> newentry ()
  64.       | (cnt, arr) as y::ys ->
  65.         match arr.(r.seq) with
  66.         | None ->
  67.             arr.(r.seq) <- Some r.body; (* レスポンスの該当する連番を満たす *)
  68.             if cnt+1=r.total then begin
  69.               (* レスポンス全体が満たされた. 保存後、この配列をバッファから除く *)
  70.               save (code r.req) (Array.to_list arr) (* 保存 *);
  71.               buf := M.add r.req (List.rev_append rest ys) map
  72.             end else
  73.               (* また足りない．受信済み数をインクリメントしバッファを更新 *)
  74.               buf := M.add r.req (List.rev_append rest ((cnt+1, arr)::ys)) map
  75.         | Some q -> (* このレスポンスでは格納済み. 次のレスポンスを見る *) 
  76.             addentry (y::rest) ys
  77.     in 
  78.     addentry [] all
  79.   end
  80. ;;
  81.  
  82.  
  83. let test = 
  84.   let a="A","1","4" and b = "B","1","2" in
  85.   let resps = [
  86.    {req=a; body={price=1100}; total=4; seq=0};
  87.    {req=a; body={price=1098}; total=4; seq=1};
  88.    {req=a; body={price=1100}; total=4; seq=0};
  89.    {req=b; body={price=910}; total=2; seq=0};
  90.    {req=a; body={price=1098}; total=4; seq=1};
  91.    {req=a; body={price=1081}; total=4; seq=2};
  92.    {req=a; body={price=1081}; total=4; seq=2};
  93.    {req=a; body={price=1120}; total=4; seq=3};
  94.    {req=b; body={price=940}; total=2; seq=1};
  95.    {req=a; body={price=1120}; total=4; seq=3};
  96.   ] in
  97.   List.iter receive_quote resps
  98.  
Success #stdin #stdout 0.02s 2736KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
A 1100;1098;1081;1120;
B 910;940;
A 1100;1098;1081;1120;
https://ideone.com/aWBKX
language:
OCaml (ocamlopt 4.05.0)
created:
12 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!