Commit d1e919a3 authored by David Hauzar's avatar David Hauzar

Better data structure for storing counter-example model.

parent 947e68e1
......@@ -11,6 +11,15 @@
open Stdlib
open Format
open Term
open Ident
open Printer
(*
***************************************************************
** Counter-example model values
****************************************************************
*)
type model_value =
| Integer of string
......@@ -68,6 +77,12 @@ print_model_value fmt value =
| Other s -> fprintf fmt "%s" s
| Array a -> print_array fmt a
(*
***************************************************************
** Model elements
***************************************************************
*)
type model_element = {
me_name : string;
me_value : model_value;
......@@ -87,40 +102,160 @@ let print_location fmt m_element =
match m_element.me_location with
| None -> fprintf fmt "\"no location\""
| Some loc -> Loc.report_position fmt loc
let rec print_model fmt model =
match model with
| [] -> ()
| m_element::t -> begin
fprintf fmt "\n%s at %a = %a"
m_element.me_name print_location m_element print_model_value m_element.me_value;
print_model fmt t
end
(*
***************************************************************
** Model definitions
***************************************************************
*)
module IntMap = Map.Make(struct type t = int let compare = compare end)
module StringMap = Map.Make(String)
type model_file = model_element list IntMap.t
type model = model_file StringMap.t
let empty_model = StringMap.empty
let empty_model_file = IntMap.empty
type model_parser = string -> Printer.printer_mapping -> model
type raw_model_parser = string -> model_element list
(*
***************************************************************
** Quering the model
***************************************************************
*)
let print_model_element fmt m_element =
fprintf fmt " %s = %a\n"
m_element.me_name print_model_value m_element.me_value
let print_model_elements fmt line m_elements =
fprintf fmt " Line %d:\n" line;
List.iter (print_model_element fmt) m_elements
let print_model_file fmt filename model_file =
fprintf fmt "File %s:\n" filename;
IntMap.iter (print_model_elements fmt) model_file
let print_model fmt model =
StringMap.iter (print_model_file fmt) model
let model_to_string model =
print_model str_formatter model;
flush_str_formatter ()
type model_parser = string -> Printer.printer_mapping -> model_element list
let get_model_file model filename =
try
StringMap.find filename model
with Not_found ->
empty_model_file
type reg_model_parser = Pp.formatted * model_parser
let get_elements model_file line_number =
try
IntMap.find line_number model_file
with Not_found ->
[]
let model_parsers : reg_model_parser Hstr.t = Hstr.create 17
(*
***************************************************************
** Building the model from raw model
***************************************************************
*)
let add_to_model model model_element =
match model_element.me_location with
| None -> model
| Some pos ->
let (filename, line_number, _, _) = Loc.get pos in
let model_file = get_model_file model filename in
let elements = get_elements model_file line_number in
let elements = model_element::elements in
let model_file = IntMap.add line_number elements model_file in
StringMap.add filename model_file model
(* Estabilish mapping to why3 code *)
let rec extract_element_name labels raw_string regexp =
match labels with
| [] -> raw_string
| label::labels_tail ->
let l_string = label.lab_string in
begin
try
ignore(Str.search_forward regexp l_string 0);
let end_pos = Str.match_end () in
String.sub l_string end_pos ((String.length l_string) - end_pos)
with Not_found -> extract_element_name labels_tail raw_string regexp
end
let get_element_name term raw_string =
let labels = Slab.elements term.t_label in
let regexp = Str.regexp "model_trace:" in
extract_element_name labels raw_string regexp
let rec build_model_rec raw_model terms model =
match raw_model with
| [] -> model
| model_element::raw_strings_tail ->
let (element_name, element_location, element_term, terms_tail) =
match terms with
| [] -> (model_element.me_name, None, None, [])
| term::t_tail ->
((get_element_name term model_element.me_name),
term.t_loc,
Some term, t_tail) in
let new_model_element = create_model_element
~name:element_name
~value:model_element.me_value
?location:element_location
?term:element_term
() in
let model = add_to_model model new_model_element in
build_model_rec
raw_strings_tail
terms_tail
model
let build_model raw_model printer_mapping =
build_model_rec raw_model printer_mapping.queried_terms empty_model
(*
***************************************************************
** Registering model parser
***************************************************************
*)
exception KnownModelParser of string
exception UnknownModelParser of string
type reg_model_parser = Pp.formatted * raw_model_parser
let model_parsers : reg_model_parser Hstr.t = Hstr.create 17
let make_mp_from_raw (raw_mp:raw_model_parser) =
fun input printer_mapping ->
let raw_model = raw_mp input in
build_model raw_model printer_mapping
let register_model_parser ~desc s p =
if Hstr.mem model_parsers s then raise (KnownModelParser s);
Hstr.replace model_parsers s (desc, p)
let lookup_model_parser s =
let lookup_raw_model_parser s =
try snd (Hstr.find model_parsers s)
with Not_found -> raise (UnknownModelParser s)
let lookup_model_parser s =
make_mp_from_raw (lookup_raw_model_parser s)
let list_model_parsers () =
Hstr.fold (fun k (desc,_) acc -> (k,desc)::acc) model_parsers []
let () = register_model_parser
~desc:"Model@ parser@ with@ no@ output@ (used@ if@ the@ solver@ does@ not@ support@ models." "no_model"
(fun _ _ -> [])
(fun _ -> [])
......@@ -9,7 +9,11 @@
(* *)
(********************************************************************)
(** Counter-example model values *)
(*
***************************************************************
** Counter-example model values
****************************************************************
*)
type model_value =
| Integer of string
| Array of model_array
......@@ -44,6 +48,12 @@ val array_add_element :
val print_model_value : Format.formatter -> model_value -> unit
(*
***************************************************************
** Model elements
***************************************************************
*)
(** Counter-example model elements. Each element represents
a counter-example for a single source-code element.*)
type model_element = {
......@@ -73,13 +83,41 @@ val create_model_element :
@param term : why term corresponding to the element *)
val print_model : Format.formatter -> model_element list -> unit
(*
***************************************************************
** Model definitions
***************************************************************
*)
type model
val empty_model : model
(*
***************************************************************
** Quering the model
***************************************************************
*)
val model_to_string : model_element list -> string
val print_model : Format.formatter -> model -> unit
val model_to_string : model -> string
(*
***************************************************************
** Registering model parser
***************************************************************
*)
type model_parser = string -> Printer.printer_mapping -> model
(** Parses the input string into model elements, estabilishes
a mapping between these elements and mapping from printer
and builds model data structure.
*)
type model_parser = string -> Printer.printer_mapping -> model_element list
type raw_model_parser = string -> model_element list
(** Parses the input string into model elements. *)
val register_model_parser : desc:Pp.formatted -> string -> model_parser -> unit
val register_model_parser : desc:Pp.formatted -> string -> raw_model_parser -> unit
val lookup_model_parser : string -> model_parser
......
......@@ -101,7 +101,7 @@ type prover_result = {
pr_output : string;
pr_time : float;
pr_steps : int; (* -1 if unknown *)
pr_model : model_element list;
pr_model : model;
}
type prover_result_parser = {
......@@ -135,7 +135,7 @@ let print_steps fmt s =
let print_prover_result fmt
{pr_answer=ans; pr_status=status; pr_output=out; pr_time=t; pr_steps=s; pr_model=m} =
fprintf fmt "%a (%.2fs%a)" print_prover_answer ans t print_steps s;
if m <> [] then begin
if m <> Model_parser.empty_model then begin
fprintf fmt "\nCounter-example model:";
Model_parser.print_model fmt m
end;
......
......@@ -44,7 +44,7 @@ type prover_result = {
pr_steps : int;
(** The number of steps taken by the prover (-1 if not available) *)
(** The model produced by a the solver *)
pr_model : model_element list;
pr_model : model;
}
val print_prover_answer : Format.formatter -> prover_answer -> unit
......
......@@ -10,66 +10,12 @@
(********************************************************************)
(* Parses the model returned by CVC4 and Z3. *)
open Printer
open Ident
open Term
open Model_parser
open Lexing
let debug = Debug.register_info_flag "parse_smtv2_model"
~desc:"Print@ debugging@ messages@ about@ parsing@ model@ \
returned@ from@ cvc4@ or@ z3."
(*
***************************************************************
** Estabilish mapping to why3 code
****************************************************************
*)
let rec extract_element_name labels raw_string regexp =
match labels with
| [] -> raw_string
| label::labels_tail ->
let l_string = label.lab_string in
begin
try
ignore(Str.search_forward regexp l_string 0);
let end_pos = Str.match_end () in
String.sub l_string end_pos ((String.length l_string) - end_pos)
with Not_found -> extract_element_name labels_tail raw_string regexp
end
let get_element_name term raw_string =
let labels = Slab.elements term.t_label in
let regexp = Str.regexp "model_trace:" in
extract_element_name labels raw_string regexp
(* Uses got from printer mapping to update model names and locations in model.
Assumes that the ordering of elements of terms corresponds the ordering
in raw_model. That is nth element of raw_model corresponds to the nth
element of terms. *)
let rec update_element_names_and_locations raw_model terms updated_model =
match raw_model with
| [] -> updated_model
| model_element::raw_strings_tail ->
let (element_name, element_location, element_term, terms_tail) =
match terms with
| [] -> (model_element.me_name, None, None, [])
| term::t_tail ->
((get_element_name term model_element.me_name),
term.t_loc,
Some term, t_tail) in
let new_model_element = create_model_element
~name:element_name
~value:model_element.me_value
?location:element_location
?term:element_term
() in
let updated_model = updated_model @ [new_model_element] in
update_element_names_and_locations
raw_strings_tail
terms_tail
updated_model
(*
***************************************************************
......@@ -104,7 +50,7 @@ let do_parsing model =
(* Parses the model returned by CVC4 or Z3.
Returns the list of pairs term - value *)
let parse input printer_mapping =
let parse input =
try
let r = Str.regexp "unknown\\|sat" in
ignore (Str.search_forward r input 0);
......@@ -112,12 +58,7 @@ let parse input printer_mapping =
let model_string =
String.sub input match_end ((String.length input) - match_end) in
let raw_model = do_parsing model_string in
update_element_names_and_locations
raw_model
printer_mapping.queried_terms
[]
do_parsing model_string
with
| Not_found -> []
......
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