(************************************************************
   search_type.ml		Created      : Tue Aug 12 02:24:58 2003
  			Last modified: Thu Nov 27 03:11:21 2003
  Compile: ../../../ocamlcomp.sh -I ../../unix -I ../../../parsing -I ../../../typing -I ../../../utils unix.cma ../../../toplevel/toplevellib.cma list2.ml searchid.ml search_type.ml -a -o search_type.cma #
  Compile: ocamlc -I ../../../parsing -I ../../../typing -I ../../../utils unix.cma toplevellib.cma list2.ml searchid.ml search_type.ml -o search_type #
  Execute: ./searchtop -I ../../../parsing -I ../../../typing -I ../../../utils #
  Compile: ocamlmktop -I ../../../parsing -I ../../../typing -I ../../../utils ../../../toplevel/toplevellib.cma list2.ml searchid.ml -o stop #
  FTP Directory: sources/ocaml #
************************************************************)
(**
  otherlibs/labltk/browser において上にかいたコマンドラインでコンパイルする

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

  ガリッグさんのコードを無断拝借。。。(汗)
*)

open StdLabels
open Unix
open Longident

(** 拝借はじめ *)
let get_files_in_directory dir =
  let len = String.length dir in
  let dir =
    if len > 0 && Sys.os_type = "Win32" &&
     (dir.[len-1] = '/' || dir.[len-1] = '\\')
    then String.sub dir 0 (len-1)
    else dir
  in match
    try Some(opendir dir) with Unix_error _ -> None
  with
    None -> []
  | Some dirh ->
      let rec get_them l =
        match
          try Some(readdir dirh) with _ -> None
        with
        | Some x ->
            get_them (x::l)
        | None ->
            closedir dirh; l 
      in
      List.sort ~cmp:compare (get_them [])

let list_modules ~path =
  List.fold_left path ~init:[] ~f:
  begin fun modules dir ->
    let l = 
      List.filter (get_files_in_directory dir)
        ~f:(fun x -> Filename.check_suffix x ".cmi") in
    let l = List.map l ~f:
    begin fun x ->
      String.capitalize (Filename.chop_suffix x ".cmi")
    end in
    List.fold_left l ~init:modules
     ~f:(fun modules item ->
          if List.mem item modules then modules else item :: modules)
  end
(** 拝借終り *)

let path = ref []

(*let rec longident_to_string = function*)
(*    Lident s -> s*)
(*  | Ldot (t, s) -> (longident_to_string t)^"."^s*)
(*  | Lapply (t1, t2) -> (longident_to_string t1)^"("^(longident_to_string t2)^")"*)

let longident_to_string id =
  Printtyp.longident Format.str_formatter id;
  Format.flush_str_formatter ()
;;

let init () =
  Config.load_path :=
    Sys.getcwd ()
    :: List.rev_map (Misc.expand_directory Config.standard_library) !path
    @ [Config.standard_library];
  Searchid.module_list := List.sort compare (list_modules ~path:!Config.load_path);
  (try Searchid.start_env := Env.open_pers_signature "Pervasives" Env.initial
  with _ -> failwith "cannot open envirionment")
;;

(*let main () = *)
(*  init ();*)
(*  let lst = Searchid.search_string_type "int->int->int" ~mode:`Exact in*)
(*  List.iter ~f:(fun (x, _) -> print_endline (longident_to_string x)) lst*)
(*;;*)
(*let _ = main ()*)