X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fmatita%2FmatitaEngine.ml;h=cf8d6860b14608d60ef443ce01919a03c1483f8c;hb=a3ca416fdbe04b22a921dfd18b55e67564b045cc;hp=8772fd03bb0ee35ca47d57b89d49d8cdbe536a5b;hpb=c807ee67cbb2406dfb6fd49677ddabf7d5f14a9b;p=helm.git diff --git a/helm/software/matita/matitaEngine.ml b/helm/software/matita/matitaEngine.ml index 8772fd03b..cf8d6860b 100644 --- a/helm/software/matita/matitaEngine.ml +++ b/helm/software/matita/matitaEngine.ml @@ -35,7 +35,7 @@ let disambiguate_tactic text prefix_len lexicon_status_ref grafite_status goal t GrafiteDisambiguate.disambiguate_tactic lexicon_status_ref (GrafiteTypes.get_proof_context grafite_status goal) - (GrafiteTypes.get_proof_metasenv grafite_status) + (GrafiteTypes.get_proof_metasenv grafite_status) (Some goal) tac in GrafiteTypes.set_metasenv metasenv grafite_status,tac @@ -63,19 +63,40 @@ let eval_ast ?do_heavy_checks lexicon_status = let lexicon_status_ref = ref lexicon_status in let baseuri = GrafiteTypes.get_baseuri grafite_status in + let changed_lexicon = ref false in + let wrap f x = changed_lexicon := true; f x in + let grafite_status = + match grafite_status.GrafiteTypes.ng_status with + | GrafiteTypes.CommandMode _ -> + { grafite_status with GrafiteTypes.ng_status = + GrafiteTypes.CommandMode lexicon_status } + | GrafiteTypes.ProofMode s -> + { grafite_status with GrafiteTypes.ng_status = + GrafiteTypes.ProofMode + { s with NTacStatus.istatus = { s.NTacStatus.istatus with NTacStatus.lstatus = lexicon_status }}} + in let new_grafite_status,new_objs = GrafiteEngine.eval_ast - ~disambiguate_tactic:(disambiguate_tactic text prefix_len lexicon_status_ref) - ~disambiguate_command:(disambiguate_command lexicon_status_ref) - ~disambiguate_macro:(disambiguate_macro lexicon_status_ref) + ~disambiguate_tactic:(wrap (disambiguate_tactic text prefix_len lexicon_status_ref)) + ~disambiguate_command:(wrap (disambiguate_command lexicon_status_ref)) + ~disambiguate_macro:(wrap (disambiguate_macro lexicon_status_ref)) ?do_heavy_checks grafite_status (text,prefix_len,ast) in let new_lexicon_status = - LexiconSync.add_aliases_for_objs !lexicon_status_ref new_objs in + if !changed_lexicon then + !lexicon_status_ref + else + match new_grafite_status.GrafiteTypes.ng_status with + | GrafiteTypes.CommandMode l -> l + | GrafiteTypes.ProofMode s -> s.NTacStatus.istatus.NTacStatus.lstatus + in + let new_lexicon_status = + LexiconSync.add_aliases_for_objs new_lexicon_status new_objs in let new_aliases = LexiconSync.alias_diff ~from:lexicon_status new_lexicon_status in let _,intermediate_states = List.fold_left - (fun (lexicon_status,acc) (k,((v,_) as value)) -> + (fun (lexicon_status,acc) (k,value) -> + let v = LexiconAst.description_of_alias value in let b = try (* this hack really sucks! *) @@ -98,7 +119,7 @@ let eval_ast ?do_heavy_checks lexicon_status ((new_grafite_status,new_lexicon_status),None)::intermediate_states exception TryingToAdd of string -exception EnrichedWithLexiconStatus of exn * LexiconEngine.status +exception EnrichedWithStatus of exn * LexiconEngine.status * GrafiteTypes.status let out = ref ignore @@ -108,6 +129,7 @@ let eval_from_stream ~first_statement_only ~include_paths ?do_heavy_checks ?(enforce_no_new_aliases=true) ?(watch_statuses=fun _ _ -> ()) lexicon_status grafite_status str cb = + let matita_debug = Helm_registry.get_bool "matita.debug" in let rec loop lexicon_status grafite_status statuses = let loop = if first_statement_only then fun _ _ statuses -> statuses @@ -140,12 +162,8 @@ let eval_from_stream ~first_statement_only ~include_paths (fun (_,alias) -> match alias with None -> () - | Some (k,((v,_) as value)) -> - let newtxt = - DisambiguatePp.pp_environment - (DisambiguateTypes.Environment.add k value - DisambiguateTypes.Environment.empty) - in + | Some (k,value) -> + let newtxt = LexiconAstPp.pp_alias value in raise (TryingToAdd newtxt)) new_statuses; let grafite_status,lexicon_status = match new_statuses with @@ -154,8 +172,8 @@ let eval_from_stream ~first_statement_only ~include_paths in watch_statuses lexicon_status grafite_status ; false, lexicon_status, grafite_status, (new_statuses @ statuses)) - with exn when (not (Helm_registry.get_bool "matita.debug")) -> - raise (EnrichedWithLexiconStatus (exn, lexicon_status)) + with exn when not matita_debug -> + raise (EnrichedWithStatus (exn, lexicon_status, grafite_status)) in if stop then s else loop l g s in