X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FgTopLevel%2FbatchParser.ml;h=0d959ac6540861dbd31bdb9843079ca89a56673f;hb=4adceafdaa4cd82c427ac9de494179c242e7ad28;hp=05fd7a614e0098b97daae67ace0da6b83dfe152a;hpb=ded0396c81ec49a45d9406becb602e1071e6820b;p=helm.git diff --git a/helm/gTopLevel/batchParser.ml b/helm/gTopLevel/batchParser.ml index 05fd7a614..0d959ac65 100644 --- a/helm/gTopLevel/batchParser.ml +++ b/helm/gTopLevel/batchParser.ml @@ -28,29 +28,51 @@ let verbose = false exception Failure of string let fail msg = raise (Failure msg) +let constants_only ~prefix = + let test_prefix = + if prefix = "" then + (fun _ -> true) + else + (fun uri -> Pcre.pmatch ~rex:(Pcre.regexp ("^" ^ prefix)) uri) + in + fun uri -> + test_prefix uri && (not (String.sub uri (String.length uri - 4) 4 = ".var")) + +let uri_predicate = ref (constants_only ~prefix:"") + +let uri_pred_of_conf tryvars ~prefix ~varsprefix = + if not tryvars then + constants_only ~prefix + else + let test_prefix = Pcre.pmatch ~rex:(Pcre.regexp ("^" ^ prefix)) in + let test_varsprefix = Pcre.pmatch ~rex:(Pcre.regexp ("^" ^ varsprefix)) in + fun uri -> + if String.sub uri (String.length uri - 4) 4 = ".var" then + test_varsprefix uri + else + test_prefix uri + module DisambiguateCallbacks = struct - let output_html ?(append_NL = true) msg = - if verbose then - (if append_NL then print_string else print_endline) - (Ui_logger.string_of_html_msg msg) - let interactive_user_uri_choice - ~selection_mode ?ok ?enable_button_for_non_vars ~title ~msg ~id = - List.filter - (fun uri -> not (String.sub uri (String.length uri - 4) 4 = ".var")) + ~selection_mode ?ok ?enable_button_for_non_vars ~title ~msg ~id choices = + List.filter !uri_predicate choices + + let interactive_interpretation_choice = + let rec aux n = + function + [] -> [] + | _::tl -> n::(aux (n+1) tl) + in + aux 0 - let interactive_interpretation_choice _ = fail "Multiple interpretations" let input_or_locate_uri ~title = fail "Unknown identifier" end module Disambiguate' = DisambiguatingParser.Make (DisambiguateCallbacks) -let mqi_debug_fun = ignore -let mqi_flags = [] -let mqi_handle = MQIConn.init mqi_flags mqi_debug_fun - -let parse = +let parse mqi_handle ?(uri_pred = constants_only ~prefix:"") = + uri_predicate := uri_pred; let empty_environment = DisambiguatingParser.EnvironmentP3.of_string DisambiguatingParser.EnvironmentP3.empty @@ -58,11 +80,10 @@ let parse = let empty_context = [] in let empty_metasenv = [] in fun input -> - let (_, metasenv, term) = - Disambiguate'.disambiguate_term - mqi_handle empty_context empty_metasenv input empty_environment - in - (metasenv, term) + (Disambiguate'.disambiguate_term + mqi_handle empty_context empty_metasenv input empty_environment) -let parse_pp input = CicPp.ppterm (snd (parse input)) +let parse_pp mqi_handle ?uri_pred input = + List.map (fun (_,_,t) -> CicPp.ppterm t) + (parse mqi_handle ?uri_pred input)