test_ancient_dict_write.ml

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