@ -25,19 +25,12 @@ let get_existing_data source_file =
ResultsDatabase . with_registered_statement select_existing_statement ~ f : ( fun db stmt ->
SourceFile . SQLite . serialize source_file | > Sqlite3 . bind stmt 1
(* :source *)
| > SqliteUtils . check_sqlite_error db ~ log : " get_existing_data bind source file " ;
match Sqlite3 . step stmt with
| Sqlite3 . Rc . ROW ->
(* the operation returned a result, get it *)
| > SqliteUtils . check_result_code db ~ log : " get_existing_data bind source file " ;
SqliteUtils . result_option ~ finalize : false db ~ log : " looking for pre-existing cfgs " stmt
~ read_row : ( fun stmt ->
let cfgs = Sqlite3 . column stmt 0 | > Cfg . SQLite . deserialize
and tenv = Sqlite3 . column stmt 1 | > Tenv . SQLite . deserialize in
( match Sqlite3 . step stmt with DONE -> () | _ -> assert false ) ;
Some ( cfgs , tenv )
| DONE ->
None
| err ->
L . die InternalError " Looking for pre-existing cfgs: %s (%s) " ( Sqlite3 . Rc . to_string err )
( Sqlite3 . errmsg db ) )
( cfgs , tenv ) ) )
let add source_file cfg tenv =
@ -62,27 +55,30 @@ let add source_file cfg tenv =
ResultsDatabase . with_registered_statement store_statement ~ f : ( fun db store_stmt ->
SourceFile . SQLite . serialize source_file | > Sqlite3 . bind store_stmt 1
(* :source *)
| > SqliteUtils . check_ sqlite_error db ~ log : " store bind source file " ;
| > SqliteUtils . check_ result_code db ~ log : " store bind source file " ;
Cfg . SQLite . serialize cfg | > Sqlite3 . bind store_stmt 2
(* :cfg *)
| > SqliteUtils . check_ sqlite_error db ~ log : " store bind cfg " ;
| > SqliteUtils . check_ result_code db ~ log : " store bind cfg " ;
Tenv . SQLite . serialize tenv | > Sqlite3 . bind store_stmt 3
(* :tenv *)
| > SqliteUtils . check_ sqlite_error db ~ log : " store bind type environment " ;
| > SqliteUtils . check_ result_code db ~ log : " store bind type environment " ;
Cfg . get_all_proc_names cfg | > Typ . Procname . SQLiteList . serialize | > Sqlite3 . bind store_stmt 4
(* :proc_names *)
| > SqliteUtils . check_ sqlite_error db ~ log : " store bind proc names " ;
| > SqliteUtils . check_ result_code db ~ log : " store bind proc names " ;
Sqlite3 . bind store_stmt 5 ( Sqlite3 . Data . INT Int64 . one )
(* :freshly_captured *)
| > SqliteUtils . check_ sqlite_error db ~ log : " store freshness " ;
SqliteUtils . sqlite_unit_step ~ finalize : false ~ log : " Cfg.store " db store_stmt )
| > SqliteUtils . check_ result_code db ~ log : " store freshness " ;
SqliteUtils . result_unit ~ finalize : false ~ log : " Cfg.store " db store_stmt )
let get_all () =
let db = ResultsDatabase . get_database () in
(* we could also register this statement but it's typically used only once per run so just prepare
it inside the function * )
Sqlite3 . prepare db " SELECT source_file FROM source_files "
| > SqliteUtils . sqlite_result_rev_list_step db ~ log : " getting all source files "
| > List . map ~ f : SourceFile . SQLite . deserialize
| > IContainer . rev_map_to_list
~ fold : ( SqliteUtils . result_fold_single_column_rows db ~ log : " getting all source files " )
~ f : SourceFile . SQLite . deserialize
let load_proc_names_statement =
@ -93,9 +89,9 @@ let load_proc_names_statement =
let proc_names_of_source source =
ResultsDatabase . with_registered_statement load_proc_names_statement ~ f : ( fun db load_stmt ->
SourceFile . SQLite . serialize source | > Sqlite3 . bind load_stmt 1
| > SqliteUtils . check_ sqlite_error db ~ log : " load bind source file " ;
SqliteUtils . sqlite_result_step ~ finalize : false db ~ log : " SourceFiles.proc_names_of_source "
load_stmt
| > SqliteUtils . check_ result_code db ~ log : " load bind source file " ;
SqliteUtils . result_single_column_option ~ finalize : false db
~ log : " SourceFiles.proc_names_of_source " load_stmt
| > Option . value_map ~ default : [] ~ f : Typ . Procname . SQLiteList . deserialize )
@ -107,8 +103,9 @@ let is_captured source =
ResultsDatabase . with_registered_statement exists_source_statement ~ f : ( fun db exists_stmt ->
SourceFile . SQLite . serialize source | > Sqlite3 . bind exists_stmt 1
(* :k *)
| > SqliteUtils . check_sqlite_error db ~ log : " load captured source file " ;
SqliteUtils . sqlite_result_step ~ finalize : false ~ log : " SourceFiles.is_captured " db exists_stmt
| > SqliteUtils . check_result_code db ~ log : " load captured source file " ;
SqliteUtils . result_single_column_option ~ finalize : false ~ log : " SourceFiles.is_captured " db
exists_stmt
| > Option . is_some )
@ -118,7 +115,7 @@ let is_non_empty_statement =
let is_empty () =
ResultsDatabase . with_registered_statement is_non_empty_statement ~ f : ( fun db stmt ->
SqliteUtils . sqlite_result_step ~ finalize : false ~ log : " SourceFiles.is_empty " db stmt
SqliteUtils . result_single_column_option ~ finalize : false ~ log : " SourceFiles.is_empty " db stmt
| > Option . is_none )
@ -135,9 +132,9 @@ let deserialize_freshly_captured = function[@warning "-8"]
let is_freshly_captured source =
ResultsDatabase . with_registered_statement is_freshly_captured_statement ~ f : ( fun db load_stmt ->
SourceFile . SQLite . serialize source | > Sqlite3 . bind load_stmt 1
| > SqliteUtils . check_ sqlite_error db ~ log : " load bind source file " ;
SqliteUtils . sqlite_result_step ~ finalize : false ~ log : " SourceFiles.is_freshly_captured " db
load_stmt
| > SqliteUtils . check_ result_code db ~ log : " load bind source file " ;
SqliteUtils . result_single_column_option ~ finalize : false
~ log : " SourceFiles.is_freshly_captured " db load_stmt
| > Option . value_map ~ default : false ~ f : deserialize_freshly_captured )
@ -147,7 +144,7 @@ let mark_all_stale_statement =
let mark_all_stale () =
ResultsDatabase . with_registered_statement mark_all_stale_statement ~ f : ( fun db stmt ->
SqliteUtils . sqlite_unit_step db ~ finalize : false ~ log : " mark_all_stale " stmt )
SqliteUtils . result_unit db ~ finalize : false ~ log : " mark_all_stale " stmt )
let select_all_source_files_statement =
@ -156,38 +153,35 @@ let select_all_source_files_statement =
let pp_all ? filter ~ cfgs ~ type_environment ~ procedure_names ~ freshly_captured fmt () =
let filter = Staged . unstage ( Filtering . mk_source_file_filter ~ filter ) in
ResultsDatabase . with_registered_statement select_all_source_files_statement ~ f : ( fun db stmt ->
let pp_procnames fmt procs =
F . fprintf fmt " @[<v> " ;
List . iter ~ f : ( F . fprintf fmt " %a@, " Typ . Procname . pp ) procs ;
F . fprintf fmt " @] "
in
let pp_if title condition deserialize pp fmt column =
let pp_if stmt title condition deserialize pp fmt column =
if condition then
F . fprintf fmt " @[<v2>%s@,%a@]@; " title pp ( Sqlite3 . column stmt column | > deserialize )
in
let pp_row fmt source_file =
let pp_row stmt fmt source_file =
F . fprintf fmt " %a@,%a%a%a%a " SourceFile . pp source_file
( pp_if " cfgs " cfgs Cfg . SQLite . deserialize Cfg . pp_proc_signatures )
( pp_if stmt " cfgs " cfgs Cfg . SQLite . deserialize Cfg . pp_proc_signatures )
1
( pp_if " type_environment " type_environment Tenv . SQLite . deserialize Tenv . pp_per_file )
( pp_if stmt " type_environment " type_environment Tenv . SQLite . deserialize Tenv . pp_per_file )
2
( pp_if " procedure_names " procedure_names Typ . Procname . SQLiteList . deserialize pp_procnames )
( pp_if stmt " procedure_names " procedure_names Typ . Procname . SQLiteList . deserialize
pp_procnames )
3
( pp_if " freshly_captured " freshly_captured deserialize_freshly_captured
( pp_if stmt " freshly_captured " freshly_captured deserialize_freshly_captured
Format . pp_print_bool )
4
in
let rec aux fmt () =
match Sqlite3 . step stmt with
| Sqlite3 . Rc . ROW ->
let source_file = Sqlite3 . column stmt 0 | > SourceFile . SQLite . deserialize in
if filter source_file then pp_row fmt source_file ;
aux fmt ()
| DONE ->
()
| err ->
L . die InternalError " source_files_iter: %s (%s) " ( Sqlite3 . Rc . to_string err )
( Sqlite3 . errmsg db )
ResultsDatabase . with_registered_statement select_all_source_files_statement ~ f : ( fun db stmt ->
let pp fmt column =
let source_file = SourceFile . SQLite . deserialize column in
if filter source_file then pp_row stmt fmt source_file
in
let pp_result fmt stmt =
Container . iter stmt ~ f : ( pp fmt )
~ fold : ( SqliteUtils . result_fold_single_column_rows db ~ log : " printing all source files " )
in
F ormat . fprintf fmt " @[<v>%a@] " aux () )
F . fprintf fmt " @[<v>%a@] " pp_result stmt )