(*********************************************************************************) |
(* Cameleon *)
(* *)
(* Copyright (C) 2005,2006 Institut National de Recherche en Informatique *)
(* et en Automatique. All rights reserved. *)
(* *)
(* This program is free software; you can redistribute it and/or modify *)
(* it under the terms of the GNU Library General Public License as *)
(* published by the Free Software Foundation; either version 2 of the *)
(* License, or any later version. *)
(* *)
(* This program is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
(* GNU Library General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Library General Public *)
(* License along with this program; if not, write to the Free Software *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *)
(* 02111-1307 USA *)
(* *)
(* Contact: Maxence.Guesdon@inria.fr *)
(* *)
(*********************************************************************************) |
(** Getting information in ocaml-generated .annot files. *) |
let filename_re = "\"\\(\\([^\\\"]\\|\\\\.\\)*\\)\""
let number_re = "\\([0-9]*\\)"
let position_re = Printf.sprintf "%s %s %s %s"
filename_re number_re number_re number_re
let s_location_re = Printf.sprintf "%s %s" position_re position_re
let location_re = Str.regexp s_location_re
let type_annot_re = Str.regexp "^type(\n\\( \\([^\n)]\\|.)\\|\n[^)]\\)*\\)\n)"
type type_info = (int * int)
(** absolute position of start and end of type annotation in the .annot file *) |
type tree = {
t_pos_left : int ;
t_pos_right : int ;
t_type_info : type_info option ;
t_children : tree list;
}
let add_node acc ~left ~right ~start ~stop =
match acc with
[] ->
let t =
{ t_pos_left = left;
t_pos_right = right;
t_type_info = Some (start, stop) ;
t_children = [] ;
}
in
[ t ]
| l ->
let rec find_children acc = function
[] -> (List.rev acc, [])
| h :: q ->
if h.t_pos_right < left then
(* no more children *)
(List.rev acc, h ::q)
else
find_children (h::acc) q
in
let (children, others) = find_children [] l in
let t =
{ t_pos_left = left ;
t_pos_right = right ;
t_type_info = Some (start, stop) ;
t_children = children ;
}
in
t :: others
let build_tree annot_string =
let rec iter acc pos =
match
try Some (Str.search_forward location_re annot_string pos)
with Not_found -> None
with
None -> List.rev acc
| Some _ ->
let left = int_of_string (Str.matched_group 5 annot_string) in
let right = int_of_string (Str.matched_group 10 annot_string) in
let newp = Str.match_end () in
match
try Some (Str.search_forward type_annot_re annot_string newp)
with Not_found -> None
with
None -> List.rev acc
| Some _ ->
let start = Str.group_beginning 1 in
let stop = Str.group_end 1 in
let newp = Str.match_end () in
let new_acc = add_node acc ~left ~right ~start ~stop in
iter new_acc newp
in
(** the list of trees is supposed to be sorted, left-most first, and inner first because the list of annotation in order that way in the .annot file *) |
match iter [] 0 with
[t] -> Some t
| [] -> None
| l ->
let t = {
t_pos_left = (List.hd l).t_pos_left ;
t_pos_right = (List.hd (List.rev l)).t_pos_right ;
t_type_info = None ;
t_children = l;
}
in
Some t
let search_in_tree =
let pred pos t =
t.t_pos_left <= pos && pos <= t.t_pos_right
in
let get_t pos l =
try Some (List.find (pred pos) l)
with Not_found -> None
in
let rec iter fallback pos tree =
if pred pos tree then
let fb =
match tree.t_type_info with
None -> fallback
| Some (start,stop) ->
Some (tree.t_pos_left, tree.t_pos_right, start, stop)
in
match get_t pos tree.t_children with
None -> fb
| Some t -> iter fb pos t
else
fallback
in
iter None