Commit bd8b6aca authored by MARCHE Claude's avatar MARCHE Claude

suppress the ad-hoc interpretation of SMTLIB's (get-info :unknown-reason) command

parent 36b42d5e
...@@ -17,7 +17,8 @@ prelude "(set-logic AUFNIRA)" ...@@ -17,7 +17,8 @@ prelude "(set-logic AUFNIRA)"
*) *)
filename "%f-%t-%g.smt2" filename "%f-%t-%g.smt2"
unknown "^\\(unknown\\|sat\\|Fail\\)$" "" unknown "^\\(unknown\\|sat\\|Fail\\)$" "\\1"
unknown "^(:reason-unknown \\([^)]*\\))$" "\\1"
time "why3cpulimit time : %s s" time "why3cpulimit time : %s s"
valid "^unsat$" valid "^unsat$"
......
...@@ -19,10 +19,6 @@ let debug = Debug.register_info_flag "call_prover" ...@@ -19,10 +19,6 @@ let debug = Debug.register_info_flag "call_prover"
let debug_attrs = Debug.register_info_flag "print_attrs" let debug_attrs = Debug.register_info_flag "print_attrs"
~desc:"Print@ attrs@ of@ identifiers@ and@ expressions." ~desc:"Print@ attrs@ of@ identifiers@ and@ expressions."
type reason_unknown =
| Resourceout
| Other
(* BEGIN{proveranswer} anchor for automatic documentation, do not remove *) (* BEGIN{proveranswer} anchor for automatic documentation, do not remove *)
type prover_answer = type prover_answer =
| Valid | Valid
...@@ -30,7 +26,7 @@ type prover_answer = ...@@ -30,7 +26,7 @@ type prover_answer =
| Timeout | Timeout
| OutOfMemory | OutOfMemory
| StepLimitExceeded | StepLimitExceeded
| Unknown of (string * reason_unknown option) | Unknown of string
| Failure of string | Failure of string
| HighFailure | HighFailure
(* END{proveranswer} anchor for automatic documentation, do not remove *) (* END{proveranswer} anchor for automatic documentation, do not remove *)
...@@ -127,6 +123,7 @@ let rec grep_steps out = function ...@@ -127,6 +123,7 @@ let rec grep_steps out = function
Some(int_of_string v) Some(int_of_string v)
with _ -> grep_steps out l end with _ -> grep_steps out l end
(*
let grep_reason_unknown out = let grep_reason_unknown out =
try try
(* TODO: this is SMTLIB specific, should be done in drivers instead *) (* TODO: this is SMTLIB specific, should be done in drivers instead *)
...@@ -137,6 +134,7 @@ let grep_reason_unknown out = ...@@ -137,6 +134,7 @@ let grep_reason_unknown out =
| _ -> Other | _ -> Other
with Not_found -> with Not_found ->
Other Other
*)
type prover_result_parser = { type prover_result_parser = {
prp_regexps : (string * prover_answer) list; prp_regexps : (string * prover_answer) list;
...@@ -146,20 +144,13 @@ type prover_result_parser = { ...@@ -146,20 +144,13 @@ type prover_result_parser = {
prp_model_parser : Model_parser.model_parser; prp_model_parser : Model_parser.model_parser;
} }
let print_unknown_reason fmt = function
| Some Resourceout -> fprintf fmt "resource limit reached"
| Some Other -> fprintf fmt "other"
| None -> fprintf fmt "none"
let print_prover_answer fmt = function let print_prover_answer fmt = function
| Valid -> fprintf fmt "Valid" | Valid -> fprintf fmt "Valid"
| Invalid -> fprintf fmt "Invalid" | Invalid -> fprintf fmt "Invalid"
| Timeout -> fprintf fmt "Timeout" | Timeout -> fprintf fmt "Timeout"
| OutOfMemory -> fprintf fmt "Ouf Of Memory" | OutOfMemory -> fprintf fmt "Ouf Of Memory"
| StepLimitExceeded -> fprintf fmt "Step limit exceeded" | StepLimitExceeded -> fprintf fmt "Step limit exceeded"
| Unknown ("", r) -> fprintf fmt "Unknown (%a)" print_unknown_reason r | Unknown s -> fprintf fmt "Unknown (%s)" s
| Failure "" -> fprintf fmt "Failure"
| Unknown (s, r) -> fprintf fmt "Unknown %a(%s)" print_unknown_reason r s
| Failure s -> fprintf fmt "Failure (%s)" s | Failure s -> fprintf fmt "Failure (%s)" s
| HighFailure -> fprintf fmt "HighFailure" | HighFailure -> fprintf fmt "HighFailure"
...@@ -192,7 +183,7 @@ let rec grep out l = match l with ...@@ -192,7 +183,7 @@ let rec grep out l = match l with
ignore (Str.search_forward re out 0); ignore (Str.search_forward re out 0);
match pa with match pa with
| Valid | Invalid | Timeout | OutOfMemory | StepLimitExceeded -> pa | Valid | Invalid | Timeout | OutOfMemory | StepLimitExceeded -> pa
| Unknown (s, ru) -> Unknown ((Str.replace_matched s out), ru) | Unknown s -> Unknown (Str.replace_matched s out)
| Failure s -> Failure (Str.replace_matched s out) | Failure s -> Failure (Str.replace_matched s out)
| HighFailure -> assert false | HighFailure -> assert false
with Not_found -> grep out l end with Not_found -> grep out l end
...@@ -233,11 +224,20 @@ let debug_print_model ~print_attrs model = ...@@ -233,11 +224,20 @@ let debug_print_model ~print_attrs model =
let model_str = Model_parser.model_to_string ~print_attrs model in let model_str = Model_parser.model_to_string ~print_attrs model in
Debug.dprintf debug "Call_provers: %s@." model_str Debug.dprintf debug "Call_provers: %s@." model_str
type answer_or_model = Answer of prover_answer | Model of string
let analyse_result res_parser printer_mapping out = let analyse_result res_parser printer_mapping out =
let list_re = res_parser.prp_regexps in let list_re = res_parser.prp_regexps in
let re = craft_efficient_re list_re in let re = craft_efficient_re list_re in
let list_re = List.map (fun (a, b) -> Str.regexp a, b) list_re in let list_re = List.map (fun (a, b) -> Str.regexp a, b) list_re in
let result_list = Str.full_split re out in let result_list = Str.full_split re out in
let result_list =
List.map
(function
| Str.Delim r -> Answer (grep r list_re)
| Str.Text t -> Model t)
result_list
in
(* Format.eprintf "[incremental model parsing] results list is @[[%a]@]@." (* Format.eprintf "[incremental model parsing] results list is @[[%a]@]@."
(Pp.print_list Pp.semi print_delim) result_list; (Pp.print_list Pp.semi print_delim) result_list;
*) *)
...@@ -248,9 +248,25 @@ let analyse_result res_parser printer_mapping out = ...@@ -248,9 +248,25 @@ let analyse_result res_parser printer_mapping out =
(HighFailure, saved_model) (HighFailure, saved_model)
else else
(Opt.get saved_res, saved_model) (Opt.get saved_res, saved_model)
| Str.Delim res :: Str.Text model :: tl -> | Answer res1 :: (Answer res2 :: tl as tl1) ->
(* Parse the text of the result *) Debug.dprintf debug "Call_provers: two consecutive answers: %a %a@."
let res = grep res list_re in print_prover_answer res1 print_prover_answer res2;
begin
match res1,res2 with
| Unknown _, Unknown "resourceout" ->
analyse saved_model saved_res (Answer StepLimitExceeded :: tl)
| Unknown _, Unknown "timeout" ->
analyse saved_model saved_res (Answer Timeout :: tl)
| Unknown "", Unknown _ ->
analyse saved_model saved_res tl1
| Unknown s1, Unknown "" ->
analyse saved_model saved_res (Answer (Unknown s1) :: tl)
| Unknown s1, Unknown s2 ->
analyse saved_model saved_res (Answer (Unknown (s1 ^ " + " ^ s2)) :: tl)
| _,_ ->
analyse saved_model saved_res tl1
end
| Answer res :: Model model :: tl ->
if res = Valid then if res = Valid then
(Valid, None) (Valid, None)
else else
...@@ -260,13 +276,12 @@ let analyse_result res_parser printer_mapping out = ...@@ -260,13 +276,12 @@ let analyse_result res_parser printer_mapping out =
debug_print_model ~print_attrs:false m; debug_print_model ~print_attrs:false m;
let m = if is_model_empty m then saved_model else (Some m) in let m = if is_model_empty m then saved_model else (Some m) in
analyse m (Some res) tl analyse m (Some res) tl
| Str.Delim res :: tl -> | Answer res :: tl ->
let res = grep res list_re in
if res = Valid then if res = Valid then
(Valid, None) (Valid, None)
else else
analyse saved_model (Some res) tl analyse saved_model (Some res) tl
| Str.Text _fail :: tl -> analyse saved_model saved_res tl | Model _fail :: tl -> analyse saved_model saved_res tl
in in
analyse None None result_list analyse None None result_list
...@@ -288,17 +303,10 @@ let parse_prover_run res_parser signaled time out exitcode limit ~printer_mappin ...@@ -288,17 +303,10 @@ let parse_prover_run res_parser signaled time out exitcode limit ~printer_mappin
(* TODO let (n, m, t) = greps out res_parser.prp_regexps in (* TODO let (n, m, t) = greps out res_parser.prp_regexps in
t, None *) t, None *)
in in
let model = match model with | Some s -> s | None -> default_model in let model = match model with Some s -> s | None -> default_model in
Debug.dprintf debug "Call_provers: prover output:@\n%s@." out; Debug.dprintf debug "Call_provers: prover output:@\n%s@." out;
let time = Opt.get_def (time) (grep_time out res_parser.prp_timeregexps) in let time = Opt.get_def (time) (grep_time out res_parser.prp_timeregexps) in
let steps = Opt.get_def (-1) (grep_steps out res_parser.prp_stepregexps) in let steps = Opt.get_def (-1) (grep_steps out res_parser.prp_stepregexps) in
(* add info for unknown if possible. FIXME: this is too SMTLIB specific *)
let ans = match ans with
| Unknown (s, _) ->
let reason_unknown = grep_reason_unknown out in
Unknown (s, Some reason_unknown)
| _ -> ans
in
(* HighFailure or Unknown close to time limit are assumed to be timeouts *) (* HighFailure or Unknown close to time limit are assumed to be timeouts *)
let tlimit = float limit.limit_time in let tlimit = float limit.limit_time in
let ans, time = let ans, time =
...@@ -488,7 +496,7 @@ let query_result_buffer id = ...@@ -488,7 +496,7 @@ let query_result_buffer id =
with Not_found -> NoUpdates with Not_found -> NoUpdates
let editor_result ret = { let editor_result ret = {
pr_answer = Unknown ("", None); pr_answer = Unknown "not yet edited";
pr_status = ret; pr_status = ret;
pr_output = ""; pr_output = "";
pr_time = 0.0; pr_time = 0.0;
......
...@@ -15,13 +15,6 @@ open Model_parser ...@@ -15,13 +15,6 @@ open Model_parser
(** {2 data types for prover answers} *) (** {2 data types for prover answers} *)
(** The reason why unknown was reported *)
type reason_unknown =
| Resourceout
(** Out of resources *)
| Other
(** Other reason *)
type prover_answer = type prover_answer =
| Valid | Valid
(** The task is valid according to the prover *) (** The task is valid according to the prover *)
...@@ -33,7 +26,7 @@ type prover_answer = ...@@ -33,7 +26,7 @@ type prover_answer =
(** the task runs out of memory *) (** the task runs out of memory *)
| StepLimitExceeded | StepLimitExceeded
(** the task required more steps than the limit provided *) (** the task required more steps than the limit provided *)
| Unknown of (string * reason_unknown option) | Unknown of string
(** The prover can't determine if the task is valid *) (** The prover can't determine if the task is valid *)
| Failure of string | Failure of string
(** The prover reports a failure *) (** The prover reports a failure *)
......
...@@ -93,7 +93,7 @@ let load_driver_absolute = let driver_tag = ref (-1) in fun env file extra_files ...@@ -93,7 +93,7 @@ let load_driver_absolute = let driver_tag = ref (-1) in fun env file extra_files
| RegexpOutOfMemory s -> add_to_list regexps (s, OutOfMemory) | RegexpOutOfMemory s -> add_to_list regexps (s, OutOfMemory)
| RegexpStepLimitExceeded s -> | RegexpStepLimitExceeded s ->
add_to_list regexps (s, StepLimitExceeded) add_to_list regexps (s, StepLimitExceeded)
| RegexpUnknown (s,t) -> add_to_list regexps (s, Unknown (t, None)) | RegexpUnknown (s,t) -> add_to_list regexps (s, Unknown t)
| RegexpFailure (s,t) -> add_to_list regexps (s, Failure t) | RegexpFailure (s,t) -> add_to_list regexps (s, Failure t)
| TimeRegexp r -> add_to_list timeregexps (Call_provers.timeregexp r) | TimeRegexp r -> add_to_list timeregexps (Call_provers.timeregexp r)
| StepRegexp (r,ns) -> | StepRegexp (r,ns) ->
...@@ -104,7 +104,7 @@ let load_driver_absolute = let driver_tag = ref (-1) in fun env file extra_files ...@@ -104,7 +104,7 @@ let load_driver_absolute = let driver_tag = ref (-1) in fun env file extra_files
| ExitCodeOutOfMemory s -> add_to_list exitcodes (s, OutOfMemory) | ExitCodeOutOfMemory s -> add_to_list exitcodes (s, OutOfMemory)
| ExitCodeStepLimitExceeded s -> | ExitCodeStepLimitExceeded s ->
add_to_list exitcodes (s, StepLimitExceeded) add_to_list exitcodes (s, StepLimitExceeded)
| ExitCodeUnknown (s,t) -> add_to_list exitcodes (s, Unknown (t, None)) | ExitCodeUnknown (s,t) -> add_to_list exitcodes (s, Unknown t)
| ExitCodeFailure (s,t) -> add_to_list exitcodes (s, Failure t) | ExitCodeFailure (s,t) -> add_to_list exitcodes (s, Failure t)
| Filename s -> set_or_raise loc filename s "filename" | Filename s -> set_or_raise loc filename s "filename"
| Printer s -> set_or_raise loc printer s "printer" | Printer s -> set_or_raise loc printer s "printer"
......
...@@ -521,6 +521,9 @@ let add_check_sat info fmt = ...@@ -521,6 +521,9 @@ let add_check_sat info fmt =
if info.info_cntexample && info.info_cntexample_need_push then if info.info_cntexample && info.info_cntexample_need_push then
fprintf fmt "@[(push)@]@\n"; fprintf fmt "@[(push)@]@\n";
fprintf fmt "@[(check-sat)@]@\n"; fprintf fmt "@[(check-sat)@]@\n";
(* unfortunately we can't do that unconditionally, since it will make
CVC4 fail and immediately exit if last answer was not 'unknown' *)
(* fprintf fmt "@[(get-info :reason-unknown)@]@\n"; *)
if info.info_cntexample then if info.info_cntexample then
fprintf fmt "@[(get-model)@]@\n" fprintf fmt "@[(get-model)@]@\n"
......
...@@ -51,7 +51,7 @@ let convert_prover_answer (pa: prover_answer) = ...@@ -51,7 +51,7 @@ let convert_prover_answer (pa: prover_answer) =
| Timeout -> "Timeout","" | Timeout -> "Timeout",""
| OutOfMemory -> "OutOfMemory","" | OutOfMemory -> "OutOfMemory",""
| StepLimitExceeded -> "StepLimitExceeded","" | StepLimitExceeded -> "StepLimitExceeded",""
| Unknown(s,_) -> "Unknown",s | Unknown s -> "Unknown",s
| Failure s -> "Failure",s | Failure s -> "Failure",s
| HighFailure -> "HighFailure","" | HighFailure -> "HighFailure",""
...@@ -533,7 +533,7 @@ let parse_prover_answer a d = ...@@ -533,7 +533,7 @@ let parse_prover_answer a d =
| "Timeout" -> Timeout | "Timeout" -> Timeout
| "OutOfMemory" -> OutOfMemory | "OutOfMemory" -> OutOfMemory
| "StepLimitExceeded" -> StepLimitExceeded | "StepLimitExceeded" -> StepLimitExceeded
| "Unknown" -> Unknown (d,None) | "Unknown" -> Unknown d
| "Failure" -> Failure d | "Failure" -> Failure d
| "HighFailure" -> HighFailure | "HighFailure" -> HighFailure
| _ -> HighFailure | _ -> HighFailure
......
...@@ -930,7 +930,7 @@ let load_result r = ...@@ -930,7 +930,7 @@ let load_result r =
match status with match status with
| "valid" -> Call_provers.Valid | "valid" -> Call_provers.Valid
| "invalid" -> Call_provers.Invalid | "invalid" -> Call_provers.Invalid
| "unknown" -> Call_provers.Unknown ("", None) | "unknown" -> Call_provers.Unknown ""
| "timeout" -> Call_provers.Timeout | "timeout" -> Call_provers.Timeout
| "outofmemory" -> Call_provers.OutOfMemory | "outofmemory" -> Call_provers.OutOfMemory
| "failure" -> Call_provers.Failure "" | "failure" -> Call_provers.Failure ""
......
...@@ -164,7 +164,7 @@ the proof containing this prover are selected"; ...@@ -164,7 +164,7 @@ the proof containing this prover are selected";
Arg.Unit (fun () -> opt_status := Call_provers.Invalid::!opt_status), Arg.Unit (fun () -> opt_status := Call_provers.Invalid::!opt_status),
" filter the invalid goals"; " filter the invalid goals";
"--filter-unknown", "--filter-unknown",
Arg.String (fun s -> opt_status := Call_provers.Unknown (s, None)::!opt_status), Arg.String (fun s -> opt_status := Call_provers.Unknown s::!opt_status),
" filter when the prover reports it can't determine if the task is valid"; " filter when the prover reports it can't determine if the task is valid";
"--filter-failure", "--filter-failure",
Arg.String (fun s -> opt_status := Call_provers.Failure s::!opt_status), Arg.String (fun s -> opt_status := Call_provers.Failure s::!opt_status),
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment