(************************************************************
   type_server_with_type_annotation.ml	Created      : Wed Aug 13 04:13:54 2003
  			Last modified: Wed Aug 13 04:38:25 2003
  Compile: ocamlc -i -I ../../../parsing -I ../../../typing -I ../../../utils unix.cma toplevellib.cma list2.ml searchid.ml search_type.ml str.cma type_server_with_type_annotation.ml -o type_server_with_type_annotation #
  FTP Directory: sources/ocaml #
************************************************************)
(**

  @author Takashi Masuyama <mamewo@dk9.so-net.ne.jp>

  標準入力に
  SEARCH,int->int->int,Exact
  SEARCH,int->int->int,Included
  のように入れると、それらの型にマッチするものを検索して
表示する。検索結果の前には結果であることを示す文字列 __RESULT
が行頭につく

  __CommandError
  Unix.read
  ....
  __END

*)

open Env
open Types

let delimiter = Str.regexp ","
(*let i = stdin*)
(*let o = stdout*)

let mode_str2mode s =
  if s = "Exact" then `Exact
  else if s = "Included" then `Included
  else raise Exit

let to_string_with_type_annotation env id =
  let (_, v) = Env.lookup_value id env in
  let t = v.val_type in
  let idstr = Search_type.longident_to_string id in
  let tstr = 
    begin
      Printtyp.type_expr Format.str_formatter t;
      Format.flush_str_formatter ()
    end in
  idstr^" : "^tstr

let newline_regexp = Str.regexp "\n"

let rec iter () =
  let command = read_line () in
  let commandlst = Str.split delimiter command in
  (match commandlst with
    ["SEARCH"; t_str; mode_str] ->
      (try 
	let lst = Searchid.search_string_type t_str (mode_str2mode mode_str) in
	print_endline "__START";
	List.iter (fun (x, _) -> 
	    let type_annotation = 
	      to_string_with_type_annotation !Searchid.start_env x in
	    let one_line_annotation = 
	      Str.global_replace newline_regexp " " type_annotation  in
	    print_endline  ("__RESULT,"^one_line_annotation)) lst;
	print_endline "__END"
      with _ -> print_endline "__SEARCH_ERROR")
  | _ -> print_endline "__COMMAND_ERROR");
  iter ()

let _ =
  Search_type.init (); 
  Printexc.print iter ()