X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Flexicon%2FlexiconSync.ml;h=616c3ef5a1f3f71f6a6cdc37e21eecbbeb454518;hb=497563d35f24bbcbcbd8d669d73284b76a823118;hp=30031943d9bb1897a5fa4a2a0dc473a715b7c796;hpb=fc4cf455977934bd737c3d6c8675ef7663a6a588;p=helm.git diff --git a/helm/software/components/lexicon/lexiconSync.ml b/helm/software/components/lexicon/lexiconSync.ml index 30031943d..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,16 +85,32 @@ 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.empty_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 type t = CicNotation.notation_id - let compare = Pervasives.compare + let compare = CicNotation.compare_notation_id end module IdSet = Set.Make (OrderedId) @@ -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 ();;