<commit_before>(******    TYPES    *******)

open Spl
;;

module SplMap = Map.Make (struct
  type t = spl
  let compare = Pervasives.compare
end)

module IdxFuncMap = Map.Make (struct
  type t = idxfunc
  let compare = Pervasives.compare
end)

module IntExprSet = Set.Make (struct
  type t = intexpr
  let compare = Pervasives.compare
end)
;;

type breakdown = (boolexpr * (intexpr * intexpr) list * spl * spl)
;;

type rstep_unpartitioned = (string * spl * IntExprSet.t * breakdown list )
;;

type closure = rstep_unpartitioned list
;;

type breakdown_enhanced = (boolexpr * (intexpr * intexpr) list * spl * spl * spl * spl)
;;

type rstep_partitioned = (string * spl * IntExprSet.t * IntExprSet.t * IntExprSet.t * breakdown_enhanced list)
;;

type lib = rstep_partitioned list
;;

type specified_arg = string * int
;;

module SpecArgMap = Map.Make (struct
  type t = specified_arg
  let compare = Pervasives.compare
end)
;;

module SpecArgSet = Set.Make (struct
  type t = specified_arg
  let compare = Pervasives.compare
end)
;;


(******** PRINTING *******)

let string_of_breakdown_enhanced ((condition, freedoms, desc, desc_with_calls, desc_with_calls_cons, desc_with_calls_comp):breakdown_enhanced) : string = 
  "APPLICABLE\t\t"^(string_of_boolexpr condition)^"\n"
  ^"FREEDOM\t\t\t"^(String.concat ", " (List.map string_of_intexpr_intexpr freedoms))^"\n"
  ^"DESCEND\t\t\t"^(string_of_spl desc)^"\n"
  ^"DESCEND - CALLS\t\t"^(string_of_spl desc_with_calls)^"\n"
  ^"DESCEND - CALLS CONS\t"^(string_of_spl desc_with_calls_cons)^"\n"
  ^"DESCEND - CALLS COMP\t"^(string_of_spl desc_with_calls_comp)^"\n"
;;

let string_of_rstep_partitioned ((name, rstep, cold, reinit, hot, breakdowns ): rstep_partitioned) : string =
  "NAME\t\t\t"^name^"\n"
  ^"RS\t\t\t"^(string_of_spl rstep)^"\n"
  ^"COLD\t\t\t"^(String.concat ", " (List.map string_of_intexpr (IntExprSet.elements cold)))^"\n"
  ^"REINIT\t\t\t"^(String.concat ", " (List.map string_of_intexpr (IntExprSet.elements reinit)))^"\n"
  ^"HOT\t\t\t"^(String.concat ", " (List.map string_of_intexpr (IntExprSet.elements hot)))^"\n"
  ^(String.concat "" (List.map string_of_breakdown_enhanced breakdowns))^"\n"
  ^"\n"
;;

let string_of_lib (lib: lib) : string =
  String.concat "" (List.map string_of_rstep_partitioned lib)
;;


(**********************
      CLOSURE
***********************)

let mark_RS : spl -> spl =
  meta_transform_spl_on_spl BottomUp ( function
  |DFT n -> RS(DFT(n))
  | x -> x)
;;  

let collect_RS: spl -> spl list =
  meta_collect_spl_on_spl ( function
  | RS(x) -> [x]
  | _ -> []
)
;;

let rec extract_constraints_func (e : idxfunc) : (intexpr * intexpr) list =
  let rec extract_constraints_within_fcompose (e : idxfunc list) (res : (intexpr * intexpr) list) : (intexpr * intexpr) list = 
    match e with
      x :: (y :: tl as etl) -> let dmn = func_domain x in
			       let rng = func_range y in
			       (* print_string ("!!!!"^(string_of_intexpr dmn)^"="^(string_of_intexpr rng)^"\n") ;   *)
			       extract_constraints_within_fcompose etl ((dmn, rng) :: res)
    | [x] -> res;
    | [] -> res
  in
  match e with
  | FCompose l -> extract_constraints_within_fcompose l (List.flatten (List.map extract_constraints_func l))
  | Pre x -> extract_constraints_func x 
  | _ -> []
;;


let rec extract_constraints_spl (e : spl) : (intexpr * intexpr) list =
  let rec extract_constraints_within_compose (e : spl list) ( res : (intexpr * intexpr) list) : (intexpr * intexpr) list = 
    match e with
      x :: (y :: tl as etl) -> let dmn = domain x in
			       let rng = range y in
			       (* print_string ((string_of_intexpr dmn)^"="^(string_of_intexpr rng)^"\n") ;  *)
			       extract_constraints_within_compose etl ((dmn, rng) :: res)
    | [x] -> res;
    | [] -> res
  in
  match e with 
    Compose l -> extract_constraints_within_compose l (List.flatten (List.map extract_constraints_spl l))
  | Diag x -> extract_constraints_func x
  | _ -> []    
;;

let rec reconcile_constraints_on_spl ((constraints,spl) : (((intexpr * intexpr) list) * spl)) : spl =
  match constraints with
    (l,r) :: tl -> let f (e : intexpr) : intexpr = if (e=r) then l else e in
		   reconcile_constraints_on_spl ((List.map (fun (l,r) -> (f l, f r)) tl), ((meta_transform_intexpr_on_spl TopDown f) spl))
  | [] -> spl
;;

let rec reconcile_constraints_on_idxfunc ((constraints,idxfunc) : (((intexpr * intexpr) list) * idxfunc)) : idxfunc =
  match constraints with
    (l,r) :: tl -> let f (e : intexpr) : intexpr = if (e=r) then l else e in
		   reconcile_constraints_on_idxfunc ((List.map (fun (l,r) -> (f l, f r)) tl), ((meta_transform_intexpr_on_idxfunc TopDown f) idxfunc))
  | [] -> idxfunc
;;

let wrap_intexprs (count : int ref) (i : intexpr) : intexpr =
    match i with 
      IMul _ | IPlus _ | IDivPerfect _ | IFreedom _ | ILoopCounter _ | IArg _ -> 
	count := !count + 1;
	ICountWrap(!count, i)
    | x -> x  
;;

let wrap_intexprs_on_spl (e :spl) : spl =
  let count = ref 0 in
  (meta_transform_intexpr_on_spl TopDown (wrap_intexprs count)) e
;;

let wrap_intexprs_on_idxfunc (e :idxfunc) : idxfunc =
  let count = ref 0 in
  (meta_transform_intexpr_on_idxfunc TopDown (wrap_intexprs count)) e
;;

let unwrap_idxfunc (e:idxfunc) : idxfunc =
  let count = ref 0 in
  let h (e:idxfunc) : idxfunc = 
    match e with
      PreWrap(n,x,d)->
	count := !count + 1;
	Pre(FArg(("lambda"^(string_of_int !count)),d))
    | x -> x
  in
  (meta_transform_idxfunc_on_idxfunc TopDown h) e
;;

let unwrap_intexpr (e:intexpr) : intexpr = 
  match e with
    ICountWrap(l,r)->IArg l
  | x -> x
;;

let unwrap_spl (e:spl) : spl =
  (meta_transform_idxfunc_on_spl TopDown unwrap_idxfunc) ((meta_transform_intexpr_on_spl TopDown unwrap_intexpr) e)
;;

let replace_by_a_call_idxfunc (wrapped:idxfunc) (name:string) (unwrapped : idxfunc) : idxfunc = 
  let printer (args:intexpr IntMap.t) : string =
    String.concat ", " (List.map (fun ((i,e):int*intexpr) -> "( "^(string_of_int i)^ " = " ^(string_of_intexpr e)^")") (IntMap.bindings args));
  in
  let extractor (args:intexpr IntMap.t) : intexpr list =
    List.map (fun ((i,e):int*intexpr) -> e) (IntMap.bindings args)
  in
  let collect_binds (idxfunc:idxfunc) : intexpr list = 
    let binds (i : intexpr) : intexpr list =
      match i with
	ICountWrap _ -> [i]
      | _ -> []
    in
    ((meta_collect_intexpr_on_idxfunc binds) idxfunc) in
  let rec mapify (binds : intexpr list) (map : intexpr IntMap.t) : intexpr IntMap.t =
    match binds with
      [] -> map
    | ICountWrap(p,expr)::tl -> mapify tl (IntMap.add p expr map)
    | _ -> failwith "type is not supported"
  in
  let map = mapify (collect_binds wrapped) IntMap.empty in
  let args = extractor map in
  print_string ("WIP ok, so what do we have here?\nunwrapped: "^(string_of_idxfunc unwrapped)^"\nwrapped: "^(string_of_idxfunc wrapped)^"\nname: "^(name)^"\nmap: "^(printer map)^"\nnewcall: "^(String.concat ", " (List.map string_of_intexpr (extractor map)))^"\nnewdef: "^(string_of_idxfunc ((meta_transform_intexpr_on_idxfunc TopDown unwrap_intexpr) wrapped))^"\n\n"); (* FRED WAS HERE *)
  PreWrap(name, wrapped, (func_domain unwrapped)) 
;;

let wrap_precomputations (e :spl) : spl =
  let namemap = ref IdxFuncMap.empty in
  let count = ref 0 in
  let register_name (ffunc:idxfunc) : _ =
    count := !count + 1;
    let name = "FunctionalEnv"^(string_of_int !count) in
    namemap := IdxFuncMap.add ffunc name !namemap;
  in

  let ensure_name (ffunc:idxfunc) : string =
    if not(IdxFuncMap.mem ffunc !namemap) then (
      register_name ffunc;
    );
    IdxFuncMap.find ffunc !namemap
  in
  let transf (i : idxfunc) : idxfunc = 
    match i with 
      Pre f ->       
	let wrapped_expr = (wrap_intexprs_on_idxfunc f) in
	let func_constraints = (extract_constraints_func wrapped_expr) in
	let reconciled = reconcile_constraints_on_idxfunc (func_constraints,wrapped_expr) in
	let new_func = unwrap_idxfunc reconciled in
	let new_name = ensure_name new_func in
	replace_by_a_call_idxfunc reconciled new_name f 
    | x -> x
  in
  (meta_transform_idxfunc_on_spl TopDown transf) e  
;;

let reintegrate_RS (e: spl) (canonized : spl list) : spl =
  let rem = ref canonized in
  let f (e:spl) : spl =
    match e with
    | RS _ -> let hd = List.hd !rem in 
	      rem := List.tl !rem;
	      RS (hd)
    | x -> x
  in
  (meta_transform_spl_on_spl TopDown f) e
;;


let drop_RS : (spl -> spl) =
  let g (e : spl) : spl = 
    match e with<commit_msg>mapification<commit_after>(******    TYPES    *******)

open Spl
;;

module SplMap = Map.Make (struct
  type t = spl
  let compare = Pervasives.compare
end)

module IdxFuncMap = Map.Make (struct
  type t = idxfunc
  let compare = Pervasives.compare
end)

module IntExprSet = Set.Make (struct
  type t = intexpr
  let compare = Pervasives.compare
end)
;;

type breakdown = (boolexpr * (intexpr * intexpr) list * spl * spl)
;;

type rstep_unpartitioned = (string * spl * IntExprSet.t * breakdown list )
;;

type closure = rstep_unpartitioned list
;;

type breakdown_enhanced = (boolexpr * (intexpr * intexpr) list * spl * spl * spl * spl)
;;

type rstep_partitioned = (string * spl * IntExprSet.t * IntExprSet.t * IntExprSet.t * breakdown_enhanced list)
;;

type lib = rstep_partitioned list
;;

type specified_arg = string * int
;;

module SpecArgMap = Map.Make (struct
  type t = specified_arg
  let compare = Pervasives.compare
end)
;;

module SpecArgSet = Set.Make (struct
  type t = specified_arg
  let compare = Pervasives.compare
end)
;;


(******** PRINTING *******)

let string_of_breakdown_enhanced ((condition, freedoms, desc, desc_with_calls, desc_with_calls_cons, desc_with_calls_comp):breakdown_enhanced) : string = 
  "APPLICABLE\t\t"^(string_of_boolexpr condition)^"\n"
  ^"FREEDOM\t\t\t"^(String.concat ", " (List.map string_of_intexpr_intexpr freedoms))^"\n"
  ^"DESCEND\t\t\t"^(string_of_spl desc)^"\n"
  ^"DESCEND - CALLS\t\t"^(string_of_spl desc_with_calls)^"\n"
  ^"DESCEND - CALLS CONS\t"^(string_of_spl desc_with_calls_cons)^"\n"
  ^"DESCEND - CALLS COMP\t"^(string_of_spl desc_with_calls_comp)^"\n"
;;

let string_of_rstep_partitioned ((name, rstep, cold, reinit, hot, breakdowns ): rstep_partitioned) : string =
  "NAME\t\t\t"^name^"\n"
  ^"RS\t\t\t"^(string_of_spl rstep)^"\n"
  ^"COLD\t\t\t"^(String.concat ", " (List.map string_of_intexpr (IntExprSet.elements cold)))^"\n"
  ^"REINIT\t\t\t"^(String.concat ", " (List.map string_of_intexpr (IntExprSet.elements reinit)))^"\n"
  ^"HOT\t\t\t"^(String.concat ", " (List.map string_of_intexpr (IntExprSet.elements hot)))^"\n"
  ^(String.concat "" (List.map string_of_breakdown_enhanced breakdowns))^"\n"
  ^"\n"
;;

let string_of_lib (lib: lib) : string =
  String.concat "" (List.map string_of_rstep_partitioned lib)
;;


(**********************
      CLOSURE
***********************)

let mark_RS : spl -> spl =
  meta_transform_spl_on_spl BottomUp ( function
  |DFT n -> RS(DFT(n))
  | x -> x)
;;  

let collect_RS: spl -> spl list =
  meta_collect_spl_on_spl ( function
  | RS(x) -> [x]
  | _ -> []
)
;;

let rec extract_constraints_func (e : idxfunc) : (intexpr * intexpr) list =
  let rec extract_constraints_within_fcompose (e : idxfunc list) (res : (intexpr * intexpr) list) : (intexpr * intexpr) list = 
    match e with
      x :: (y :: tl as etl) -> let dmn = func_domain x in
			       let rng = func_range y in
			       (* print_string ("!!!!"^(string_of_intexpr dmn)^"="^(string_of_intexpr rng)^"\n") ;   *)
			       extract_constraints_within_fcompose etl ((dmn, rng) :: res)
    | [x] -> res;
    | [] -> res
  in
  match e with
  | FCompose l -> extract_constraints_within_fcompose l (List.flatten (List.map extract_constraints_func l))
  | Pre x -> extract_constraints_func x 
  | _ -> []
;;


let rec extract_constraints_spl (e : spl) : (intexpr * intexpr) list =
  let rec extract_constraints_within_compose (e : spl list) ( res : (intexpr * intexpr) list) : (intexpr * intexpr) list = 
    match e with
      x :: (y :: tl as etl) -> let dmn = domain x in
			       let rng = range y in
			       (* print_string ((string_of_intexpr dmn)^"="^(string_of_intexpr rng)^"\n") ;  *)
			       extract_constraints_within_compose etl ((dmn, rng) :: res)
    | [x] -> res;
    | [] -> res
  in
  match e with 
    Compose l -> extract_constraints_within_compose l (List.flatten (List.map extract_constraints_spl l))
  | Diag x -> extract_constraints_func x
  | _ -> []    
;;

let rec reconcile_constraints_on_spl ((constraints,spl) : (((intexpr * intexpr) list) * spl)) : spl =
  match constraints with
    (l,r) :: tl -> let f (e : intexpr) : intexpr = if (e=r) then l else e in
		   reconcile_constraints_on_spl ((List.map (fun (l,r) -> (f l, f r)) tl), ((meta_transform_intexpr_on_spl TopDown f) spl))
  | [] -> spl
;;

let rec reconcile_constraints_on_idxfunc ((constraints,idxfunc) : (((intexpr * intexpr) list) * idxfunc)) : idxfunc =
  match constraints with
    (l,r) :: tl -> let f (e : intexpr) : intexpr = if (e=r) then l else e in
		   reconcile_constraints_on_idxfunc ((List.map (fun (l,r) -> (f l, f r)) tl), ((meta_transform_intexpr_on_idxfunc TopDown f) idxfunc))
  | [] -> idxfunc
;;

let wrap_intexprs (count : int ref) (i : intexpr) : intexpr =
    match i with 
      IMul _ | IPlus _ | IDivPerfect _ | IFreedom _ | ILoopCounter _ | IArg _ -> 
	count := !count + 1;
	ICountWrap(!count, i)
    | x -> x  
;;

let wrap_intexprs_on_spl (e :spl) : spl =
  let count = ref 0 in
  (meta_transform_intexpr_on_spl TopDown (wrap_intexprs count)) e
;;

let wrap_intexprs_on_idxfunc (e :idxfunc) : idxfunc =
  let count = ref 0 in
  (meta_transform_intexpr_on_idxfunc TopDown (wrap_intexprs count)) e
;;

let unwrap_idxfunc (e:idxfunc) : idxfunc =
  let count = ref 0 in
  let h (e:idxfunc) : idxfunc = 
    match e with
      PreWrap(n,x,d)->
	count := !count + 1;
	Pre(FArg(("lambda"^(string_of_int !count)),d))
    | x -> x
  in
  (meta_transform_idxfunc_on_idxfunc TopDown h) e
;;

let unwrap_intexpr (e:intexpr) : intexpr = 
  match e with
    ICountWrap(l,r)->IArg l
  | x -> x
;;

let unwrap_spl (e:spl) : spl =
  (meta_transform_idxfunc_on_spl TopDown unwrap_idxfunc) ((meta_transform_intexpr_on_spl TopDown unwrap_intexpr) e)
;;

let replace_by_a_call_idxfunc (wrapped:idxfunc) (name:string) (domain : intexpr) : idxfunc = 
  let printer (args:intexpr IntMap.t) : string =
    String.concat ", " (List.map (fun ((i,e):int*intexpr) -> "( "^(string_of_int i)^ " = " ^(string_of_intexpr e)^")") (IntMap.bindings args));
  in
  let extractor (args:intexpr IntMap.t) : intexpr list =
    List.map (fun ((i,e):int*intexpr) -> e) (IntMap.bindings args)
  in
  let collect_binds (idxfunc:idxfunc) : intexpr list = 
    let binds (i : intexpr) : intexpr list =
      match i with
	ICountWrap _ -> [i]
      | _ -> []
    in
    ((meta_collect_intexpr_on_idxfunc binds) idxfunc) in
  let rec mapify (binds : intexpr list) (map : intexpr IntMap.t) : intexpr IntMap.t =
    match binds with
      [] -> map
    | ICountWrap(p,expr)::tl -> mapify tl (IntMap.add p expr map)
    | _ -> failwith "type is not supported"
  in
  let map = mapify (collect_binds wrapped) IntMap.empty in
  let args = extractor map in
  print_string ("WIP ok, so what do we have here?\nwrapped: "^(string_of_idxfunc wrapped)^"\nname: "^(name)^"\nmap: "^(printer map)^"\nnewcall: "^(String.concat ", " (List.map string_of_intexpr args))^"\nnewdef: "^(string_of_idxfunc ((meta_transform_intexpr_on_idxfunc TopDown unwrap_intexpr) wrapped))^"\n\n"); (* FRED WAS HERE *)
  PreWrap(name, wrapped, domain) 
;;

let wrap_precomputations (e :spl) : spl =
  let namemap = ref IdxFuncMap.empty in
  let count = ref 0 in
  let register_name (ffunc:idxfunc) : _ =
    count := !count + 1;
    let name = "FunctionalEnv"^(string_of_int !count) in
    namemap := IdxFuncMap.add ffunc name !namemap;
  in

  let ensure_name (ffunc:idxfunc) : string =
    if not(IdxFuncMap.mem ffunc !namemap) then (
      register_name ffunc;
    );
    IdxFuncMap.find ffunc !namemap
  in
  let transf (i : idxfunc) : idxfunc = 
    match i with 
      Pre f ->       
	let wrapped_expr = (wrap_intexprs_on_idxfunc f) in
	let func_constraints = (extract_constraints_func wrapped_expr) in
	let reconciled = reconcile_constraints_on_idxfunc (func_constraints,wrapped_expr) in
	let new_func = unwrap_idxfunc reconciled in
	let new_name = ensure_name new_func in
	replace_by_a_call_idxfunc reconciled new_name (func_domain f) 
    | x -> x
  in
  (meta_transform_idxfunc_on_spl TopDown transf) e  
;;

let reintegrate_RS (e: spl) (canonized : spl list) : spl =
  let rem = ref canonized in
  let f (e:spl) : spl =
    match e with
    | RS _ -> let hd = List.hd !rem in 
	      rem := List.tl !rem;
	      RS (hd)
    | x -> x
  in
  (meta_transform_spl_on_spl TopDown f) e
;;


let drop_RS : (spl -> spl) =
  let g (e : spl) : spl = 
    match e with
{'fraction_non_alphanumeric': 0.14265352179593777, 'fraction_numerical': 0.0008314526665874807, 'mean_word_length': 3.663251176959291, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 87, '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': '5838295', 'n_tokens_mistral': 6634, 'n_tokens_neox': 6421, 'n_words': 1576}