Revision 6ee5d28a8988618b187e10ebbe680be736c694c4 authored by fclement on 21 September 2006, 15:57:14 UTC, committed by fclement on 21 September 2006, 15:57:14 UTC
1 parent 4442830
Raw File
ocamlp3ltop.ml
open Toolbase;;

let command, arguments, openmodule, description =
  let () = set_argu () in
  let () = dconf.exe <- Top in
  get_cmd ();;

let ids = "OcamlP3l version "^(string_of_float version);;

let open_cmd = List.map (fun x -> "open "^x^";;\n") openmodule;;

let max_len = 250;;
let buffer = String.create max_len;;


(* When eliminating, we must consider the situation where the input
   string is not fully produced at that moment, hence ... 
   We need not consider the cases where some sign contains another sign *)
let eliminate s signs =
  let rec contain a b =
    let len_a = String.length a and len_b = String.length b in
    if len_a >= len_b then
      match compare (String.sub a 0 len_b) b with
        | 0 -> Some(true, String.sub a len_b (len_a-len_b))  | _ -> None
    else 
      match compare (String.sub b 0 len_a) a with
        | 0 -> Some(false, String.sub b 0 len_a) | _ -> None in
  let rec matchs str pats =
    if str="" then ("","") else
      match pats with
        | [] ->  
            let rem,res = 
              matchs (String.sub str 1 (String.length str - 1)) signs in
            (String.sub str 0 1)^rem, res
        | pat::t -> 
            (match contain str pat with
               | None -> matchs str t
               | Some (true, s) -> matchs s signs
               | Some (false,s) -> ("",s)) in
  matchs s signs;;

let mainloop fin fout slaver_id =
  let keep_read in_id out_id rem signs =
    let len = Unix.read in_id buffer 0 max_len in
    let sf, sr = eliminate (rem^(String.sub buffer 0 len)) signs in
    let _ = Unix.write out_id sf 0 (String.length sf) in 
    sr in
  let step = 
    let irem = ref "" and orem = ref "" in
    fun () -> 
      match Unix.select [Unix.stdin; fin] [] [] (0.1) with
        | f::_,_,_ when f = fin ->
            irem := keep_read fin Unix.stdout !irem 
              (List.map (fun x -> x^".") openmodule)
        | f::_, _, _ when f = Unix.stdin -> 
            orem := keep_read Unix.stdin fout !orem []
        | _ -> () in
  while 
    (match Unix.waitpid [Unix.WNOHANG] (-1) with
       | 0, _ -> true
       | p, sign when p = slaver_id ->
           let () = match sign with
             | Unix.WEXITED _ -> 
                 print_endline (ids^" exit successfully")
             | Unix.WSIGNALED n -> 
                 print_endline ("Killed by signal"^(string_of_int n))
             | Unix.WSTOPPED n ->
                 print_endline ("Stopped by signal"^(string_of_int n)) in
           false
       | _ -> print_endline ("Something strange happend!"); false)
  do 
    step ()
  done;;

let main () =
  let twice f x = ignore(f x); ignore(f x) in
  let master_read, slaver_write = Unix.pipe () in
  let slaver_read, master_write = Unix.pipe () in
  let master_in = Unix.in_channel_of_descr master_read in
  let master_out = Unix.out_channel_of_descr master_write in 
  let slaver = Unix.create_process command 
    (Array.of_list (command::arguments))
    slaver_read slaver_write slaver_write in
  begin
    print_endline description;
(*
    print_endline (String.concat " " (command::arguments));
*)
    twice input_line master_in;
    twice input_char master_in;
    List.iter(fun x -> 
                output_string master_out x;
                flush master_out;
                twice input_char master_in
             ) open_cmd;
    print_string ("        " ^ ids ^ "\n\n# ");
    flush stdout;
  end;
  mainloop master_read master_write slaver
;;

main ();;
back to top