- | 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)
+ | Some (newt, subst, id2, dir, pos) ->
+ begin
+ match build_clause bag (fun _ -> true) Terms.Demodulation
+ newt subst 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, id2, dir, pos) ->
+ match build_clause bag (fun _ -> true)
+ Terms.Demodulation newt subst id id2 pos dir
+ with
+ | None -> assert false
+ | Some x -> Some (x,true)
+ ;;
+
+ let parallel_demod table vl bag t pos ctx id =
+ match demod table vl t with
+ | None -> (bag,t,id)
+ | Some (newside, subst, id2, dir) ->
+ match build_clause bag (fun _ -> true)
+ Terms.Demodulation (ctx newside) subst id id2 pos dir
+ with
+ | None -> assert false
+ | Some (bag,(id,_,_,_)) ->
+ (bag,newside,id)
+ ;;
+
+ let demodulate_once ~jump_to_right bag (id, literal, vl, pr) table =
+ match literal with
+ | Terms.Predicate t -> assert false
+ | Terms.Equation (l,r,ty,_) ->
+ let bag,l,id1 = if jump_to_right then (bag,l,id) else
+ parallel_positions bag [2]
+ (fun x -> Terms.Node [ Terms.Leaf B.eqP; ty; x; r ]) id l
+ (parallel_demod table vl)
+ in
+ let jump_to_right = id1 = id in
+ let bag,r,id2 =
+ parallel_positions bag [3]
+ (fun x -> Terms.Node [ Terms.Leaf B.eqP; ty; l; x ]) id1 r
+ (parallel_demod table vl)
+ in
+ if id = id2 then None
+ else
+ let cl,_,_ = Terms.get_from_bag id2 bag in
+ Some ((bag,cl),jump_to_right)