<commit_before>(*pp camlp4orf *)
(*
 * Copyright (c) 2009-2010
 *     <NAME> <<EMAIL>>
 *     <NAME> <<EMAIL>>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Camlp4
open PreCast
open Ast

open P4_utils

let init n   = n ^ "_init"
let initRO n = n ^ "_init_read_only"
let save n   = n ^ "_save"
let get n    = n ^ "_get"
let delete n = n ^ "_delete"
let id n     = n ^ "_id"
let cache n  = n ^ "_cache"

let env_to_env _loc env =
	let sl_of_sl sl = 
		expr_list_of_list _loc (List.map (fun s -> <:expr< $str:s$ >>) sl) in
	let aux = function
		| `Unique l -> <:expr< `Unique $expr_list_of_list _loc (List.map (fun (x,y) -> <:expr< ($str:x$, $sl_of_sl y$) >>) l)$ >>
		| `Index l  -> <:expr< `Index $expr_list_of_list _loc (List.map (fun (x,y) -> <:expr< ($str:x$, $sl_of_sl y$) >>) l)$ >>
		| `Debug l  -> <:expr< `Debug $sl_of_sl l$ >>
		| `Dot f    -> <:expr< `Dot $str:f$ >> in
	expr_list_of_list _loc (List.map aux env)

let init_binding env tds (_loc, n, t) =
	<:binding< $lid:init n$ =
	fun __file__ ->
		let __file__ = OI.realpath __file__ in
		let __db__ = OB.new_state __file__ in
		let () = if not (OI.database_exists ~env:__env__ ~db:__db__) then OC.flush_all __env__ __file__ else () in
		let () = OI.init_tables ~mode:`RW ~env:__env__ ~db:__db__ $lid:P4_type.type_of n$ in
		let () = List.iter (OC.Trigger.create_function ~env:__env__ ~db:__db__) (Type.foreigns $lid:P4_type.type_of n$) in
		__db__
	>>

let initRO_binding env tds (_loc, n, t) =
	<:binding< $lid:initRO n$ =
	fun __file__ ->
		let __file__ = OI.realpath __file__ in
		let __db__ = OB.new_state __file__ in
		let () = if not (OI.database_exists ~env:__env__ ~db:__db__) then OC.flush_all __env__ __file__ else () in
		let () = OI.init_tables ~mode:`RO ~env:__env__ ~db:__db__ $lid:P4_type.type_of n$ in
		let () = List.iter (OC.Trigger.create_function ~env:__env__ ~db:__db__) (Type.foreigns $lid:P4_type.type_of n$) in
		__db__
	>>

let save_binding env tds (_loc, n, t) =
	<:binding< $lid:save n$ =
	let __get_id__ __name__ =
		let __db__ = OB.new_state __name__ in
		fun __v__ ->
			if OC.mem __env__ $lid:cache n$ __name__ __v__ then
				OC.to_weakid __env__ $lid:cache n$ __name__ __v__
			else (
				let __id__ = OS.empty_row ~env:__env__ ~db:__db__ $str:n$ in
				do { OC.add __env__ $lid:cache n$ __name__ __v__ __id__; __id__ }
			) in
	let () = $lid:P4_value.set_new_id n$ __get_id__ in
	if Type.is_mutable $lid:P4_type.type_of n$ then (
		fun ~db: __db__ ->
			fun $lid:n$ ->
				let v = $lid:P4_value.value_of n$ ~key:__db__.OB.name $lid:n$ in
				let () = Printf.printf "saving(m): %s\n%!" (Value.to_string v) in
				OS.update_value ~env:__env__ ~db:__db__ v
    ) else (
		fun ~db:__db__ ->
			fun $lid:n$ ->
				if not (OC.mem __env__ $lid:cache n$ __db__.OB.name $lid:n$) then (
					let v = $lid:P4_value.value_of n$ ~key:__db__.OB.name $lid:n$ in
					let () = Printf.printf "saving(i): %s\n%!" (Value.to_string v) in
					OS.update_value ~env:__env__ ~db:__db__ v
				) else ()
    )
	>> 

module Get = struct
	(* This type is computed at preprocessing time, so no information is available on the external type variabales *)
	let pp_type_of _loc tds name =
		let tys = P4_type.create tds in
		let _, _, t = List.find (fun (_, n, _) -> n = name) tys in
		t

	let map_type fn t =
		let module T = Type in
		let rec aux name accu t =
			(match fn name t with None -> [] | Some r -> [r])
			@ match t with
				| T.Unit | T.Sum _ | T.Var _ | T.Arrow _
				| T.Bool | T.Float | T.Char | T.String | T.Int _ | T.Option _ | T.Enum _
					-> accu
				| T.Dict d when name = []
					-> List.fold_left (fun accu (n,_,t) -> aux [n] accu t) accu d
				| T.Dict _  -> accu<commit_msg>[lib] remove debug messages.<commit_after>(*pp camlp4orf *)
(*
 * Copyright (c) 2009-2010
 *     <NAME> <<EMAIL>>
 *     <NAME> <<EMAIL>>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Camlp4
open PreCast
open Ast

open P4_utils

let init n   = n ^ "_init"
let initRO n = n ^ "_init_read_only"
let save n   = n ^ "_save"
let get n    = n ^ "_get"
let delete n = n ^ "_delete"
let id n     = n ^ "_id"
let cache n  = n ^ "_cache"

let env_to_env _loc env =
	let sl_of_sl sl = 
		expr_list_of_list _loc (List.map (fun s -> <:expr< $str:s$ >>) sl) in
	let aux = function
		| `Unique l -> <:expr< `Unique $expr_list_of_list _loc (List.map (fun (x,y) -> <:expr< ($str:x$, $sl_of_sl y$) >>) l)$ >>
		| `Index l  -> <:expr< `Index $expr_list_of_list _loc (List.map (fun (x,y) -> <:expr< ($str:x$, $sl_of_sl y$) >>) l)$ >>
		| `Debug l  -> <:expr< `Debug $sl_of_sl l$ >>
		| `Dot f    -> <:expr< `Dot $str:f$ >> in
	expr_list_of_list _loc (List.map aux env)

let init_binding env tds (_loc, n, t) =
	<:binding< $lid:init n$ =
	fun __file__ ->
		let __file__ = OI.realpath __file__ in
		let __db__ = OB.new_state __file__ in
		let () = if not (OI.database_exists ~env:__env__ ~db:__db__) then OC.flush_all __env__ __file__ else () in
		let () = OI.init_tables ~mode:`RW ~env:__env__ ~db:__db__ $lid:P4_type.type_of n$ in
		let () = List.iter (OC.Trigger.create_function ~env:__env__ ~db:__db__) (Type.foreigns $lid:P4_type.type_of n$) in
		__db__
	>>

let initRO_binding env tds (_loc, n, t) =
	<:binding< $lid:initRO n$ =
	fun __file__ ->
		let __file__ = OI.realpath __file__ in
		let __db__ = OB.new_state __file__ in
		let () = if not (OI.database_exists ~env:__env__ ~db:__db__) then OC.flush_all __env__ __file__ else () in
		let () = OI.init_tables ~mode:`RO ~env:__env__ ~db:__db__ $lid:P4_type.type_of n$ in
		let () = List.iter (OC.Trigger.create_function ~env:__env__ ~db:__db__) (Type.foreigns $lid:P4_type.type_of n$) in
		__db__
	>>

let save_binding env tds (_loc, n, t) =
	<:binding< $lid:save n$ =
	let __get_id__ __name__ =
		let __db__ = OB.new_state __name__ in
		fun __v__ ->
			if OC.mem __env__ $lid:cache n$ __name__ __v__ then
				OC.to_weakid __env__ $lid:cache n$ __name__ __v__
			else (
				let __id__ = OS.empty_row ~env:__env__ ~db:__db__ $str:n$ in
				do { OC.add __env__ $lid:cache n$ __name__ __v__ __id__; __id__ }
			) in
	let () = $lid:P4_value.set_new_id n$ __get_id__ in
	if Type.is_mutable $lid:P4_type.type_of n$ then (
		fun ~db: __db__ ->
			fun $lid:n$ ->
				let v = $lid:P4_value.value_of n$ ~key:__db__.OB.name $lid:n$ in
				OS.update_value ~env:__env__ ~db:__db__ v
    ) else (
		fun ~db:__db__ ->
			fun $lid:n$ ->
				if not (OC.mem __env__ $lid:cache n$ __db__.OB.name $lid:n$) then (
					let v = $lid:P4_value.value_of n$ ~key:__db__.OB.name $lid:n$ in
					OS.update_value ~env:__env__ ~db:__db__ v
				) else ()
    )
	>> 

module Get = struct
	(* This type is computed at preprocessing time, so no information is available on the external type variabales *)
	let pp_type_of _loc tds name =
		let tys = P4_type.create tds in
		let _, _, t = List.find (fun (_, n, _) -> n = name) tys in
		t

	let map_type fn t =
		let module T = Type in
		let rec aux name accu t =
			(match fn name t with None -> [] | Some r -> [r])
			@ match t with
				| T.Unit | T.Sum _ | T.Var _ | T.Arrow _
				| T.Bool | T.Float | T.Char | T.String | T.Int _ | T.Option _ | T.Enum _
					-> accu
				| T.Dict d when name = []
					-> List.fold_left (fun accu (n,_,t) -> aux [n] accu t) accu d
				| T.Dict _  -> accu
{'fraction_non_alphanumeric': 0.1311990686845169, 'fraction_numerical': 0.004656577415599534, 'mean_word_length': 3.2955, 'pattern_counts': {'":': 0, '<': 55, '<?xml version=': 0, '>': 97, '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': '617735', 'n_tokens_mistral': 3629, 'n_tokens_neox': 3370, 'n_words': 1076}