Commit 1f6da25d authored by Sylvain Dailler's avatar Sylvain Dailler

Q217-025 Use get-model instead of get-values for CE

This commit allows parsing of the result of get-model from smtsolvers.
It changes the communication between why3 and Spark for CE to communicate
records and array as JSON values.

 * src/core/model_parser.ml
(model_value): Adding boolean and record type to model values.
(print_*): Changed printing functions to print arrays and records as JSON
values not as strings.

 * src/driver/collect_data_model.ml
(get_variables_*): collect all internal variables of a term and put them
into a map.
(add_all_cvc): Add all cvc4 variables in the model to a global map.
(add_vars_to_table): Add values of variables that can be deduced from ITE
 to the table.
(corres_else_element): Take the definitions of functions to_rep/of_rep
and extract the values of internal CVC variables from it.
(refine_*): Recursively replace internal variables in a term with values
taken from the table.
(convert_*): Convert to type model_value from model_parser.ml.
(create_list): Combine the following to get a list of model_value from
the parsing of the model.

* src/driver/parse_smtv2_model.ml
(parse): Changed the detected end of model.

* src/driver/parse_smtv2_model_lexer.mll
(rule): Added tokens related to model definitions and SPARK definitions of
records, discriminants and ref.

* src/driver/parse_smtv2_model_parser.mly
(output): Changed the parser so that it can parse a model as returned by
Cvc4 or z3.

* src/driver/smt2_model_defs.ml
(print_*): Added printing functions for terms.
(make_local*): Changes the AST of terms to differentiate smtsolver
internal variables, user-defined variables and local variables.
(subst*): Removes the local let bindings introduced by z3.
(build_record_discr): Put definitions of discriminants inside the record
definition.

 * src/printer/smtv2.ml
(print_logic_decl): Removed get-values and added get-model.

* src/transform/intro_projections_counterexmp.ml
(intro_const_equal_to_term): Only allow projections for attributes first,
last and field projections. Necessary when the field of a record is
itself on array on which we want to get First and Last.

* src/transform/intro_vc_vars_counterexmp.ml
(do_intro): Some definitions moved to intro_projections_counterexmp.ml.

Change-Id: Ib77fb66a2f7c53a9f54cfc300c8984e1fcec8087
parent 216f2ecd
......@@ -158,8 +158,8 @@ LIBGENERATED = src/util/config.ml \
src/parser/parser.mli src/parser/parser.ml \
src/driver/driver_parser.mli src/driver/driver_parser.ml \
src/driver/driver_lexer.ml \
src/driver/parse_smtv2_model_parser.mli src/driver/parse_smtv2_model_parser.ml \
src/driver/parse_smtv2_model_lexer.ml \
src/driver/parse_smtv2_model_parser.mli src/driver/parse_smtv2_model_parser.ml \
src/driver/parse_smtv2_model_lexer.ml \
src/session/compress.ml src/session/xml.ml \
src/session/strategy_parser.ml \
lib/ocaml/why3__BigInt_compat.ml
......@@ -173,8 +173,10 @@ LIB_CORE = ident ty term pattern decl theory \
task pretty dterm env trans printer model_parser
LIB_DRIVER = prove_client call_provers driver_ast driver_parser driver_lexer driver \
whyconf autodetection \
parse_smtv2_model_parser parse_smtv2_model_lexer parse_smtv2_model
whyconf autodetection \
smt2_model_defs parse_smtv2_model_parser \
collect_data_model parse_smtv2_model_lexer parse_smtv2_model \
parse_smtv2_model
LIB_MLW = ity expr dexpr pdecl pmodule
......
......@@ -30,17 +30,23 @@ let debug = Debug.register_info_flag "model_parser"
type model_value =
| Integer of string
| Decimal of (string * string)
| Boolean of bool
| Array of model_array
| Record of model_record
| Bitvector of string
| Unparsed of string
and arr_index = {
arr_index_key : model_value;
arr_index_key : string; (* Even array indices can exceed MAX_INT with Z3 *)
arr_index_value : model_value;
}
and model_array = {
arr_others : model_value;
arr_indices : arr_index list;
}
and model_record = {
discrs : model_value list;
fields : model_value list;
}
let array_create_constant ~value =
{
......@@ -61,37 +67,69 @@ let array_add_element ~array ~index ~value =
arr_indices = arr_index::array.arr_indices;
}
let rec print_indices fmt indices =
match indices with
| [] -> ()
| index::tail ->
fprintf fmt "%a => " print_model_value index.arr_index_key;
print_model_value fmt index.arr_index_value;
fprintf fmt ", ";
print_indices fmt tail
and
print_array fmt arr =
fprintf fmt "(";
print_indices fmt arr.arr_indices;
fprintf fmt "others => ";
print_model_value fmt arr.arr_others;
fprintf fmt ")"
and
print_model_value_sanit sanit_print fmt value =
(* Prints model value. *)
let rec convert_model_value value : Json.json =
match value with
| Integer s -> sanit_print fmt s
| Integer s ->
let m = Mstr.add "type" (Json.String "Integer") Stdlib.Mstr.empty in
let m = Mstr.add "val" (Json.String s) m in
Json.Record m
| Decimal (int_part, fract_part) ->
sanit_print fmt (int_part^"."^fract_part)
| Unparsed s -> sanit_print fmt s
let m = Mstr.add "type" (Json.String "Float") Stdlib.Mstr.empty in
let m = Mstr.add "val" (Json.String (int_part^"."^fract_part)) m in
Json.Record m
| Unparsed s ->
let m = Mstr.add "type" (Json.String "Unparsed") Stdlib.Mstr.empty in
let m = Mstr.add "val" (Json.String s) m in
Json.Record m
| Bitvector v ->
let m = Mstr.add "type" (Json.String "Bv") Stdlib.Mstr.empty in
let m = Mstr.add "val" (Json.String v) m in
Json.Record m
| Boolean b ->
let m = Mstr.add "type" (Json.String "Boolean") Stdlib.Mstr.empty in
let m = Mstr.add "val" (Json.Bool b) m in
Json.Record m
| Array a ->
print_array str_formatter a;
sanit_print fmt (flush_str_formatter ())
| Bitvector v -> sanit_print fmt v
and
print_model_value fmt value =
print_model_value_sanit (fun fmt s -> fprintf fmt "%s" s) fmt value
let l = convert_array a in
let m = Mstr.add "type" (Json.String "Array") Stdlib.Mstr.empty in
let m = Mstr.add "val" (Json.List l) m in
Json.Record m
| Record r ->
convert_record r
and convert_array a =
let m_others =
Mstr.add "others" (convert_model_value a.arr_others) Stdlib.Mstr.empty in
convert_indices a.arr_indices @ [Json.Record m_others]
and convert_indices indices =
match indices with
| [] -> []
| index :: tail ->
let m = Mstr.add "indice" (Json.String index.arr_index_key) Stdlib.Mstr.empty in
let m = Mstr.add "value" (convert_model_value index.arr_index_value) m in
Json.Record m :: convert_indices tail
and convert_record r =
let m = Mstr.add "type" (Json.String "Record") Stdlib.Mstr.empty in
let fields = convert_fields r.fields in
let discrs = convert_discrs r.discrs in
let m_field_discr = Mstr.add "Field" fields Stdlib.Mstr.empty in
let m_field_discr = Mstr.add "Discr" discrs m_field_discr in
let m = Mstr.add "val" (Json.Record m_field_discr) m in
Json.Record m
and convert_fields fields =
Json.List (List.map convert_model_value fields)
and convert_discrs discrs =
Json.List (List.map convert_model_value discrs)
let print_model_value_sanit fmt v =
let v = convert_model_value v in
Json.print_json fmt v
let print_model_value = print_model_value_sanit
(*
***************************************************************
......@@ -324,7 +362,7 @@ let interleave_with_source
*)
let print_model_element_json me_name_to_str fmt me =
let print_value fmt =
fprintf fmt "%a" (print_model_value_sanit Json.string) me.me_value in
fprintf fmt "%a" print_model_value_sanit me.me_value in
let print_kind fmt =
match me.me_name.men_kind with
| Result -> fprintf fmt "%a" Json.string "result"
......
......@@ -17,17 +17,23 @@
type model_value =
| Integer of string
| Decimal of (string * string)
| Boolean of bool
| Array of model_array
| Record of model_record
| Bitvector of string
| Unparsed of string
and arr_index = {
arr_index_key : model_value;
arr_index_key : string;
arr_index_value : model_value;
}
and model_array = {
arr_others : model_value;
arr_indices : arr_index list;
}
and model_record ={
discrs : model_value list;
fields : model_value list;
}
val array_create_constant :
value : model_value ->
......@@ -36,7 +42,7 @@ val array_create_constant :
val array_add_element :
array : model_array ->
index : model_value ->
index : string ->
value : model_value ->
model_array
(** Adds an element to the array.
......
This diff is collapsed.
(* Debugging function *)
val print_table:
Smt2_model_defs.correspondance_table -> unit
(* From the table generated by the parser, build a list of model_element *)
val create_list:
Smt2_model_defs.correspondance_table -> Model_parser.model_element list
......@@ -40,27 +40,35 @@ let do_parsing model =
Warning.emit
~loc:(get_position lexbuf)
"Error@ during@ lexing@ of@ smtlib@ model:@ unexpected character";
[]
Stdlib.Mstr.empty
| Parse_smtv2_model_parser.Error ->
begin
let loc = get_position lexbuf in
Warning.emit ~loc:loc "Error@ during@ parsing@ of@ smtlib@ model";
[]
Stdlib.Mstr.empty
end
let do_parsing model =
let m = do_parsing model in
Collect_data_model.create_list m
(* Parses the model returned by CVC4, Z3 or Alt-ergo.
Returns the list of pairs term - value *)
(* For Alt-ergo the output is not the same and we
match on "I don't know". But we also need to begin
parsing on a fresh new line ".*" ensures it *)
let parse input =
let parse : raw_model_parser = function input ->
try
let r = Str.regexp "unknown\\|sat\\|\\(I don't know.*\\)" in
ignore (Str.search_forward r input 0);
let match_end = Str.match_end () in
let nr1 = Str.regexp "(:reason-unknown" in
let nr2 = Str.regexp "(error \"Can" in
let res1 = try Str.search_forward nr1 input 0 with Not_found -> 0 in
let res2 = try Str.search_forward nr2 input 0 with Not_found -> 0 in
let res = max (res1) (res2) in
let model_string =
String.sub input match_end ((String.length input) - match_end) in
if res = 0 then "" else String.sub input match_end (res - match_end) in
do_parsing model_string
with
| Not_found -> []
......
......@@ -15,8 +15,9 @@
}
let atom = [^'('')'' ''\t''\n']
let space = [' ''\t''\n']
let space = [' ''\t''\n''\r']
let num = ['0'-'9']+
let opt_num = ['0'-'9']*
let dec_num = num"."num
rule token = parse
......@@ -24,7 +25,6 @@ rule token = parse
{ token lexbuf }
| space+ as space_str
{ SPACE (space_str) }
| "mk_t__ref"(num*) { MK_T_REF }
| "store" { STORE }
| "const" { CONST }
| "model" {MODEL}
......@@ -33,7 +33,40 @@ rule token = parse
{ LPAREN }
| ')'
{ RPAREN }
| ';' { read_string (Buffer.create 17) lexbuf }
| ";;" { read_string (Buffer.create 17) lexbuf }
| '=' { EQUAL }
| '_' { UNDERSCORE }
| "as-array" { AS_ARRAY }
| "ite" { ITE }
| "define-fun" { DEFINE_FUN }
| "declare-fun" { DECLARE_FUN }
| "declare-sort" { DECLARE_SORT } (* z3 declare functions *)
| "forall" { FORALL } (* z3 cardinality *)
| "declare-datatypes" { DECLARE_DATATYPES }
| "let" { LET }
| "true" { TRUE }
| "false" { FALSE }
| "LAMBDA" { LAMBDA }
| "ARRAY_LAMBDA" { ARRAY_LAMBDA }
| "mk___split_fields"(opt_num as n) opt_num {
match n with
| "" -> MK_SPLIT_FIELD ("mk___split_fields",0)
| n -> MK_SPLIT_FIELD ("mk____split_fields"^n, int_of_string n) }
| "mk___rep"(opt_num as n) opt_num {
match n with
| "" -> MK_REP ("mk___rep", 0)
| n -> MK_REP ("mk___rep"^n, int_of_string n) }
| "mk___t"(opt_num as n) opt_num {
match n with
| "" -> MK_T ("mk___t", 0)
| n -> MK_T ("mk___t"^n, int_of_string n) }
| "mk___split_discrs"(opt_num as n) opt_num {
match n with
| "" -> MK_SPLIT_DISCRS ("mk___split_discrs",0)
| n -> MK_SPLIT_DISCRS ("mk____split_discrs"^n, int_of_string n) }
| "(_ bv"(num as bv_value)" "num")" { BITVECTOR_VALUE bv_value }
| "(_ BitVec "num")" { BITVECTOR_TYPE }
| num as integer
{ INT_STR (integer) }
| '-'space*(num as integer) { MINUS_INT_STR ("-"^integer) }
......@@ -44,6 +77,12 @@ rule token = parse
| atom+ as at { ATOM (at) }
| eof
{ EOF }
(* | space { SPACE } *)
| _
{ raise SyntaxError }
and read_string buf =
parse
| '\n' { COMMENT (Buffer.contents buf) }
| '\r' { COMMENT (Buffer.contents buf) }
| eof { COMMENT (Buffer.contents buf) }
| _ as a { Buffer.add_char buf a; read_string buf lexbuf }
......@@ -12,134 +12,207 @@
%{
%}
%start <Model_parser.model_element list> output
%start <Smt2_model_defs.correspondance_table> output
%token <string> SPACE
%token <string> ATOM
%token MODEL
%token STORE
%token CONST
%token AS
%token DEFINE_FUN
%token DECLARE_FUN
%token DECLARE_SORT
%token DECLARE_DATATYPES
%token FORALL
%token UNDERSCORE
%token AS_ARRAY
%token EQUAL
%token ITE
%token LAMBDA
%token ARRAY_LAMBDA
%token TRUE FALSE
%token LET
%token <string> COMMENT
%token <string> BITVECTOR_VALUE
%token BITVECTOR_TYPE
%token <string> INT_STR
%token <string> MINUS_INT_STR
%token <string * string> DEC_STR
%token <string * string> MINUS_DEC_STR
%token LPAREN RPAREN
%token MK_T_REF
%token <string * int> MK_REP
%token <string * int> MK_SPLIT_FIELD
%token <string * int> MK_T
%token <string * int> MK_SPLIT_DISCRS
%token EOF
%%
output:
| possible_space LPAREN MODEL output1 RPAREN {$4}
| output1 {$1}
output1:
| EOF { [] }
| possible_space text { [] }
| possible_space LPAREN text { [] }
(* Error of the prover while getting counter-example *)
| possible_space LPAREN pairs RPAREN { $3 }
pairs:
| possible_space { [] }
| possible_space LPAREN term SPACE value RPAREN pairs
{ (Model_parser.create_model_element ~name:$3 ~value:$5 ())::$7 }
possible_space:
| { "" }
| SPACE { $1 }
term:
| text { $1 }
| LPAREN term_list RPAREN
{ "(" ^ $2 ^ ")" }
term_list:
| possible_space { $1 }
| possible_space term term_list { $1 ^ $2 ^ $3 }
text:
| MINUS_INT_STR { $1 }
| INT_STR { $1 }
| text_without_int { $1 }
| EOF { Stdlib.Mstr.empty }
| LPAREN ps MODEL ps list_decls RPAREN { $5 }
text_without_int:
| ATOM { $1 }
| STORE { "store" }
| CONST { "const" }
| AS { "as" }
value:
| LPAREN MK_T_REF SPACE value RPAREN { $4 }
| integer { $1 }
| decimal { $1 }
| other_val_str { Model_parser.Unparsed $1 }
| array { Model_parser.Array $1 }
| bitvector { Model_parser.Bitvector $1 }
list_decls:
| LPAREN decl RPAREN ps { Smt2_model_defs.add_element $2 Stdlib.Mstr.empty false}
| LPAREN decl RPAREN ps list_decls { Smt2_model_defs.add_element $2 $5 false }
| COMMENT ps list_decls { $3 } (* Lines beginning with ';' are ignored *)
integer:
| INT_STR { Model_parser.Integer $1 }
| LPAREN possible_space MINUS_INT_STR possible_space RPAREN
{ Model_parser.Integer $3 }
(* Examples:
"(define-fun to_rep ((_ufmt_1 enum_t)) Int 0)"
"(declare-sort enum_t 0)"
"(declare-datatypes () ((tuple0 (Tuple0))
))"
*)
decl:
| DEFINE_FUN SPACE tname ps LPAREN ps args_lists RPAREN
ps ireturn_type SPACE smt_term
{ let t = Smt2_model_defs.make_local $7 $12 in
Some ($3, (Smt2_model_defs.Function ($7, t))) }
| DECLARE_SORT SPACE isort_def { None }
| DECLARE_DATATYPES SPACE idata_def ps { None }
| DECLARE_FUN SPACE tname ps LPAREN ps args_lists RPAREN
ps ireturn_type { None } (* z3 declare function *)
| FORALL SPACE LPAREN ps args_lists RPAREN ps smt_term { None } (* z3 cardinality *)
(* Names. For atoms that are used to recognize different types of values,
we return the string the lexer detected (as expected). These names
are not used. *)
tname:
| name { $1 }
| MK_REP { fst $1 }
| MK_SPLIT_FIELD { fst $1 }
| MK_T { fst $1 }
| MK_SPLIT_DISCRS { fst $1 }
smt_term:
| name { Smt2_model_defs.Variable $1 }
| integer { Smt2_model_defs.Integer $1 }
| decimal { Smt2_model_defs.Decimal $1 }
| array { Smt2_model_defs.Array $1 }
| bitvector { Smt2_model_defs.Bitvector $1 }
| boolean { Smt2_model_defs.Boolean $1 }
(* ite (= ?a ?b) ?c ?d *)
| LPAREN ITE ps pair_equal ps smt_term ps smt_term RPAREN
{ match $4 with
| None -> Smt2_model_defs.Other ""
| Some (t1, t2) -> Smt2_model_defs.Ite (t1, t2, $6, $8) }
(* No parsable value are applications. *)
| application { Smt2_model_defs.Other "" }
(* This is SPARK-specific stuff. It is used to parse records, discriminants
and stuff generated by SPARK with specific "keywords" :
mk___rep(num), mk___split_field(num) etc *)
| LPAREN MK_REP SPACE list_smt_term RPAREN
{ Smt2_model_defs.build_record_discr (List.rev $4) }
(* Specifically for mk___t, we are only interested in the first value *)
| LPAREN MK_T SPACE list_smt_term RPAREN { List.hd (List.rev $4) }
| LPAREN MK_SPLIT_FIELD SPACE list_smt_term RPAREN
{ Smt2_model_defs.Record (snd $2, List.rev $4) }
| LPAREN MK_SPLIT_DISCRS SPACE list_smt_term RPAREN
{ Smt2_model_defs.Discr (snd $2, List.rev $4) }
(* Particular case for functions that are defined as an equality:
define-fun f ((a int) (b int)) (= a b) *)
| LPAREN EQUAL ps list_smt_term RPAREN { Smt2_model_defs.Other "" }
| LPAREN LET ps LPAREN list_let RPAREN SPACE smt_term RPAREN
{ Smt2_model_defs.substitute $5 $8 }
(* z3 specific constructor *)
| LPAREN UNDERSCORE ps AS_ARRAY ps tname RPAREN
{ Smt2_model_defs.To_array (Smt2_model_defs.Variable $6) }
(* value of let are not used *)
list_let:
| { [] }
| LPAREN tname SPACE smt_term RPAREN ps list_let { ($2, $4) :: $7 }
(* TODO not efficient *)
(* Condition of an if-then-else. We are only interested in equality case *)
pair_equal:
| LPAREN EQUAL ps smt_term ps smt_term RPAREN { Some ($4, $6) }
| application { None }
| name { None }
list_smt_term:
| smt_term { [$1] }
| list_smt_term SPACE smt_term { $3 :: $1}
application:
| LPAREN ps name SPACE list_smt_term RPAREN { $3 }
decimal:
| DEC_STR { Model_parser.Decimal $1 }
| LPAREN possible_space MINUS_DEC_STR possible_space RPAREN
{ Model_parser.Decimal ($3) }
(* Everything that cannot be integer (positive and negative) and array. *)
other_val_str:
| text_without_int { $1 }
| LPAREN possible_space RPAREN { "(" ^ $2 ^ ")" }
| LPAREN possible_space paren_other_val_str RPAREN
{ "(" ^ $3 ^ ")" }
(* Everything that cannot be negative integer and start of an array *)
paren_other_val_str:
| other_than_neg_int_and_array_store term_list { $1 ^ $2 }
| LPAREN possible_space other_than_const_array possible_space RPAREN
{ "(" ^ $3 ^ ")" }
other_than_neg_int_and_array_store:
| INT_STR { $1 }
array:
| LPAREN ps
LPAREN AS SPACE CONST ps ireturn_type
RPAREN ps smt_term
RPAREN{ Smt2_model_defs.Const $11 }
| LPAREN ps
STORE ps array SPACE smt_term SPACE smt_term ps
RPAREN { Smt2_model_defs.Store ($5, $7, $9) }
(* When array is of type int -> bool, Cvc4 returns something that looks like:
(ARRAY_LAMBDA (LAMBDA ((BOUND_VARIABLE_1162 Int)) false)) *)
| LPAREN
ARRAY_LAMBDA ps
LPAREN LAMBDA ps LPAREN args_lists RPAREN ps smt_term
RPAREN ps RPAREN
{ Smt2_model_defs.Const $11 }
(* Possible space *)
ps:
| { }
| SPACE { }
args_lists:
| { [] }
| LPAREN args RPAREN ps args_lists { $2 :: $5 }
(* TODO This is inefficient and should be done in a left recursive way *)
args:
| name SPACE ireturn_type { $1 }
name:
| ATOM { $1 }
| CONST { "const" }
| AS { "as" }
(* Should not happen in relevant part of the model (ad hoc) *)
| BITVECTOR_TYPE { "" }
other_than_const_array:
| MINUS_INT_STR { $1 }
integer:
| INT_STR { $1 }
| CONST { "const" }
| LPAREN ps MINUS_INT_STR ps RPAREN
{ $3 }
(* Examples:
(1) Map from int to int:
(store (store ((as const (Array Int Int)) 0) 1 2) 3 4)
(2) Map from int to bool:
(store (store ((as const (Array Int Int)) false) 1 true) 3 true)
(3) Map from int to map from int to int (all elemets are 0):
((as const (Array Int (Array Int Int))) ((as const (Array Int Int)) 0))
(4) Map from int to map from int to int (element [1][1] is 3, all others are 0)
(store (store ((as const (Array Int (Array Int Int))) ((as const (Array Int Int)) 0)) 0 (store ((as const (Array Int Int)) 0) 0 3)) 1 (store ((as const (Array Int Int)) 0) 1 3))
*)
array:
| LPAREN possible_space
LPAREN possible_space
AS SPACE CONST possible_space array_skipped_part possible_space
RPAREN possible_space
value possible_space
RPAREN
{ Model_parser.array_create_constant ~value:$13 }
| LPAREN possible_space
STORE possible_space array possible_space value SPACE value
possible_space
RPAREN
{ Model_parser.array_add_element ~array:$5 ~index:$7 ~value:$9 }
array_skipped_part:
| LPAREN term_list RPAREN {}
decimal:
| DEC_STR { $1 }
| LPAREN ps MINUS_DEC_STR ps RPAREN
{ $3 }
(* Example:
(_ bv2048 16) *)
bitvector:
| BITVECTOR_VALUE
{ $1 }
boolean:
| TRUE { true }
| FALSE { false }
(* BEGIN IGNORED TYPES *)
(* Types are badly parsed (for future use) but never saved *)
ireturn_type:
| tname {}
| LPAREN idata_type RPAREN {}
isort_def:
| tname SPACE integer { }
idata_def:
| LPAREN ps RPAREN ps LPAREN ps LPAREN idata_type RPAREN ps RPAREN { }
| LPAREN ps RPAREN ps LPAREN ps LPAREN RPAREN ps RPAREN { }
ilist_app:
| tname { }
| tname SPACE ilist_app { }
| LPAREN idata_type RPAREN { }
| LPAREN idata_type RPAREN SPACE ilist_app { }
idata_type:
| tname { }
| tname SPACE ilist_app { }
(* END IGNORED TYPES *)