spacepaste

Paste details

reply | raw

  1.  
  2. %token CR EOF COLON SEMICOLON COMMA OPENP CLOSEP
  3. %token <int> EDGE_LABEL
  4. %token <float> REAL
  5. %token <string> LABEL
  7. %start tree
  8. %type<Newick_bark.newick_bark Gtree.gtree> tree
  9. %%
  11. %{
  12. open Ppatteries
  14. (* parse state *)
  15. type 'a ps = {
  16. stree: Stree.stree;
  17. bark: 'a IntMap.t;
  18. }
  19. (* list parse state *)
  20. type 'a lps = {
  21. stree_l: Stree.stree list;
  22. bark_l: 'a IntMap.t;
  23. }
  25. let combine = IntMap.fold IntMap.add
  26. let empty_lps = {stree_l = []; bark_l = IntMap.empty}
  27. let lps_append lp lps =
  28. {stree_l = lp.stree :: lps.stree_l; bark_l = combine lp.bark lps.bark_l}
  30. let node_num = ref (-1)
  31. let add_bark add_fun ?label x s =
  32. let label =
  33. match label with
  34. | None -> Stree.top_id s.stree
  35. | Some x -> x
  36. in {
  37. stree = s.stree;
  38. bark = add_fun label x s.bark;
  39. }
  40. let add_bl = add_bark Newick_bark.map_set_bl
  41. let add_name = add_bark Newick_bark.map_set_name
  42. let add_boot = add_bark Newick_bark.map_set_boot
  43. let add_id id lp = {
  44. stree = Stree.of_id id lp.stree;
  45. bark =
  46. try
  47. let value, bark' = Stree.top_id lp.stree
  48. |> flip IntMap.extract lp.bark
  49. in
  50. IntMap.add id value bark'
  51. with Not_found -> lp.bark
  52. }
  54. let add_leaf () =
  55. incr node_num;
  56. {
  57. stree = Stree.leaf !node_num;
  58. bark = IntMap.empty;
  59. }
  60. let add_internal ls =
  61. incr node_num;
  62. {
  63. stree = Stree.node !node_num ls.stree_l;
  64. bark = ls.bark_l;
  65. }
  67. %}
  69. named_leaf:
  70. | LABEL
  71. { add_leaf () |> add_name $1 }
  72. | REAL
  73. { add_leaf () |> add_name (string_of_float $1) }
  75. subtree_list:
  76. | subtree COMMA subtree_list
  77. { lps_append $1 $3 }
  78. | subtree
  79. { lps_append $1 empty_lps }
  81. subtree:
  82. | OPENP subtree_list CLOSEP
  83. { add_internal $2 }
  84. | named_leaf { $1 }
  86. tree:
  87. | subtree EOF
  88. { Gtree.gtree $1.stree $1.bark }
  89.  
Powered by spacepaste. Paste removal.