X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fmetadata%2FmetadataDb.ml;h=d82894ed6f67ba9287a727c12b64df98b9f07389;hb=acf29bdbdcdc6ad8c2d9d27e8a47500981b605cd;hp=6cbfeb1ff12e3a47d464d02da468c2d428258538;hpb=aa2ba3c6aa2f84f1fa1e72ddc4f3559030cd718b;p=helm.git diff --git a/helm/ocaml/metadata/metadataDb.ml b/helm/ocaml/metadata/metadataDb.ml index 6cbfeb1ff..d82894ed6 100644 --- a/helm/ocaml/metadata/metadataDb.ml +++ b/helm/ocaml/metadata/metadataDb.ml @@ -27,46 +27,78 @@ open MetadataTypes open Printf -let prepare_insert () = - (* - let insert_owner a b = - sprintf "INSERT %s VALUES (\"%s\", \"%s\")" (owners_tbl ())a b +let execute_insert dbd uri (sort_cols, rel_cols, obj_cols) = + let sort_tuples = + List.fold_left (fun s l -> match l with + | [`String a; `String b; `Int c; `String d] -> + sprintf "(\"%s\", \"%s\", %d, \"%s\")" a b c d :: s + | _ -> assert false ) + [] sort_cols in - *) - let insert_sort a b c d = - sprintf "INSERT %s VALUES (\"%s\", \"%s\", %d, \"%s\")" (sort_tbl ())a b c d - in - let insert_rel a b c = - sprintf "INSERT %s VALUES (\"%s\", \"%s\", %d)" (rel_tbl ()) a b c - in - let insert_obj a b c d = - sprintf "INSERT %s VALUES (\"%s\", \"%s\", \"%s\", %s)" (obj_tbl ()) a b c d - in - ((*insert_owner, *)insert_sort, insert_rel, insert_obj) - -let execute_insert dbd ((*insert_owner, *)insert_sort, insert_rel, insert_obj) - uri (sort_cols, rel_cols, obj_cols) -= - (* ignore (Mysql.exec dbd (insert_owner uri owner)); *) - List.iter (function - | [`String a; `String b; `Int c; `String d] -> - ignore (Mysql.exec dbd (insert_sort a b c d)) - | _ -> assert false) - sort_cols; - List.iter (function + let rel_tuples = + List.fold_left (fun s l -> match l with | [`String a; `String b; `Int c] -> - ignore (Mysql.exec dbd (insert_rel a b c)) + sprintf "(\"%s\", \"%s\", %d)" a b c :: s | _ -> assert false) - rel_cols; - List.iter (function + [] rel_cols + in + let obj_tuples = List.fold_left (fun s l -> match l with | [`String a; `String b; `String c; `Int d] -> - ignore (Mysql.exec dbd (insert_obj a b c (string_of_int d))) + sprintf "(\"%s\", \"%s\", \"%s\", %d)" a b c d :: s | [`String a; `String b; `String c; `Null] -> - ignore (Mysql.exec dbd (insert_obj a b c "NULL")) + sprintf "(\"%s\", \"%s\", \"%s\", %s)" a b c "NULL" :: s | _ -> assert false) - obj_cols - + [] obj_cols + in + if sort_tuples <> [] then + begin + let query_sort = + sprintf "INSERT %s VALUES %s;" (sort_tbl ()) (String.concat "," sort_tuples) + in + ignore (Mysql.exec dbd query_sort) + end; + if rel_tuples <> [] then + begin + let query_rel = + sprintf "INSERT %s VALUES %s;" (rel_tbl ()) (String.concat "," rel_tuples) + in + ignore (Mysql.exec dbd query_rel) + end; + if obj_tuples <> [] then + begin + let query_obj = + sprintf "INSERT %s VALUES %s;" (obj_tbl ()) (String.concat "," obj_tuples) + in + ignore (Mysql.exec dbd query_obj) + end + + +let count_distinct position l = + MetadataConstraints.StringSet.cardinal + (List.fold_left (fun acc d -> + match position with + | `Conclusion -> + (match d with + | `Obj (name,`InConclusion) + | `Obj (name,`MainConclusion _ ) -> + MetadataConstraints.StringSet.add name acc + | _ -> acc) + | `Hypothesis -> + (match d with + | `Obj (name,`InHypothesis) + | `Obj (name,`MainHypothesis _) -> + MetadataConstraints.StringSet.add name acc + | _ -> acc) + | `Statement -> + (match d with + | `Obj (name,`InBody) -> acc + | `Obj (name,_) -> MetadataConstraints.StringSet.add name acc + | _ -> acc) + ) MetadataConstraints.StringSet.empty l) +(* let insert_const_no dbd uri = + let term = CicUtil.term_of_uri uri in + let ty = CicTypeChecker.type_of_aux' let inconcl_no = sprintf "INSERT %s SELECT \"%s\", COUNT(DISTINCT h_occurrence) FROM %s WHERE (h_position=\"%s\" OR h_position=\"%s\") AND source LIKE \"%s%%\"" (conclno_tbl ()) uri (obj_tbl ()) inconcl_pos mainconcl_pos uri @@ -80,7 +112,17 @@ let insert_const_no dbd uri = in ignore (Mysql.exec dbd inconcl_no); ignore (Mysql.exec dbd concl_hyp) - +*) +let insert_const_no dbd (uri,metadata) = + let no_concl = count_distinct `Conclusion metadata in + let no_hyp = count_distinct `Hypothesis metadata in + let no_full = count_distinct `Statement metadata in + let insert = + sprintf "INSERT INTO %s VALUES (\"%s\", %d, %d, %d)" + (count_tbl ()) uri no_concl no_hyp no_full + in + ignore (Mysql.exec dbd insert) + let insert_name ~dbd ~uri ~name = let query = sprintf "INSERT %s VALUES (\"%s\", \"%s\")" (name_tbl ()) uri name @@ -92,7 +134,7 @@ type columns = (* TODO ZACK: verify if an object has already been indexed *) let already_indexed _ = false - +(* let index_constant ~dbd = let query = prepare_insert () in fun ~uri ~body ~ty -> @@ -110,7 +152,7 @@ let index_inductive_def ~dbd = let query = prepare_insert () in fun ~uri ~types -> if not (already_indexed uri) then begin - let metadata = MetadataExtractor.compute_ind ~uri ~types in + let metadata = MetadataExtractor.compute_obj uri in let uri_of (a,b,c) = a in let uris = UriManager.string_of_uri uri :: List.map uri_of metadata in let uri = UriManager.string_of_uri uri in @@ -119,13 +161,25 @@ let index_inductive_def ~dbd = List.iter (insert_const_no dbd) uris; List.iter (fun (uri, name, _) -> insert_name ~dbd ~uri ~name) metadata end +*) +let index_obj ~dbd ~uri = + if not (already_indexed uri) then begin + let metadata = MetadataExtractor.compute_obj uri in + let uri_of (a,b,c) = (a,c) in + let uri = UriManager.string_of_uri uri in + let columns = MetadataPp.columns_of_metadata metadata in + execute_insert dbd uri (columns :> columns); + List.iter (insert_const_no dbd) (List.map uri_of metadata); + List.iter (fun (uri, name, _) -> insert_name ~dbd ~uri ~name) metadata + end + let tables_to_clean = - [sort_tbl; rel_tbl; obj_tbl; conclno_tbl; fullno_tbl; name_tbl; hypno_tbl] + [sort_tbl; rel_tbl; obj_tbl; name_tbl; count_tbl] let clean ~(dbd:Mysql.dbd) = let owned_uris = (* list of uris in list-of-columns format *) - let query = sprintf "SELECT source FROM %s" (obj_tbl ()) in + let query = sprintf "SELECT source FROM %s" (name_tbl ()) in let result = Mysql.exec dbd query in let uris = Mysql.map result (fun cols -> match cols.(0) with