<commit_before>open Sexplib.Std

type tvar = int
with sexp_of

type value =
(* Primitives *)
| Tvar          of tvar
| TvarTy
| Nil
| NilTy
| Truth
| Lies
| BooleanTy
| Int           of int
| IntTy
| Symbol        of string
| SymbolTy
(* Product types *)
| Tuple         of value list
| TupleTy       of value list
| Record        of value Table.t
| RecordTy      of value Table.t
(* Function type *)
| Environment   of local_env
| EnvironmentTy of local_env_ty
| Lambda        of lambda
| LambdaTy      of lambda_ty
(* Packages *)
| Package       of package
(* User-defined types *)
| Class         of klass specialized
| Mixin         of mixin specialized
| Instance      of klass specialized * value Table.t
and binding_ty = {
  b_location_ty   : Location.t;
  b_is_mutable_ty : bool;
  b_value_ty      : value;
}
and local_env_ty = {
  e_parent_ty     : local_env_ty option;
  e_bindings_ty   : binding_ty Table.t;
}
and binding = {
  b_location      : Location.t;
  b_is_mutable    : bool;
  b_value         : value;
}
and local_env = {
  e_parent        : local_env option;
  e_bindings      : binding Table.t;
}
and type_env =      tvar Table.t
and const_env =     package list ref
and lambda = {
  l_ty            : value;
  l_local_env     : local_env;
  l_type_env      : type_env;
  l_code          : Syntax.expr;
}
and lambda_ty = {
  l_args_ty       : value;
  l_kwargs_ty     : value;
  l_return_ty     : value;
}
and 'a specialized = 'a * value Table.t
and package = {
  p_name      : string;
  (* p_metaclass : klass; *)
  p_constants : value Table.t;
}
and klass = {
  k_name      : string;
  k_metaclass : klass;
  k_ancestor  : klass   option;
  k_tvars     : tvar    Table.t;
  k_ivars     : ivar    Table.t;
  k_methods   : imethod Table.t;
  k_prepended : mixin   list;
  k_appended  : mixin   list;
}
and mixin = {
  m_name      : string;
  m_metaclass : klass;
  m_methods   : imethod Table.t;
}
and imethod = {
  im_body     : lambda;
  im_dynamic  : bool;
}
and ivar_kind =
| IvarImmutable
| IvarMutable
| IvarMetaMutable
and ivar = {
  iv_ty       : value;
  iv_kind     : ivar_kind;
}
and exc = {
  ex_message    : string;
  ex_location   : int * int;
  ex_highlights : (int * int) list;
}
with sexp_of

exception Exc of exc
with sexp

let lastvar = ref 0
let genvar () : tvar =
  incr lastvar;
  !lastvar

let rec typeof value =
  match value with
  | Truth | Lies  -> BooleanTy
  | Nil           -> NilTy

  | Tvar(_)       -> TvarTy
  | Int(_)        -> IntTy
  | Symbol(_)     -> SymbolTy
  | Tuple(xs)     -> TupleTy(List.map typeof xs)
  | Record(xs)    -> RecordTy(Table.map (fun v -> typeof v) xs)

  | Lambda(c)     -> c.l_ty

  | Instance(k,_) -> Class(k)
  | _ -> failwith ("cannot typeof " ^ (Sexplib.Sexp.to_string_hum (sexp_of_value value)))

let string_of_value value =
   (Sexplib.Sexp.to_string_hum (sexp_of_value value))

let inspect_literal_or value f =
  match value with
  | Truth     -> "true"
  | Lies      -> "false"
  | Nil       -> "nil"
  | Int(n)    -> string_of_int n
  | Symbol(s) -> ":" ^ s
  | _         -> f value

let rec inspect_value value =
  inspect_literal_or value (fun x ->
    match value with
    | Tuple(xs)    -> "[" ^ (String.concat ", " (List.map inspect_value xs)) ^ "]"
    | Record(xs)   -> "{" ^ (String.concat ", " (Table.map_list
                                (fun k v -> k ^ ": " ^ (inspect_value v)) xs)) ^ "}"
    | Lambda(lm)   -> "#<Lambda " ^ Location.at(Syntax.loc lm.l_code) ^ ">"
    | _ -> (string_of_value value))

let rec inspect_type_pair name ty =
  name ^ ": " ^ (inspect_type ty)

and inspect_type ty =
  inspect_literal_or ty (fun x ->
    match ty with
    | TvarTy       -> "TypeVariable"
    | BooleanTy    -> "Boolean"
    | NilTy        -> "Nil"
    | IntTy        -> "Integer"
    | SymbolTy     -> "Symbol"
    | TupleTy(xs)  -> "[" ^ (String.concat ", " (List.map inspect_type xs)) ^ "]"
    | RecordTy(xs) -> "{" ^ (String.concat ", " (Table.map_list inspect_type_pair xs)) ^ "}"
    | LambdaTy(lm)
    -> (let args_ty =
          match lm.l_args_ty with
          | TupleTy(xs) -> List.map inspect_type xs
          | o -> ["*" ^ (inspect_type o)]
        in let kwargs_ty =
          match lm.l_kwargs_ty with
          | RecordTy(xs) -> Table.map_list inspect_type_pair xs
          | o -> ["**" ^ (inspect_type o)]
        in "(" ^ (String.concat ", " (args_ty @ kwargs_ty)) ^
           ") -> " ^ (inspect_type lm.l_return_ty))
    | Tvar(tv)     -> "\\" ^ (string_of_int tv)
    | _            -> "((" ^ (inspect_value ty) ^ "))")

let inspect value =
  (inspect_value value) ^ " : " ^ (inspect_type (typeof value))

(* Exceptions *)

let exc_fail message loc hilights =
  raise (Exc {
    ex_message    = message;
    ex_location   = loc;
    ex_highlights = hilights;
  })

let exc_type expected obj loc =
  exc_fail (expected ^ " expected; " ^ (inspect obj) ^ " found") loc []

(* Local environment *)

exception LEnvUnbound
exception LEnvAlreadyBound of binding
exception LEnvImmutable    of binding

let lenv_create () : local_env =
  { e_parent   = None;
    e_bindings = Table.create [] }

let lenv_bind env name ~loc ~is_mutable ~value =<commit_msg>Don't die on untypable values.<commit_after>open Sexplib.Std

type tvar = int
with sexp_of

type value =
(* Primitives *)
| Tvar          of tvar
| TvarTy
| Nil
| NilTy
| Truth
| Lies
| BooleanTy
| Int           of int
| IntTy
| Symbol        of string
| SymbolTy
(* Product types *)
| Tuple         of value list
| TupleTy       of value list
| Record        of value Table.t
| RecordTy      of value Table.t
(* Function type *)
| Environment   of local_env
| EnvironmentTy of local_env_ty
| Lambda        of lambda
| LambdaTy      of lambda_ty
(* Packages *)
| Package       of package
(* User-defined types *)
| Class         of klass specialized
| Mixin         of mixin specialized
| Instance      of klass specialized * value Table.t
and binding_ty = {
  b_location_ty   : Location.t;
  b_is_mutable_ty : bool;
  b_value_ty      : value;
}
and local_env_ty = {
  e_parent_ty     : local_env_ty option;
  e_bindings_ty   : binding_ty Table.t;
}
and binding = {
  b_location      : Location.t;
  b_is_mutable    : bool;
  b_value         : value;
}
and local_env = {
  e_parent        : local_env option;
  e_bindings      : binding Table.t;
}
and type_env =      tvar Table.t
and const_env =     package list ref
and lambda = {
  l_ty            : value;
  l_local_env     : local_env;
  l_type_env      : type_env;
  l_code          : Syntax.expr;
}
and lambda_ty = {
  l_args_ty       : value;
  l_kwargs_ty     : value;
  l_return_ty     : value;
}
and 'a specialized = 'a * value Table.t
and package = {
  p_name      : string;
  (* p_metaclass : klass; *)
  p_constants : value Table.t;
}
and klass = {
  k_name      : string;
  k_metaclass : klass;
  k_ancestor  : klass   option;
  k_tvars     : tvar    Table.t;
  k_ivars     : ivar    Table.t;
  k_methods   : imethod Table.t;
  k_prepended : mixin   list;
  k_appended  : mixin   list;
}
and mixin = {
  m_name      : string;
  m_metaclass : klass;
  m_methods   : imethod Table.t;
}
and imethod = {
  im_body     : lambda;
  im_dynamic  : bool;
}
and ivar_kind =
| IvarImmutable
| IvarMutable
| IvarMetaMutable
and ivar = {
  iv_ty       : value;
  iv_kind     : ivar_kind;
}
and exc = {
  ex_message    : string;
  ex_location   : int * int;
  ex_highlights : (int * int) list;
}
with sexp_of

exception Exc of exc
with sexp

let lastvar = ref 0
let genvar () : tvar =
  incr lastvar;
  !lastvar

let rec typeof value =
  match value with
  | Truth | Lies  -> BooleanTy
  | Nil           -> NilTy

  | Tvar(_)       -> TvarTy
  | Int(_)        -> IntTy
  | Symbol(_)     -> SymbolTy
  | Tuple(xs)     -> TupleTy(List.map typeof xs)
  | Record(xs)    -> RecordTy(Table.map (fun v -> typeof v) xs)

  | Lambda(c)     -> c.l_ty

  | Instance(k,_) -> Class(k)
  | _ -> failwith ("cannot typeof " ^ (Sexplib.Sexp.to_string_hum (sexp_of_value value)))

let string_of_value value =
   (Sexplib.Sexp.to_string_hum (sexp_of_value value))

let inspect_literal_or value f =
  match value with
  | Truth     -> "true"
  | Lies      -> "false"
  | Nil       -> "nil"
  | Int(n)    -> string_of_int n
  | Symbol(s) -> ":" ^ s
  | _         -> f value

let rec inspect_value value =
  inspect_literal_or value (fun x ->
    match value with
    | Tuple(xs)    -> "[" ^ (String.concat ", " (List.map inspect_value xs)) ^ "]"
    | Record(xs)   -> "{" ^ (String.concat ", " (Table.map_list
                                (fun k v -> k ^ ": " ^ (inspect_value v)) xs)) ^ "}"
    | Lambda(lm)   -> "#<Lambda " ^ Location.at(Syntax.loc lm.l_code) ^ ">"
    | _ -> (string_of_value value))

let rec inspect_type_pair name ty =
  name ^ ": " ^ (inspect_type ty)

and inspect_type ty =
  inspect_literal_or ty (fun x ->
    match ty with
    | TvarTy       -> "TypeVariable"
    | BooleanTy    -> "Boolean"
    | NilTy        -> "Nil"
    | IntTy        -> "Integer"
    | SymbolTy     -> "Symbol"
    | TupleTy(xs)  -> "[" ^ (String.concat ", " (List.map inspect_type xs)) ^ "]"
    | RecordTy(xs) -> "{" ^ (String.concat ", " (Table.map_list inspect_type_pair xs)) ^ "}"
    | LambdaTy(lm)
    -> (let args_ty =
          match lm.l_args_ty with
          | TupleTy(xs) -> List.map inspect_type xs
          | o -> ["*" ^ (inspect_type o)]
        in let kwargs_ty =
          match lm.l_kwargs_ty with
          | RecordTy(xs) -> Table.map_list inspect_type_pair xs
          | o -> ["**" ^ (inspect_type o)]
        in "(" ^ (String.concat ", " (args_ty @ kwargs_ty)) ^
           ") -> " ^ (inspect_type lm.l_return_ty))
    | Tvar(tv)     -> "\\" ^ (string_of_int tv)
    | _            -> "((" ^ (inspect_value ty) ^ "))")

let inspect value =
  let ty =
    try  (inspect_type (typeof value))
    with Failure(_) -> "#<untypable value>"
  in (inspect_value value) ^ " : " ^ ty

(* Exceptions *)

let exc_fail message loc hilights =
  raise (Exc {
    ex_message    = message;
    ex_location   = loc;
    ex_highlights = hilights;
  })

let exc_type expected obj loc =
  exc_fail (expected ^ " expected; " ^ (inspect obj) ^ " found") loc []

(* Local environment *)

exception LEnvUnbound
exception LEnvAlreadyBound of binding
exception LEnvImmutable    of binding

let lenv_create () : local_env =
  { e_parent   = None;
    e_bindings = Table.create [] }

let lenv_bind env name ~loc ~is_mutable ~value =
{'fraction_non_alphanumeric': 0.12347809414245997, 'fraction_numerical': 0.00019173617102866456, 'mean_word_length': 2.2691946098401754, 'pattern_counts': {'":': 6, '<': 6, '<?xml version=': 0, '>': 85, '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': '2899780', 'n_tokens_mistral': 3821, 'n_tokens_neox': 3796, 'n_words': 943}