X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaDisambiguator.ml;h=e286fb5502a3714087fe925a2181d1ce75cda81b;hb=d9394782ed9580f3565eb9b4682d8348aae6349e;hp=183e775d0630e4b24c6433f455e5aa52d61adc52;hpb=07dde6f87105c18b28fc784b7d596a5d242e1225;p=helm.git diff --git a/helm/matita/matitaDisambiguator.ml b/helm/matita/matitaDisambiguator.ml index 183e775d0..e286fb550 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,60 +23,44 @@ * http://helm.cs.unibo.it/ *) -class parserr () = - object - method parseTerm (stream: char Stream.t) = - CicTextualParser2.parse_term stream +open Printf - (* TODO Zack: implements methods below *) - method parseTactic (_: char Stream.t) : DisambiguateTypes.tactic = - MatitaTypes.not_implemented "parserr.parseTactic" - method parseTactical (_: char Stream.t) : DisambiguateTypes.tactical = - MatitaTypes.not_implemented "parserr.parseTactical" - method parseCommand (_: char Stream.t) : DisambiguateTypes.command = - MatitaTypes.not_implemented "parserr.parseCommand" - method parseScript (_: char Stream.t) : DisambiguateTypes.script = - MatitaTypes.not_implemented "parserr.parseScript" - end +open MatitaTypes + +exception Ambiguous_input + +type choose_uris_callback = id:string -> UriManager.uri list -> UriManager.uri list +type choose_interp_callback = (string * string) list list -> int list -class disambiguator - ~parserr ~mqiconn ~(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 +let mono_uris_callback ~id = raise Ambiguous_input +let mono_interp_callback _ = raise Ambiguous_input - 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 _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 = DisambiguateTypes.Environment.empty) termAst - = - disambiguate_term mqiconn context metasenv termAst ~aliases:env +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