X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FgTopLevel%2FbatchParser.ml;h=8eb800b84795f39be0b05a6f930ab132032db8d0;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=05fd7a614e0098b97daae67ace0da6b83dfe152a;hpb=ded0396c81ec49a45d9406becb602e1071e6820b;p=helm.git diff --git a/helm/gTopLevel/batchParser.ml b/helm/gTopLevel/batchParser.ml index 05fd7a614..8eb800b84 100644 --- a/helm/gTopLevel/batchParser.ml +++ b/helm/gTopLevel/batchParser.ml @@ -28,41 +28,63 @@ 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 dbd ?(uri_pred = constants_only ~prefix:"") = + uri_predicate := uri_pred; let empty_environment = DisambiguatingParser.EnvironmentP3.of_string DisambiguatingParser.EnvironmentP3.empty in 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) + fun input ugraph -> + (Disambiguate'.disambiguate_term + ~dbd empty_context empty_metasenv input empty_environment + ~initial_ugraph:ugraph) -let parse_pp input = CicPp.ppterm (snd (parse input)) +let parse_pp dbd ?uri_pred input ugraph = + List.map (fun (_,_,t,_) -> CicPp.ppterm t) + (parse dbd ?uri_pred input ugraph )