<commit_before>(*pp camlp4orf *)

open Printf
open Lexing

open Camlp4
open PreCast
open Ast
open Syntax
open Pa_type_conv

(* Extend grammar with options for SQL tables *)
let sql_parms = Gram.Entry.mk "sql_parms"
EXTEND Gram

GLOBAL: sql_parms;

svars: [
  [ l = LIST0 [ `LIDENT(x) -> x ] SEP "," -> l ]
];

param: [
  [ "unique"; ":"; x = svars -> x ]
];

sql_parms: [
  [ l = LIST0 [ param ] SEP ";" -> l ]
];

END

(* Begin implementation *)

(* convenience function to wrap the TyDcl constructor since I cant
   find an appropriate quotation to use for this *)
let declare_type _loc name ty =
  Ast.TyDcl (_loc, name, [], ty, [])

(* defines the Ast.binding for a function of form:
let fun_name ?(opt_arg1) ?(opt_arg2) ident1 ident2 = function_body ...
*)
let function_with_label_args _loc ~fun_name ~idents ~function_body ~return_type opt_args =
   let opt_args = opt_args @ (List.map (fun x -> <:patt< $lid:x$ >>) idents) in
   <:binding< $lid:fun_name$ = 
      $List.fold_right (fun b a ->
        <:expr<fun $b$ -> $a$ >>
       ) opt_args <:expr< ( $function_body$ : $return_type$ ) >>
      $ >>

(* convert a list of bindings into an expr fragment:
   let x = 1 in y = 2 in z = 3 in ()
*)
let biList_to_expr _loc bindings final =
  List.fold_right (fun b a -> 
    <:expr< let $b$ in $a$ >>
  ) bindings final

(* build something like 'f ?x1 ?x2 ?x3 ... xn' *)
let apply _loc f label_args =
  let make x = Ast.ExId (_loc, Ast.IdLid (_loc, x)) in
  let make_label x = Ast.ExOlb (_loc, x, Ast.ExNil _loc) in
  let rec aux = function
  | []   -> make f
  | h::t -> Ast.ExApp (_loc, aux t , make_label h) in
  aux (List.rev label_args)

let access_array _loc a i =
  let make x = Ast.ExId (_loc, Ast.IdLid (_loc, x)) in
  Ast.ExAre (_loc, make a, Ast.ExInt (_loc, string_of_int i))

(* List.map with the integer position passed to the function *)
let mapi fn =
  let pos = ref 0 in
  List.map (fun x ->
    incr pos;
    fn !pos x
  ) 
    
open Sql_types

(* declare the types used to pass SQL objects back and forth *)
let construct_typedefs env =
  let _loc = Loc.ghost in

  let tables = exposed_tables env in
  let nlit = tables_no_list_item env in

  let id_decl =
    let ids = List.flatten (List.map (fun t -> [
      <:ctyp< $lid:tidfn t$ : $uid:whashfn t$.t int64 >> ;
      <:ctyp< $lid:tridfn t$ : $uid:rhashfn t$.t $ctyp_of_table t$ >> 
    ]) nlit) in
   declare_type _loc "_cache" <:ctyp< { $tySem_of_list ids$ } >>
  in

  let id_new = 
    let ids = List.flatten (List.map (fun t -> [
      <:rec_binding< $lid:tidfn t$ = $uid:whashfn t$.create 1 >> ;
      <:rec_binding< $lid:tridfn t$ = $uid:rhashfn t$.create 1 >>;
     ]) nlit) in
    <:binding< _cache_new () = { $rbSem_of_list ids$ } >>
  in

  let wh_decls = List.map (fun t ->
    <:str_item< 
      module $uid:whashfn t$ = Weaktbl.Make (
          struct 
            type t = $ctyp_of_table t$;
            value equal = ( == );
            value compare = ( == );
            value hash = Hashtbl.hash;
          end );
      module $uid:rhashfn t$ = Weaktbl.Make (
          struct
            type t = int64;
            value equal = (=);
            value compare = Int64.compare;
            value hash = Hashtbl.hash;
          end );
    >>
  ) nlit in

  let cache_decls =
    let sum_type = List.flatten (List.map (fun t ->
      [ (_loc, (fcachefn t), [ ]) ;  (* Full cache entry C_t *)
      ]
    ) nlit)
    in
    let sum_type =
      if List.length sum_type = 1 then
        <:ctyp< $lid:(List.hd tables).t_name$ >>
      else
        <:ctyp< [ $sum_type_of_list sum_type$ ] >> in
      declare_type _loc "cache_elt" sum_type in
<commit_msg>fix the generate of cache elements<commit_after>(*pp camlp4orf *)

open Printf
open Lexing

open Camlp4
open PreCast
open Ast
open Syntax
open Pa_type_conv

(* Extend grammar with options for SQL tables *)
let sql_parms = Gram.Entry.mk "sql_parms"
EXTEND Gram

GLOBAL: sql_parms;

svars: [
  [ l = LIST0 [ `LIDENT(x) -> x ] SEP "," -> l ]
];

param: [
  [ "unique"; ":"; x = svars -> x ]
];

sql_parms: [
  [ l = LIST0 [ param ] SEP ";" -> l ]
];

END

(* Begin implementation *)

(* convenience function to wrap the TyDcl constructor since I cant
   find an appropriate quotation to use for this *)
let declare_type _loc name ty =
  Ast.TyDcl (_loc, name, [], ty, [])

(* defines the Ast.binding for a function of form:
let fun_name ?(opt_arg1) ?(opt_arg2) ident1 ident2 = function_body ...
*)
let function_with_label_args _loc ~fun_name ~idents ~function_body ~return_type opt_args =
   let opt_args = opt_args @ (List.map (fun x -> <:patt< $lid:x$ >>) idents) in
   <:binding< $lid:fun_name$ = 
      $List.fold_right (fun b a ->
        <:expr<fun $b$ -> $a$ >>
       ) opt_args <:expr< ( $function_body$ : $return_type$ ) >>
      $ >>

(* convert a list of bindings into an expr fragment:
   let x = 1 in y = 2 in z = 3 in ()
*)
let biList_to_expr _loc bindings final =
  List.fold_right (fun b a -> 
    <:expr< let $b$ in $a$ >>
  ) bindings final

(* build something like 'f ?x1 ?x2 ?x3 ... xn' *)
let apply _loc f label_args =
  let make x = Ast.ExId (_loc, Ast.IdLid (_loc, x)) in
  let make_label x = Ast.ExOlb (_loc, x, Ast.ExNil _loc) in
  let rec aux = function
  | []   -> make f
  | h::t -> Ast.ExApp (_loc, aux t , make_label h) in
  aux (List.rev label_args)

let access_array _loc a i =
  let make x = Ast.ExId (_loc, Ast.IdLid (_loc, x)) in
  Ast.ExAre (_loc, make a, Ast.ExInt (_loc, string_of_int i))

(* List.map with the integer position passed to the function *)
let mapi fn =
  let pos = ref 0 in
  List.map (fun x ->
    incr pos;
    fn !pos x
  ) 
    
open Sql_types

(* declare the types used to pass SQL objects back and forth *)
let construct_typedefs env =
  let _loc = Loc.ghost in

  let tables = exposed_tables env in
  let nlit = tables_no_list_item env in

  let id_decl =
    let ids = List.flatten (List.map (fun t -> [
      <:ctyp< $lid:tidfn t$ : $uid:whashfn t$.t int64 >> ;
      <:ctyp< $lid:tridfn t$ : $uid:rhashfn t$.t $ctyp_of_table t$ >> 
    ]) nlit) in
   declare_type _loc "_cache" <:ctyp< { $tySem_of_list ids$ } >>
  in

  let id_new = 
    let ids = List.flatten (List.map (fun t -> [
      <:rec_binding< $lid:tidfn t$ = $uid:whashfn t$.create 1 >> ;
      <:rec_binding< $lid:tridfn t$ = $uid:rhashfn t$.create 1 >>;
     ]) nlit) in
    <:binding< _cache_new () = { $rbSem_of_list ids$ } >>
  in

  let wh_decls = List.map (fun t ->
    <:str_item< 
      module $uid:whashfn t$ = Weaktbl.Make (
          struct 
            type t = $ctyp_of_table t$;
            value equal = ( == );
            value compare = ( == );
            value hash = Hashtbl.hash;
          end );
      module $uid:rhashfn t$ = Weaktbl.Make (
          struct
            type t = int64;
            value equal = (=);
            value compare = Int64.compare;
            value hash = Hashtbl.hash;
          end );
    >>
  ) nlit in

  let cache_decls =
    let sum_type = List.flatten (List.map (fun t ->
      [ (_loc, (fcachefn t), [ ]) ;  (* Full cache entry C_t *)
      ]
    ) nlit)
    in
    let sum_type = <:ctyp< [ $sum_type_of_list sum_type$ ] >> in
    declare_type _loc "cache_elt" sum_type in

{'fraction_non_alphanumeric': 0.13492504164353136, 'fraction_numerical': 0.006524153248195447, 'mean_word_length': 2.4874152952565343, 'pattern_counts': {'":': 2, '<': 57, '<?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': '6834975', 'n_tokens_mistral': 2734, 'n_tokens_neox': 2671, 'n_words': 838}