(* $Header: /usr/local/cvsrep/add-a-gram/add-a-gram.ml,v 1.14 2002/04/05 23:59:32 edi Exp $ *)

let sort_string w =
  let s = String.copy w in
  for i = 1 to String.length s - 1 do
    let val_i = String.unsafe_get s i
    and j = ref i in
    while !j > 0 && val_i < String.unsafe_get s (!j - 1) do
      String.unsafe_set s !j (String.unsafe_get s (!j - 1));
      decr j
    done;
    String.unsafe_set s !j val_i
  done;
  s ;;

let hx = Hashtbl.create 20000 ;;

let array_length = ref 4 ;;

let word_list = ref (Array.init !array_length (function i -> [])) ;;

let ic = open_in (Array.get Sys.argv 1) ;;

try
  while true do
    let line = input_line ic in
    let length = String.length line in
    if (length > 2) then
      let sorted_line = (sort_string line) in
        begin
          Hashtbl.add hx sorted_line line ;
          if (length >= !array_length)
          then
            begin
            word_list :=
              Array.init (length + 1)
                         (function i -> if i < !array_length then (Array.unsafe_get !word_list i) else []) ;
            array_length := length + 1
            end ;
          Array.unsafe_set !word_list length (sorted_line :: (Array.unsafe_get !word_list length))
        end
  done
with End_of_file -> () ;;

let remove_char str i =
  let new_length = String.length str - 1 in
  let result = String.create new_length in
  String.unsafe_blit str 0 result 0 i ;
  String.unsafe_blit str (i + 1) result i (new_length - i) ;
  result ;;

exception Found ;;

let rec is_add_a_gram str =
  let result = ref [] in
  let length = String.length str in
  if length = 3 then 
    if Hashtbl.mem hx str then [ str ] else []
  else
    try
      for i = 0 to (length - 1) do
        let shorter_string = remove_char str i in
        if (Hashtbl.mem hx shorter_string) then
          begin
            result := is_add_a_gram shorter_string ;
            if !result != []
            then raise Found
          end
      done ;
      Hashtbl.remove hx str ;
      []
    with Found -> str :: !result ;;

let rec print_list list = match list with 
  | [] -> ()
  | hd :: tl -> begin
                  print_string (String.concat " " (Hashtbl.find_all hx hd)) ;
                  print_newline () ;
                  print_list tl ;
                  ()
                end ;;

let result = ref [] in
try
  for i = !array_length - 1 downto 3 do
    List.iter
      (function word ->
        result := is_add_a_gram word ;
        if [] != !result then raise Found)
      (Array.unsafe_get !word_list i)
  done
with Found -> print_list !result;;