X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fgrafite_parser%2FgrafiteDisambiguate.ml;h=ef9da1f2008f04e099175f5b3bb9c0e3cb0fcbe4;hb=13bfd154ade0996d34e7e723398ac7ab76a51717;hp=318b38f619d9fbec96560372e35532c100a55db6;hpb=ca41435a6021292ccba239aa173651c0be705b45;p=helm.git diff --git a/helm/software/components/grafite_parser/grafiteDisambiguate.ml b/helm/software/components/grafite_parser/grafiteDisambiguate.ml index 318b38f61..ef9da1f20 100644 --- a/helm/software/components/grafite_parser/grafiteDisambiguate.ml +++ b/helm/software/components/grafite_parser/grafiteDisambiguate.ml @@ -45,19 +45,71 @@ let singleton msg = function in HLog.debug debug; assert false + +let lookup_in_library interactive_user_uri_choice input_or_locate_uri item = + let dbd = LibraryDb.instance () in + let choices_of_id id = + let uris = Whelp.locate ~dbd id in + let uris = + match uris with + | [] -> + (match + (input_or_locate_uri + ~title:("URI matching \"" ^ id ^ "\" unknown.") + ?id:(Some id) ()) + with + | None -> [] + | Some uri -> [uri]) + | [uri] -> [uri] + | _ -> + interactive_user_uri_choice ~selection_mode:`MULTIPLE + ?ok:(Some "Try selected.") + ?enable_button_for_non_vars:(Some true) + ~title:"Ambiguous input." + ~msg: ("Ambiguous input \"" ^ id ^ + "\". Please, choose one or more interpretations:") + ~id + uris + in + List.map + (fun uri -> + (UriManager.string_of_uri uri, + let term = + try + CicUtil.term_of_uri uri + with exn -> + assert false + in + fun _ _ _ -> term)) + uris + in + match item with + | DisambiguateTypes.Id id -> choices_of_id id + | DisambiguateTypes.Symbol (symb, _) -> + (try + List.map DisambiguateChoices.mk_choice + (TermAcicContent.lookup_interpretations symb) + with + TermAcicContent.Interpretation_not_found -> []) + | DisambiguateTypes.Num instance -> + DisambiguateChoices.lookup_num_choices () +;; + (** @param term not meaningful when context is given *) -let disambiguate_term text prefix_len lexicon_status_ref context metasenv term = +let disambiguate_term goal text prefix_len lexicon_status_ref context metasenv +term = let lexicon_status = !lexicon_status_ref in - let (diff, metasenv, cic, _) = + let (diff, metasenv, subst, cic, _) = singleton "first" - (GrafiteDisambiguator.disambiguate_term ~dbd:(LibraryDb.instance ()) + (MultiPassDisambiguator.disambiguate_term ~aliases:lexicon_status.LexiconEngine.aliases - ~universe:(Some lexicon_status.LexiconEngine.multi_aliases) - ~context ~metasenv (text,prefix_len,term)) + ?goal ~universe:(Some lexicon_status.LexiconEngine.multi_aliases) + ~lookup_in_library + ~context ~metasenv ~subst:[] (text,prefix_len,term)) in let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in lexicon_status_ref := lexicon_status; - metasenv,cic + metasenv,(*subst,*) cic ;; (** disambiguate_lazy_term (circa): term -> (unit -> status) * lazy_term @@ -65,15 +117,15 @@ let disambiguate_term text prefix_len lexicon_status_ref context metasenv 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 text prefix_len lexicon_status_ref term = +let disambiguate_lazy_term goal text prefix_len lexicon_status_ref term = (fun context metasenv ugraph -> let lexicon_status = !lexicon_status_ref in - let (diff, metasenv, cic, ugraph) = + let (diff, metasenv, _, cic, ugraph) = singleton "second" - (GrafiteDisambiguator.disambiguate_term ~dbd:(LibraryDb.instance ()) + (MultiPassDisambiguator.disambiguate_term ~lookup_in_library ~initial_ugraph:ugraph ~aliases:lexicon_status.LexiconEngine.aliases ~universe:(Some lexicon_status.LexiconEngine.multi_aliases) - ~context ~metasenv + ~context ~metasenv ~subst:[] ?goal (text,prefix_len,term)) in let lexicon_status = LexiconEngine.set_proof_aliases lexicon_status diff in lexicon_status_ref := lexicon_status; @@ -83,7 +135,7 @@ let disambiguate_lazy_term text prefix_len lexicon_status_ref term = let disambiguate_pattern text prefix_len lexicon_status_ref (wanted, hyp_paths, goal_path) = - let interp path = Disambiguate.interpretate_path [] path in + let interp path =CicDisambiguate.interpretate_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 = @@ -91,7 +143,7 @@ let disambiguate_pattern None -> None | Some wanted -> let wanted = - disambiguate_lazy_term text prefix_len lexicon_status_ref wanted + disambiguate_lazy_term None text prefix_len lexicon_status_ref wanted in Some wanted in @@ -100,7 +152,8 @@ let disambiguate_pattern let disambiguate_reduction_kind text prefix_len lexicon_status_ref = function | `Unfold (Some t) -> - let t = disambiguate_lazy_term text prefix_len lexicon_status_ref t in + let t = + disambiguate_lazy_term None text prefix_len lexicon_status_ref t in `Unfold (Some t) | `Normalize | `Simpl @@ -133,18 +186,20 @@ let disambiguate_just disambiguate_term context metasenv = ;; let rec disambiguate_tactic - lexicon_status_ref context metasenv (text,prefix_len,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 disambiguate_term = - disambiguate_term text prefix_len lexicon_status_ref in + disambiguate_term None text prefix_len lexicon_status_ref in let disambiguate_pattern = disambiguate_pattern text prefix_len lexicon_status_ref in let disambiguate_reduction_kind = disambiguate_reduction_kind text prefix_len lexicon_status_ref in let disambiguate_lazy_term = - disambiguate_lazy_term text prefix_len lexicon_status_ref in + disambiguate_lazy_term None text prefix_len lexicon_status_ref in let disambiguate_tactic metasenv tac = - disambiguate_tactic lexicon_status_ref context metasenv (text,prefix_len,tac) + disambiguate_tactic lexicon_status_ref context metasenv goal (text,prefix_len,tac) in let disambiguate_auto_params m p = disambiguate_auto_params disambiguate_term m context p @@ -207,6 +262,12 @@ let rec disambiguate_tactic | GrafiteAst.Apply (loc, term) -> let metasenv,cic = disambiguate_term context metasenv term in metasenv,GrafiteAst.Apply (loc, cic) + | GrafiteAst.ApplyRule (loc, term) -> + let metasenv,cic = disambiguate_term_hint context metasenv term in + metasenv,GrafiteAst.ApplyRule (loc, cic) + | GrafiteAst.ApplyP (loc, term) -> + let metasenv,cic = disambiguate_term context metasenv term in + metasenv,GrafiteAst.ApplyP (loc, cic) | GrafiteAst.ApplyS (loc, term, params) -> let metasenv, params = disambiguate_auto_params metasenv params in let metasenv,cic = disambiguate_term context metasenv term in @@ -446,9 +507,28 @@ let disambiguate_obj lexicon_status ?baseuri metasenv (text,prefix_len,obj) = | None -> raise BaseUriNotSetYet) | CicNotationPt.Inductive _ -> assert false | CicNotationPt.Theorem _ -> None in - let (diff, metasenv, cic, _) = + (* + (match obj with + CicNotationPt.Theorem (_,_,ty,_) -> + (try + let [_,_,_,ty],_ = + NMultiPassDisambiguator.disambiguate_term + ~context:[] ~metasenv:[] ~subst:[] + ~aliases:DisambiguateTypes.Environment.empty + ~universe:(Some DisambiguateTypes.Environment.empty) + ("",0,ty) + in + prerr_endline ("NUOVA DISAMBIGUAZIONE OK!!!!!!!!! " ^ + NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[] ty) + with NMultiPassDisambiguator.DisambiguationError _ -> + prerr_endline "ERRORE NUOVA DISAMBIGUAZIONE"; + assert false + | exn -> ()) + | _ -> () + ); *) + let (diff, metasenv, _, cic, _) = singleton "third" - (GrafiteDisambiguator.disambiguate_obj ~dbd:(LibraryDb.instance ()) + (MultiPassDisambiguator.disambiguate_obj ~lookup_in_library ~aliases:lexicon_status.LexiconEngine.aliases ~universe:(Some lexicon_status.LexiconEngine.multi_aliases) ~uri (text,prefix_len,obj)) in @@ -460,7 +540,7 @@ let disambiguate_command lexicon_status ?baseuri metasenv (text,prefix_len,cmd)= | GrafiteAst.Index(loc,key,uri) -> let lexicon_status_ref = ref lexicon_status in let disambiguate_term = - disambiguate_term text prefix_len lexicon_status_ref [] in + disambiguate_term None text prefix_len lexicon_status_ref [] in let disambiguate_term_option metasenv = function None -> metasenv,None @@ -473,7 +553,7 @@ let disambiguate_command lexicon_status ?baseuri metasenv (text,prefix_len,cmd)= | GrafiteAst.Coercion (loc,t,b,a,s) -> let lexicon_status_ref = ref lexicon_status in let disambiguate_term = - disambiguate_term text prefix_len lexicon_status_ref [] in + 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.Default _ @@ -490,7 +570,7 @@ let disambiguate_command lexicon_status ?baseuri metasenv (text,prefix_len,cmd)= | GrafiteAst.Relation (loc,id,a,aeq,refl,sym,trans) -> let lexicon_status_ref = ref lexicon_status in let disambiguate_term = - disambiguate_term text prefix_len lexicon_status_ref [] in + disambiguate_term None text prefix_len lexicon_status_ref [] in let disambiguate_term_option metasenv = function None -> metasenv,None @@ -509,7 +589,9 @@ let disambiguate_command lexicon_status ?baseuri metasenv (text,prefix_len,cmd)= let disambiguate_macro lexicon_status_ref metasenv context (text,prefix_len, macro) = - let disambiguate_term = disambiguate_term text prefix_len lexicon_status_ref in + let disambiguate_term = disambiguate_term None text prefix_len lexicon_status_ref in + let disambiguate_reduction_kind = + disambiguate_reduction_kind text prefix_len lexicon_status_ref in match macro with | GrafiteAst.WMatch (loc,term) -> let metasenv,term = disambiguate_term context metasenv term in @@ -526,6 +608,10 @@ let disambiguate_macro | GrafiteAst.Check (loc,term) -> let metasenv,term = disambiguate_term context metasenv term in metasenv,GrafiteAst.Check (loc,term) + | GrafiteAst.Eval (loc,kind,term) -> + let metasenv, term = disambiguate_term context metasenv term in + let kind = disambiguate_reduction_kind kind in + metasenv,GrafiteAst.Eval (loc,kind,term) | GrafiteAst.AutoInteractive (loc, params) -> let metasenv, params = disambiguate_auto_params disambiguate_term metasenv context params in