(* Create shared dictionary.
 * $Id: test_ancient_dict_write.ml,v 1.1 2006-10-06 15:03:47 rich Exp $
 *)

open Printf
open Unix

let argv = Array.to_list Sys.argv

let wordsfile, datafile, baseaddr =
  match argv with
  | [_; wordsfile; datafile; baseaddr] ->
      let baseaddr = Nativeint.of_string baseaddr in
      wordsfile, datafile, baseaddr
  | _ ->
      failwith (sprintf "usage: %s wordsfile datafile baseaddr"
		  Sys.executable_name)

let md =
  let fd = openfile datafile [O_RDWR; O_TRUNC; O_CREAT] 0o644 in
  Ancient.attach fd baseaddr

(* Tree used to store the words.  This is stupid and inefficient
 * but it is here to demonstrate the 'Ancient' module, not good use
 * of trees.
 *)

let arraysize = 256 (* one element for each character *)

type t = Not_Found | Exists of t array | Not_Exists of t array;;
let tree : t array = Array.make arraysize Not_Found

let add_to_tree word =
  let len = String.length word in
  if len > 0 then (
    let tree = ref tree in
    for i = 0 to len-2; do
      let c = word.[i] in
      let c = Char.code c in
      match (!tree).(c) with
      | Not_Found ->
	  (* Allocate more tree. *)
	  let tree' = Array.make arraysize Not_Found in
	  (!tree).(c) <- Not_Exists tree';
	  tree := tree'
      | Exists tree'
      | Not_Exists tree' ->
	  tree := tree'
    done;

    (* Final character. *)
    let c = word.[len-1] in
    let c = Char.code c in
    match (!tree).(c) with
    | Not_Found ->
	(!tree).(c) <- Exists (Array.make arraysize Not_Found)
    | Exists _ -> () (* same word added twice *)
    | Not_Exists tree' ->
	(!tree).(c) <- Exists tree'
  )

let () =
  (* Read in the words and put them in the tree. *)
  let chan = open_in wordsfile in
  let count = ref 0 in
  let rec loop () =
    let word = input_line chan in
    add_to_tree word;
    incr count;
    loop ()
  in
  (try loop () with End_of_file -> ());
  close_in chan;

  printf "Added %d words to the tree.\n" !count;

  printf "Sharing tree in data file ...\n%!";
  ignore (Ancient.share md 0 tree);

  (* Perform a full GC and compact, which is a good way to see
   * if we've trashed the OCaml heap in some way.
   *)
  Array.fill tree 0 arraysize Not_Found;
  printf "Garbage collecting ...\n%!";
  Gc.compact ();

  printf "Detaching file and finishing.\n%!";

  Ancient.detach md