<commit_before>(**************************************************************************)
(*                                                                        *)
(*  Copyright (C) 2010-                                                   *)
(*    <NAME>                                                      *)
(*    <NAME>                                           *)
(*    <NAME>                                                      *)
(*    <NAME>                                                    *)
(*                                                                        *)
(*  This software is free software; you can redistribute it and/or        *)
(*  modify it under the terms of the GNU Library General Public           *)
(*  License version 2.1, with the special exception on linking            *)
(*  described in file LICENSE.                                            *)
(*                                                                        *)
(*  This software is distributed in the hope that it will be useful,      *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
(*                                                                        *)
(**************************************************************************)

open Util
open Ident
open Ty
open Term
open Decl
open Task

type state = {
  mt_map : lsymbol Mts.t;       (* from type symbols to selector functions *)
  pj_map : lsymbol list Mls.t;  (* from constructors to projections *)
}

let empty_state = {
  mt_map = Mts.empty;
  pj_map = Mls.empty;
}

let uncompiled = "eliminate_algebraic: compile_match required"

let rec rewriteT kn state t = match t.t_node with
  | Tcase ([t1],bl) ->
      let mk_br (w,m) br =
        let (pl,e) = t_open_branch br in
        match pl with
        | [{ pat_node = Papp (cs,pl) }] ->
            let add_var e p pj = match p.pat_node with
              | Pvar v -> t_let v (t_app pj [t1] v.vs_ty) e
              | _ -> failwith uncompiled
            in
            let pjl = Mls.find cs state.pj_map in
            let e = List.fold_left2 add_var e pl pjl in
            w, Mls.add cs e m
        | [{ pat_node = Pwild }] ->
            Some e, m
        | _ -> failwith uncompiled
      in
      let w,m = List.fold_left mk_br (None,Mls.empty) bl in
      let find cs = try Mls.find cs m with Not_found -> of_option w in
      let ts = match t1.t_ty.ty_node with
        | Tyapp (ts,_) -> ts
        | _ -> failwith uncompiled
      in
      let tl = List.map find (find_constructors kn ts) in
      t_app (Mts.find ts state.mt_map) (t1::tl) t.t_ty
  | Tcase _ -> failwith uncompiled
  | _ -> t_map (rewriteT kn state) (rewriteF kn state) t

and rewriteF kn state f = match f.f_node with
  | Fcase ([t1],bl) ->
      let mk_br (w,m) br =
        let (pl,e) = f_open_branch br in
        match pl with
        | [{ pat_node = Papp (cs,pl) }] ->
            let add_var e p pj = match p.pat_node with
              | Pvar v -> f_let v (t_app pj [t1] v.vs_ty) e
              | _ -> failwith uncompiled
            in
            let pjl = Mls.find cs state.pj_map in
            let e = List.fold_left2 add_var e pl pjl in<commit_msg>bugfix in eliminate_algebraic<commit_after>(**************************************************************************)
(*                                                                        *)
(*  Copyright (C) 2010-                                                   *)
(*    <NAME>                                                      *)
(*    <NAME>                                           *)
(*    <NAME>                                                      *)
(*    <NAME>                                                    *)
(*                                                                        *)
(*  This software is free software; you can redistribute it and/or        *)
(*  modify it under the terms of the GNU Library General Public           *)
(*  License version 2.1, with the special exception on linking            *)
(*  described in file LICENSE.                                            *)
(*                                                                        *)
(*  This software is distributed in the hope that it will be useful,      *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
(*                                                                        *)
(**************************************************************************)

open Util
open Ident
open Ty
open Term
open Decl
open Task

type state = {
  mt_map : lsymbol Mts.t;       (* from type symbols to selector functions *)
  pj_map : lsymbol list Mls.t;  (* from constructors to projections *)
}

let empty_state = {
  mt_map = Mts.empty;
  pj_map = Mls.empty;
}

let uncompiled = "eliminate_algebraic: compile_match required"

let rec rewriteT kn state t = match t.t_node with
  | Tcase ([t1],bl) ->
      let t1 = rewriteT kn state t1 in
      let mk_br (w,m) br =
        let (pl,e) = t_open_branch br in
        let e = rewriteT kn state e in
        match pl with
        | [{ pat_node = Papp (cs,pl) }] ->
            let add_var e p pj = match p.pat_node with
              | Pvar v -> t_let v (t_app pj [t1] v.vs_ty) e
              | _ -> failwith uncompiled
            in
            let pjl = Mls.find cs state.pj_map in
            let e = List.fold_left2 add_var e pl pjl in
            w, Mls.add cs e m
        | [{ pat_node = Pwild }] ->
            Some e, m
        | _ -> failwith uncompiled
      in
      let w,m = List.fold_left mk_br (None,Mls.empty) bl in
      let find cs = try Mls.find cs m with Not_found -> of_option w in
      let ts = match t1.t_ty.ty_node with
        | Tyapp (ts,_) -> ts
        | _ -> failwith uncompiled
      in
      let tl = List.map find (find_constructors kn ts) in
      t_app (Mts.find ts state.mt_map) (t1::tl) t.t_ty
  | Tcase _ -> failwith uncompiled
  | _ -> t_map (rewriteT kn state) (rewriteF kn state) t

and rewriteF kn state f = match f.f_node with
  | Fcase ([t1],bl) ->
      let t1 = rewriteT kn state t1 in
      let mk_br (w,m) br =
        let (pl,e) = f_open_branch br in
        let e = rewriteF kn state e in
        match pl with
        | [{ pat_node = Papp (cs,pl) }] ->
            let add_var e p pj = match p.pat_node with
              | Pvar v -> f_let v (t_app pj [t1] v.vs_ty) e
              | _ -> failwith uncompiled
            in
            let pjl = Mls.find cs state.pj_map in
            let e = List.fold_left2 add_var e pl pjl in
{'fraction_non_alphanumeric': 0.1262656343061346, 'fraction_numerical': 0.004764740917212627, 'mean_word_length': 1.2746359634270235, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 41, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 48, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1440611', 'n_tokens_mistral': 1838, 'n_tokens_neox': 1772, 'n_words': 629}