68 lines
2.1 KiB
Text
68 lines
2.1 KiB
Text
/-
|
||
Copyright (c) 2017 Gabriel Ebner. All rights reserved.
|
||
Released under Apache 2.0 license as described in the file LICENSE.
|
||
Authors: Gabriel Ebner
|
||
-/
|
||
import .superposition
|
||
open tactic monad expr
|
||
|
||
namespace super
|
||
|
||
meta def is_demodulator (c : clause) : bool :=
|
||
match c^.get_lits with
|
||
| [clause.literal.right eqn] := eqn^.is_eq^.is_some
|
||
| _ := ff
|
||
end
|
||
|
||
variable gt : expr → expr → bool
|
||
|
||
meta def demod' (cs1 : list derived_clause) : clause → list derived_clause → tactic (list derived_clause × clause) | c2 used_demods :=
|
||
(first $ do
|
||
i ← list.range c2^.num_lits,
|
||
pos ← rwr_positions c2 i,
|
||
c1 ← cs1,
|
||
(ltr, congr_ax) ← [(tt, ``super.sup_ltr), (ff, ``super.sup_rtl)],
|
||
[do c2' ← try_sup gt c1^.c c2 0 i pos ltr tt congr_ax,
|
||
demod' c2' (c1 :: used_demods)]
|
||
) <|> return (used_demods, c2)
|
||
|
||
meta def demod (cs1 : list derived_clause) (c2 : clause) : tactic (list derived_clause × clause) := do
|
||
c2qf ← c2^.open_constn c2^.num_quants,
|
||
(used_demods, c2qf') ← demod' gt cs1 c2qf.1 [],
|
||
if used_demods^.empty then return ([], c2) else
|
||
return (used_demods, c2qf'^.close_constn c2qf.2)
|
||
|
||
meta def demod_fwd_inf : inference :=
|
||
take given, do
|
||
active ← get_active,
|
||
demods ← return (do ac ← active^.values, guard $ is_demodulator ac^.c, guard $ ac^.id ≠ given^.id, [ac]),
|
||
if demods^.empty then skip else do
|
||
(used_demods, given') ← demod gt demods given^.c,
|
||
if used_demods^.empty then skip else do
|
||
remove_redundant given^.id used_demods,
|
||
mk_derived given' given^.sc^.sched_now >>= add_inferred
|
||
|
||
meta def demod_back1 (given active : derived_clause) : prover unit := do
|
||
(used_demods, c') ← demod gt [given] active^.c,
|
||
if used_demods^.empty then skip else do
|
||
remove_redundant active^.id used_demods,
|
||
mk_derived c' active^.sc^.sched_now >>= add_inferred
|
||
|
||
meta def demod_back_inf : inference :=
|
||
take given, if ¬is_demodulator given^.c then skip else
|
||
do active ← get_active, sequence' $ do
|
||
ac ← active^.values,
|
||
guard $ ac^.id ≠ given^.id,
|
||
[demod_back1 gt given ac]
|
||
|
||
@[super.inf]
|
||
meta def demod_inf : inf_decl := {
|
||
prio := 10,
|
||
inf := take given, do
|
||
gt ← get_term_order,
|
||
demod_fwd_inf gt given,
|
||
demod_back_inf gt given,
|
||
skip
|
||
}
|
||
|
||
end super
|