<commit_before>(** Checking the well-formedness of a program in [Ast] *)

(** TODO this module needs to be rewritten properly with constraints and
 * everything; the bidirectional algorithm is remarkably poor and extremely
 * fragile! *)

open Ast
open Warnings
open Constant
open Location
open PrintAst.Ops
open Helpers

let buf_any_msg = format_of_string {|
This subexpression creates a buffer with an unknown type:
  %a

Here's a hint. If you're using untagged unions, instead of:

  match e with
  | Foo ->
      Buffer.create e1 l1
  | Bar ->
      Buffer.create e2 l2

where e1: t1 and e2: t2, try:

  match e with
  | Foo ->
      let b: Buffer.buffer t1 = Buffer.create e1 l1 in
      b
  | Bar ->
      let b: Buffer.buffer t2 = Buffer.create e2 l2 in
      b
|}

(** Environments ------------------------------------------------------------ *)

exception UnboundLid of lident

module M = Map.Make(struct
  type t = lident
  let compare = compare
end)

let uint32 = TInt UInt32
let c_string = TQualified ([ "C" ], "string")

type env = {
  globals: typ M.t;
  locals: binder list;
  types: type_def M.t;
  location: loc list;
  enums: lident M.t;
  warn: bool;
}

let empty: env = {
  globals = M.empty;
  locals = [];
  types = M.empty;
  location = [];
  enums = M.empty;
  warn = false
}

let push env binder =
  (* KPrint.bprintf "pushing %s at type %a\n" binder.node.name ptyp binder.typ; *)
  { env with locals = binder :: env.locals }

let find env i =
  List.nth env.locals i

let lookup_type env lid =
  match M.find lid env.types with
  | exception Not_found ->
      raise (UnboundLid lid)
  | x ->
      x

let possibly_warn =
  let h = Hashtbl.create 41 in
  fun env lid ->
    match Hashtbl.find h lid with
    | exception Not_found ->
        Hashtbl.add h lid ();
        raise_error_l (KPrint.bsprintf "%a" ploc env.location,
          UnboundReference (KPrint.bsprintf "%a" plid lid))
    | () ->
        ()

let lookup_global env lid =
  match M.find lid env.globals with
  | exception Not_found ->
      possibly_warn env lid;
      TAny
  | x ->
      x

let populate_env files =
  List.fold_left (fun env (_, decls) ->
    List.fold_left (fun env decl ->
      match decl with<commit_msg>Revert "Proper reporting of error two"<commit_after>(** Checking the well-formedness of a program in [Ast] *)

(** TODO this module needs to be rewritten properly with constraints and
 * everything; the bidirectional algorithm is remarkably poor and extremely
 * fragile! *)

open Ast
open Warnings
open Constant
open Location
open PrintAst.Ops
open Helpers

let buf_any_msg = format_of_string {|
This subexpression creates a buffer with an unknown type:
  %a

Here's a hint. If you're using untagged unions, instead of:

  match e with
  | Foo ->
      Buffer.create e1 l1
  | Bar ->
      Buffer.create e2 l2

where e1: t1 and e2: t2, try:

  match e with
  | Foo ->
      let b: Buffer.buffer t1 = Buffer.create e1 l1 in
      b
  | Bar ->
      let b: Buffer.buffer t2 = Buffer.create e2 l2 in
      b
|}

(** Environments ------------------------------------------------------------ *)

exception UnboundLid of lident

module M = Map.Make(struct
  type t = lident
  let compare = compare
end)

let uint32 = TInt UInt32
let c_string = TQualified ([ "C" ], "string")

type env = {
  globals: typ M.t;
  locals: binder list;
  types: type_def M.t;
  location: loc list;
  enums: lident M.t;
  warn: bool;
}

let empty: env = {
  globals = M.empty;
  locals = [];
  types = M.empty;
  location = [];
  enums = M.empty;
  warn = false
}

let push env binder =
  (* KPrint.bprintf "pushing %s at type %a\n" binder.node.name ptyp binder.typ; *)
  { env with locals = binder :: env.locals }

let find env i =
  List.nth env.locals i

let lookup_type env lid =
  match M.find lid env.types with
  | exception Not_found ->
      raise (UnboundLid lid)
  | x ->
      x

let possibly_warn =
  let h = Hashtbl.create 41 in
  fun env lid ->
    match Hashtbl.find h lid with
    | exception Not_found ->
        Hashtbl.add h lid ();
        maybe_fatal_error (KPrint.bsprintf "%a" ploc env.location,
          UnboundReference (KPrint.bsprintf "%a" plid lid))
    | () ->
        ()

let lookup_global env lid =
  match M.find lid env.globals with
  | exception Not_found ->
      possibly_warn env lid;
      TAny
  | x ->
      x

let populate_env files =
  List.fold_left (fun env (_, decls) ->
    List.fold_left (fun env decl ->
      match decl with
{'fraction_non_alphanumeric': 0.12222968435191403, 'fraction_numerical': 0.008954555630176853, 'mean_word_length': 2.3951367781155017, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 29, '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': '1403272', 'n_tokens_mistral': 1536, 'n_tokens_neox': 1482, 'n_words': 532}