X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaDisambiguator.ml;h=f6db501b3f456267cff48818c395f8f722a2e98d;hb=358cefe50cccd4cb7d8e2a9cecb7efcb5780b8a3;hp=15f21e50909a934ee44747575cf6f6ed52e8c6b6;hpb=541a200b13431987114dd3fd88ec9764cee1e772;p=helm.git diff --git a/helm/matita/matitaDisambiguator.ml b/helm/matita/matitaDisambiguator.ml index 15f21e509..f6db501b3 100644 --- a/helm/matita/matitaDisambiguator.ml +++ b/helm/matita/matitaDisambiguator.ml @@ -1,4 +1,4 @@ -(* Copyright (C) 2004, HELM Team. +(* Copyright (C) 2004-2005, HELM Team. * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science @@ -23,71 +23,44 @@ * http://helm.cs.unibo.it/ *) +open Printf + open MatitaTypes -class parserr () = - object - method parseTerm = CicTextualParser2.parse_term - method parseTactical = CicTextualParser2.parse_tactical - end +exception Ambiguous_input -class disambiguator - ~parserr ~dbd ~(chooseUris: MatitaTypes.choose_uris_callback) - ~(chooseInterp: MatitaTypes.choose_interp_callback) () - = - let disambiguate_term = - let module Callbacks = - struct - let interactive_user_uri_choice - ~selection_mode ?ok ?(enable_button_for_non_vars = true) ~title ~msg - ~id uris - = - chooseUris ~selection_mode ~title ~msg - ~nonvars_button:enable_button_for_non_vars uris +type choose_uris_callback = id:string -> string list -> string list +type choose_interp_callback = (string * string) list list -> int list - let interactive_interpretation_choice = chooseInterp - let input_or_locate_uri ~(title:string) ?id = - (* Zack: I try to avoid using this callback. I therefore assume that - * the presence of an identifier that can't be resolved via "locate" - * query is a syntax error *) - let msg = match id with Some id -> id | _ -> "" in - raise (Unbound_identifier msg) - end - in - let module Disambiguator = Disambiguate.Make (Callbacks) in - Disambiguator.disambiguate_term - in - object (self) - val mutable parserr: parserr = parserr - method parserr = parserr - method setParserr p = parserr <- p +let mono_uris_callback ~id = raise Ambiguous_input +let mono_interp_callback _ = raise Ambiguous_input - val mutable _env = DisambiguateTypes.Environment.empty - method env = _env - method setEnv e = _env <- e +let _choose_uris_callback = ref mono_uris_callback +let _choose_interp_callback = ref mono_interp_callback +let set_choose_uris_callback f = _choose_uris_callback := f +let set_choose_interp_callback f = _choose_interp_callback := f - method disambiguateTermAst ?(context = []) ?(metasenv = []) ?env termAst = - let (save_state, env) = - match env with - | Some env -> (false, env) - | None -> (true, _env) - in - match disambiguate_term ~initial_ugraph:CicUniv.empty_ugraph - ~dbd context metasenv termAst ~aliases:env with - | [ (env, metasenv, term,ugraph) as x ] -> - if save_state then self#setEnv env; - x - | _ -> assert false +module Callbacks = + struct + let interactive_user_uri_choice ~selection_mode ?ok + ?(enable_button_for_non_vars = true) ~title ~msg ~id uris = + !_choose_uris_callback ~id uris - method disambiguateTermAsts ?(metasenv = []) ?env asts = - let ast = CicAst.pack asts in - let (env, metasenv, term, ugraph) = - self#disambiguateTermAst ~context:[] ~metasenv ?env ast - in - (env, metasenv, CicUtil.unpack term, ugraph) + let interactive_interpretation_choice interp = + !_choose_interp_callback interp - method disambiguateTerm ?context ?metasenv ?env stream = - self#disambiguateTermAst ?context ?metasenv ?env - (parserr#parseTerm stream) + let input_or_locate_uri ~(title:string) ?id = + (* Zack: I try to avoid using this callback. I therefore assume that + * the presence of an identifier that can't be resolved via "locate" + * query is a syntax error *) + let msg = match id with Some id -> id | _ -> "_" in + raise (Unbound_identifier msg) end + +module Disambiguator = Disambiguate.Make (Callbacks) + +(* implement module's API *) + +let disambiguate_term = Disambiguator.disambiguate_term +let disambiguate_obj = Disambiguator.disambiguate_obj