Procedural: bug fix

[helm.git] / components / acic_procedural / acic2Procedural.ml

diff --git a/components/acic_procedural/acic2Procedural.ml b/components/acic_procedural/acic2Procedural.ml
index 28fa9894795e52e629d6cfdf1d14a3064ccfebf6..e91c4bdfc1b9c8f24bb94c9ed83d9fef15dc418b 100644 (file)
--- a/components/acic_procedural/acic2Procedural.ml
+++ b/components/acic_procedural/acic2Procedural.ml
@@ -219,6 +219,7 @@ let rec mk_atomic st dtext what =
       script @ mk_fwd_proof st dtext name what, T.mk_arel 0 name
 
 and mk_fwd_rewrite st dtext name tl direction =
+try   
    let what, where = List.nth tl 5, List.nth tl 3 in
    let rps, predicate = [List.nth tl 4], List.nth tl 2 in
    let e = Cn.mk_pattern rps predicate in
@@ -227,6 +228,7 @@ and mk_fwd_rewrite st dtext name tl direction =
          let script, what = mk_atomic st dtext what in
          T.Rewrite (direction, what, Some (premise, name), e, dtext) :: script
       | _                         -> assert false
+with e -> failwith ("mk_fwd_rewrite: " ^ Printexc.to_string e)
 
 and mk_fwd_proof st dtext name = function
    | C.ALetIn (_, n, v, t)                           ->
@@ -248,12 +250,12 @@ and mk_fwd_proof st dtext name = function
             let text = Printf.sprintf "%u %s" (List.length classes) (Cl.to_string h) in
            [T.LetIn (name, v, dtext ^ text)]
       end
-   | C.AMutCase (id, uri, tyno, outty, arg, cases) as v ->
+(*   | C.AMutCase (id, uri, tyno, outty, arg, cases) as v ->
       begin match Cn.mk_ind st.context id uri tyno outty arg cases with 
          | None   -> [T.LetIn (name, v, dtext)] 
          | Some v -> mk_fwd_proof st dtext name v
       end
-   | C.ACast (_, v, _)                                  ->
+*)   | C.ACast (_, v, _)                                  ->
       mk_fwd_proof st dtext name v
    | v                                                  ->
       match get_inner_types st v with
@@ -263,7 +265,9 @@ and mk_fwd_proof st dtext name = function
          | _             ->
             [T.LetIn (name, v, dtext)]
 
-and mk_proof st = function
+and mk_proof st t = 
+try   
+   match t with
    | C.ALambda (_, name, v, t)                     ->
       let entry = Some (name, C.Decl (cic v)) in
       let intro = get_intro name t in
@@ -342,6 +346,7 @@ and mk_proof st = function
       let text = Printf.sprintf "%s: %s" "UNEXPANDED" (string_of_head t) in
       let script = [T.Note text] in
       mk_intros st script
+with e -> failwith ("mk_proof: " ^ Printexc.to_string e)
 
 and mk_bkd_proofs st synth classes ts =
 try