|
Packit |
1f8b6b |
(****************************************************************************)
|
|
Packit |
1f8b6b |
(* *)
|
|
Packit |
1f8b6b |
(* OCaml *)
|
|
Packit |
1f8b6b |
(* *)
|
|
Packit |
1f8b6b |
(* INRIA Rocquencourt *)
|
|
Packit |
1f8b6b |
(* *)
|
|
Packit |
1f8b6b |
(* Copyright 2006 Institut National de Recherche en Informatique et *)
|
|
Packit |
1f8b6b |
(* en Automatique. All rights reserved. This file is distributed under *)
|
|
Packit |
1f8b6b |
(* the terms of the GNU Library General Public License, with the special *)
|
|
Packit |
1f8b6b |
(* exception on linking described in LICENSE at the top of the Camlp4 *)
|
|
Packit |
1f8b6b |
(* source tree. *)
|
|
Packit |
1f8b6b |
(* *)
|
|
Packit |
1f8b6b |
(****************************************************************************)
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
(* Authors:
|
|
Packit |
1f8b6b |
* - Daniel de Rauglaudre: initial version
|
|
Packit |
1f8b6b |
* - Nicolas Pouillard: refactoring
|
|
Packit |
1f8b6b |
*)
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
(* PR#5090: don't do lookahead on get_prev_loc. *)
|
|
Packit |
1f8b6b |
value get_prev_loc_only = ref False;
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
module Make (Structure : Structure.S) = struct
|
|
Packit |
1f8b6b |
open Structure;
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
value empty_entry ename _ =
|
|
Packit |
1f8b6b |
raise (Stream.Error ("entry [" ^ ename ^ "] is empty"));
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
value rec stream_map f = parser
|
|
Packit |
1f8b6b |
[ [: ` x; strm :] -> [: ` (f x); stream_map f strm :]
|
|
Packit |
1f8b6b |
| [: :] -> [: :] ];
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
value keep_prev_loc strm =
|
|
Packit |
1f8b6b |
match Stream.peek strm with
|
|
Packit |
1f8b6b |
[ None -> [: :]
|
|
Packit |
1f8b6b |
| Some (tok0,init_loc) ->
|
|
Packit |
1f8b6b |
let rec go prev_loc strm1 =
|
|
Packit |
1f8b6b |
if get_prev_loc_only.val then
|
|
Packit |
1f8b6b |
[: `(tok0, {prev_loc; cur_loc = prev_loc; prev_loc_only = True});
|
|
Packit |
1f8b6b |
go prev_loc strm1 :]
|
|
Packit |
1f8b6b |
else
|
|
Packit |
1f8b6b |
match strm1 with parser
|
|
Packit |
1f8b6b |
[ [: `(tok,cur_loc); strm :] ->
|
|
Packit |
1f8b6b |
[: `(tok, {prev_loc; cur_loc; prev_loc_only = False});
|
|
Packit |
1f8b6b |
go cur_loc strm :]
|
|
Packit |
1f8b6b |
| [: :] -> [: :] ]
|
|
Packit |
1f8b6b |
in go init_loc strm ];
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
value drop_prev_loc strm = stream_map (fun (tok,r) -> (tok,r.cur_loc)) strm;
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
value get_cur_loc strm =
|
|
Packit |
1f8b6b |
match Stream.peek strm with
|
|
Packit |
1f8b6b |
[ Some (_,r) -> r.cur_loc
|
|
Packit |
1f8b6b |
| None -> Loc.ghost ];
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
value get_prev_loc strm =
|
|
Packit |
1f8b6b |
begin
|
|
Packit |
1f8b6b |
get_prev_loc_only.val := True;
|
|
Packit |
1f8b6b |
let result = match Stream.peek strm with
|
|
Packit |
1f8b6b |
[ Some (_, {prev_loc; prev_loc_only = True}) ->
|
|
Packit |
1f8b6b |
begin Stream.junk strm; prev_loc end
|
|
Packit |
1f8b6b |
| Some (_, {prev_loc; prev_loc_only = False}) -> prev_loc
|
|
Packit |
1f8b6b |
| None -> Loc.ghost ];
|
|
Packit |
1f8b6b |
get_prev_loc_only.val := False;
|
|
Packit |
1f8b6b |
result
|
|
Packit |
1f8b6b |
end;
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
value is_level_labelled n lev =
|
|
Packit |
1f8b6b |
match lev.lname with
|
|
Packit |
1f8b6b |
[ Some n1 -> n = n1
|
|
Packit |
1f8b6b |
| None -> False ];
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
value warning_verbose = ref True;
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
value rec get_token_list entry tokl last_tok tree =
|
|
Packit |
1f8b6b |
match tree with
|
|
Packit |
1f8b6b |
[ Node {node = (Stoken _ | Skeyword _ as tok); son = son; brother = DeadEnd} ->
|
|
Packit |
1f8b6b |
get_token_list entry [last_tok :: tokl] tok son
|
|
Packit |
1f8b6b |
| _ ->
|
|
Packit |
1f8b6b |
if tokl = [] then None
|
|
Packit |
1f8b6b |
else Some (List.rev [last_tok :: tokl], last_tok, tree) ];
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
value is_antiquot s =
|
|
Packit |
1f8b6b |
let len = String.length s in
|
|
Packit |
1f8b6b |
len > 1 && s.[0] = '$';
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
value eq_Stoken_ids s1 s2 =
|
|
Packit |
1f8b6b |
not (is_antiquot s1) && not (is_antiquot s2) && s1 = s2;
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
value logically_eq_symbols entry =
|
|
Packit |
1f8b6b |
let rec eq_symbols s1 s2 =
|
|
Packit |
1f8b6b |
match (s1, s2) with
|
|
Packit |
1f8b6b |
[ (Snterm e1, Snterm e2) -> e1.ename = e2.ename
|
|
Packit |
1f8b6b |
| (Snterm e1, Sself) -> e1.ename = entry.ename
|
|
Packit |
1f8b6b |
| (Sself, Snterm e2) -> entry.ename = e2.ename
|
|
Packit |
1f8b6b |
| (Snterml e1 l1, Snterml e2 l2) -> e1.ename = e2.ename && l1 = l2
|
|
Packit |
1f8b6b |
| (Slist0 s1, Slist0 s2) |
|
|
Packit |
1f8b6b |
(Slist1 s1, Slist1 s2) |
|
|
Packit |
1f8b6b |
(Sopt s1, Sopt s2) |
|
|
Packit |
1f8b6b |
(Stry s1, Stry s2) -> eq_symbols s1 s2
|
|
Packit |
1f8b6b |
| (Slist0sep s1 sep1, Slist0sep s2 sep2) |
|
|
Packit |
1f8b6b |
(Slist1sep s1 sep1, Slist1sep s2 sep2) ->
|
|
Packit |
1f8b6b |
eq_symbols s1 s2 && eq_symbols sep1 sep2
|
|
Packit |
1f8b6b |
| (Stree t1, Stree t2) -> eq_trees t1 t2
|
|
Packit |
1f8b6b |
| (Stoken (_, s1), Stoken (_, s2)) -> eq_Stoken_ids s1 s2
|
|
Packit |
1f8b6b |
| _ -> s1 = s2 ]
|
|
Packit |
1f8b6b |
and eq_trees t1 t2 =
|
|
Packit |
1f8b6b |
match (t1, t2) with
|
|
Packit |
1f8b6b |
[ (Node n1, Node n2) ->
|
|
Packit |
1f8b6b |
eq_symbols n1.node n2.node && eq_trees n1.son n2.son &&
|
|
Packit |
1f8b6b |
eq_trees n1.brother n2.brother
|
|
Packit |
1f8b6b |
| (LocAct _ _ | DeadEnd, LocAct _ _ | DeadEnd) -> True
|
|
Packit |
1f8b6b |
| _ -> False ]
|
|
Packit |
1f8b6b |
in
|
|
Packit |
1f8b6b |
eq_symbols;
|
|
Packit |
1f8b6b |
|
|
Packit |
1f8b6b |
value rec eq_symbol s1 s2 =
|
|
Packit |
1f8b6b |
match (s1, s2) with
|
|
Packit |
1f8b6b |
[ (Snterm e1, Snterm e2) -> e1 == e2
|
|
Packit |
1f8b6b |
| (Snterml e1 l1, Snterml e2 l2) -> e1 == e2 && l1 = l2
|
|
Packit |
1f8b6b |
| (Slist0 s1, Slist0 s2) |
|
|
Packit |
1f8b6b |
(Slist1 s1, Slist1 s2) |
|
|
Packit |
1f8b6b |
(Sopt s1, Sopt s2) |
|
|
Packit |
1f8b6b |
(Stry s1, Stry s2) -> eq_symbol s1 s2
|
|
Packit |
1f8b6b |
| (Slist0sep s1 sep1, Slist0sep s2 sep2) |
|
|
Packit |
1f8b6b |
(Slist1sep s1 sep1, Slist1sep s2 sep2) ->
|
|
Packit |
1f8b6b |
eq_symbol s1 s2 && eq_symbol sep1 sep2
|
|
Packit |
1f8b6b |
| (Stree _, Stree _) -> False
|
|
Packit |
1f8b6b |
| (Stoken (_, s1), Stoken (_, s2)) -> eq_Stoken_ids s1 s2
|
|
Packit |
1f8b6b |
| _ -> s1 = s2 ]
|
|
Packit |
1f8b6b |
;
|
|
Packit |
1f8b6b |
end;
|