mirror of
https://github.com/c-cube/sidekick.git
synced 2025-12-06 11:15:43 -05:00
feat(main): handle check-sat-assuming statement
This commit is contained in:
parent
3fedca069d
commit
367c1945ef
4 changed files with 26 additions and 9 deletions
|
|
@ -146,7 +146,7 @@ type statement =
|
||||||
| Stmt_define of definition list
|
| Stmt_define of definition list
|
||||||
| Stmt_assert of term
|
| Stmt_assert of term
|
||||||
| Stmt_assert_clause of term list
|
| Stmt_assert_clause of term list
|
||||||
| Stmt_check_sat
|
| Stmt_check_sat of (bool * term) list
|
||||||
| Stmt_exit
|
| Stmt_exit
|
||||||
|
|
||||||
let[@inline] term_equal_ (a:term) b = a==b
|
let[@inline] term_equal_ (a:term) b = a==b
|
||||||
|
|
@ -1110,14 +1110,19 @@ module Statement = struct
|
||||||
| Stmt_define of definition list
|
| Stmt_define of definition list
|
||||||
| Stmt_assert of term
|
| Stmt_assert of term
|
||||||
| Stmt_assert_clause of term list
|
| Stmt_assert_clause of term list
|
||||||
| Stmt_check_sat
|
| Stmt_check_sat of (bool * term) list
|
||||||
| Stmt_exit
|
| Stmt_exit
|
||||||
|
|
||||||
let pp out = function
|
let pp out = function
|
||||||
| Stmt_set_logic s -> Fmt.fprintf out "(set-logic %s)" s
|
| Stmt_set_logic s -> Fmt.fprintf out "(set-logic %s)" s
|
||||||
| Stmt_set_option l -> Fmt.fprintf out "(@[set-logic@ %a@])" (Util.pp_list Fmt.string) l
|
| Stmt_set_option l -> Fmt.fprintf out "(@[set-logic@ %a@])" (Util.pp_list Fmt.string) l
|
||||||
| Stmt_set_info (a,b) -> Fmt.fprintf out "(@[set-info@ %s@ %s@])" a b
|
| Stmt_set_info (a,b) -> Fmt.fprintf out "(@[set-info@ %s@ %s@])" a b
|
||||||
| Stmt_check_sat -> Fmt.string out "(check-sat)"
|
| Stmt_check_sat [] -> Fmt.string out "(check-sat)"
|
||||||
|
| Stmt_check_sat l ->
|
||||||
|
let pp_pair out (b,t) =
|
||||||
|
if b then pp_term out t else Fmt.fprintf out "(@[not %a@])" pp_term t in
|
||||||
|
Fmt.fprintf out "(@[check-sat-assuming@ (@[%a@])@])"
|
||||||
|
(Fmt.list pp_pair) l
|
||||||
| Stmt_ty_decl (s,n) -> Fmt.fprintf out "(@[declare-sort@ %a %d@])" ID.pp s n
|
| Stmt_ty_decl (s,n) -> Fmt.fprintf out "(@[declare-sort@ %a %d@])" ID.pp s n
|
||||||
| Stmt_decl (id,args,ret) ->
|
| Stmt_decl (id,args,ret) ->
|
||||||
Fmt.fprintf out "(@[<1>declare-fun@ %a (@[%a@])@ %a@])"
|
Fmt.fprintf out "(@[<1>declare-fun@ %a (@[%a@])@ %a@])"
|
||||||
|
|
|
||||||
|
|
@ -111,7 +111,7 @@ module Dimacs = struct
|
||||||
(fun c ->
|
(fun c ->
|
||||||
let lits = List.rev_map get_lit c in
|
let lits = List.rev_map get_lit c in
|
||||||
stmts := Statement.Stmt_assert_clause lits :: !stmts);
|
stmts := Statement.Stmt_assert_clause lits :: !stmts);
|
||||||
stmts := Statement.Stmt_check_sat :: !stmts;
|
stmts := Statement.Stmt_check_sat [] :: !stmts;
|
||||||
Ok (List.rev !stmts))
|
Ok (List.rev !stmts))
|
||||||
with e ->
|
with e ->
|
||||||
E.of_exn_trace e
|
E.of_exn_trace e
|
||||||
|
|
|
||||||
|
|
@ -235,10 +235,13 @@ let process_stmt
|
||||||
| Statement.Stmt_exit ->
|
| Statement.Stmt_exit ->
|
||||||
Log.debug 1 "exit";
|
Log.debug 1 "exit";
|
||||||
raise Exit
|
raise Exit
|
||||||
| Statement.Stmt_check_sat ->
|
| Statement.Stmt_check_sat l ->
|
||||||
|
let assumptions =
|
||||||
|
List.map (fun (sign,t) -> Solver.mk_atom_t solver ~sign t) l
|
||||||
|
in
|
||||||
solve
|
solve
|
||||||
?gc ?restarts ?dot_proof ~check ?pp_model ?time ?memory ?progress
|
?gc ?restarts ?dot_proof ~check ?pp_model ?time ?memory ?progress
|
||||||
~assumptions:[] ?hyps
|
~assumptions ?hyps
|
||||||
solver;
|
solver;
|
||||||
E.return()
|
E.return()
|
||||||
| Statement.Stmt_ty_decl (id,n) ->
|
| Statement.Stmt_ty_decl (id,n) ->
|
||||||
|
|
|
||||||
|
|
@ -513,9 +513,18 @@ and conv_statement_aux ctx (stmt:PA.statement) : Stmt.t list =
|
||||||
let t = conv_term ctx t in
|
let t = conv_term ctx t in
|
||||||
check_bool_ ctx t;
|
check_bool_ ctx t;
|
||||||
[Stmt.Stmt_assert t]
|
[Stmt.Stmt_assert t]
|
||||||
| PA.Stmt_check_sat -> [Stmt.Stmt_check_sat]
|
| PA.Stmt_check_sat -> [Stmt.Stmt_check_sat []]
|
||||||
| PA.Stmt_check_sat_assuming _
|
| PA.Stmt_check_sat_assuming l ->
|
||||||
| PA.Stmt_get_assertions
|
let l =
|
||||||
|
List.map
|
||||||
|
(fun (t,b) ->
|
||||||
|
let t = conv_term ctx (PA.const t) in
|
||||||
|
check_bool_ ctx t;
|
||||||
|
b,t)
|
||||||
|
l
|
||||||
|
in
|
||||||
|
[Stmt.Stmt_check_sat l]
|
||||||
|
| PA.Stmt_get_assertions
|
||||||
| PA.Stmt_get_option _
|
| PA.Stmt_get_option _
|
||||||
| PA.Stmt_get_info _
|
| PA.Stmt_get_info _
|
||||||
| PA.Stmt_get_model
|
| PA.Stmt_get_model
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue