grew_node.ml 3.04 KB
Newer Older
1 2
open Printf

bguillaum's avatar
bguillaum committed
3 4
open Grew_utils
open Grew_ast
pj2m's avatar
pj2m committed
5 6 7
open Grew_edge
open Grew_fs

8 9
(* ================================================================================ *)
module G_node = struct
pj2m's avatar
pj2m committed
10
  type t = {
11
      fs: G_fs.t;
12
      pos: int option;
13
      next: G_edge.t Massoc_gid.t;
pj2m's avatar
pj2m committed
14 15
    }

16 17 18 19 20
  let get_fs t = t.fs
  let get_next t = t.next

  let set_fs t fs = {t with fs = fs}

21
  let empty = { fs = G_fs.empty; pos = None; next = Massoc_gid.empty }
22

bguillaum's avatar
bguillaum committed
23 24
  let to_string t =
    Printf.sprintf "  fs=[%s]\n  next=%s\n"
25
      (G_fs.to_string t.fs)
26
      (Massoc_gid.to_string G_edge.to_string t.next)
27

bguillaum's avatar
bguillaum committed
28 29
  let to_gr t =
    sprintf "%s [%s] "
30
      (match t.pos with Some i -> sprintf "(%d)" i | None -> "")
31
      (G_fs.to_gr t.fs)
32 33

  let add_edge g_edge gid_tar t =
34
    match Massoc_gid.add gid_tar g_edge t.next with
35 36
    | Some l -> Some {t with next = l}
    | None -> None
pj2m's avatar
pj2m committed
37

38
  let build (ast_node, loc) =
bguillaum's avatar
bguillaum committed
39
    (ast_node.Ast.node_id,
40
     { fs = G_fs.build ast_node.Ast.fs;
pj2m's avatar
pj2m committed
41
       pos = ast_node.Ast.position;
42
       next = Massoc_gid.empty;
pj2m's avatar
pj2m committed
43
     } )
44

bguillaum's avatar
bguillaum committed
45
  let of_conll line = {
46
      fs = G_fs.of_conll line;
bguillaum's avatar
bguillaum committed
47
      pos = Some line.Conll.num;
48
      next = Massoc_gid.empty;
bguillaum's avatar
bguillaum committed
49
    }
bguillaum's avatar
bguillaum committed
50

51
  let remove (id_tar : Gid.t) label t = {t with next = Massoc_gid.remove id_tar label t.next}
bguillaum's avatar
bguillaum committed
52 53

  let remove_key node_id t =
54
    try {t with next = Massoc_gid.remove_key node_id t.next} with Not_found -> t
55

bguillaum's avatar
bguillaum committed
56
  let merge_key ?(strict=false) src_id tar_id t =
57 58
    try Some {t with next = Massoc_gid.merge_key src_id tar_id t.next}
    with Massoc_gid.Duplicate -> if strict then None else Some t
59

bguillaum's avatar
bguillaum committed
60
  let shift_out ?(strict=false) src_t tar_t =
61 62
    try Some {tar_t with next = Massoc_gid.disjoint_union src_t.next tar_t.next}
    with Massoc_gid.Not_disjoint -> if strict then None else Some tar_t
63

64
  let rm_out_edges t = {t with next = Massoc_gid.empty}
65 66 67 68 69 70 71 72 73 74 75


  let build_neighbour t = {empty with pos = match t.pos with Some x -> Some (x+1) | None -> None}

  let pos_comp n1 n2 = Pervasives.compare n1.pos n2.pos
end
(* ================================================================================ *)

(* ================================================================================ *)
module P_node = struct
  type t = {
bguillaum's avatar
bguillaum committed
76
      name: Id.name;
77
      fs: P_fs.t;
bguillaum's avatar
bguillaum committed
78
      next: P_edge.t Massoc_pid.t;
79
      loc: Loc.t option;
80 81
    }

bguillaum's avatar
bguillaum committed
82
  let get_name t = t.name
83 84 85
  let get_fs t = t.fs
  let get_next t = t.next

bguillaum's avatar
bguillaum committed
86 87
  let unif_fs fs t = { t with fs = P_fs.unif fs t.fs }

bguillaum's avatar
bguillaum committed
88
  let empty = { fs = P_fs.empty; next = Massoc_pid.empty; name = ""; loc=None   }
bguillaum's avatar
bguillaum committed
89

90
  let build ?pat_vars (ast_node, loc) =
bguillaum's avatar
bguillaum committed
91 92
    (ast_node.Ast.node_id,
     {
bguillaum's avatar
bguillaum committed
93 94
       name = ast_node.Ast.node_id;
       fs = P_fs.build ?pat_vars ast_node.Ast.fs;
bguillaum's avatar
bguillaum committed
95
       next = Massoc_pid.empty;
96
       loc = Some loc;
97 98 99
     } )

  let add_edge p_edge pid_tar t =
bguillaum's avatar
bguillaum committed
100
    match Massoc_pid.add pid_tar p_edge t.next with
101 102
    | Some l -> Some {t with next = l}
    | None -> None
pj2m's avatar
pj2m committed
103

104
  let match_ ?param p_node g_node = P_fs.match_ ?param p_node.fs (G_node.get_fs g_node)
pj2m's avatar
pj2m committed
105

106
  let compare_pos t1 t2 = Pervasives.compare t1.loc t2.loc
pj2m's avatar
pj2m committed
107
end
108 109 110 111
(* ================================================================================ *)