<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 Type inference} *)

(** Reference:
    https://en.wikipedia.org/wiki/Hindley-Milner
*)

module Ty = Type
module S = Substs.Ty
module Unif = TypeUnif

module STbl = Symbol.Tbl

type scope = Substs.scope

let prof_infer = Util.mk_profiler "TypeInference.infer"

(** {2 Typing context}

The scope maintained by the typing context starts at 1.
Scope 0 should be used for ground types.
*)

module Ctx = struct
  type t = {
    default : Type.t;               (* default type *)
    mutable scope : int;            (* next scope *)
    mutable var : int;              (* generate fresh vars *)
    mutable db : (Type.t * scope) list;  (* types of bound variables (stack) *)
    mutable signature : Signature.t;(* symbol -> type *)
    mutable subst : S.t;            (* variable bindings *)
    symbols : (Type.t * scope) STbl.t; (* symbol -> instantiated type *)
    tyctx : Type.ctx;               (* convert types *)
    vars : (string, (int * Type.t)) Hashtbl.t;  (* var name -> number + type *)
  }

  let create ?(default=Type.i) ?(base=true) () =
    let signature = if base then Signature.base else Signature.empty in
    let ctx = {
      default;
      scope = 1;
      var = 0;
      db = [];
      signature;
      subst = S.create 17;
      symbols = STbl.create 7;
      tyctx = Type.create_ctx ();
      vars = Hashtbl.create 13;
    } in
    ctx

  let of_signature ?(default=Type.i) signature =
    let ctx = {
      default;
      scope = 1;
      var = ~-1;
      db = [];
      signature;
      subst = S.create 17;
      symbols = STbl.create 7;
      tyctx = Type.create_ctx ();
      vars = Hashtbl.create 13;
    } in
    ctx

  let clear ctx =
    ctx.scope <- 0;
    ctx.var <- ~-1;
    ctx.db <- [];
    ctx.subst <- S.empty;
    STbl.clear ctx.symbols;
    ctx.signature <- Signature.empty;
    Hashtbl.clear ctx.tyctx;
    ()

  let add_signature ctx signature =
    ctx.signature <- Signature.merge ctx.signature signature;
    ()

  let set_signature ctx signature =
    ctx.signature <- signature;
    ()

  let _cur_scope ctx = ctx.scope

  let _new_scope ctx =
    let n = ctx.scope in
    ctx.scope <- n+1;
    n

  (* generate fresh vars. Those should always live in their own scope *)
  let _new_var ctx =
    let n = ctx.var in
    ctx.var <- n + 1 ;
    Type.var n

  let _of_parsed ctx ty =
    Type.of_parsed ~ctx:ctx.tyctx ty

  (* variable number and type, for the given name. An optional type can
    be provided.*)
  let _get_var ?ty ctx name =
    try
      let n, ty' = Hashtbl.find ctx.vars name in
      match ty with
      | None -> n, ty'
      | Some ty ->
        (* check same type *)
        if Type.eq ty ty'
          then n, ty'
          else failwith
            (Util.sprintf "type mismatch for var %s: %a and %a"
              name Type.pp ty Type.pp ty')
    with Not_found ->
      let n = Hashtbl.length ctx.vars in
      let ty = match ty with
        | None -> ctx.default
        | Some ty -> ty
      in<commit_msg>bugfix in type inference (generation of fresh vars/scopes: use negative ints)<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 Type inference} *)

(** Reference:
    https://en.wikipedia.org/wiki/Hindley-Milner
*)

module Ty = Type
module S = Substs.Ty
module Unif = TypeUnif

module STbl = Symbol.Tbl

type scope = Substs.scope

let prof_infer = Util.mk_profiler "TypeInference.infer"

(** {2 Typing context}

The scope maintained by the typing context starts at 1.
Scope 0 should be used for ground types.
*)

module Ctx = struct
  type t = {
    default : Type.t;               (* default type *)
    mutable scope : int;            (* next scope *)
    mutable var : int;              (* generate fresh vars *)
    mutable db : (Type.t * scope) list;  (* types of bound variables (stack) *)
    mutable signature : Signature.t;(* symbol -> type *)
    mutable subst : S.t;            (* variable bindings *)
    symbols : (Type.t * scope) STbl.t; (* symbol -> instantiated type *)
    tyctx : Type.ctx;               (* convert types *)
    vars : (string, (int * Type.t)) Hashtbl.t;  (* var name -> number + type *)
  }

  let create ?(default=Type.i) ?(base=true) () =
    let signature = if base then Signature.base else Signature.empty in
    let ctx = {
      default;
      scope = ~-1;
      var = ~-1;
      db = [];
      signature;
      subst = S.create 17;
      symbols = STbl.create 7;
      tyctx = Type.create_ctx ();
      vars = Hashtbl.create 13;
    } in
    ctx

  let of_signature ?(default=Type.i) signature =
    let ctx = {
      default;
      scope = ~-1;
      var = ~-1;
      db = [];
      signature;
      subst = S.create 17;
      symbols = STbl.create 7;
      tyctx = Type.create_ctx ();
      vars = Hashtbl.create 13;
    } in
    ctx

  let clear ctx =
    ctx.scope <- 0;
    ctx.var <- ~-1;
    ctx.db <- [];
    ctx.subst <- S.empty;
    STbl.clear ctx.symbols;
    ctx.signature <- Signature.empty;
    Hashtbl.clear ctx.tyctx;
    ()

  let add_signature ctx signature =
    ctx.signature <- Signature.merge ctx.signature signature;
    ()

  let set_signature ctx signature =
    ctx.signature <- signature;
    ()

  let _cur_scope ctx = ctx.scope

  let _new_scope ctx =
    let n = ctx.scope in
    ctx.scope <- n-1;
    n

  (* generate fresh vars. Those should always live in their own scope *)
  let _new_var ctx =
    let n = ctx.var in
    ctx.var <- n - 1 ;
    Type.__var n

  let _of_parsed ctx ty =
    Type.of_parsed ~ctx:ctx.tyctx ty

  (* variable number and type, for the given name. An optional type can
    be provided.*)
  let _get_var ?ty ctx name =
    try
      let n, ty' = Hashtbl.find ctx.vars name in
      match ty with
      | None -> n, ty'
      | Some ty ->
        (* check same type *)
        if Type.eq ty ty'
          then n, ty'
          else failwith
            (Util.sprintf "type mismatch for var %s: %a and %a"
              name Type.pp ty Type.pp ty')
    with Not_found ->
      let n = Hashtbl.length ctx.vars in
      let ty = match ty with
        | None -> ctx.default
        | Some ty -> ty
      in
{'fraction_non_alphanumeric': 0.09118259662115251, 'fraction_numerical': 0.006017125665355242, 'mean_word_length': 2.506288032454361, 'pattern_counts': {'":': 0, '<': 23, '<?xml version=': 0, '>': 21, 'https://': 2, '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': '5133360', 'n_tokens_mistral': 2684, 'n_tokens_neox': 2513, 'n_words': 1029}