(*********************************************************************************)

(*                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