X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=inline;f=helm%2Fsoftware%2Fcomponents%2Flexicon%2FlexiconSync.ml;h=616c3ef5a1f3f71f6a6cdc37e21eecbbeb454518;hb=0caee5d7da2d106650189660f4c74928a42b8b16;hp=b9c9b1cc2c43a77198fd1240e7d114f6a1407b24;hpb=e053aaf3085a079c3125ed4666ba648a48fbb2af;p=helm.git diff --git a/helm/software/components/lexicon/lexiconSync.ml b/helm/software/components/lexicon/lexiconSync.ml index b9c9b1cc2..616c3ef5a 100644 --- a/helm/software/components/lexicon/lexiconSync.ml +++ b/helm/software/components/lexicon/lexiconSync.ml @@ -28,9 +28,13 @@ let alias_diff ~from status = let module Map = DisambiguateTypes.Environment in Map.fold - (fun domain_item (description1,_ as codomain_item) acc -> + (fun domain_item codomain_item acc -> + let description1 = LexiconAst.description_of_alias codomain_item in try - let description2,_ = Map.find domain_item from.LexiconEngine.aliases in + let description2 = + LexiconAst.description_of_alias + (Map.find domain_item from.LexiconEngine.aliases) + in if description1 <> description2 then (domain_item,codomain_item)::acc else @@ -39,6 +43,7 @@ let alias_diff ~from status = Not_found -> (domain_item,codomain_item)::acc) status.LexiconEngine.aliases [] +;; let alias_diff = let profiler = HExtlib.profile "alias_diff(conteg. anche in include)" in @@ -60,8 +65,8 @@ let extract_alias types uri = let build_aliases = List.map (fun (name,uri) -> - DisambiguateTypes.Id name, - (UriManager.string_of_uri uri, fun _ _ _ -> CicUtil.term_of_uri uri)) + DisambiguateTypes.Id name, LexiconAst.Ident_alias (name, + UriManager.string_of_uri uri)) let add_aliases_for_inductive_def status types uri = let aliases = build_aliases (extract_alias types uri) in @@ -80,11 +85,27 @@ let add_aliases_for_object status uri = | Cic.Variable _ | Cic.CurrentProof _ -> assert false -let add_aliases_for_objs = - List.fold_left - (fun status uri -> - let obj,_ = CicEnvironment.get_obj CicUniv.oblivion_ugraph uri in - add_aliases_for_object status uri obj) +let add_aliases_for_objs status = + function + `Old uris -> + List.fold_left + (fun status uri -> + let obj,_ = CicEnvironment.get_obj CicUniv.oblivion_ugraph uri in + add_aliases_for_object status uri obj) status uris + | `New nrefs -> + List.fold_left + (fun status nref -> + let references = NCicLibrary.aliases_of nref in + let new_env = + List.map + (fun u -> + let name = NCicPp.r2s true u in + DisambiguateTypes.Id name, + LexiconAst.Ident_alias (name,NReference.string_of_reference u) + ) references + in + LexiconEngine.set_proof_aliases status new_env + ) status nrefs module OrderedId = struct @@ -109,3 +130,5 @@ let time_travel ~present ~past = in List.iter CicNotation.remove_notation notation_to_remove +let push () = CicNotation.push ();; +let pop () = CicNotation.pop ();;