test_ancient_dict_read.ml

   1 (* Read shared dictionary.
   2  * $Id: test_ancient_dict_read.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 datafile =
  11   match argv with
  12   | [_; datafile] ->
  13       datafile
  14   | _ ->
  15       failwith (sprintf "usage: %s datafile"
  16                   Sys.executable_name)
  17
  18 let md =
  19   let fd = openfile datafile [O_RDWR] 0o644 in
  20   Ancient.attach fd 0n
  21
  22 let arraysize = 256 (* one element for each character *)
  23
  24 type t = Not_Found | Exists of t array | Not_Exists of t array;;
  25 let tree : t array Ancient.ancient = Ancient.get md 0
  26 let tree = Ancient.follow tree
  27
  28 let word_exists word =
  29   try
  30     let tree = ref tree in
  31     let len = String.length word in
  32     for i = 0 to len-2; do
  33       let c = word.[i] in
  34       let c = Char.code c in
  35       match (!tree).(c) with
  36       | Not_Found -> raise Not_found
  37       | Exists tree'
  38       | Not_Exists tree' -> tree := tree'
  39     done;
  40
  41     (* Final character. *)
  42     let c = word.[len-1] in
  43     let c = Char.code c in
  44     match (!tree).(c) with
  45     | Not_Found
  46     | Not_Exists _ -> false
  47     | Exists _ -> true
  48   with
  49     Not_found -> false
  50
  51 let () =
  52   let rec loop () =
  53     printf "Enter a word to check (q = quit program): ";
  54     let word = read_line () in
  55     if word <> "q" then (
  56       printf "'%s' exists? %B\n%!" word (word_exists word);
  57       loop ()
  58     )
  59   in
  60   loop ();
  61
  62   Ancient.detach md;
  63
  64   (* Garbage collect - good way to check we haven't broken anything. *)
  65   Gc.compact ();
  66
  67   printf "Program finished.\n"