src/grammar.ml

   1 type t
   2
   3 type node = [ `Grammar ] Node.t
   4 type symbol = [ `Terminal | `NonTerminal | `Parameter ] Node.t
   5
   6 type p_symbol = [ `Parameter ] Node.t
   7 type n_symbol = [ `NonTerminal ] Node.t
   8 type t_symbol = [ `Terminal ] Node.t
   9
  10 type partial = Node of n_symbol * partial array | Leaf of node
  11
  12
  13
  14
  15 external is_nil : t -> t_symbol -> bool = "caml_grammar_is_nil"
  16 external get_tag : t -> t_symbol -> string = "caml_grammar_get_tag"
  17
  18 external get_symbol_at : t -> symbol -> node -> symbol = "caml_grammar_get_symbol_at"
  19 external first_child : t -> symbol -> node -> node = "caml_grammar_first_child"
  20 external next_sibling : t -> symbol -> node -> node = "caml_grammar_next_sibling"
  21
  22
  23 let is_non_terminal (n : symbol) =
  24   let n = Node.to_int n in
  25   n land 3 == 0
  26
  27 let is_terminal (n : symbol) =
  28   let n = Node.to_int n in
  29   n land 3 == 1
  30
  31 let is_parameter (n : symbol) =
  32   let n = Node.to_int n in
  33   n land 3 == 2
  34
  35
  36 external parameter : symbol -> p_symbol = "%identity"
  37 external terminal : symbol -> t_symbol = "%identity"
  38 external non_terminal : symbol -> n_symbol = "%identity"
  39
  40
  41 let num_params (n : n_symbol) =
  42   let n = Node.to_int n in
  43   (n lsr 2) land 0xf
  44
  45 external load : Unix.file_descr -> bool -> t = "caml_grammar_load"
  46
  47
  48
  49 let traversal g =
  50   let start_symbol = (Node.of_int 0) in
  51   let rec start_loop idx =
  52     if idx >= Node.null then begin
  53       let symbol = get_symbol_at g start_symbol idx in
  54       if is_terminal symbol then
  55         let ts = terminal symbol in
  56         if is_nil g ts then () else
  57           let str = get_tag g ts in
  58           Printf.printf "<%s>%!" str;
  59           start_loop (first_child g start_symbol idx);
  60           start_loop (next_sibling g start_symbol idx);
  61           Printf.printf "</%s>%!" str;
  62       else
  63         let tn = non_terminal symbol in
  64         let nparam = num_params tn in
  65         let child = ref (first_child g start_symbol idx) in
  66         let a_param = Array.init nparam
  67           (fun _ -> let c = !child in
  68                     child := next_sibling g start_symbol c;
  69                     c)
  70         in
  71         rule_loop tn a_param
  72     end
  73   and rule_loop (nterm : [ `NonTerminal | `Terminal ] Node.t)  a_param =
  74     let
  75
  76   in
  77   start_loop (Node.of_int 0)
  78 ;;
  79
  80
  81
  82 let load filename bp =
  83   let fd = Unix.openfile filename [ Unix.O_RDONLY ] 0o600 in
  84   let g =
  85     try load fd bp with
  86     | e -> (Unix.close fd; raise e)
  87   in
  88   Unix.close fd;
  89   g
  90
  91