Skip to content

Commit

Permalink
Save and get lists by chunks of 64 elements (as it seems to be the ma…
Browse files Browse the repository at this point in the history 
…ximum number of JOINs for a select query)
  • Loading branch information
@samoht
samoht committed Nov 8, 2010
1 parent b35578f commit 3a6a7a7
Show file tree
Hide file tree
Showing 4 changed files with 155 additions and 55 deletions.
3 changes: 3 additions & 0 deletions lib/sql_backend.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,9 @@
open Sqlite3
open Printf

(* Maximum number of JOINS *)
let max_join = 64

type transaction_mode = [ `Deferred |`Immediate |`Exclusive ]

type state = {
Expand Down
101 changes: 64 additions & 37 deletions lib/sql_get.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -153,41 +153,68 @@ and get_enum_values ~env ~db ~id name t =
let row = row_data stmt in
let id = match row.(0) with Data.INT i -> i | s -> process_error t s "__id__" in
let next = match row.(1) with Data.INT i -> Some i | Data.NULL -> None | s -> process_error t s "__next__" in
let size = match row.(2) with Data.INT i -> Int64.to_int i | s -> process_error t s "__size__" in
let v, _ = parse_row ~env ~db ~skip:false ~name t row 3 in
id, next, size, v in
let constraints = [ "__id__", "=", Some (Data.INT id) ] in
let field_names = "__id__" :: "__next__" :: "__size__" :: field_names_of_type ~id:false t in
match process ~env ~db ~constraints name field_names aux with
| [ _ , None , _ , v ] -> [ v ]
| [ id, Some next, size, _ ] ->
let rec joints i =
if i = 0
then sprintf "%s AS __t0__" name :: joints (i+1)
else if i > size
then []
else sprintf "%s AS __t%i__ ON __t%i__.__next__=__t%i__.__id__" name i (i-1) i :: joints (i+1) in
let names = field_names_of_type ~id:false t in
let rec field_names i =
if i = (-1)
then []
else field_names (i-1) @ List.map (fun f -> sprintf "__t%i__.%s" i f) names in
let table_name = String.concat " JOIN " (joints 0) in
let constraints = [ (sprintf "__t%i__.__next__" size, "ISNULL", None) ; ("__t0__.__id__","=", Some (Data.INT id)) ] in
let fn stmt =
let row = row_data stmt in
let rec aux n =
if n >= Array.length row
let next_chunk = match row.(2) with Data.INT i -> Some i | Data.NULL -> None | s -> process_error t s "__next_chunk__" in
let size = match row.(3) with Data.INT i -> Int64.to_int i | s -> process_error t s "__size__" in
let v, _ = parse_row ~env ~db ~skip:false ~name t row 4 in
id, next, next_chunk, size, v in

let get_chunk first_id =
let constraints = [ "__id__", "=", Some (Data.INT first_id) ] in
let field_names = "__id__" :: "__next__" :: "__next_chunk__" :: "__size__" :: field_names_of_type ~id:false t in
match process ~env ~db ~constraints name field_names aux with
| [ _ , None , None , _ , v ] -> None, [ v ]
| [ id, Some next, next_chunk, size, _ ] ->
let size = min size max_join in
let rec joints i =
if i = 0
then sprintf "%s AS __t0__" name :: joints (i+1)
else if i = size
then []
else
let v, m = parse_row ~env ~db ~skip:false ~name t row n in
v :: aux m in
aux 0 in
begin match process ~env ~db ~constraints table_name (field_names size) fn with
| [r] -> r
| [] -> process_error t Data.NULL "No result found"
| rs -> process_error t Data.NULL "Too many results found"
end
| l ->
let aux (id, next, size, v) = Printf.sprintf "(%Ld,%s,%i,%s)" id (match next with None -> "NULL" | Some n -> Int64.to_string n) size (Value.to_string v) in
process_error t Data.NULL (Printf.sprintf "get_enum_values{%s}" (String.concat ";" (List.map aux l)))
else sprintf "%s AS __t%i__ ON __t%i__.__next__=__t%i__.__id__" name i (i-1) i :: joints (i+1) in
let names = field_names_of_type ~id:false t in
let rec field_names i =
if i = size
then []
else List.map (fun f -> sprintf "__t%i__.%s" i f) names @ field_names (i+1) in
let table_name = String.concat " JOIN " (joints 0) in
let constraints = [
(match next_chunk with
| None -> sprintf "__t%i__.__next__" (size-1), "ISNULL", None;
| Some next_id -> sprintf "__t%i__.__next__" (size-1), "=" , Some (Data.INT next_id));
"__t0__.__id__","=", Some (Data.INT first_id);
] in
let fn stmt =
let row = row_data stmt in
let rec aux n =
if n >= Array.length row
then []
else
let v, m = parse_row ~env ~db ~skip:false ~name t row n in
v :: aux m in
aux 0 in
begin match process ~env ~db ~constraints table_name (field_names 0) fn with
| [r] -> next_chunk, r
| [] -> process_error t Data.NULL "No result found"
| rs -> process_error t Data.NULL "Too many results found"
end
| l ->
let aux (id, next, next_chunk, size, v) =
Printf.sprintf "(%Ld,%s,%s,%i,%s)"
id
(match next with None -> "NULL" | Some n -> Int64.to_string n)
(match next_chunk with None -> "NULL" | Some n -> Int64.to_string n)
size
(Value.to_string v) in
process_error t Data.NULL (Printf.sprintf "get_enum_values{%s}" (String.concat ";" (List.map aux l))) in

let result = ref [[]] in
let stop = ref false in
let first_id = ref id in
while not !stop do
let n, r = get_chunk !first_id in
(match n with
| None -> stop := true;
| Some k -> first_id := k);
result := r :: !result;
done;
List.concat (List.rev !result)
2 changes: 1 addition & 1 deletion lib/sql_init.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -86,7 +86,7 @@ let create_tables ~mode ~env ~db tables =
let field_names = field_names_of_type ~id:false t_internal in
let field_types = field_types_of_type ~id:false t_internal in
let fields = List.map2 (sprintf "%s %s") field_names field_types in
let extra = if is_enum t then "__next__ INTEGER,__size__ INTEGER," else "" in
let extra = if is_enum t then "__next__ INTEGER,__next_chunk__ INTEGER,__size__ INTEGER," else "" in
let sql =
sprintf "CREATE TABLE IF NOT EXISTS %s (__id__ INTEGER PRIMARY KEY AUTOINCREMENT, %s%s);" name extra (String.concat "," fields) in
exec_sql ~env ~db sql [] (db_must_step db);
Expand Down
104 changes: 87 additions & 17 deletions lib/sql_save.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -61,35 +61,105 @@ let process_row ~env ~db table_name field_names field_values v =
| [] -> exec_sql ~env ~db insert field_values (db_must_step db); last_insert_rowid db.db
| ds -> process_error v (sprintf "Found {%s}" (String.concat "," (List.map string_of_data ds)))

(* Cut a list into chunks of size [chunk_size] *)
(* The result is in the reverse order *)
let cut_into_chunks chunk_size l =
let rec aux chunks n accu = function
| [] -> (List.rev accu) :: chunks
| h::t ->
if n mod chunk_size = 0 then
aux ((List.rev (h :: accu)) :: chunks) (n+1) [] t
else
aux chunks (n+1) (h :: accu) t in
aux [] 1 [] l


(*
let _ =
cut_into_chunks 3 [1;2;3;4;5;6;7;8]
*)

let combine chunks =
let rec one list accu (a,b) = match list with
| (c,d)::t when b=c -> one t ((a,d)::accu) (a,b)
| _ :: t -> one t accu (a,b)
| [] -> accu in
let rec merge l1 l2 =
List.fold_left (one l2) [] l1 in
let rec aux = function
| [] -> []
| [l] -> l
| l1::l2::t -> aux ((merge l1 l2)::t) in
aux chunks

(*
let _ =
combine [
[ (1,2); (1,3) ];
[ (2,4); (3,5); (5,6); ];
[ (4,5); (5,6); (7,8); ];
]
*)

(* Insert a collection of rows in a specific table *)
let process_enum_rows ~env ~db table_name field_names field_values_enum v =
let join =
sprintf "%s as __t0__" table_name ::
list_mapi (fun i _ -> sprintf "%s AS __t%i__ ON __t%i__.__next__=__t%i__.__id__" table_name (i+1) i (i+1)) (List.tl field_values_enum) in

let get_chunk chunk next_chunks =
let join =
sprintf "%s as __t0__" table_name ::
list_mapi (fun i _ -> sprintf "%s AS __t%i__ ON __t%i__.__next__=__t%i__.__id__" table_name (i+1) i (i+1)) (List.tl chunk) in
let constraints =
List.flatten (list_mapi (fun i _ -> List.map (fun f -> sprintf "__t%i__.%s=?" i f) field_names) field_values_enum) in
List.flatten (list_mapi (fun i _ -> List.map (fun f -> sprintf "__t%i__.%s=?" i f) field_names) chunk)
@ (match next_chunks with
| [] -> [sprintf "__t%i__.__next__ ISNULL" (List.length chunk - 1)]
| l -> [sprintf "(%s)" (String.concat " OR " (List.map (sprintf "__t%i__.__next__ = %Ld" (List.length chunk - 1)) l))]) in
let binds =
List.flatten field_values_enum in
let select = sprintf "SELECT __t0__.__id__ FROM %s WHERE __t%i__.__next__ ISNULL AND %s;"
List.flatten chunk in
let select = sprintf "SELECT __t0__.__id__ FROM %s WHERE %s;"
(String.concat " JOIN " join)
(List.length field_values_enum - 1)
(String.concat " AND " constraints) in
let fn stmt = step_map db stmt (fun stmt -> column stmt 0) in
match exec_sql ~env ~db select binds fn with
| [Data.INT i ] -> i
| [] ->
let rec aux ?last i = function
| [] -> (match last with None -> process_error v "Empy enum" | Some id -> id)
| [] -> raise Not_found
| l -> List.map (function Data.INT i -> i | k -> process_error v "get_chunk") l in

let get_by_chunks () =
let next_chunks = ref [] in
let chunks = Array.of_list (cut_into_chunks max_join field_values_enum) in
try
for i = 0 to Array.length chunks - 1 do
next_chunks := get_chunk chunks.(i) !next_chunks;
done;
!next_chunks
with _ -> [] in

(* The array is in reverse order *)
let ids = Array.create (List.length field_values_enum) (-1L) in
let get_id n =
if n < 0 then
Data.NULL
else
Data.INT ids.(n) in
let first () =
match ids.(List.length field_values_enum - 1) with
| -1L -> process_error v "Empy enum"
| i -> i in

match get_by_chunks () with
| [i] -> i
| [] ->
let rec save i = function
| [] -> first ()
| field_values :: t ->
let last = match last with None -> Data.NULL | Some id -> Data.INT id in
let id = process_row ~env ~db
table_name
("__next__" :: "__size__" :: field_names)
(last :: Data.INT (Int64.of_int i) :: field_values)
("__next__" :: "__next_chunk__" :: "__size__" :: field_names)
(get_id (i-1) :: get_id (i-max_join) :: Data.INT (Int64.of_int (i+1)) :: field_values)
v in
aux ~last:id (i+1) t in
aux 0 (List.rev field_values_enum)
| ds -> process_error v (sprintf "Found {%s}" (String.concat "," (List.map string_of_data ds)))
ids.(i) <- id;
save (i+1) t in
save 0 (List.rev field_values_enum)
| ds -> process_error v (sprintf "Found {%s}" (String.concat "," (List.map Int64.to_string ds)))

let rec value_of_field ~env ~db name v =
match v with
Expand Down

0 comments on commit 3a6a7a7

Please sign in to comment.