test_ancient_dict_write.ml

   1 (* Create shared dictionary. *)
   2
   3 open Printf
   4 open Unix
   5
   6 let argv = Array.to_list Sys.argv
   7
   8 let wordsfile, datafile, baseaddr =
   9   match argv with
  10   | [_; wordsfile; datafile; baseaddr] ->
  11       let baseaddr = Nativeint.of_string baseaddr in
  12       wordsfile, datafile, baseaddr
  13   | _ ->
  14       failwith (sprintf "usage: %s wordsfile datafile baseaddr"
  15                   Sys.executable_name)
  16
  17 let md =
  18   let fd = openfile datafile [O_RDWR; O_TRUNC; O_CREAT] 0o644 in
  19   Ancient.attach fd baseaddr
  20
  21 (* Tree used to store the words.  This is stupid and inefficient
  22  * but it is here to demonstrate the 'Ancient' module, not good use
  23  * of trees.
  24  *)
  25
  26 let arraysize = 256 (* one element for each character *)
  27
  28 type t = Not_Found | Exists of t array | Not_Exists of t array;;
  29 let tree : t array = Array.make arraysize Not_Found
  30
  31 let add_to_tree word =
  32   let len = String.length word in
  33   if len > 0 then (
  34     let tree = ref tree in
  35     for i = 0 to len-2; do
  36       let c = word.[i] in
  37       let c = Char.code c in
  38       match (!tree).(c) with
  39       | Not_Found ->
  40           (* Allocate more tree. *)
  41           let tree' = Array.make arraysize Not_Found in
  42           (!tree).(c) <- Not_Exists tree';
  43           tree := tree'
  44       | Exists tree'
  45       | Not_Exists tree' ->
  46           tree := tree'
  47     done;
  48
  49     (* Final character. *)
  50     let c = word.[len-1] in
  51     let c = Char.code c in
  52     match (!tree).(c) with
  53     | Not_Found ->
  54         (!tree).(c) <- Exists (Array.make arraysize Not_Found)
  55     | Exists _ -> () (* same word added twice *)
  56     | Not_Exists tree' ->
  57         (!tree).(c) <- Exists tree'
  58   )
  59
  60 let () =
  61   (* Read in the words and put them in the tree. *)
  62   let chan = open_in wordsfile in
  63   let count = ref 0 in
  64   let rec loop () =
  65     let word = input_line chan in
  66     add_to_tree word;
  67     incr count;
  68     loop ()
  69   in
  70   (try loop () with End_of_file -> ());
  71   close_in chan;
  72
  73   printf "Added %d words to the tree.\n" !count;
  74
  75   printf "Sharing tree in data file ...\n%!";
  76   ignore (Ancient.share md 0 tree);
  77
  78   (* Perform a full GC and compact, which is a good way to see
  79    * if we've trashed the OCaml heap in some way.
  80    *)
  81   Array.fill tree 0 arraysize Not_Found;
  82   printf "Garbage collecting ...\n%!";
  83   Gc.compact ();
  84
  85   printf "Detaching file and finishing.\n%!";
  86
  87   Ancient.detach md