(************************************************************
   type_server.ml	Created      : Tue Aug 12 03:47:08 2003
  			Last modified: Thu Jan 08 02:29:18 2004
  Compile: ../../../ocamlcomp.sh -custom -I ../../unix/ -I ../../str/ -I ../../../parsing -I ../../../typing -I ../../../utils search_type.cma list2.ml searchid.ml search_type.ml str.cma ../../str/libstr.a type_server.ml -o type_server #
  Compile: ocamlc -i -I ../../../parsing -I ../../../typing -I ../../../utils unix.cma toplevellib.cma list2.ml searchid.ml search_type.ml str.cma type_server.ml -o type_server #
  FTP Directory: sources/ocaml #
************************************************************)
(**

  @author Takashi Masuyama <mamewo@dk9.so-net.ne.jp>
  otherlibs/labltk/browser において上にかいたコマンドラインでコンパイルする

  SEARCH\tint\tExact
  SEARCH\tint\tIncluded

  __CommandError
  Unix.read
  ....
  __END

*)
open Env
open Types

let delimiter = Str.regexp "\t"
let newline_regexp = Str.regexp "\n"
let annotation_mode = true

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 rec iter () =
  let command = read_line () in
  let commandlst = Str.split delimiter command in
  (match commandlst with
    "SEARCH":: t_str :: modeopt ->
      (try 
	let mode = match modeopt with [mode_str] -> mode_str2mode mode_str | _ -> `Included in
	let lst = Searchid.search_string_type t_str mode in
	print_endline "__START";
	List.iter (fun (x, _) ->
	  if annotation_mode then
	    print_endline ("__RESULT\t"^(Search_type.longident_to_string x))
	  else 
	    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 ()