X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Facic_procedural%2Facic2Procedural.ml;h=c004fd346b4e2a9ff30714fa3cf84af50a5acf00;hb=58ce236b589513e779e00759e54e72cbbf2bd2c3;hp=cc4ec10a340e9793999d5b09bbd3d12b4dcd40c8;hpb=468ee32f0fc7de271454ed94643b4dd7c9578e5f;p=helm.git

diff --git a/helm/software/components/acic_procedural/acic2Procedural.ml b/helm/software/components/acic_procedural/acic2Procedural.ml
index cc4ec10a3..c004fd346 100644
--- a/helm/software/components/acic_procedural/acic2Procedural.ml
+++ b/helm/software/components/acic_procedural/acic2Procedural.ml
@@ -201,6 +201,7 @@ let mk_convert st ?name sty ety note =
    assert (Ut.is_sober csty); 
    assert (Ut.is_sober cety);
    if Ut.alpha_equivalence csty cety then [(* T.Note note *)] else 
+   let sty, ety = H.acic_bc st.context sty, H.acic_bc st.context ety in
    match name with
       | None         -> [T.Change (sty, ety, None, e, ""(*note*))]
       | Some (id, i) -> 
@@ -281,7 +282,7 @@ let rec proc_lambda st name v t =
    let intro = get_intro name in
    proc_proof (add st entry intro) t
 
-and proc_letin st what name v t =
+and proc_letin st what name v w t =
    let intro = get_intro name in
    let proceed, dtext = test_depth st in
    let script = if proceed then 
@@ -294,11 +295,12 @@ and proc_letin st what name v t =
 	          mk_fwd_rewrite st dtext intro tl false v
 	       | v                                                     ->
 	          let qs = [proc_proof (next st) v; [T.Id ""]] in
-	          st, [T.Branch (qs, ""); T.Cut (intro, ity, dtext)]
+	          let ity = H.acic_bc st.context ity in
+		  st, [T.Branch (qs, ""); T.Cut (intro, ity, dtext)]
 	    in
 	    st, C.Decl (H.cic ity), rqv
 	 | None          ->
-	    st, C.Def (H.cic v, None), [T.LetIn (intro, v, dtext)]
+	    st, C.Def (H.cic v, H.cic w), [T.LetIn (intro, v, dtext)]
       in
       let entry = Some (name, hyp) in
       let qt = proc_proof (next (add st entry intro)) t in
@@ -319,6 +321,11 @@ and proc_mutconstruct st what =
    let script = [T.Apply (what, dtext)] in 
    mk_intros st what script
 
+and proc_const st what = 
+   let _, dtext = test_depth st in
+   let script = [T.Apply (what, dtext)] in 
+   mk_intros st what script
+
 and proc_appl st what hd tl =
    let proceed, dtext = test_depth st in
    let script = if proceed then
@@ -382,12 +389,13 @@ and proc_proof st t =
       {st with context = context; clears = clears; clears_note = note; }
    in
    match t with
-      | C.ALambda (_, name, w, t)        -> proc_lambda st name w t
-      | C.ALetIn (_, name, v, t) as what -> proc_letin (f st) what name v t
-      | C.ARel _ as what                 -> proc_rel (f st) what
-      | C.AMutConstruct _ as what        -> proc_mutconstruct (f st) what
-      | C.AAppl (_, hd :: tl) as what    -> proc_appl (f st) what hd tl
-      | what                             -> proc_other (f st) what
+      | C.ALambda (_, name, w, t)           -> proc_lambda st name w t
+      | C.ALetIn (_, name, v, w, t) as what -> proc_letin (f st) what name v w t
+      | C.ARel _ as what                    -> proc_rel (f st) what
+      | C.AMutConstruct _ as what           -> proc_mutconstruct (f st) what
+      | C.AConst _ as what                  -> proc_const (f st) what
+      | C.AAppl (_, hd :: tl) as what       -> proc_appl (f st) what hd tl
+      | what                                -> proc_other (f st) what
 
 and proc_bkd_proofs st synth names classes ts =
 try 
@@ -416,7 +424,8 @@ with Invalid_argument s -> failwith ("A2P.proc_bkd_proofs: " ^ s)
 
 (* object costruction *******************************************************)
 
-let is_theorem pars =   
+let is_theorem pars =
+   pars = [] ||
    List.mem (`Flavour `Theorem) pars || List.mem (`Flavour `Fact) pars || 
    List.mem (`Flavour `Remark) pars || List.mem (`Flavour `Lemma) pars