spacepaste

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