X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Facic_procedural%2Fprocedural2.ml;h=45444f4fc19cfd2f06136ce0d5e729ced7722cc6;hb=cfb41205e930ede65c1d19ec7ec6f252e0803d55;hp=46d4431bde2b19be822125f269c70df37fbf927f;hpb=b4fd90e993045c2a71b6fd2479cd515f09d36d06;p=helm.git diff --git a/helm/software/components/acic_procedural/procedural2.ml b/helm/software/components/acic_procedural/procedural2.ml index 46d4431bd..45444f4fc 100644 --- a/helm/software/components/acic_procedural/procedural2.ml +++ b/helm/software/components/acic_procedural/procedural2.ml @@ -171,19 +171,31 @@ let get_type msg st t = H.get_type msg st.context (H.cic t) let anonymous_premise = C.Name "UNNAMED" -let mk_exp_args hd tl classes synth = +let mk_exp_args hd tl classes synth qs = + let exp = ref 0 in let meta id = C.AImplicit (id, None) in let map v (cl, b) = - if I.overlaps synth cl && b then v else meta "" + if I.overlaps synth cl then + let w = if H.is_atomic (H.cic v) then v else meta "" in + if b then v, v else meta "", w + else + meta "", meta "" in - let rec aux b = function - | [] -> b, [] + let rec rev a = function + | [] -> a | hd :: tl -> - if hd = meta "" then aux true tl else b, List.rev (hd :: tl) + if snd hd <> meta "" then incr exp; + rev (snd hd :: a) tl + in + let rec aux = function + | [] -> [] + | hd :: tl -> + if fst hd = meta "" then aux tl else rev [] (hd :: tl) in let args = T.list_rev_map2 map tl classes in - let b, args = aux false args in - if args = [] then b, hd else b, C.AAppl ("", hd :: args) + let args = aux args in + let part = !exp < List.length tl in + if args = [] then part, hd, qs else part, C.AAppl ("", hd :: args), qs let mk_convert st ?name sty ety note = let ppterm t = @@ -342,6 +354,7 @@ and proc_appl st what hd tl = let diff = goal_arity - decurry in if diff < 0 then let text = Printf.sprintf "partial application: %i" diff in + prerr_endline ("Procedural 2: " ^ text); [T.Exact (what, dtext ^ text)] else let classes = Cl.adjust st.context tl ?goal classes in @@ -366,7 +379,7 @@ and proc_appl st what hd tl = in if List.length qs <> List.length names then let qs = proc_bkd_proofs (next st) synth [] classes tl in - let b, hd = mk_exp_args hd tl classes synth in + let b, hd, qs = mk_exp_args hd tl classes synth qs in script @ [tactic b hd (dtext ^ text); T.Branch (qs, "")] else if is_rewrite_right st hd then script2 @ mk_rewrite st dtext where qs tl2 false what ety @@ -381,7 +394,7 @@ and proc_appl st what hd tl = | _ -> let names = get_sub_names hd tl in let qs = proc_bkd_proofs (next st) synth names classes tl in - let b, hd = mk_exp_args hd tl classes synth in + let b, hd, qs = mk_exp_args hd tl classes synth qs in script @ [tactic b hd (dtext ^ text); T.Branch (qs, "")] else [T.Exact (what, dtext)]