]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/components/grafite_parser/grafiteDisambiguate.ml
Lookup_in_library implemented for new objects. Basically, this stupid (??),
[helm.git] / helm / software / components / grafite_parser / grafiteDisambiguate.ml
index 32d666a384eaa69a04310f9f2dfa6ecadaa91593..8830a600dbaa315497030e0c61c716ab19b1c5b7 100644 (file)
@@ -89,8 +89,13 @@ let ncic_mk_choice = function
   | LexiconAst.Ident_alias (name, uri) -> 
      uri, `Sym_interp 
       (fun l->assert(l = []);
-      let uri = UriManager.uri_of_string uri in
-       fst (OCic2NCic.convert_term uri (CicUtil.term_of_uri uri)))
+        try
+         let nref = NReference.reference_of_string uri in
+          NCic.Const nref
+        with
+         NReference.IllFormedReference _ ->
+          let uri = UriManager.uri_of_string uri in
+           fst (OCic2NCic.convert_term uri (CicUtil.term_of_uri uri)))
 ;;
 
 
@@ -152,15 +157,32 @@ let lookup_in_library
   | DisambiguateTypes.Num instance -> mk_num_alias instance
 ;;
 
+let nlookup_in_library 
+  interactive_user_uri_choice input_or_locate_uri item 
+=
+  match item with
+  | DisambiguateTypes.Id id -> 
+     (try
+       let references = NCicLibrary.resolve id in
+        List.map
+         (fun u -> LexiconAst.Ident_alias (id,NReference.string_of_reference u)
+         ) references @
+        lookup_in_library interactive_user_uri_choice input_or_locate_uri item
+      with
+       NCicLibrary.ObjectNotFound _ ->
+        lookup_in_library interactive_user_uri_choice input_or_locate_uri item)
+  | _ -> lookup_in_library interactive_user_uri_choice input_or_locate_uri item 
+;;
+
   (** @param term not meaningful when context is given *)
-let disambiguate_term goal text prefix_len lexicon_status_ref context metasenv
+let disambiguate_term expty text prefix_len lexicon_status_ref context metasenv
 term =
   let lexicon_status = !lexicon_status_ref in
   let (diff, metasenv, subst, cic, _) =
     singleton "first"
       (CicDisambiguate.disambiguate_term
         ~aliases:lexicon_status.LexiconEngine.aliases
-        ?goal ~universe:(Some lexicon_status.LexiconEngine.multi_aliases)
+        ~expty ~universe:(Some lexicon_status.LexiconEngine.multi_aliases)
         ~lookup_in_library
         ~mk_choice:cic_mk_choice
         ~mk_implicit
@@ -172,12 +194,32 @@ term =
   metasenv,(*subst,*) cic
 ;;
 
+let disambiguate_nterm expty lexicon_status context metasenv subst thing
+=
+  let diff, metasenv, subst, cic =
+    singleton "first"
+      (NCicDisambiguate.disambiguate_term
+        ~coercion_db:(NCicCoercion.db ())
+        ~aliases:lexicon_status.LexiconEngine.aliases
+        ~expty 
+        ~universe:(Some lexicon_status.LexiconEngine.multi_aliases)
+        ~lookup_in_library:nlookup_in_library
+        ~mk_choice:ncic_mk_choice
+        ~mk_implicit
+        ~description_of_alias:LexiconAst.description_of_alias
+        ~context ~metasenv ~subst thing)
+  in
+  let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
+  metasenv, subst, lexicon_status, cic
+;;
+
+
   (** disambiguate_lazy_term (circa): term -> (unit -> status) * lazy_term
    * rationale: lazy_term will be invoked in different context to obtain a term,
    * each invocation will disambiguate the term and can add aliases. Once all
    * disambiguations have been performed, the first returned function can be
    * used to obtain the resulting aliases *)
-let disambiguate_lazy_term goal text prefix_len lexicon_status_ref term =
+let disambiguate_lazy_term expty text prefix_len lexicon_status_ref term =
   (fun context metasenv ugraph ->
     let lexicon_status = !lexicon_status_ref in
     let (diff, metasenv, _, cic, ugraph) =
@@ -189,8 +231,8 @@ let disambiguate_lazy_term goal text prefix_len lexicon_status_ref term =
           ~description_of_alias:LexiconAst.description_of_alias
           ~initial_ugraph:ugraph ~aliases:lexicon_status.LexiconEngine.aliases
           ~universe:(Some lexicon_status.LexiconEngine.multi_aliases)
-          ~context ~metasenv ~subst:[] ?goal
-          (text,prefix_len,term)) in
+          ~context ~metasenv ~subst:[] 
+          (text,prefix_len,term) ~expty) in
     let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
     lexicon_status_ref := lexicon_status;
     cic, metasenv, ugraph)
@@ -214,6 +256,20 @@ let disambiguate_pattern
   (wanted, hyp_paths, goal_path)
 ;;
 
+type pattern = 
+  CicNotationPt.term Disambiguate.disambiguator_input option * 
+  (string * NCic.term) list * NCic.term option
+
+let disambiguate_npattern (text, prefix_len, (wanted, hyp_paths, goal_path)) =
+  let interp path = NCicDisambiguate.disambiguate_path path in
+  let goal_path = HExtlib.map_option interp goal_path in
+  let hyp_paths = List.map (fun (name, path) -> name, interp path) hyp_paths in
+  let wanted = 
+    match wanted with None -> None | Some x -> Some (text,prefix_len,x)
+  in
+   (wanted, hyp_paths, goal_path)
+;;
+
 let disambiguate_reduction_kind text prefix_len lexicon_status_ref = function
   | `Unfold (Some t) ->
       let t = 
@@ -253,7 +309,10 @@ let rec disambiguate_tactic
   lexicon_status_ref context metasenv goal (text,prefix_len,tactic) 
 =
   let disambiguate_term_hint = 
-    disambiguate_term goal text prefix_len lexicon_status_ref in
+    let _,_,expty = 
+      List.find (fun (x,_,_) -> Some x = goal) metasenv
+    in
+    disambiguate_term (Some expty) text prefix_len lexicon_status_ref in
   let disambiguate_term = 
     disambiguate_term None text prefix_len lexicon_status_ref in
   let disambiguate_pattern = 
@@ -573,18 +632,18 @@ let disambiguate_obj lexicon_status ?baseuri metasenv (text,prefix_len,obj) =
    in
      UriManager.uri_of_string (baseuri ^ "/" ^ name)
   in
- let try_new cic =
+ let _try_new cic =
   (NCicLibrary.clear_cache ();
    NCicEnvironment.invalidate ();
    OCic2NCic.clear ();
    let graph = 
      match cic with
-     | Cic.CurrentProof (_,metasenv, _, ty,_,_) ->
+     | Some (Cic.CurrentProof (_,metasenv, _, ty,_,_)) ->
          let _, ugraph = 
            CicTypeChecker.type_of_aux' metasenv [] ty CicUniv.empty_ugraph
          in
            ugraph
-     | Cic.Constant (_,_, ty,_,_) ->
+     | Some (Cic.Constant (_,_, ty,_,_)) ->
          let _, ugraph = 
                  CicTypeChecker.type_of_aux' [] [] ty CicUniv.empty_ugraph
          in
@@ -627,7 +686,7 @@ let disambiguate_obj lexicon_status ?baseuri metasenv (text,prefix_len,obj) =
        (try
          (match 
           NCicDisambiguate.disambiguate_obj
-           ~lookup_in_library:lookup_in_library
+           ~lookup_in_library:nlookup_in_library
            ~description_of_alias:LexiconAst.description_of_alias
            ~mk_choice:ncic_mk_choice
            ~mk_implicit
@@ -685,7 +744,7 @@ let disambiguate_obj lexicon_status ?baseuri metasenv (text,prefix_len,obj) =
   prerr_endline ("VECCHIA DISAMBIGUAZIONE ("^
     UriManager.string_of_uri uri ^"): " ^ string_of_float time);
 *)
-(*   try_new cic;  *)
+(*    try_new (Some cic);   *)
 
 
   let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
@@ -694,12 +753,43 @@ let disambiguate_obj lexicon_status ?baseuri metasenv (text,prefix_len,obj) =
  with 
  | Sys.Break as exn -> raise exn
  | exn ->
+(*    try_new None; *)
    raise exn
+;;
 
+let disambiguate_nobj lexicon_status ?baseuri (text,prefix_len,obj) =
+  let uri =
+   let baseuri = 
+     match baseuri with Some x -> x | None -> raise BaseUriNotSetYet
+   in
+   let name = 
+     match obj with
+     | CicNotationPt.Inductive (_,(name,_,_,_)::_)
+     | CicNotationPt.Record (_,name,_,_) -> name ^ ".ind"
+     | CicNotationPt.Theorem (_,name,_,_) -> name ^ ".con"
+     | CicNotationPt.Inductive _ -> assert false
+   in
+     UriManager.uri_of_string (baseuri ^ "/" ^ name)
+  in
+  let diff, _, _, cic =
+   singleton "third"
+    (NCicDisambiguate.disambiguate_obj
+      ~lookup_in_library:nlookup_in_library
+      ~description_of_alias:LexiconAst.description_of_alias
+      ~mk_choice:ncic_mk_choice
+      ~mk_implicit
+      ~uri:(OCic2NCic.nuri_of_ouri uri)
+      ~coercion_db:(NCicCoercion.db ())
+      ~aliases:lexicon_status.LexiconEngine.aliases
+      ~universe:(Some lexicon_status.LexiconEngine.multi_aliases) 
+      (text,prefix_len,obj)) in
+  let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
+  lexicon_status, cic
 ;;
   
 let disambiguate_command lexicon_status ?baseuri metasenv (text,prefix_len,cmd)=
   match cmd with
+   | GrafiteAst.NObj(loc,obj) -> lexicon_status, metasenv, GrafiteAst.NObj(loc,obj)
    | GrafiteAst.Index(loc,key,uri) ->
        let lexicon_status_ref = ref lexicon_status in 
        let disambiguate_term =
@@ -713,6 +803,10 @@ let disambiguate_command lexicon_status ?baseuri metasenv (text,prefix_len,cmd)=
        in
        let metasenv,key = disambiguate_term_option metasenv key in
        !lexicon_status_ref, metasenv,GrafiteAst.Index(loc,key,uri)
+   | GrafiteAst.Select (loc,uri) -> 
+        lexicon_status, metasenv, GrafiteAst.Select(loc,uri)
+   | GrafiteAst.Pump(loc,i) -> 
+        lexicon_status, metasenv, GrafiteAst.Pump(loc,i)
    | GrafiteAst.PreferCoercion (loc,t) -> 
        let lexicon_status_ref = ref lexicon_status in 
        let disambiguate_term =
@@ -725,17 +819,23 @@ let disambiguate_command lexicon_status ?baseuri metasenv (text,prefix_len,cmd)=
          disambiguate_term None text prefix_len lexicon_status_ref [] in
       let metasenv,t = disambiguate_term metasenv t in
       !lexicon_status_ref, metasenv, GrafiteAst.Coercion (loc,t,b,a,s)
-   | GrafiteAst.UnificationHint (loc, t) ->
+   | GrafiteAst.Inverter (loc,n,indty,params) ->
+       let lexicon_status_ref = ref lexicon_status in
+       let disambiguate_term = disambiguate_term None text prefix_len lexicon_status_ref [] in
+      let metasenv,indty = disambiguate_term metasenv indty in
+      !lexicon_status_ref, metasenv, GrafiteAst.Inverter (loc,n,indty,params)
+   | GrafiteAst.UnificationHint (loc, t, n) ->
        let lexicon_status_ref = ref lexicon_status in 
        let disambiguate_term =
          disambiguate_term None text prefix_len lexicon_status_ref [] in
       let metasenv,t = disambiguate_term metasenv t in
-      !lexicon_status_ref, metasenv, GrafiteAst.UnificationHint (loc,t)
+      !lexicon_status_ref, metasenv, GrafiteAst.UnificationHint (loc,t,n)
    | GrafiteAst.Default _
    | GrafiteAst.Drop _
    | GrafiteAst.Include _
    | GrafiteAst.Print _
    | GrafiteAst.Qed _
+   | GrafiteAst.NQed _
    | GrafiteAst.Set _ as cmd ->
        lexicon_status,metasenv,cmd
    | GrafiteAst.Obj (loc,obj) ->