List.fold_left
(fun (i,acc) t ->
i+1,
- let f = extract amount vl f in
+ let f = extract amount vl f in
if i = n then
let imp = NCic.Implicit `Term in
NCic.Appl (dag::imp::imp::imp(* f *)::imp::imp::
in aux ft (List.rev pl)
;;
- (* we should better split forward and backard rewriting *)
+ (* we should better split forward and backward rewriting *)
let mk_proof ?(demod=false) (bag : NCic.term Terms.bag) mp subst steps =
let module NCicBlob =
NCicBlob.NCicBlob(
let lit,_,_ = get_literal mp in
let lit = Subst.apply_subst subst lit in
extract 0 [] lit in
+ (* composition of all subst acting on goal *)
+ let res_subst =
+ let rec rsaux ongoal acc =
+ function
+ | [] -> acc (* is the final subst for refl *)
+ | id::tl when ongoal ->
+ let lit,vl,proof = get_literal id in
+ (match proof with
+ | Terms.Exact _ -> rsaux ongoal acc tl
+ | Terms.Step (_, _, _, _, _, s) ->
+ rsaux ongoal (s@acc) tl)
+ | id::tl ->
+ (* subst is the the substitution for refl *)
+ rsaux (id=mp) subst tl
+ in
+ let r = rsaux false [] steps in
+ (* prerr_endline ("res substitution: " ^ Pp.pp_substitution r);
+ prerr_endline ("\n" ^ "subst: " ^ Pp.pp_substitution subst); *)
+ r
+ in
let rec aux ongoal seen = function
| [] -> NCic.Rel 1
| id :: tl ->
let id, id1,(lit,vl,proof) =
if ongoal then
let lit,vl,proof = get_literal id1 in
- id1,id,(Subst.apply_subst subst lit,
- Subst.filter subst vl, proof)
+ id1,id,(Subst.apply_subst res_subst lit,
+ Subst.filter res_subst vl, proof)
else id,id1,(lit,vl,proof) in
- let vl = if ongoal then [] else vl in
+ (* free variables remaining in the goal should not
+ be abstracted: we do not want to prove a generalization *)
+ let vl = if ongoal then [] else vl in
let proof_of_id id =
let vars = List.rev (vars_of id seen) in
let args = List.map (Subst.apply_subst subst) vars in
let body = aux ongoal
((id,(List.map (fun x -> Terms.Var x) vl,lit))::seen) tl
in
- if NCicUntrusted.count_occurrences [] 0 body <= 1 then
+ let occ= NCicUntrusted.count_occurrences [] 1 body in
+ if occ <= 1 then
NCicSubstitution.subst
~avoid_beta_redexes:true ~no_implicit:false
(close_with_lambdas vl rewrite_step) body
else WeightPassiveSet.min_elt passives_w
;;
+ let mk_unit_clause bag maxvar (t,ty) =
+ let c, maxvar = Utils.mk_unit_clause maxvar (B.embed ty) (B.embed t) in
+ let bag, c = Terms.add_to_bag c bag in
+ (bag, maxvar), c
+ ;;
+
let mk_clause bag maxvar (t,ty) =
let (proof,ty) = B.saturate t ty in
let c, maxvar = Utils.mk_unit_clause maxvar ty proof in
;;
let mk_passive (bag,maxvar) = mk_clause bag maxvar;;
+
let mk_goal (bag,maxvar) = mk_clause bag maxvar;;
+
let initialize_goal (bag,maxvar,actives,passives,_,_) t =
- let (bag,maxvar), g = mk_goal (bag,maxvar) t in
+ let (bag,maxvar), g = mk_unit_clause bag maxvar t in
let g_passives = g_passive_empty_set in
(* if the goal is not an equation we returns an empty
passive set *)
(List.map Pp.pp_unit_clause actives_l)))
^
("Passives:" ^(String.concat ";\n"
- (List.map (fun _,cl -> Pp.pp_unit_clause cl)
+ (List.map (fun (_,cl) -> Pp.pp_unit_clause cl)
(IDX.ClauseSet.elements wset))))
;;
* P' = P + new' *)
debug (lazy "Forward infer step...");
debug (lazy("Number of actives : " ^ (string_of_int (List.length (fst actives)))));
- debug (lazy (pp_clauses actives passives));
+ noprint (lazy (pp_clauses actives passives));
match Sup.keep_simplified current actives bag maxvar
with
| _,None -> s
let _ = noprint
(lazy
("Passives:" ^(String.concat ";\n"
- (List.map (fun _,cl -> Pp.pp_unit_clause cl)
+ (List.map (fun (_,cl) -> Pp.pp_unit_clause cl)
(IDX.ClauseSet.elements wset))))) in
let g_passives =
WeightPassiveSet.fold
let fast_eq_check s goal =
let (_,_,_,_,_,g_passives) as s = initialize_goal s goal in
- if is_passive_g_set_empty g_passives then Error "not an equation"
+ if is_passive_g_set_empty g_passives then Error "not an equation"
else
try
goal_narrowing 0 2 None s
match acc with
| None -> None
| Some(bag,maxvar,(id,lit,vl,p),subst) ->
+ (* prerr_endline ("input subst = "^Pp.pp_substitution subst); *)
let l = Subst.apply_subst subst l in
let r = Subst.apply_subst subst r in
try
with FoUnif.UnificationFailure _ ->
match rewrite_eq ~unify l r ty vl table with
| Some (id2, dir, subst1) ->
+ (* prerr_endline ("subst1 = "^Pp.pp_substitution subst1);
+ prerr_endline ("old subst = "^Pp.pp_substitution subst);*)
let newsubst = Subst.concat subst1 subst in
let id_t =
FoSubst.apply_subst newsubst
subst1 id id2 (pos@[2]) dir
with
| Some ((bag, maxvar), c), r ->
- let newsubst = Subst.concat r newsubst in
+ (* prerr_endline ("r = "^Pp.pp_substitution r); *)
+ let newsubst = Subst.flat
+ (Subst.concat r subst) in
Some(bag,maxvar,c,newsubst)
| None, _ -> assert false)
| None ->