X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Ftactics%2Fauto.ml;h=fc9b146f78bc5995d9c64c260dc96d3bff05ee08;hb=bf7f52019b3f65b6d635a8b49a63f0d95080f189;hp=c3e2b6b4894929dc84648e5549a3c7be412bf6f2;hpb=6719c0e318b312b51b089fea3d69d1b7103245ea;p=helm.git diff --git a/helm/software/components/tactics/auto.ml b/helm/software/components/tactics/auto.ml index c3e2b6b48..fc9b146f7 100644 --- a/helm/software/components/tactics/auto.ml +++ b/helm/software/components/tactics/auto.ml @@ -807,7 +807,7 @@ type menv = Cic.metasenv type subst = Cic.substitution type goal = ProofEngineTypes.goal * int * AutoTypes.sort let candidate_no = ref 0;; -type candidate = int * Cic.term +type candidate = int * Cic.term Lazy.t type cache = AutoCache.cache type tables = Saturation.active_table * Saturation.passive_table * Equality.equality_bag @@ -837,8 +837,8 @@ type auto_result = (* the status exported to the external observer *) type auto_status = (* context, (goal,candidate) list, and_list, history *) - Cic.context * (int * Cic.term * bool * int * (int * Cic.term) list) list * - (int * Cic.term * int) list * Cic.term list + Cic.context * (int * Cic.term * bool * int * (int * Cic.term Lazy.t) list) list * + (int * Cic.term * int) list * Cic.term Lazy.t list let d_prefix l = let rec aux acc = function @@ -890,7 +890,7 @@ let pp_status ctx status = | None -> Printf.sprintf "D(%d, _, %d)" gi d in let string_of_s m su k (ci,ct) gi = - Printf.sprintf "S(%d, %s, %s, %d)" gi (pp k) (pp ct) ci + Printf.sprintf "S(%d, %s, %s, %d)" gi (pp k) (pp (Lazy.force ct)) ci in let string_of_ol m su l = String.concat " | " @@ -1028,6 +1028,15 @@ let list_union l1 l2 = (* TODO ottimizzare compare *) HExtlib.list_uniq (List.sort compare (l1 @ l1)) ;; +let rec eq_todo l1 l2 = + match l1,l2 with + | (D g1) :: tl1,(D g2) :: tl2 when g1=g2 -> eq_todo tl1 tl2 + | (S (g1,k1,(c1,lt1),i1)) :: tl1, (S (g2,k2,(c2,lt2),i2)) :: tl2 + when i1 = i2 && g1 = g2 && k1 = k2 && c1 = c2 -> + if Lazy.force lt1 = Lazy.force lt2 then eq_todo tl1 tl2 else false + | [],[] -> true + | _ -> false +;; let eat_head todo id fl orlist = let rec aux acc = function | [] -> [], acc @@ -1037,7 +1046,7 @@ let eat_head todo id fl orlist = | None -> orlist, acc | Some (((gno,_,_),_,_,_), todo11) -> (* TODO confronto tra todo da ottimizzare *) - if gno = id && todo11 = todo then + if gno = id && eq_todo todo11 todo then aux (list_union fl1 acc) tl else aux1 todo11 @@ -1129,7 +1138,7 @@ let put_in_subst subst metasenv (goalno,_,_) canonical_ctx t ty = subst, metasenv ;; let mk_fake_proof metasenv subst (goalno,_,_) goalty context = - None,metasenv,subst ,Cic.Meta(goalno,mk_irl context),goalty, [] + None,metasenv,subst ,(lazy (Cic.Meta(goalno,mk_irl context))),goalty, [] ;; let equational_case tables maxm cache depth fake_proof goalno goalty subst context @@ -1208,7 +1217,7 @@ let try_candidate let open_goals = order_new_goals metasenv subst open_goals ppterm in let open_goals = List.map (fun (x,sort) -> x,depth-1,sort) open_goals in incr candidate_no; - Some ((!candidate_no,cand),metasenv,subst,open_goals), tables , maxmeta + Some ((!candidate_no,lazy cand),metasenv,subst,open_goals), tables , maxmeta with | ProofEngineTypes.Fail s -> None,tables, maxm | CicUnification.Uncertain s -> None,tables, maxm