@ -31,36 +31,38 @@ module Implementation = struct
ResultsDatabase . register_statement
ResultsDatabase . register_statement
{ |
{ |
INSERT OR REPLACE INTO procedures
INSERT OR REPLACE INTO procedures
SELECT : pname, : proc_name_hum , : akind , : sfile , : pattr , : cfg , : callees
SELECT : uid, : pname, : proc_name_hum , : akind , : sfile , : pattr , : cfg , : callees
FROM (
FROM (
SELECT NULL
SELECT NULL
FROM (
FROM (
SELECT COALESCE ( MAX ( attr_kind ) , - 1 ) AS attr_kind ,
SELECT COALESCE ( MAX ( attr_kind ) , - 1 ) AS attr_kind ,
COALESCE ( MAX ( source_file ) , " " ) AS source_file
COALESCE ( MAX ( source_file ) , " " ) AS source_file
FROM procedures
FROM procedures
WHERE proc_ name = : pname )
WHERE proc_ uid = : uid )
WHERE attr_kind < : akind
WHERE attr_kind < : akind
OR ( attr_kind = : akind AND source_file < = : sfile ) )
OR ( attr_kind = : akind AND source_file < = : sfile ) )
| }
| }
in
in
fun ~ p name_str ~ p name ~ a kind ~ source_file ~ attributes ~ proc_desc ~ callees ->
fun ~ p roc_uid ~ proc_ name ~ p roc_ name_hum ~ a ttr_ kind ~ source_file ~ proc_attributes ~ cfg ~ callees ->
ResultsDatabase . with_registered_statement attribute_replace_statement
ResultsDatabase . with_registered_statement attribute_replace_statement
~ f : ( fun db replace_stmt ->
~ f : ( fun db replace_stmt ->
Sqlite3 . bind replace_stmt 1 (* :pname *) pname
Sqlite3 . bind replace_stmt 1 (* :proc_uid *) ( Sqlite3 . Data . TEXT proc_uid )
| > SqliteUtils . check_result_code db ~ log : " replace bind pname " ;
| > SqliteUtils . check_result_code db ~ log : " replace bind proc_uid " ;
Sqlite3 . bind replace_stmt 2 (* :proc_name_hum *) ( Sqlite3 . Data . TEXT pname_str )
Sqlite3 . bind replace_stmt 2 (* :pname *) proc_name
| > SqliteUtils . check_result_code db ~ log : " replace bind proc_name " ;
Sqlite3 . bind replace_stmt 3 (* :proc_name_hum *) ( Sqlite3 . Data . TEXT proc_name_hum )
| > SqliteUtils . check_result_code db ~ log : " replace bind proc_name_hum " ;
| > SqliteUtils . check_result_code db ~ log : " replace bind proc_name_hum " ;
Sqlite3 . bind replace_stmt 3 (* :akind *) ( Sqlite3 . Data . INT akind )
Sqlite3 . bind replace_stmt 4 (* :akind *) ( Sqlite3 . Data . INT a ttr_ kind)
| > SqliteUtils . check_result_code db ~ log : " replace bind attr ibute kind" ;
| > SqliteUtils . check_result_code db ~ log : " replace bind attr _ kind" ;
Sqlite3 . bind replace_stmt 4 (* :sfile *) source_file
Sqlite3 . bind replace_stmt 5 (* :sfile *) source_file
| > SqliteUtils . check_result_code db ~ log : " replace bind source file" ;
| > SqliteUtils . check_result_code db ~ log : " replace bind source source_ file" ;
Sqlite3 . bind replace_stmt 5 (* :pattr *) attributes
Sqlite3 . bind replace_stmt 6 (* :pattr *) proc_ attributes
| > SqliteUtils . check_result_code db ~ log : " replace bind proc attributes" ;
| > SqliteUtils . check_result_code db ~ log : " replace bind proc proc_ attributes" ;
Sqlite3 . bind replace_stmt 6 (* :cfg *) proc_desc
Sqlite3 . bind replace_stmt 7 (* :cfg *) cfg
| > SqliteUtils . check_result_code db ~ log : " replace bind cfg " ;
| > SqliteUtils . check_result_code db ~ log : " replace bind cfg " ;
Sqlite3 . bind replace_stmt 7 (* :callees *) callees
Sqlite3 . bind replace_stmt 8 (* :callees *) callees
| > SqliteUtils . check_result_code db ~ log : " replace bind callees " ;
| > SqliteUtils . check_result_code db ~ log : " replace bind callees " ;
SqliteUtils . result_unit db ~ finalize : false ~ log : " Attributes.replace " replace_stmt )
SqliteUtils . result_unit db ~ finalize : false ~ log : " replace_attributes " replace_stmt )
let add_source_file =
let add_source_file =
@ -108,6 +110,7 @@ module Implementation = struct
{ |
{ |
INSERT OR REPLACE INTO memdb . procedures
INSERT OR REPLACE INTO memdb . procedures
SELECT
SELECT
sub . proc_uid ,
sub . proc_name ,
sub . proc_name ,
sub . proc_name_hum ,
sub . proc_name_hum ,
sub . attr_kind ,
sub . attr_kind ,
@ -118,7 +121,7 @@ module Implementation = struct
FROM (
FROM (
attached . procedures AS sub
attached . procedures AS sub
LEFT OUTER JOIN memdb . procedures AS main
LEFT OUTER JOIN memdb . procedures AS main
ON sub . proc_ name = main . proc_name )
ON sub . proc_ uid = main . proc_uid )
WHERE
WHERE
main . attr_kind IS NULL
main . attr_kind IS NULL
OR main . attr_kind < sub . attr_kind
OR main . attr_kind < sub . attr_kind
@ -180,27 +183,32 @@ module Implementation = struct
let store_spec =
let store_spec =
let store_statement =
let store_statement =
ResultsDatabase . register_statement
ResultsDatabase . register_statement
" INSERT OR REPLACE INTO specs VALUES (:proc_name, :analysis_summary, :report_summary) "
{ |
INSERT OR REPLACE INTO specs
VALUES ( : proc_uid , : proc_name , : analysis_summary , : report_summary )
| }
in
in
fun ~ proc_name ~ analysis_summary ~ report_summary ->
fun ~ proc_ uid ~ proc_ name ~ analysis_summary ~ report_summary ->
ResultsDatabase . with_registered_statement store_statement ~ f : ( fun db store_stmt ->
ResultsDatabase . with_registered_statement store_statement ~ f : ( fun db store_stmt ->
Sqlite3 . bind store_stmt 1 proc_name
Sqlite3 . bind store_stmt 1 ( Sqlite3 . Data . TEXT proc_uid )
| > SqliteUtils . check_result_code db ~ log : " store spec bind proc_uid " ;
Sqlite3 . bind store_stmt 2 proc_name
| > SqliteUtils . check_result_code db ~ log : " store spec bind proc_name " ;
| > SqliteUtils . check_result_code db ~ log : " store spec bind proc_name " ;
Sqlite3 . bind store_stmt 2 analysis_summary
Sqlite3 . bind store_stmt 3 analysis_summary
| > SqliteUtils . check_result_code db ~ log : " store spec bind analysis_summary " ;
| > SqliteUtils . check_result_code db ~ log : " store spec bind analysis_summary " ;
Sqlite3 . bind store_stmt 3 report_summary
Sqlite3 . bind store_stmt 4 report_summary
| > SqliteUtils . check_result_code db ~ log : " store spec bind report_summary " ;
| > SqliteUtils . check_result_code db ~ log : " store spec bind report_summary " ;
SqliteUtils . result_unit ~ finalize : false ~ log : " store spec " db store_stmt )
SqliteUtils . result_unit ~ finalize : false ~ log : " store spec " db store_stmt )
let delete_spec =
let delete_spec =
let delete_statement =
let delete_statement =
ResultsDatabase . register_statement " DELETE FROM specs WHERE proc_ name = :k"
ResultsDatabase . register_statement " DELETE FROM specs WHERE proc_ uid = :k"
in
in
fun ~ proc_ name ->
fun ~ proc_ uid ->
ResultsDatabase . with_registered_statement delete_statement ~ f : ( fun db delete_stmt ->
ResultsDatabase . with_registered_statement delete_statement ~ f : ( fun db delete_stmt ->
Sqlite3 . bind delete_stmt 1 proc_name
Sqlite3 . bind delete_stmt 1 ( Sqlite3 . Data . TEXT proc_uid )
| > SqliteUtils . check_result_code db ~ log : " delete spec bind proc_ name " ;
| > SqliteUtils . check_result_code db ~ log : " delete spec bind proc_ uid " ;
SqliteUtils . result_unit ~ finalize : false ~ log : " store spec " db delete_stmt )
SqliteUtils . result_unit ~ finalize : false ~ log : " store spec " db delete_stmt )
@ -217,19 +225,23 @@ module Command = struct
; integer_type_widths : Sqlite3 . Data . t
; integer_type_widths : Sqlite3 . Data . t
; proc_names : Sqlite3 . Data . t }
; proc_names : Sqlite3 . Data . t }
| DeleteAllSpecs
| DeleteAllSpecs
| DeleteSpec of { proc_ name: Sqlite3 . Data . t }
| DeleteSpec of { proc_ uid: string }
| Handshake
| Handshake
| MarkAllSourceFilesStale
| MarkAllSourceFilesStale
| Merge of { infer_deps_file : string }
| Merge of { infer_deps_file : string }
| StoreSpec of
| StoreSpec of
{ proc_name : Sqlite3 . Data . t ; analysis_summary : Sqlite3 . Data . t ; report_summary : Sqlite3 . Data . t }
{ proc_uid : string
; proc_name : Sqlite3 . Data . t
; analysis_summary : Sqlite3 . Data . t
; report_summary : Sqlite3 . Data . t }
| ReplaceAttributes of
| ReplaceAttributes of
{ pname_str : string
{ proc_uid : string
; pname : Sqlite3 . Data . t
; proc_name : Sqlite3 . Data . t
; akind : int64
; proc_name_hum : string
; attr_kind : int64
; source_file : Sqlite3 . Data . t
; source_file : Sqlite3 . Data . t
; attributes: Sqlite3 . Data . t
; proc_ attributes: Sqlite3 . Data . t
; proc_desc : Sqlite3 . Data . t
; cfg : Sqlite3 . Data . t
; callees : Sqlite3 . Data . t }
; callees : Sqlite3 . Data . t }
| ResetCaptureTables
| ResetCaptureTables
| Terminate
| Terminate
@ -267,19 +279,21 @@ module Command = struct
Implementation . add_source_file ~ source_file ~ tenv ~ integer_type_widths ~ proc_names
Implementation . add_source_file ~ source_file ~ tenv ~ integer_type_widths ~ proc_names
| DeleteAllSpecs ->
| DeleteAllSpecs ->
Implementation . delete_all_specs ()
Implementation . delete_all_specs ()
| DeleteSpec { proc_ name } ->
| DeleteSpec { proc_ uid } ->
Implementation . delete_spec ~ proc_ name
Implementation . delete_spec ~ proc_ uid
| Handshake ->
| Handshake ->
()
()
| MarkAllSourceFilesStale ->
| MarkAllSourceFilesStale ->
Implementation . mark_all_source_files_stale ()
Implementation . mark_all_source_files_stale ()
| Merge { infer_deps_file } ->
| Merge { infer_deps_file } ->
Implementation . merge infer_deps_file
Implementation . merge infer_deps_file
| StoreSpec { proc_name ; analysis_summary ; report_summary } ->
| StoreSpec { proc_uid ; proc_name ; analysis_summary ; report_summary } ->
Implementation . store_spec ~ proc_name ~ analysis_summary ~ report_summary
Implementation . store_spec ~ proc_uid ~ proc_name ~ analysis_summary ~ report_summary
| ReplaceAttributes { pname_str ; pname ; akind ; source_file ; attributes ; proc_desc ; callees } ->
| ReplaceAttributes
Implementation . replace_attributes ~ pname_str ~ pname ~ akind ~ source_file ~ attributes
{ proc_uid ; proc_name ; proc_name_hum ; attr_kind ; source_file ; proc_attributes ; cfg ; callees }
~ proc_desc ~ callees
->
Implementation . replace_attributes ~ proc_uid ~ proc_name ~ proc_name_hum ~ attr_kind
~ source_file ~ proc_attributes ~ cfg ~ callees
| ResetCaptureTables ->
| ResetCaptureTables ->
Implementation . reset_capture_tables ()
Implementation . reset_capture_tables ()
| Terminate ->
| Terminate ->
@ -383,8 +397,11 @@ let start () = Server.start ()
let stop () = Server . send Command . Terminate
let stop () = Server . send Command . Terminate
let replace_attributes ~ pname_str ~ pname ~ akind ~ source_file ~ attributes ~ proc_desc ~ callees =
let replace_attributes ~ proc_uid ~ proc_name ~ proc_name_hum ~ attr_kind ~ source_file ~ proc_attributes
perform ( ReplaceAttributes { pname_str ; pname ; akind ; source_file ; attributes ; proc_desc ; callees } )
~ cfg ~ callees =
perform
( ReplaceAttributes
{ proc_uid ; proc_name ; proc_name_hum ; attr_kind ; source_file ; proc_attributes ; cfg ; callees } )
let add_source_file ~ source_file ~ tenv ~ integer_type_widths ~ proc_names =
let add_source_file ~ source_file ~ tenv ~ integer_type_widths ~ proc_names =
@ -399,10 +416,10 @@ let canonicalize () = perform Vacuum
let reset_capture_tables () = perform ResetCaptureTables
let reset_capture_tables () = perform ResetCaptureTables
let store_spec ~ proc_ name ~ analysis_summary ~ report_summary =
let store_spec ~ proc_ uid ~ proc_ name ~ analysis_summary ~ report_summary =
perform ( StoreSpec { proc_ name; analysis_summary ; report_summary } )
perform ( StoreSpec { proc_ uid; proc_ name; analysis_summary ; report_summary } )
let delete_spec ~ proc_ name = perform ( DeleteSpec { proc_name } )
let delete_spec ~ proc_ uid = perform ( DeleteSpec { proc_uid } )
let delete_all_specs () = perform DeleteAllSpecs
let delete_all_specs () = perform DeleteAllSpecs