src/grammar.ml

   1 INCLUDE "utils.ml"
   2 INCLUDE "debug.ml"
   3 INCLUDE "trace.ml"
   4
   5
   6 type t
   7
   8 type node = [ `Grammar ] Node.t
   9
  10 type p_type  = [ `Parameter ]
  11 type n_type = [ `NonTerminal ]
  12 type t_type = [ `Terminal ]
  13 type any_type = [ p_type | n_type | t_type ]
  14 type symbol = [ any_type ] Node.t
  15
  16 type p_symbol = p_type Node.t
  17 type n_symbol = n_type Node.t
  18 type t_symbol = t_type Node.t
  19 type tn_symbol = [ n_type | t_type ] Node.t
  20
  21 type partial =
  22     Leaf of node
  23   | Node of tn_symbol * partial array
  24
  25
  26 external is_nil : t -> t_symbol -> bool = "caml_grammar_is_nil"
  27 external nil_symbol : t -> t_symbol = "caml_grammar_nil_id"
  28 external translate_tag : t -> Tag.t -> Tag.t = "caml_grammar_translate_tag"
  29 external to_string : t -> Tag.t -> string = "caml_grammar_get_tag"
  30 external register_tag : t -> string -> Tag.t = "caml_grammar_register_tag"
  31
  32
  33
  34 let tag_operations t = {
  35   Tag.tag = (fun s -> register_tag t s);
  36   Tag.to_string = (fun s -> to_string t s);
  37   Tag.translate = (fun s -> translate_tag t s);
  38 }
  39
  40 external get_symbol_at : t -> symbol -> node -> symbol = "caml_grammar_get_symbol_at"
  41 external first_child : t -> symbol -> node -> node = "caml_grammar_first_child"
  42 external next_sibling : t -> symbol -> node -> node = "caml_grammar_next_sibling"
  43
  44 external start_first_child : t -> node -> node = "caml_grammar_start_first_child"
  45 external start_next_sibling : t -> node -> node = "caml_grammar_start_next_sibling"
  46
  47
  48 let is_non_terminal (n : [< any_type ] Node.t) =
  49   let n = Node.to_int n in
  50   n land 3 == 0
  51
  52 let is_terminal (n : [< any_type ] Node.t) =
  53   let n = Node.to_int n in
  54   n land 3 == 1
  55
  56 let is_parameter (n : [< any_type ] Node.t) =
  57   let n = Node.to_int n in
  58   n land 3 == 2
  59
  60
  61 let symbol_tag (n : t_symbol) = (Node.to_int n) lsr 2
  62 ;;
  63 let tag = symbol_tag
  64 let get_tag g (n : t_symbol) = to_string g (symbol_tag n)
  65 let symbol (n : n_symbol) = ((Node.to_int n) lsr 10) land 0x7ffffff
  66 ;;
  67
  68
  69 external parameter : [< any_type ] Node.t -> p_symbol = "%identity"
  70 external terminal : [< any_type ] Node.t -> t_symbol = "%identity"
  71 external non_terminal : [< any_type ] Node.t -> n_symbol = "%identity"
  72
  73 external get_id1 : t -> n_symbol -> tn_symbol = "caml_grammar_get_id1"
  74 external get_id2 : t -> n_symbol -> tn_symbol = "caml_grammar_get_id2"
  75 (*external get_param_pos : t -> n_symbol -> int = "caml_grammar_get_param_pos" *)
  76 let get_param_pos (n : n_symbol) =
  77   let n = Node.to_int n in
  78   (n lsr 6) land 0xf
  79
  80 let num_params (n : n_symbol) =
  81   let n = Node.to_int n in
  82   (n lsr 2) land 0xf
  83
  84 let num_children (n : [< t_type | n_type ] Node.t ) =
  85   if is_non_terminal n then
  86     num_params (non_terminal n)
  87   else
  88     2
  89
  90
  91 external load : Unix.file_descr -> bool -> t = "caml_grammar_load"
  92
  93
  94 let load filename bp =
  95   let fd = Unix.openfile filename [ Unix.O_RDONLY ] 0o600 in
  96   let g =
  97     try load fd bp with
  98     | e -> (Unix.close fd; raise e)
  99   in
 100   Unix.close fd;
 101   Tag.init (tag_operations g);
 102   g
 103
 104