<commit_before>(*
Copyright (c) 2013, <NAME>
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.  Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)

(** {1 Precedence (total ordering) on symbols} *)

type symbol_status =
  | Multiset
  | Lexicographic

(** {2 Signature} *)

module type S = sig
  type symbol

  type t
    (** Total Ordering on a finite number of symbols, plus a few more
        data (weight for KBO, status for RPC) *)

  type precedence = t

  val eq : t -> t -> bool
    (** Check whether the two precedences are equal (same snapshot) *)

  val snapshot : t -> symbol list
    (** Current list of symbols, in decreasing order *)

  val compare : t -> symbol -> symbol -> int
    (** Compare two symbols using the precedence *)

  val status : t -> symbol -> symbol_status
    (** Status of the symbol *)

  val weight : t -> symbol -> int
    (** Weight of a symbol (for KBO). Strictly positive int. *)

  val add_list : t -> symbol list -> t
    (** Update the precedence with the given symbols *)

  val add_seq : t -> symbol Sequence.t -> t

  val declare_status : t -> symbol -> symbol_status -> t
    (** Change the status of the given precedence *)

  module Seq : sig
    val symbols : t -> symbol Sequence.t
  end

  val pp_snapshot : Buffer.t -> symbol list -> unit
  val pp : Buffer.t -> t -> unit
  val fmt : Format.formatter -> t -> unit
  val to_string : t -> string

  (** {2 Builtin constraints} *)

  module Constr : sig
    type t = symbol -> symbol -> Comparison.t
      (** A partial order on symbols, used to make the precedence more
          precise *)

    val cluster : symbol list list -> t
      (** ordering constraint by clustering symbols by decreasing order.
          all symbols in the first clusters are bigger than those in the second, etc. *)

    val of_list : symbol list -> t
      (** symbols in the given list are in decreasing order *)

    val of_precedence : precedence -> t
      (** Copy of another precedence on the common symbols *)

    val arity : (symbol -> int) -> t
      (** decreasing arity constraint (big arity => high in precedence) *)

    val invfreq : symbol Sequence.t -> t
      (** symbols with high frequency are smaller *)

    val max : symbol list -> t
      (** maximal symbols, in decreasing order *)

    val min : symbol list -> t
      (** minimal symbols, in decreasing order *)

    val alpha : t
      (** alphabetic ordering on symbols *)
  end

  (** {2 Creation of a precedence from constraints} *)

  val create : Constr.t list -> symbol list -> t
    (** make a precedence from the given constraints. Constraints near
        the head of the list are {b more important} than constraints close
        to the tail. Only the very first constraint is assured to be totally
        satisfied if constraints do not agree with one another. *)

  val default : symbol list -> t
    (** default precedence. Default status for symbols is {!Lexicographic}. *)

  val default_seq : symbol Sequence.t -> t
    (** default precedence on the given sequence of symbols *)
end

(** {2 Functor} *)

module type SYMBOL = sig
  type t

  val eq : t -> t -> bool
  val hash : t -> int
  val cmp : t -> t -> int

  val false_ : t
  val true_ : t

  val pp : Buffer.t -> t -> unit
end

module Make(Sym : SYMBOL) = struct
  type symbol = Sym.t

  module Tbl = PersistentHashtbl.Make(struct
    type t = Sym.t
    let equal = Sym.eq
    let hash = Sym.hash
  end)

  (* used to complete orderings *)
  module PO = PartialOrder.Make(Sym)

  type t = {
    snapshot : symbol list; (* symbols by decreasing order *)
    index : int Tbl.t;      (* symbol -> index in precedence *)
    weight : symbol -> int; (* symbol -> weight *)
    status : unit Tbl.t;    (* set of multiset-status symbols *)
    constr : (symbol -> symbol -> Comparison.t) list;
      (* constraints used to build the precedence *)
  }

  type precedence = t

  let eq p1 p2 =
    try List.for_all2 (==) p1.snapshot p2.snapshot
    with Invalid_argument _ -> false

  let snapshot p = p.snapshot

  let compare p s1 s2 =
    let i1 = try Tbl.find p.index s1 with Not_found -> -1 in
    let i2 = try Tbl.find p.index s2 with Not_found -> -1 in
    let c = i2 - i1 in
    if c = 0
      then Sym.cmp s1 s2
      else c

  let status p s =
    if Tbl.mem p.status s
      then Multiset
      else Lexicographic

  let weight p s = p.weight s

  let declare_status p s status =
    match status with
    | Lexicographic when not (Tbl.mem p.status s) -> p
    | Multiset when (Tbl.mem p.status s) -> p
    | Lexicographic ->
      { p with status = Tbl.remove p.status s; }
    | Multiset ->
      { p with status = Tbl.replace p.status s (); }

  module Seq = struct
    let symbols p = Sequence.of_list p.snapshot
  end

  let pp_snapshot buf s =
    Util.pp_list ~sep:" > " Sym.pp buf s

  let pp buf prec = pp_snapshot buf prec.snapshot

  let to_string = Util.on_buffer pp

  let fmt fmt p = Format.pp_print_string fmt (to_string p)

  (* build a table  symbol -> i. such as if
      [tbl s = i], then w[List.nth i l = s] *)
  let _mk_table l =
    Util.list_foldi
      (fun tbl i s -> Tbl.replace tbl s i)
      (Tbl.create 7) l

  (** {3 Constraints} *)
<commit_msg>more accurate printing of precedence (print status of symbols)<commit_after>(*
Copyright (c) 2013, <NAME>
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.  Redistributions in binary
form must reproduce the above copyright notice, this list of conditions and the
following disclaimer in the documentation and/or other materials provided with
the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)

(** {1 Precedence (total ordering) on symbols} *)

type symbol_status =
  | Multiset
  | Lexicographic

(** {2 Signature} *)

module type S = sig
  type symbol

  type t
    (** Total Ordering on a finite number of symbols, plus a few more
        data (weight for KBO, status for RPC) *)

  type precedence = t

  val eq : t -> t -> bool
    (** Check whether the two precedences are equal (same snapshot) *)

  val snapshot : t -> symbol list
    (** Current list of symbols, in decreasing order *)

  val compare : t -> symbol -> symbol -> int
    (** Compare two symbols using the precedence *)

  val status : t -> symbol -> symbol_status
    (** Status of the symbol *)

  val weight : t -> symbol -> int
    (** Weight of a symbol (for KBO). Strictly positive int. *)

  val add_list : t -> symbol list -> t
    (** Update the precedence with the given symbols *)

  val add_seq : t -> symbol Sequence.t -> t

  val declare_status : t -> symbol -> symbol_status -> t
    (** Change the status of the given precedence *)

  module Seq : sig
    val symbols : t -> symbol Sequence.t
  end

  val pp_snapshot : Buffer.t -> symbol list -> unit
  val pp : Buffer.t -> t -> unit
  val fmt : Format.formatter -> t -> unit
  val to_string : t -> string

  (** {2 Builtin constraints} *)

  module Constr : sig
    type t = symbol -> symbol -> Comparison.t
      (** A partial order on symbols, used to make the precedence more
          precise *)

    val cluster : symbol list list -> t
      (** ordering constraint by clustering symbols by decreasing order.
          all symbols in the first clusters are bigger than those in the second, etc. *)

    val of_list : symbol list -> t
      (** symbols in the given list are in decreasing order *)

    val of_precedence : precedence -> t
      (** Copy of another precedence on the common symbols *)

    val arity : (symbol -> int) -> t
      (** decreasing arity constraint (big arity => high in precedence) *)

    val invfreq : symbol Sequence.t -> t
      (** symbols with high frequency are smaller *)

    val max : symbol list -> t
      (** maximal symbols, in decreasing order *)

    val min : symbol list -> t
      (** minimal symbols, in decreasing order *)

    val alpha : t
      (** alphabetic ordering on symbols *)
  end

  (** {2 Creation of a precedence from constraints} *)

  val create : Constr.t list -> symbol list -> t
    (** make a precedence from the given constraints. Constraints near
        the head of the list are {b more important} than constraints close
        to the tail. Only the very first constraint is assured to be totally
        satisfied if constraints do not agree with one another. *)

  val default : symbol list -> t
    (** default precedence. Default status for symbols is {!Lexicographic}. *)

  val default_seq : symbol Sequence.t -> t
    (** default precedence on the given sequence of symbols *)
end

(** {2 Functor} *)

module type SYMBOL = sig
  type t

  val eq : t -> t -> bool
  val hash : t -> int
  val cmp : t -> t -> int

  val false_ : t
  val true_ : t

  val pp : Buffer.t -> t -> unit
end

module Make(Sym : SYMBOL) = struct
  type symbol = Sym.t

  module Tbl = PersistentHashtbl.Make(struct
    type t = Sym.t
    let equal = Sym.eq
    let hash = Sym.hash
  end)

  (* used to complete orderings *)
  module PO = PartialOrder.Make(Sym)

  type t = {
    snapshot : symbol list; (* symbols by decreasing order *)
    index : int Tbl.t;      (* symbol -> index in precedence *)
    weight : symbol -> int; (* symbol -> weight *)
    status : unit Tbl.t;    (* set of multiset-status symbols *)
    constr : (symbol -> symbol -> Comparison.t) list;
      (* constraints used to build the precedence *)
  }

  type precedence = t

  let eq p1 p2 =
    try List.for_all2 (==) p1.snapshot p2.snapshot
    with Invalid_argument _ -> false

  let snapshot p = p.snapshot

  let compare p s1 s2 =
    let i1 = try Tbl.find p.index s1 with Not_found -> -1 in
    let i2 = try Tbl.find p.index s2 with Not_found -> -1 in
    let c = i2 - i1 in
    if c = 0
      then Sym.cmp s1 s2
      else c

  let status p s =
    if Tbl.mem p.status s
      then Multiset
      else Lexicographic

  let weight p s = p.weight s

  let declare_status p s status =
    match status with
    | Lexicographic when not (Tbl.mem p.status s) -> p
    | Multiset when (Tbl.mem p.status s) -> p
    | Lexicographic ->
      { p with status = Tbl.remove p.status s; }
    | Multiset ->
      { p with status = Tbl.replace p.status s (); }

  module Seq = struct
    let symbols p = Sequence.of_list p.snapshot
  end

  let pp_snapshot buf s =
    Util.pp_list ~sep:" > " Sym.pp buf s

  let pp buf prec =
    Util.pp_list ~sep:" > "
      (fun buf s -> match status prec s with
        | Multiset -> Printf.bprintf buf "%a[M]" Sym.pp s
        | Lexicographic -> Sym.pp buf s)
      buf prec.snapshot

  let to_string = Util.on_buffer pp

  let fmt fmt p = Format.pp_print_string fmt (to_string p)

  (* build a table  symbol -> i. such as if
      [tbl s = i], then w[List.nth i l = s] *)
  let _mk_table l =
    Util.list_foldi
      (fun tbl i s -> Tbl.replace tbl s i)
      (Tbl.create 7) l

  (** {3 Constraints} *)

{'fraction_non_alphanumeric': 0.08743338225071445, 'fraction_numerical': 0.0044798022707963235, 'mean_word_length': 2.6909920182440135, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 133, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, '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': '1022527', 'n_tokens_mistral': 3865, 'n_tokens_neox': 3599, 'n_words': 1723}