<commit_before>(* Evaluation of the ExEff language, big step. *)
open Utils
open Language
module V = Value
module RuntimeEnv = Map.Make (CoreTypes.Variable)

type state = V.value RuntimeEnv.t

let initial_state = RuntimeEnv.empty

let update x = RuntimeEnv.add x

let lookup x state = RuntimeEnv.find_opt x state

exception PatternMatch of Location.t

let rec extend_value p v state =
  match (p, v) with
  | Typed.PVar x, v -> update x v state
  (* | Typed.PAnnotated (p, _t), v -> extend_value p v state *)
  | Typed.PAs (p, x), v ->
      let state = extend_value p v state in
      update x v state
  | Typed.PNonbinding, _ -> state
  | Typed.PTuple ps, V.Tuple vs -> List.fold_right2 extend_value ps vs state
  | Typed.PRecord ps, V.Record vs -> (
      let extender state (f, p) =
        match Assoc.lookup f vs with
        | None -> raise Not_found
        | Some v -> extend_value p v state
      in
      try Assoc.fold_left extender state ps
      with Not_found -> raise (PatternMatch Location.unknown))
  | Typed.PVariant (lbl, p), V.Variant (lbl', v) when lbl = lbl' ->
      extend_value p v state
  | Typed.PConst c, V.Const c' when Const.equal c c' -> state
  | _, _ -> raise (PatternMatch Location.unknown)

let extend p v state =
  try extend_value p v state
  with PatternMatch _loc -> Error.runtime "Pattern match failure."

let rec sequence k = function
  | V.Value v -> k v
  | V.Call (op, v, k') ->
      let k'' u = sequence k (k' u) in
      V.Call (op, v, k'')

let rec ceval state c =
  match c with
  | Typed.Apply (e1, e2) -> (
      let v1 = veval state e1 and v2 = veval state e2 in
      match v1 with
      | V.Closure f -> f v2
      | _ -> Error.runtime "Only functions can be applied.")
  | Typed.Value e -> V.Value (veval state e)
  | Typed.Match (e, _ty, cases) ->
      let v = veval state e in
      let rec eval_case = function
        | [] -> Error.runtime "No branches succeeded in a pattern match."
        | a :: lst -> (
            let p, c = a in
            try ceval (extend_value p v state) c
            with PatternMatch _ -> eval_case lst)
      in
      eval_case cases
  | Typed.Handle (e, c) ->
      let v = veval state e in
      let r = ceval state c in
      let h = V.to_handler v in
      h r
  | Typed.LetVal (e, (p, _ty, c)) -> eval_let state [ (p, Typed.Value e) ] c
  | Typed.LetRec (defs, c) ->
      (* strip types *)
      let stripped =
        List.map (fun (v, _, _, abs) -> (v, abs)) defs |> Assoc.of_list
      in
      let state = extend_let_rec state stripped in
      ceval state c
  | Typed.Call (_, _, _) -> assert false
  | Typed.Op (_, _) -> assert false
  | Typed.Bind (_, _) -> assert false
  | Typed.CastComp (c, _) | Typed.CastComp_ty (c, _) | Typed.CastComp_dirt (c, _)
    ->
      ceval state c

and eval_let state lst c =
  match lst with
  | [] -> ceval state c
  | (p, d) :: lst ->
      let r = ceval state d in
      sequence (fun v -> eval_let (extend p v state) lst c) r

and extend_let_rec state defs =
  let state' = ref state in
  let state =
    Assoc.fold_right
      (fun (f, a) state ->
        let p, c = a in
        let g = V.Closure (fun v -> ceval (extend p v !state') c) in
        update f g state)
      defs state
  in
  state' := state;
  state

and veval state e =
  match e with
  | Typed.Var x -> (
      match lookup x state with
      | Some v -> v<commit_msg>Added bind evaluation<commit_after>(* Evaluation of the ExEff language, big step. *)
open Utils
open Language
module V = Value
module RuntimeEnv = Map.Make (CoreTypes.Variable)

type state = V.value RuntimeEnv.t

let initial_state = RuntimeEnv.empty

let update x = RuntimeEnv.add x

let lookup x state = RuntimeEnv.find_opt x state

exception PatternMatch of Location.t

let rec extend_value p v state =
  match (p, v) with
  | Typed.PVar x, v -> update x v state
  (* | Typed.PAnnotated (p, _t), v -> extend_value p v state *)
  | Typed.PAs (p, x), v ->
      let state = extend_value p v state in
      update x v state
  | Typed.PNonbinding, _ -> state
  | Typed.PTuple ps, V.Tuple vs -> List.fold_right2 extend_value ps vs state
  | Typed.PRecord ps, V.Record vs -> (
      let extender state (f, p) =
        match Assoc.lookup f vs with
        | None -> raise Not_found
        | Some v -> extend_value p v state
      in
      try Assoc.fold_left extender state ps
      with Not_found -> raise (PatternMatch Location.unknown))
  | Typed.PVariant (lbl, p), V.Variant (lbl', v) when lbl = lbl' ->
      extend_value p v state
  | Typed.PConst c, V.Const c' when Const.equal c c' -> state
  | _, _ -> raise (PatternMatch Location.unknown)

let extend p v state =
  try extend_value p v state
  with PatternMatch _loc -> Error.runtime "Pattern match failure."

let rec sequence k = function
  | V.Value v -> k v
  | V.Call (op, v, k') ->
      let k'' u = sequence k (k' u) in
      V.Call (op, v, k'')

let rec ceval state c =
  match c with
  | Typed.Apply (e1, e2) -> (
      let v1 = veval state e1 and v2 = veval state e2 in
      match v1 with
      | V.Closure f -> f v2
      | _ -> Error.runtime "Only functions can be applied.")
  | Typed.Value e -> V.Value (veval state e)
  | Typed.Match (e, _ty, cases) ->
      let v = veval state e in
      let rec eval_case = function
        | [] -> Error.runtime "No branches succeeded in a pattern match."
        | a :: lst -> (
            let p, c = a in
            try ceval (extend_value p v state) c
            with PatternMatch _ -> eval_case lst)
      in
      eval_case cases
  | Typed.Handle (e, c) ->
      let v = veval state e in
      let r = ceval state c in
      let h = V.to_handler v in
      h r
  | Typed.LetVal (e, (p, _ty, c)) -> eval_let state [ (p, Typed.Value e) ] c
  | Typed.LetRec (defs, c) ->
      (* strip types *)
      let stripped =
        List.map (fun (v, _, _, abs) -> (v, abs)) defs |> Assoc.of_list
      in
      let state = extend_let_rec state stripped in
      ceval state c
  | Typed.Call (_, _, _) -> assert false
  | Typed.Op (_, _) -> assert false
  | Typed.Bind (c1, (p, c2)) -> eval_let state [ (p, c1) ] c2
  | Typed.CastComp (c, _) | Typed.CastComp_ty (c, _) | Typed.CastComp_dirt (c, _)
    ->
      ceval state c

and eval_let state lst c =
  match lst with
  | [] -> ceval state c
  | (p, d) :: lst ->
      let r = ceval state d in
      sequence (fun v -> eval_let (extend p v state) lst c) r

and extend_let_rec state defs =
  let state' = ref state in
  let state =
    Assoc.fold_right
      (fun (f, a) state ->
        let p, c = a in
        let g = V.Closure (fun v -> ceval (extend p v !state') c) in
        update f g state)
      defs state
  in
  state' := state;
  state

and veval state e =
  match e with
  | Typed.Var x -> (
      match lookup x state with
      | Some v -> v
{'fraction_non_alphanumeric': 0.11101295641931684, 'fraction_numerical': 0.0032391048292108363, 'mean_word_length': 2.1551323734324197, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 81, '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': '118931', 'n_tokens_mistral': 2369, 'n_tokens_neox': 2368, 'n_words': 897}