90 lines
3.6 KiB
OCaml
90 lines
3.6 KiB
OCaml
(****************************************************************************)
|
|
(* *)
|
|
(* Objective Caml *)
|
|
(* *)
|
|
(* INRIA Rocquencourt *)
|
|
(* *)
|
|
(* Copyright 2006 Institut National de Recherche en Informatique et *)
|
|
(* en Automatique. All rights reserved. This file is distributed under *)
|
|
(* the terms of the GNU Library General Public License, with the special *)
|
|
(* exception on linking described in LICENSE at the top of the Objective *)
|
|
(* Caml source tree. *)
|
|
(* *)
|
|
(****************************************************************************)
|
|
|
|
(* Authors:
|
|
* - Daniel de Rauglaudre: initial version
|
|
* - Nicolas Pouillard: refactoring
|
|
*)
|
|
module Make (Structure : Structure.S) = struct
|
|
open Structure;
|
|
|
|
value empty_entry ename _ _ _ =
|
|
raise (Stream.Error ("entry [" ^ ename ^ "] is empty"));
|
|
|
|
value is_level_labelled n lev =
|
|
match lev.lname with
|
|
[ Some n1 -> n = n1
|
|
| None -> False ];
|
|
|
|
value warning_verbose = ref True;
|
|
|
|
value rec get_token_list entry tokl last_tok tree =
|
|
match tree with
|
|
[ Node {node = (Stoken _ | Skeyword _ as tok); son = son; brother = DeadEnd} ->
|
|
get_token_list entry [last_tok :: tokl] tok son
|
|
| _ ->
|
|
if tokl = [] then None
|
|
else Some (List.rev [last_tok :: tokl], last_tok, tree) ];
|
|
|
|
value is_antiquot s =
|
|
let len = String.length s in
|
|
len > 1 && s.[0] = '$';
|
|
|
|
value eq_Stoken_ids s1 s2 =
|
|
not (is_antiquot s1) && not (is_antiquot s2) && s1 = s2;
|
|
|
|
value logically_eq_symbols entry =
|
|
let rec eq_symbols s1 s2 =
|
|
match (s1, s2) with
|
|
[ (Snterm e1, Snterm e2) -> e1.ename = e2.ename
|
|
| (Snterm e1, Sself) -> e1.ename = entry.ename
|
|
| (Sself, Snterm e2) -> entry.ename = e2.ename
|
|
| (Snterml e1 l1, Snterml e2 l2) -> e1.ename = e2.ename && l1 = l2
|
|
| (Slist0 s1, Slist0 s2) -> eq_symbols s1 s2
|
|
| (Slist0sep s1 sep1, Slist0sep s2 sep2) ->
|
|
eq_symbols s1 s2 && eq_symbols sep1 sep2
|
|
| (Slist1 s1, Slist1 s2) -> eq_symbols s1 s2
|
|
| (Slist1sep s1 sep1, Slist1sep s2 sep2) ->
|
|
eq_symbols s1 s2 && eq_symbols sep1 sep2
|
|
| (Sopt s1, Sopt s2) -> eq_symbols s1 s2
|
|
| (Stree t1, Stree t2) -> eq_trees t1 t2
|
|
| (Stoken (_, s1), Stoken (_, s2)) -> eq_Stoken_ids s1 s2
|
|
| _ -> s1 = s2 ]
|
|
and eq_trees t1 t2 =
|
|
match (t1, t2) with
|
|
[ (Node n1, Node n2) ->
|
|
eq_symbols n1.node n2.node && eq_trees n1.son n2.son &&
|
|
eq_trees n1.brother n2.brother
|
|
| (LocAct _ _ | DeadEnd, LocAct _ _ | DeadEnd) -> True
|
|
| _ -> False ]
|
|
in
|
|
eq_symbols;
|
|
|
|
value rec eq_symbol s1 s2 =
|
|
match (s1, s2) with
|
|
[ (Snterm e1, Snterm e2) -> e1 == e2
|
|
| (Snterml e1 l1, Snterml e2 l2) -> e1 == e2 && l1 = l2
|
|
| (Slist0 s1, Slist0 s2) -> eq_symbol s1 s2
|
|
| (Slist0sep s1 sep1, Slist0sep s2 sep2) ->
|
|
eq_symbol s1 s2 && eq_symbol sep1 sep2
|
|
| (Slist1 s1, Slist1 s2) -> eq_symbol s1 s2
|
|
| (Slist1sep s1 sep1, Slist1sep s2 sep2) ->
|
|
eq_symbol s1 s2 && eq_symbol sep1 sep2
|
|
| (Sopt s1, Sopt s2) -> eq_symbol s1 s2
|
|
| (Stree _, Stree _) -> False
|
|
| (Stoken (_, s1), Stoken (_, s2)) -> eq_Stoken_ids s1 s2
|
|
| _ -> s1 = s2 ]
|
|
;
|
|
end;
|