(** Entry point file for elf_arrows *)

exception NotElf;;
exception NoDwarf;;
exception NoDwarfStatic;;

let (>>=) = Error.bind

let make_pp linksem_pp =
  (fun fmt arg ->
     linksem_pp arg
   |> Format.fprintf fmt "%s")

type elf_path = string
type elf_handle =
    ElfHandle of elf_path * Elf_file.elf_file * Dwarf.dwarf_static
                 * Asm_info.NoAnnot.asm_info_t

(** Open an ELF file and loads its dwarf_static infos. *)
let open_elf elf_path =

  (Byte_sequence.acquire elf_path >>= fun elf_bs -> (
      match Elf_file.read_elf64_file elf_bs with
      | Error.Success elf64 -> Error.Success (Elf_file.ELF_File_64 elf64)
      | Error.Fail _ -> (match Elf_file.read_elf32_file elf_bs with
        | Error.Success elf32 -> Error.Success (Elf_file.ELF_File_32 elf32)
        | Error.Fail _ -> raise NotElf)
    ))
  >>= fun elf_file -> (
    let asm_info = Asm_acquire.acquire_asm elf_path in
    let static_info = (match Dwarf.extract_dwarf_static elf_file with
        | Some static_info -> static_info
        | None -> raise NoDwarfStatic) in
    Error.Success (ElfHandle (elf_path, elf_file, static_info, asm_info)))


(** Add boxes according to DWARF info *)
let add_line_boxes render_data matcher_data dwarf_lines =
  (* List.fold_left with two elements in scope at once. *)
  let fold_ahead folder base lst =
    let rec do_fold accu = function
      | [] | _::[] -> accu
      | hd1::hd2::tl -> do_fold (folder accu hd1 hd2) (hd2::tl)
    in
    do_fold base lst
  in

  List.fold_left (fun (cur_render_data, cur_matcher_data)
                   (reg_header, reg_list) ->
      fold_ahead (fun (cur_render_data, cur_matcher_data) cur_reg reg_ahead ->
          let box_start = Z.to_int @@ cur_reg.Dwarf.lnr_address in
          let box_end = Z.to_int @@ reg_ahead.Dwarf.lnr_address in
          (match box_start = box_end with
           | true -> cur_render_data, cur_matcher_data
           | false ->
             Format.eprintf "Add box %x -- %x@." box_start box_end ;
             let n_matcher_data, block_class_id =
               Asm_matcher.add_block cur_matcher_data reg_header cur_reg in
             let file_name = (
               let file_id = cur_reg.lnr_file
                             |> Z.to_int in
               Asm_matcher.extract_file_name file_id reg_header.lnh_file_names
             ) in
             let n_render_data, _ = Renderer.add_box_excl
                 cur_render_data (box_start, box_end)
                 Renderer.(Some {
                     box_file = file_name ;
                     box_line = Z.to_int cur_reg.lnr_line;
                     box_col = Z.to_int cur_reg.lnr_column;
                     box_class_id = block_class_id;
                   })
             in
             (n_render_data, n_matcher_data))
        )
        (cur_render_data, cur_matcher_data) reg_list)
    (render_data, matcher_data)
    dwarf_lines

let elf_files = ref []
let speclist = []
let parse_anon_arg arg =
  elf_files := arg :: (!elf_files)

let _ =
  Arg.parse speclist parse_anon_arg "./test ELF_FILE" ;
  let elf_handles = List.rev @@
    List.map (fun path -> match open_elf path with
        | Error.Success handle -> handle
        | Error.Fail msg ->
          raise (Failure ("Could not open " ^ path ^ ": " ^ msg)))
      !elf_files
  in

  List.iter (fun (ElfHandle(path, _, static_info, _)) ->
      let line_info = static_info.ds_evaluated_line_info in
      Format.eprintf "Line infos <%s>:@. %a@."
        path
        (make_pp Dwarf.pp_evaluated_line_info)
        line_info ;
    ) elf_handles ;

  let map_with_state mapper initial_state lst =
    List.fold_right (fun elt (cur_state, accu) ->
        let n_state, mapped_elt = mapper cur_state elt in
        n_state, mapped_elt::accu)
      lst
      (initial_state, [])
  in

  let _, multi_render_data = map_with_state
      (fun matcher_state (ElfHandle(path, _, static_info, asm)) ->
         let render_data = Renderer.init_render_data asm path in
         let line_info = static_info.ds_evaluated_line_info in
         let boxed_render_data, n_matcher_state =
           add_line_boxes render_data matcher_state line_info in
         n_matcher_state, boxed_render_data
      ) Asm_matcher.empty_state elf_handles in

  Format.printf "%s@."
    (Renderer.to_string Html_renderer.render multi_render_data)