added parsing time benchmark

[helm.git] / helm / ocaml / tactics / metadataQuery.ml

diff --git a/helm/ocaml/tactics/metadataQuery.ml b/helm/ocaml/tactics/metadataQuery.ml
index f65318896ae7bd9c57718021fa4df7edc978acb4..3bc3c566e778ba9a591bc3042c7f3f5a8abbcd4c 100644 (file)
--- a/helm/ocaml/tactics/metadataQuery.ml
+++ b/helm/ocaml/tactics/metadataQuery.ml
@@ -49,8 +49,10 @@ let nonvar s =
 let locate ~(dbd:Mysql.dbd) ?(vars = false) pat =
   let sql_pat = sqlpat_of_shellglob pat in
   let query =
-    sprintf "SELECT source FROM %s WHERE value LIKE \"%s\""
-      MetadataTypes.name_tbl sql_pat
+        sprintf ("SELECT source FROM %s WHERE value LIKE \"%s\" UNION "^^
+                 "SELECT source FROM %s WHERE value LIKE \"%s\"")
+          (MetadataTypes.name_tbl ()) sql_pat
+           MetadataTypes.library_name_tbl sql_pat
   in
   let result = Mysql.exec dbd query in
   List.filter nonvar
@@ -58,13 +60,47 @@ let locate ~(dbd:Mysql.dbd) ?(vars = false) pat =
       (fun cols -> match cols.(0) with Some s -> s | _ -> assert false))
 
 let match_term ~(dbd:Mysql.dbd) ty =
+(*   prerr_endline (CicPp.ppterm ty); *)
   let metadata = MetadataExtractor.compute ~body:None ~ty in
   let constants_no =
     MetadataConstraints.StringSet.cardinal (MetadataConstraints.constants_of ty)
   in
+  let full_card, diff =
+    if CicUtil.is_meta_closed ty then
+      Some (MetadataConstraints.Eq constants_no), None
+    else
+      let diff_no =
+        let (hyp_constants, concl_constants) =
+          (* collect different constants in hypotheses and conclusions *)
+          List.fold_left
+            (fun ((hyp, concl) as acc) metadata ->
+               match (metadata: MetadataTypes.metadata) with
+               | `Sort _ | `Rel _ -> acc
+               | `Obj (uri, `InConclusion) | `Obj (uri, `MainConclusion _)
+                 when not (List.mem uri concl) -> (hyp, uri :: concl)
+               | `Obj (uri, `InHypothesis) | `Obj (uri, `MainHypothesis _)
+                 when not (List.mem uri hyp) -> (uri :: hyp, concl)
+               | `Obj _ -> acc)
+            ([], [])
+            metadata
+        in
+        List.length hyp_constants - List.length concl_constants
+      in
+      let (concl_metas, hyp_metas) = MetadataExtractor.compute_metas ty in
+      let diff =
+        if MetadataExtractor.IntSet.equal concl_metas hyp_metas then
+          Some (MetadataConstraints.Eq diff_no)
+        else if MetadataExtractor.IntSet.subset concl_metas hyp_metas then
+          Some (MetadataConstraints.Gt (diff_no - 1))
+        else if MetadataExtractor.IntSet.subset hyp_metas concl_metas then
+          Some (MetadataConstraints.Lt (diff_no + 1))
+        else
+          None
+      in
+      None, diff
+  in
   let constraints = List.map MetadataTypes.constr_of_metadata metadata in
-  Constr.at_least ~dbd ~full_card:(MetadataConstraints.Eq constants_no)
-    constraints
+  Constr.at_least ~dbd ?full_card ?diff constraints
 
 let ( ** ) x y = int_of_float ((float_of_int x) ** (float_of_int y))
 
@@ -152,7 +188,7 @@ let hint ~(dbd:Mysql.dbd) ?(facts=false) ?signature ((proof, goal) as status) =
   let hyp_constants =
     Constr.StringSet.diff (signature_of_hypothesis context) types_constants
   in
-Constr.StringSet.iter prerr_endline hyp_constants;
+(* Constr.StringSet.iter prerr_endline hyp_constants; *)
   let other_constants = Constr.StringSet.union sig_constants hyp_constants in
   let uris = 
     let pow = 2 ** (Constr.StringSet.cardinal other_constants) in
@@ -223,7 +259,7 @@ let experimental_hint
   let hyp_constants =
     Constr.StringSet.diff (signature_of_hypothesis context) types_constants
   in
-Constr.StringSet.iter prerr_endline hyp_constants;
+(* Constr.StringSet.iter prerr_endline hyp_constants; *)
   let other_constants = Constr.StringSet.union sig_constants hyp_constants in
   let uris = 
     let pow = 2 ** (Constr.StringSet.cardinal other_constants) in
@@ -268,5 +304,5 @@ let elim ~dbd uri =
      `Obj (uri,[`InHypothesis]);
     ]
   in
-  MetadataConstraints.at_least ~dbd constraints
+  MetadataConstraints.at_least ~rating:`Hits ~dbd constraints