- (* XXX: possible optimization, if the literal has a "side" already
- * in normal form we should not traverse it again *)
- let demodulate_once bag (id, literal, vl, pr) table =
- debug ("Demodulating : " ^ (Pp.pp_unit_clause (id, literal, vl, pr)));
- let t =
- match literal with
- | Terms.Predicate t -> t
- | Terms.Equation (l,r,ty,_) -> Terms.Node [ Terms.Leaf B.eqP; ty; l; r ]
- in
- match first_position [] (fun x -> x) t (demod table vl) with
- | None -> None
- | Some (newt, subst, varlist, id2, pos, dir) ->
- build_clause bag (fun _ -> true) Terms.Demodulation
- newt subst varlist id id2 pos dir
+ let demodulate_once ~jump_to_right bag (id, literal, vl, pr) table =
+ (* debug ("Demodulating : " ^ (Pp.pp_unit_clause (id, literal, vl, pr)));*)
+ match literal with
+ | Terms.Predicate t -> assert false
+ | Terms.Equation (l,r,ty,_) ->
+ let left_position = if jump_to_right then None else
+ first_position [2]
+ (fun x -> Terms.Node [ Terms.Leaf B.eqP; ty; x; r ]) l
+ (demod table vl)
+ in
+ match left_position with
+ | Some (newt, subst, varlist, id2, pos, dir) ->
+ begin
+ match build_clause bag (fun _ -> true) Terms.Demodulation
+ newt subst varlist id id2 pos dir
+ with
+ | None -> assert false
+ | Some x -> Some (x,false)
+ end
+ | None ->
+ match first_position
+ [3] (fun x -> Terms.Node [ Terms.Leaf B.eqP; ty; l; x ]) r
+ (demod table vl)
+ with
+ | None -> None
+ | Some (newt, subst, varlist, id2, pos, dir) ->
+ match build_clause bag (fun _ -> true)
+ Terms.Demodulation newt subst varlist id id2 pos dir
+ with
+ | None -> assert false
+ | Some x -> Some (x,true)