]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/components/grafite_parser/grafiteDisambiguate.ml
Experimental enhancements to the ndestruct tactic. By using the syntax
[helm.git] / helm / software / components / grafite_parser / grafiteDisambiguate.ml
index 0dfab7a371c376fadb1dda67e61bc94861db1c05..7ce0407e85d58e24a481f023b024a0eb49159368 100644 (file)
@@ -81,12 +81,18 @@ let ncic_mk_choice = function
         ~term_of_nref:(fun nref -> NCic.Const nref)
        name dsc
   | LexiconAst.Number_alias (_, dsc) -> 
-       let desc,f = DisambiguateChoices.lookup_num_by_dsc dsc in
-       desc, `Num_interp
+     (try
+       let desc,f = DisambiguateChoices.nlookup_num_by_dsc dsc in
+        desc, `Num_interp
+         (fun num -> match f with `Num_interp f -> f num | _ -> assert false)
+      with
+       DisambiguateChoices.Choice_not_found _ ->
+        let desc,f = DisambiguateChoices.lookup_num_by_dsc dsc in
+        desc, `Num_interp
          (fun num -> 
             fst (OCic2NCic.convert_term 
               (UriManager.uri_of_string "cic:/xxx/x.con") 
-              (match f with `Num_interp f -> f num | _ -> assert false)))
+              (match f with `Num_interp f -> f num | _ -> assert false))))
   | LexiconAst.Ident_alias (name, uri) -> 
      uri, `Sym_interp 
       (fun l->assert(l = []);
@@ -175,6 +181,24 @@ let nlookup_in_library
   | _ -> lookup_in_library interactive_user_uri_choice input_or_locate_uri item 
 ;;
 
+let fix_instance item l =
+ match item with
+    DisambiguateTypes.Symbol (_,n) ->
+     List.map
+      (function
+          LexiconAst.Symbol_alias (s,_,d) -> LexiconAst.Symbol_alias (s,n,d)
+        | _ -> assert false
+      ) l
+  | DisambiguateTypes.Num n ->
+     List.map
+      (function
+          LexiconAst.Number_alias (_,d) -> LexiconAst.Number_alias (n,d)
+        | _ -> assert false
+      ) l
+  | DisambiguateTypes.Id _ -> l
+;;
+
+
   (** @param term not meaningful when context is given *)
 let disambiguate_term expty text prefix_len lexicon_status_ref context metasenv
 term =
@@ -182,11 +206,11 @@ 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
+        ~mk_implicit ~fix_instance
         ~description_of_alias:LexiconAst.description_of_alias
         ~context ~metasenv ~subst:[] (text,prefix_len,term))
   in
@@ -200,19 +224,18 @@ let disambiguate_nterm expty estatus context metasenv subst thing
   let diff, metasenv, subst, cic =
     singleton "first"
       (NCicDisambiguate.disambiguate_term
-        ~rdb:estatus.NEstatus.rstatus.NRstatus.refiner_status
-        ~aliases:estatus.NEstatus.lstatus.LexiconEngine.aliases
+        ~rdb:estatus
+        ~aliases:estatus#lstatus.LexiconEngine.aliases
         ~expty 
-        ~universe:(Some estatus.NEstatus.lstatus.LexiconEngine.multi_aliases)
+        ~universe:(Some estatus#lstatus.LexiconEngine.multi_aliases)
         ~lookup_in_library:nlookup_in_library
         ~mk_choice:ncic_mk_choice
-        ~mk_implicit
+        ~mk_implicit ~fix_instance
         ~description_of_alias:LexiconAst.description_of_alias
         ~context ~metasenv ~subst thing)
   in
-  let lexicon_status = 
-    LexiconEngine.set_proof_aliases estatus.NEstatus.lstatus diff in
-  metasenv, subst, { estatus with NEstatus.lstatus = lexicon_status }, cic
+  let estatus = LexiconEngine.set_proof_aliases estatus diff in
+   metasenv, subst, estatus, cic
 ;;
 
 
@@ -229,10 +252,10 @@ let disambiguate_lazy_term expty text prefix_len lexicon_status_ref term =
         (CicDisambiguate.disambiguate_term 
           ~lookup_in_library
           ~mk_choice:cic_mk_choice
-          ~mk_implicit
+          ~mk_implicit ~fix_instance
           ~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
@@ -284,15 +307,18 @@ let disambiguate_reduction_kind text prefix_len lexicon_status_ref = function
 ;;
 
 let disambiguate_auto_params 
-  disambiguate_term metasenv context (terms, params) 
+  disambiguate_term metasenv context (oterms, params) 
 =
-    let metasenv, terms = 
-      List.fold_right 
-       (fun t (metasenv, terms) ->
-         let metasenv,t = disambiguate_term context metasenv t in
-         metasenv,t::terms) terms (metasenv, [])
-    in
-    metasenv, (terms, params)
+  match oterms with 
+    | None -> metasenv, (None, params)
+    | Some terms ->
+       let metasenv, terms = 
+         List.fold_right 
+           (fun t (metasenv, terms) ->
+               let metasenv,t = disambiguate_term context metasenv t in
+                metasenv,t::terms) terms (metasenv, [])
+       in
+         metasenv, (Some terms, params)
 ;;
 
 let disambiguate_just disambiguate_term context metasenv =
@@ -629,11 +655,12 @@ let disambiguate_obj estatus ?baseuri metasenv (text,prefix_len,obj) =
      match obj with
      | CicNotationPt.Inductive (_,(name,_,_,_)::_)
      | CicNotationPt.Record (_,name,_,_) -> name ^ ".ind"
-     | CicNotationPt.Theorem (_,name,_,_) -> name ^ ".con"
+     | CicNotationPt.Theorem (_,name,_,_,_) -> name ^ ".con"
      | CicNotationPt.Inductive _ -> assert false
    in
      UriManager.uri_of_string (baseuri ^ "/" ^ name)
   in
+(*
  let _try_new cic =
   (NCicLibrary.clear_cache ();
    NCicEnvironment.invalidate ();
@@ -688,14 +715,14 @@ let disambiguate_obj estatus ?baseuri metasenv (text,prefix_len,obj) =
        (try
          (match 
           NCicDisambiguate.disambiguate_obj
-           ~rdb:estatus.NEstatus.rstatus.NRstatus.refiner_status
+           ~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)
-           ~aliases:estatus.NEstatus.lstatus.LexiconEngine.aliases
-           ~universe:(Some estatus.NEstatus.lstatus.LexiconEngine.multi_aliases)
+           ~aliases:estatus#lstatus.LexiconEngine.aliases
+           ~universe:(Some estatus#lstatus.LexiconEngine.multi_aliases)
            (text,prefix_len,obj)
          with
          | [_,_,_,obj],_ ->
@@ -722,22 +749,22 @@ let disambiguate_obj estatus ?baseuri metasenv (text,prefix_len,obj) =
        )
   )
  in 
+*)
 
 
  try
 (*   let time = Unix.gettimeofday () in  *)
 
 
-  let lexicon_status = estatus.NEstatus.lstatus in
   let (diff, metasenv, _, cic, _) =
     singleton "third"
       (CicDisambiguate.disambiguate_obj 
         ~lookup_in_library 
         ~mk_choice:cic_mk_choice
-        ~mk_implicit
+        ~mk_implicit ~fix_instance
         ~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
@@ -751,8 +778,8 @@ let disambiguate_obj estatus ?baseuri metasenv (text,prefix_len,obj) =
 (*    try_new (Some cic);   *)
 
 
-  let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in
-  { estatus with NEstatus.lstatus = lexicon_status }, metasenv, cic
+  let estatus = LexiconEngine.set_proof_aliases estatus diff in
+   estatus, metasenv, cic
 
  with 
  | Sys.Break as exn -> raise exn
@@ -770,7 +797,7 @@ let disambiguate_nobj estatus ?baseuri (text,prefix_len,obj) =
      match obj with
      | CicNotationPt.Inductive (_,(name,_,_,_)::_)
      | CicNotationPt.Record (_,name,_,_) -> name ^ ".ind"
-     | CicNotationPt.Theorem (_,name,_,_) -> name ^ ".con"
+     | CicNotationPt.Theorem (_,name,_,_,_) -> name ^ ".con"
      | CicNotationPt.Inductive _ -> assert false
    in
      UriManager.uri_of_string (baseuri ^ "/" ^ name)
@@ -781,22 +808,20 @@ let disambiguate_nobj estatus ?baseuri (text,prefix_len,obj) =
       ~lookup_in_library:nlookup_in_library
       ~description_of_alias:LexiconAst.description_of_alias
       ~mk_choice:ncic_mk_choice
-      ~mk_implicit
+      ~mk_implicit ~fix_instance
       ~uri:(OCic2NCic.nuri_of_ouri uri)
-      ~rdb:estatus.NEstatus.rstatus.NRstatus.refiner_status
-      ~aliases:estatus.NEstatus.lstatus.LexiconEngine.aliases
-      ~universe:(Some estatus.NEstatus.lstatus.LexiconEngine.multi_aliases) 
+      ~rdb:estatus
+      ~aliases:estatus#lstatus.LexiconEngine.aliases
+      ~universe:(Some estatus#lstatus.LexiconEngine.multi_aliases) 
       (text,prefix_len,obj)) in
-  let lexicon_status =
-    LexiconEngine.set_proof_aliases estatus.NEstatus.lstatus diff in
-  { estatus with NEstatus.lstatus = lexicon_status }, cic
+  let estatus = LexiconEngine.set_proof_aliases estatus diff in
+   estatus, cic
 ;;
   
 let disambiguate_command estatus ?baseuri metasenv (text,prefix_len,cmd)=
   match cmd with
-   | GrafiteAst.NObj(loc,obj) -> estatus, metasenv, GrafiteAst.NObj(loc,obj)
    | GrafiteAst.Index(loc,key,uri) ->
-       let lexicon_status_ref = ref estatus.NEstatus.lstatus 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 =
@@ -807,41 +832,34 @@ let disambiguate_command estatus ?baseuri metasenv (text,prefix_len,cmd)=
                  metasenv, Some t
        in
        let metasenv,key = disambiguate_term_option metasenv key in
-       { estatus with NEstatus.lstatus = !lexicon_status_ref }, 
-       metasenv,GrafiteAst.Index(loc,key,uri)
+        !lexicon_status_ref,metasenv,GrafiteAst.Index(loc,key,uri)
    | GrafiteAst.Select (loc,uri) -> 
         estatus, metasenv, GrafiteAst.Select(loc,uri)
    | GrafiteAst.Pump(loc,i) -> 
         estatus, metasenv, GrafiteAst.Pump(loc,i)
    | GrafiteAst.PreferCoercion (loc,t) -> 
-       let lexicon_status_ref = ref estatus.NEstatus.lstatus 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
-      { estatus with NEstatus.lstatus = !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 estatus.NEstatus.lstatus 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
-      { estatus with NEstatus.lstatus = !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 estatus.NEstatus.lstatus in
+       let lexicon_status_ref = ref estatus in
        let disambiguate_term = 
          disambiguate_term None text prefix_len lexicon_status_ref [] in
        let metasenv,indty = disambiguate_term metasenv indty in
-       { estatus with NEstatus.lstatus = !lexicon_status_ref }, 
-       metasenv, GrafiteAst.Inverter (loc,n,indty,params)
-   | GrafiteAst.UnificationHint _
+        !lexicon_status_ref, metasenv, GrafiteAst.Inverter (loc,n,indty,params)
    | GrafiteAst.Default _
    | GrafiteAst.Drop _
    | GrafiteAst.Include _
    | GrafiteAst.Print _
    | GrafiteAst.Qed _
-   | GrafiteAst.NQed _
-   | GrafiteAst.NUnivConstraint _
    | GrafiteAst.Set _ as cmd ->
        estatus,metasenv,cmd
    | GrafiteAst.Obj (loc,obj) ->
@@ -849,7 +867,7 @@ let disambiguate_command estatus ?baseuri metasenv (text,prefix_len,cmd)=
         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 estatus.NEstatus.lstatus 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 =
@@ -864,7 +882,7 @@ let disambiguate_command estatus ?baseuri metasenv (text,prefix_len,cmd)=
       let metasenv,refl = disambiguate_term_option metasenv refl in
       let metasenv,sym = disambiguate_term_option metasenv sym in
       let metasenv,trans = disambiguate_term_option metasenv trans in
-      { estatus with NEstatus.lstatus = !lexicon_status_ref }, metasenv,
+       !lexicon_status_ref, metasenv,
         GrafiteAst.Relation (loc,id,a,aeq,refl,sym,trans)
 
 let disambiguate_macro