<commit_before>(* Js_of_ocaml compiler
 * http://www.ocsigen.org/js_of_ocaml/
 * Copyright (C) 2010 <NAME>
 * Laboratoire PPS - CNRS Université Paris Diderot
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, with linking exception;
 * either version 2.1 of the License, or (at your option) 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 Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser 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.
*)

open Code
open Instr

let debug_parser = Option.Debug.find "parser"

type code = string

(* Copied from ocaml/typing/ident.ml *)
module Ident = struct
  type t = { stamp: int; name: string; mutable flags: int }
  type 'a tbl =
    | Empty
    | Node of 'a tbl * 'a data * 'a tbl * int
  and 'a data =
    { ident: t;
      data: 'a;
      previous: 'a data option }

  let rec table_contents_rec sz t rem =
    match t with
      Empty ->
      rem
    | Node (l, v, r, _) ->
      table_contents_rec sz l
        ((sz - v.data, v.ident.name) :: table_contents_rec sz r rem)

  let table_contents sz t =
    List.sort (fun (i, _) (j, _) -> compare i j)
      (table_contents_rec sz t [])
end
(* Copied from ocaml/utils/tbl.ml *)
module Tbl = struct
  type ('a, 'b) t =
    | Empty
    | Node of ('a, 'b) t * 'a * 'b * ('a, 'b) t * int

  let rec iter f = function
      Empty -> ()
    | Node(l, v, d, r, _) ->
      iter f l; f v d; iter f r

  let rec find compare x = function
      Empty ->
      raise Not_found
    | Node(l, v, d, r, _) ->
      let c = compare x v in
      if c = 0 then d
      else find compare x (if c < 0 then l else r)

  let rec fold f m accu =
    match m with
    | Empty -> accu
    | Node(l, v, d, r, _) ->
      fold f r (f v d (fold f l accu))
end

type 'a numtable =
  { num_cnt: int;
    num_tbl: ('a, int) Tbl.t }

(* Read and manipulate debug section *)
module Debug : sig
  type compilation_env =
    { ce_stack: int Ident.tbl; (* Positions of variables in the stack *)
      ce_heap: int Ident.tbl;  (* Structure of the heap-allocated env *)
      ce_rec: int Ident.tbl }  (* Functions bound by the same let rec *)

  type pos =
    { pos_fname: string;
      pos_lnum: int;
      pos_bol: int;
      pos_cnum: int }

  type loc_info =
    { li_start: pos;
      li_end: pos;
      li_ghost: unit }

  type debug_event =
    { mutable ev_pos: int;                (* Position in bytecode *)
      ev_module: string;                  (* Name of defining module *)
      ev_loc: loc_info;                   (* Location in source file *)
      ev_kind: debug_event_kind;          (* Before/after event *)
      ev_info: debug_event_info;          (* Extra information *)
      ev_typenv: unit;                    (* Typing environment *)
      ev_typsubst: unit;                  (* Substitution over types *)
      ev_compenv: compilation_env;        (* Compilation environment *)
      ev_stacksize: int;                  (* Size of stack frame *)
      ev_repr: unit }                     (* Position of the representative *)

  and debug_event_kind =
      Event_before
    | Event_after of unit
    | Event_pseudo

  and debug_event_info = unit
  (*   Event_function *)
  (* | Event_return of int *)
  (* | Event_other *)

  type data

  val propagate : Code.Var.t list -> Code.Var.t list -> unit
  val find : data -> Code.addr -> (int * string) list
  val find_loc : data -> ?after:bool -> int -> Parse_info.t option
  val mem : data -> Code.addr -> bool
  val read : in_channel -> data
  val no_data : unit -> data
  val fold : data -> (Code.addr -> debug_event -> 'a -> 'a) -> 'a -> 'a
end = struct

  type compilation_env =
    { ce_stack: int Ident.tbl; (* Positions of variables in the stack *)
      ce_heap: int Ident.tbl;  (* Structure of the heap-allocated env *)
      ce_rec: int Ident.tbl }  (* Functions bound by the same let rec *)

  type pos =
    { pos_fname: string;
      pos_lnum: int;
      pos_bol: int;
      pos_cnum: int }

  type loc_info =
    { li_start: pos;
      li_end: pos;
      li_ghost: unit }

  type debug_event =
    { mutable ev_pos: int;                (* Position in bytecode *)
      ev_module: string;                  (* Name of defining module *)
      ev_loc: loc_info;                   (* Location in source file *)
      ev_kind: debug_event_kind;          (* Before/after event *)
      ev_info: debug_event_info;          (* Extra information *)
      ev_typenv: unit;                    (* Typing environment *)
      ev_typsubst: unit;                  (* Substitution over types *)
      ev_compenv: compilation_env;        (* Compilation environment *)
      ev_stacksize: int;                  (* Size of stack frame *)
      ev_repr: unit }                     (* Position of the representative *)

  and debug_event_kind =
      Event_before
    | Event_after of unit
    | Event_pseudo

  and debug_event_info = unit
  (*   Event_function *)
  (* | Event_return of int *)
  (* | Event_other *)

  type data = (int, debug_event) Hashtbl.t

  let relocate_event orig ev = ev.ev_pos <- (orig + ev.ev_pos) / 4

  let no_data () = Hashtbl.create 17

  let read ic =
    let events_by_pc = Hashtbl.create 257 in
    let read_paths : unit -> string list =
      match Util.Version.v with
      | `V3 -> (fun () -> [])
      | `V4_02 -> (fun () -> (input_value ic : string list)) in
    let len = input_binary_int ic in
    for i = 0 to len - 1 do
      let orig = input_binary_int ic in
      let evl : debug_event list = input_value ic in
      ignore(read_paths ());
      List.iter
        (fun ev ->
           relocate_event orig ev; Hashtbl.add events_by_pc ev.ev_pos ev)
        evl
    done;
    events_by_pc

  let find events_by_pc pc =
    try
      let ev = Hashtbl.find events_by_pc pc in
      Ident.table_contents ev.ev_stacksize ev.ev_compenv.ce_stack
    with Not_found ->
      []

  let mem = Hashtbl.mem

  let find_loc events_by_pc ?(after = false) pc =
    try
      let (before, ev) =
        try false, Hashtbl.find events_by_pc pc with Not_found ->
        true,
        try Hashtbl.find events_by_pc (pc + 1) with Not_found ->
        try Hashtbl.find events_by_pc (pc + 2) with Not_found ->
        Hashtbl.find events_by_pc (pc + 3)
      in
      let loc = ev.ev_loc in
      let pos =
        if after then loc.li_end else
        if before then loc.li_start else
        match ev.ev_kind with Event_after _ -> loc.li_end | _ -> loc.li_start in
      Some {Parse_info.name = pos.pos_fname;
            line=pos.pos_lnum - 1;
            col=pos.pos_cnum - pos.pos_bol;<commit_msg>Compiler: workaround a bug in 4.02 while reading debug section<commit_after>(* Js_of_ocaml compiler
 * http://www.ocsigen.org/js_of_ocaml/
 * Copyright (C) 2010 <NAME>
 * Laboratoire PPS - CNRS Université Paris Diderot
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, with linking exception;
 * either version 2.1 of the License, or (at your option) 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 Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser 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.
*)

open Code
open Instr

let debug_parser = Option.Debug.find "parser"

type code = string

(* Copied from ocaml/typing/ident.ml *)
module Ident = struct
  type t = { stamp: int; name: string; mutable flags: int }
  type 'a tbl =
    | Empty
    | Node of 'a tbl * 'a data * 'a tbl * int
  and 'a data =
    { ident: t;
      data: 'a;
      previous: 'a data option }

  let rec table_contents_rec sz t rem =
    match t with
      Empty ->
      rem
    | Node (l, v, r, _) ->
      table_contents_rec sz l
        ((sz - v.data, v.ident.name) :: table_contents_rec sz r rem)

  let table_contents sz t =
    List.sort (fun (i, _) (j, _) -> compare i j)
      (table_contents_rec sz t [])
end
(* Copied from ocaml/utils/tbl.ml *)
module Tbl = struct
  type ('a, 'b) t =
    | Empty
    | Node of ('a, 'b) t * 'a * 'b * ('a, 'b) t * int

  let rec iter f = function
      Empty -> ()
    | Node(l, v, d, r, _) ->
      iter f l; f v d; iter f r

  let rec find compare x = function
      Empty ->
      raise Not_found
    | Node(l, v, d, r, _) ->
      let c = compare x v in
      if c = 0 then d
      else find compare x (if c < 0 then l else r)

  let rec fold f m accu =
    match m with
    | Empty -> accu
    | Node(l, v, d, r, _) ->
      fold f r (f v d (fold f l accu))
end

type 'a numtable =
  { num_cnt: int;
    num_tbl: ('a, int) Tbl.t }

(* Read and manipulate debug section *)
module Debug : sig
  type compilation_env =
    { ce_stack: int Ident.tbl; (* Positions of variables in the stack *)
      ce_heap: int Ident.tbl;  (* Structure of the heap-allocated env *)
      ce_rec: int Ident.tbl }  (* Functions bound by the same let rec *)

  type pos =
    { pos_fname: string;
      pos_lnum: int;
      pos_bol: int;
      pos_cnum: int }

  type loc_info =
    { li_start: pos;
      li_end: pos;
      li_ghost: unit }

  type debug_event =
    { mutable ev_pos: int;                (* Position in bytecode *)
      ev_module: string;                  (* Name of defining module *)
      ev_loc: loc_info;                   (* Location in source file *)
      ev_kind: debug_event_kind;          (* Before/after event *)
      ev_info: debug_event_info;          (* Extra information *)
      ev_typenv: unit;                    (* Typing environment *)
      ev_typsubst: unit;                  (* Substitution over types *)
      ev_compenv: compilation_env;        (* Compilation environment *)
      ev_stacksize: int;                  (* Size of stack frame *)
      ev_repr: unit }                     (* Position of the representative *)

  and debug_event_kind =
      Event_before
    | Event_after of unit
    | Event_pseudo

  and debug_event_info = unit
  (*   Event_function *)
  (* | Event_return of int *)
  (* | Event_other *)

  type data

  val propagate : Code.Var.t list -> Code.Var.t list -> unit
  val find : data -> Code.addr -> (int * string) list
  val find_loc : data -> ?after:bool -> int -> Parse_info.t option
  val mem : data -> Code.addr -> bool
  val read : in_channel -> data
  val no_data : unit -> data
  val fold : data -> (Code.addr -> debug_event -> 'a -> 'a) -> 'a -> 'a
end = struct

  type compilation_env =
    { ce_stack: int Ident.tbl; (* Positions of variables in the stack *)
      ce_heap: int Ident.tbl;  (* Structure of the heap-allocated env *)
      ce_rec: int Ident.tbl }  (* Functions bound by the same let rec *)

  type pos =
    { pos_fname: string;
      pos_lnum: int;
      pos_bol: int;
      pos_cnum: int }

  type loc_info =
    { li_start: pos;
      li_end: pos;
      li_ghost: unit }

  type debug_event =
    { mutable ev_pos: int;                (* Position in bytecode *)
      ev_module: string;                  (* Name of defining module *)
      ev_loc: loc_info;                   (* Location in source file *)
      ev_kind: debug_event_kind;          (* Before/after event *)
      ev_info: debug_event_info;          (* Extra information *)
      ev_typenv: unit;                    (* Typing environment *)
      ev_typsubst: unit;                  (* Substitution over types *)
      ev_compenv: compilation_env;        (* Compilation environment *)
      ev_stacksize: int;                  (* Size of stack frame *)
      ev_repr: unit }                     (* Position of the representative *)

  and debug_event_kind =
      Event_before
    | Event_after of unit
    | Event_pseudo

  and debug_event_info = unit
  (*   Event_function *)
  (* | Event_return of int *)
  (* | Event_other *)

  type data = (int, debug_event) Hashtbl.t

  let relocate_event orig ev = ev.ev_pos <- (orig + ev.ev_pos) / 4

  let no_data () = Hashtbl.create 17

  let read ic =
    let events_by_pc = Hashtbl.create 257 in
    let read_paths : unit -> string list =
      match Util.Version.v with
      | `V3 -> (fun () -> [])
      | `V4_02 -> (fun () -> (input_value ic : string list)) in
    let len = input_binary_int ic in
    for i = 0 to len - 1 do
      let orig = input_binary_int ic in
      let evl : debug_event list = input_value ic in

      (* Work arround a bug in ocaml 4.02 *)
      (* debug section in pack module may be wrong *)
      (* containing no debug_info. *)
      (* In this case, evl in not a debug_info list but a *)
      (* string list (see read_paths) *)

      (* save the current position *)
      let pos = pos_in ic in
      let evl_is_valid = try
          ignore(read_paths ());true
        with Failure _ ->
          (* restore position *)
          seek_in ic pos; false in
      if evl_is_valid then
        List.iter
          (fun ev ->
             relocate_event orig ev; Hashtbl.add events_by_pc ev.ev_pos ev)
          evl
    done;
    events_by_pc

  let find events_by_pc pc =
    try
      let ev = Hashtbl.find events_by_pc pc in
      Ident.table_contents ev.ev_stacksize ev.ev_compenv.ce_stack
    with Not_found ->
      []

  let mem = Hashtbl.mem

  let find_loc events_by_pc ?(after = false) pc =
    try
      let (before, ev) =
        try false, Hashtbl.find events_by_pc pc with Not_found ->
        true,
        try Hashtbl.find events_by_pc (pc + 1) with Not_found ->
        try Hashtbl.find events_by_pc (pc + 2) with Not_found ->
        Hashtbl.find events_by_pc (pc + 3)
      in
      let loc = ev.ev_loc in
      let pos =
        if after then loc.li_end else
        if before then loc.li_start else
        match ev.ev_kind with Event_after _ -> loc.li_end | _ -> loc.li_start in
      Some {Parse_info.name = pos.pos_fname;
            line=pos.pos_lnum - 1;
            col=pos.pos_cnum - pos.pos_bol;
{'fraction_non_alphanumeric': 0.09719651792446364, 'fraction_numerical': 0.005620673109877305, 'mean_word_length': 2.1128653723063793, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 82, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1044345', 'n_tokens_mistral': 4778, 'n_tokens_neox': 4578, 'n_words': 1636}