]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/components/grafite_parser/grafiteDisambiguate.ml
1) grafiteWalker removed
[helm.git] / helm / software / components / grafite_parser / grafiteDisambiguate.ml
index 4ea3a95b3889cb6784cb77522e809e773039f836..a0558d9f65a06af2f3703d3826f5f4a678339092 100644 (file)
@@ -78,6 +78,7 @@ let ncic_mk_choice = function
            (NCic.Appl l)::tl -> NCic.Appl (l@tl) | l -> NCic.Appl l)
         ~term_of_uri:(fun uri ->
            fst (OCic2NCic.convert_term uri (CicUtil.term_of_uri uri)))
+        ~term_of_nref:(fun nref -> NCic.Const nref)
        name dsc
   | LexiconAst.Number_alias (_, dsc) -> 
        let desc,f = DisambiguateChoices.lookup_num_by_dsc dsc in
@@ -89,15 +90,13 @@ let ncic_mk_choice = function
   | LexiconAst.Ident_alias (name, uri) -> 
      uri, `Sym_interp 
       (fun l->assert(l = []);
-        if String.sub uri 5 9 = "ng_matita" then
-         let nuri =
-          NUri.uri_of_string (String.sub uri 0 (String.length uri -3) ^ "def")
-         in
-          NCic.Const
-           (NReference.reference_of_spec nuri (NReference.Def 0))
-        else
-         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)))
 ;;
 
 
@@ -159,6 +158,23 @@ 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
+       NCicEnvironment.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 expty text prefix_len lexicon_status_ref context metasenv
 term =
@@ -166,8 +182,8 @@ term =
   let (diff, metasenv, subst, cic, _) =
     singleton "first"
       (CicDisambiguate.disambiguate_term
-        ~aliases:lexicon_status.LexiconEngine.aliases
-        ~expty ~universe:(Some lexicon_status.LexiconEngine.multi_aliases)
+        ~aliases:lexicon_status#lstatus.LexiconEngine.aliases
+        ~expty ~universe:(Some lexicon_status#lstatus.LexiconEngine.multi_aliases)
         ~lookup_in_library
         ~mk_choice:cic_mk_choice
         ~mk_implicit
@@ -179,23 +195,23 @@ term =
   metasenv,(*subst,*) cic
 ;;
 
-let disambiguate_nterm expty lexicon_status context metasenv subst thing
+let disambiguate_nterm expty estatus context metasenv subst thing
 =
   let diff, metasenv, subst, cic =
     singleton "first"
       (NCicDisambiguate.disambiguate_term
-        ~coercion_db:(NCicCoercion.db ())
-        ~aliases:lexicon_status.LexiconEngine.aliases
+        ~rdb:estatus
+        ~aliases:estatus#lstatus.LexiconEngine.aliases
         ~expty 
-        ~universe:(Some lexicon_status.LexiconEngine.multi_aliases)
-        ~lookup_in_library
+        ~universe:(Some estatus#lstatus.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
+  let estatus = LexiconEngine.set_proof_aliases estatus diff in
+   metasenv, subst, estatus, cic
 ;;
 
 
@@ -214,8 +230,8 @@ let disambiguate_lazy_term expty text prefix_len lexicon_status_ref term =
           ~mk_choice:cic_mk_choice
           ~mk_implicit
           ~description_of_alias:LexiconAst.description_of_alias
-          ~initial_ugraph:ugraph ~aliases:lexicon_status.LexiconEngine.aliases
-          ~universe:(Some lexicon_status.LexiconEngine.multi_aliases)
+          ~initial_ugraph:ugraph ~aliases:lexicon_status#lstatus.LexiconEngine.aliases
+          ~universe:(Some lexicon_status#lstatus.LexiconEngine.multi_aliases)
           ~context ~metasenv ~subst:[] 
           (text,prefix_len,term) ~expty) in
     let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
@@ -603,7 +619,7 @@ let rec disambiguate_tactic
           | `Proof as t -> metasenv,t in
         metasenv,GrafiteAst.RewritingStep (loc, cic, cic', cic'', cont)   
 
-let disambiguate_obj lexicon_status ?baseuri metasenv (text,prefix_len,obj) =
+let disambiguate_obj estatus ?baseuri metasenv (text,prefix_len,obj) =
   let uri =
    let baseuri = 
      match baseuri with Some x -> x | None -> raise BaseUriNotSetYet
@@ -652,7 +668,7 @@ let disambiguate_obj lexicon_status ?baseuri metasenv (text,prefix_len,obj) =
                 let _,g = CicTypeChecker.typecheck uri in
                 CicUniv.merge_ugraphs ~base_ugraph:graph ~increment:(g,uri))
              graph l)
-       graph (CoercDb.to_list ())
+       graph (CoercDb.to_list (CoercDb.dump ()))
    in
    ignore(CicUniv.do_rank graph);
 
@@ -671,14 +687,14 @@ let disambiguate_obj lexicon_status ?baseuri metasenv (text,prefix_len,obj) =
        (try
          (match 
           NCicDisambiguate.disambiguate_obj
-           ~lookup_in_library
+           ~rdb:estatus
+           ~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) 
+           ~aliases:estatus#lstatus.LexiconEngine.aliases
+           ~universe:(Some estatus#lstatus.LexiconEngine.multi_aliases)
            (text,prefix_len,obj)
          with
          | [_,_,_,obj],_ ->
@@ -718,10 +734,11 @@ let disambiguate_obj lexicon_status ?baseuri metasenv (text,prefix_len,obj) =
         ~mk_choice:cic_mk_choice
         ~mk_implicit
         ~description_of_alias:LexiconAst.description_of_alias
-        ~aliases:lexicon_status.LexiconEngine.aliases
-        ~universe:(Some lexicon_status.LexiconEngine.multi_aliases) 
+        ~aliases:estatus#lstatus.LexiconEngine.aliases
+        ~universe:(Some estatus#lstatus.LexiconEngine.multi_aliases) 
         ~uri:(Some uri)
-        (text,prefix_len,obj)) in
+        (text,prefix_len,obj)) 
+  in
 
 
 (*
@@ -732,22 +749,50 @@ let disambiguate_obj lexicon_status ?baseuri metasenv (text,prefix_len,obj) =
 (*    try_new (Some cic);   *)
 
 
-  let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
-  lexicon_status, metasenv, cic
+  let estatus = LexiconEngine.set_proof_aliases estatus diff in
+   estatus, metasenv, cic
 
  with 
  | Sys.Break as exn -> raise exn
  | exn ->
 (*    try_new None; *)
    raise exn
+;;
 
+let disambiguate_nobj estatus ?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)
+      ~rdb:estatus
+      ~aliases:estatus#lstatus.LexiconEngine.aliases
+      ~universe:(Some estatus#lstatus.LexiconEngine.multi_aliases) 
+      (text,prefix_len,obj)) in
+  let estatus = LexiconEngine.set_proof_aliases estatus diff in
+   estatus, cic
 ;;
   
-let disambiguate_command lexicon_status ?baseuri metasenv (text,prefix_len,cmd)=
+let disambiguate_command estatus ?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 lexicon_status_ref = ref estatus in 
        let disambiguate_term =
          disambiguate_term None text prefix_len lexicon_status_ref [] in
        let disambiguate_term_option metasenv =
@@ -758,48 +803,42 @@ let disambiguate_command lexicon_status ?baseuri metasenv (text,prefix_len,cmd)=
                  metasenv, Some t
        in
        let metasenv,key = disambiguate_term_option metasenv key in
-       !lexicon_status_ref, metasenv,GrafiteAst.Index(loc,key,uri)
+        !lexicon_status_ref,metasenv,GrafiteAst.Index(loc,key,uri)
    | GrafiteAst.Select (loc,uri) -> 
-        lexicon_status, metasenv, GrafiteAst.Select(loc,uri)
+        estatus, metasenv, GrafiteAst.Select(loc,uri)
    | GrafiteAst.Pump(loc,i) -> 
-        lexicon_status, metasenv, GrafiteAst.Pump(loc,i)
+        estatus, metasenv, GrafiteAst.Pump(loc,i)
    | GrafiteAst.PreferCoercion (loc,t) -> 
-       let lexicon_status_ref = ref lexicon_status in 
+       let lexicon_status_ref = ref estatus 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.PreferCoercion (loc,t)
+       !lexicon_status_ref, metasenv, GrafiteAst.PreferCoercion (loc,t)
    | GrafiteAst.Coercion (loc,t,b,a,s) -> 
-       let lexicon_status_ref = ref lexicon_status in 
+       let lexicon_status_ref = ref estatus 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.Coercion (loc,t,b,a,s)
+       !lexicon_status_ref, metasenv, GrafiteAst.Coercion (loc,t,b,a,s)
    | 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 =
+       let lexicon_status_ref = ref estatus 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,n)
+       let metasenv,indty = disambiguate_term metasenv indty in
+        !lexicon_status_ref, metasenv, GrafiteAst.Inverter (loc,n,indty,params)
    | GrafiteAst.Default _
    | GrafiteAst.Drop _
    | GrafiteAst.Include _
    | GrafiteAst.Print _
    | GrafiteAst.Qed _
-   | GrafiteAst.NQed _
    | GrafiteAst.Set _ as cmd ->
-       lexicon_status,metasenv,cmd
+       estatus,metasenv,cmd
    | GrafiteAst.Obj (loc,obj) ->
-       let lexicon_status,metasenv,obj =
-        disambiguate_obj lexicon_status ?baseuri metasenv (text,prefix_len,obj)in
-       lexicon_status, metasenv, GrafiteAst.Obj (loc,obj)
+       let estatus,metasenv,obj =
+        disambiguate_obj estatus ?baseuri metasenv (text,prefix_len,obj)in
+       estatus, metasenv, GrafiteAst.Obj (loc,obj)
    | GrafiteAst.Relation (loc,id,a,aeq,refl,sym,trans) ->
-      let lexicon_status_ref = ref lexicon_status in 
+      let lexicon_status_ref = ref estatus in 
       let disambiguate_term =
        disambiguate_term None text prefix_len lexicon_status_ref [] in
       let disambiguate_term_option metasenv =