@ -11,84 +11,109 @@ module L = Logging
type attributes_kind = ProcUndefined | ProcObjCAccessor | ProcDefined [ @@ deriving compare ]
let least_relevant_up_to_proc_kind_exclusive = function
| ProcUndefined
-> []
| ProcObjCAccessor
-> [ ProcUndefined ]
| ProcDefined
-> [ ProcUndefined ; ProcObjCAccessor ]
let most_relevant_down_to_proc_kind_inclusive = function
| ProcUndefined
-> [ ProcDefined ; ProcObjCAccessor ; ProcUndefined ]
| ProcObjCAccessor
-> [ ProcDefined ; ProcObjCAccessor ]
| ProcDefined
-> [ ProcDefined ]
let int64_of_attributes_kind =
(* only allocate this once *)
let int64_two = Int64 . of_int 2 in
function ProcUndefined -> Int64 . zero | ProcObjCAccessor -> Int64 . one | ProcDefined -> int64_two
let proc_kind_of_attr ( proc_attributes : ProcAttributes . t ) =
if proc_attributes . is_defined then ProcDefined
else if Option . is_some proc_attributes . objc_accessor then ProcObjCAccessor
else ProcUndefined
let should_override_attr attr1 attr2 =
(* use the source file to be more deterministic in case the same procedure name is defined in several files *)
[ % compare : attributes_kind * SourceFile . t ]
( proc_kind_of_attr attr1 , attr1 . ProcAttributes . loc . file )
( proc_kind_of_attr attr2 , attr2 . ProcAttributes . loc . file )
> 0
module type Data = sig
val of_pname : Typ . Procname . t -> Sqlite3 . Data . t
module Table = struct
type key = string
val of_source_file : SourceFile . t -> Sqlite3 . Data . t
type value = ProcAttributes . t
val of_proc_attr : ProcAttributes . t -> Sqlite3 . Data . t
let table = ResultsDir . attributes_table
val to_proc_attr : Sqlite3 . Data . t -> ProcAttributes . t
end
module Store = KeyValue . Make ( Table )
module Data : Data = struct
let pname_to_key = Base . Hashtbl . create ( module Typ . Procname ) ()
let string_of_pkind = function
| ProcUndefined
-> " U "
| ProcObjCAccessor
-> " O "
| ProcDefined
-> " D "
let of_pname pname =
let default () = Sqlite3 . Data . TEXT ( Typ . Procname . to_filename pname ) in
Base . Hashtbl . find_or_add pname_to_key pname ~ default
module KeyHashtbl = Caml . Hashtbl . Make ( struct
type t = Typ . Procname . t * attributes_kind
let of_source_file file = Sqlite3 . Data . TEXT ( SourceFile . to_string file )
let equal = [ % compare . equal : Typ . Procname . t * attributes_kind ]
let to_proc_attr = function [ @ warning " -8 " ] Sqlite3 . Data . BLOB b -> Marshal . from_string b 0
let hash = Hashtbl . hash
end )
let pname_to_key = KeyHashtbl . create 16
let key_of_pname_pkind ( pname , pkind as p ) =
try KeyHashtbl . find pname_to_key p
with Not_found ->
let key = Typ . Procname . to_filename pname ^ string_of_pkind pkind | > Store . blob_of_key in
KeyHashtbl . replace pname_to_key p key ; key
let load_aux ? ( min_kind = ProcUndefined ) pname =
List . find_map ( most_relevant_down_to_proc_kind_inclusive min_kind ) ~ f : ( fun pkind ->
key_of_pname_pkind ( pname , pkind ) | > Store . find )
let of_proc_attr x = Sqlite3 . Data . BLOB ( Marshal . to_string x [] )
end
let load pname : ProcAttributes . t option = load_aux pname
let get_replace_statement =
(* The innermost SELECT returns either the current attributes_kind and source_file associated with
the given proc name , or default values of ( - 1 , " " ) . These default values have the property that
they are always " less than " any legit value . More precisely , MAX ensures that some value is
returned even if there is no row satisfying WHERE ( we'll get NULL in that case , the value in
the row otherwise ) . COALESCE then returns the first non - NULL value , which will be either the
value of the row corresponding to that pname in the DB , or the default if no such row exists .
The next ( second - outermost ) SELECT filters out that value if it is " more defined " than the ones
we would like to insert ( which will never be the case if the default values are returned ) . If
not , it returns a trivial row ( consisting solely of NULL since we don't use its values ) and the
INSERT OR REPLACE will proceed and insert or update the values stored into the DB for that
pname . * )
(* TRICK: use the source file to be more deterministic in case the same procedure name is defined
in several files * )
(* TRICK: older versions of sqlite ( prior to version 3.15.0 ( 2016-10-14 ) ) do not support row
values so the lexicographic ordering for ( : akind , : sfile ) is done by hand * )
(* TODO ( optim ) : it might be worth not generating the source file everytime we do a store, but
only generate it if the attribute needs updating ( which should be orders of magnitude less
frequent ) * )
ResultsDir . register_statement
{ |
INSERT OR REPLACE INTO attributes
SELECT : pname , : akind , : sfile , : pattr
FROM (
SELECT NULL
FROM (
SELECT COALESCE ( MAX ( attr_kind ) , - 1 ) AS attr_kind ,
COALESCE ( MAX ( source_file ) , " " ) AS source_file
FROM attributes
WHERE proc_name = : pname )
WHERE attr_kind < : akind
OR ( attr_kind = : akind AND source_file < : sfile ) ) | }
let replace pname_blob akind loc_file attr_blob =
let replace_stmt = get_replace_statement () in
Sqlite3 . bind replace_stmt 1 (* :pname *) pname_blob
| > SqliteUtils . check_sqlite_error ~ log : " replace bind pname " ;
Sqlite3 . bind replace_stmt 2 (* :akind *) ( Sqlite3 . Data . INT ( int64_of_attributes_kind akind ) )
| > SqliteUtils . check_sqlite_error ~ log : " replace bind attribute kind " ;
Sqlite3 . bind replace_stmt 3 (* :sfile *) loc_file
| > SqliteUtils . check_sqlite_error ~ log : " replace bind source file " ;
Sqlite3 . bind replace_stmt 4 (* :pattr *) attr_blob
| > SqliteUtils . check_sqlite_error ~ log : " replace bind proc attributes " ;
SqliteUtils . sqlite_unit_step ~ finalize : false ~ log : " Attributes.replace " replace_stmt
let get_select_statement =
ResultsDir . register_statement " SELECT proc_attributes FROM attributes WHERE proc_name = :k "
let get_select_defined_statement =
ResultsDir . register_statement
" SELECT proc_attributes FROM attributes WHERE proc_name = :k AND attr_kind = %Ld "
( int64_of_attributes_kind ProcDefined )
let find ~ defined pname_blob =
let select_stmt = if defined then get_select_defined_statement () else get_select_statement () in
Sqlite3 . bind select_stmt 1 pname_blob
| > SqliteUtils . check_sqlite_error ~ log : " find bind proc name " ;
SqliteUtils . sqlite_result_step ~ finalize : false ~ log : " Attributes.find " select_stmt
| > Option . map ~ f : Data . to_proc_attr
let load pname = Data . of_pname pname | > find ~ defined : false
let store ( attr : ProcAttributes . t ) =
let pkind = proc_kind_of_attr attr in
if load attr . proc_name | > Option . value_map ~ default : true ~ f : ( should_override_attr attr ) then
(* NOTE: We need to do this dance of adding the proc_kind to the key because there's a race condition between the time we load the attributes from the db and the time we write possibly better ones. We could avoid this by making the db schema richer than just key/value and turning the SELECT + REPLACE into an atomic transaction. *)
let key = key_of_pname_pkind ( attr . proc_name , pkind ) in
Store . replace key ( Store . blob_of_value attr ) ;
least_relevant_up_to_proc_kind_exclusive pkind
| > List . iter ~ f : ( fun k -> key_of_pname_pkind ( attr . proc_name , k ) | > Store . delete )
let load_defined pname = load_aux ~ min_kind : ProcDefined pname
let key = Data . of_pname attr . proc_name in
replace key pkind ( Data . of_source_file attr . loc . Location . file ) ( Data . of_proc_attr attr )
let load_defined pname = Data . of_pname pname | > find ~ defined : true
let get_correct_type_from_objc_class_name type_name =
(* ToDo: this function should return a type that includes a reference to the tenv computed by:
Jules Villard
8 years ago
committed by
Facebook Github Bot