X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaDisambiguator.ml;h=f6db501b3f456267cff48818c395f8f722a2e98d;hb=8aaf525856e25bcd8f355e505fd00f45c62bc18f;hp=01e85e0c45c0f4ba42bffa85c6d29902c955a275;hpb=afd3b379d4959e4a18c1f26f25e4a9c14997866f;p=helm.git diff --git a/helm/matita/matitaDisambiguator.ml b/helm/matita/matitaDisambiguator.ml index 01e85e0c4..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,61 +23,44 @@ * http://helm.cs.unibo.it/ *) -class parserr () = - object - method parseTerm = CicTextualParser2.parse_term - method parseTactical = CicTextualParser2.parse_tactical - end +open Printf + +open MatitaTypes + +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) = - (* TODO 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 *) - MatitaTypes.not_implemented - "MatitaDisambiguator: input_or_locate_uri callback" - 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 ~dbd context metasenv termAst ~aliases:env with - | [ (env, metasenv, term) 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 disambiguateTerm ?context ?metasenv ?env stream = - self#disambiguateTermAst ?context ?metasenv ?env - (parserr#parseTerm stream) + let interactive_interpretation_choice interp = + !_choose_interp_callback interp + + 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