we rebuilt the dependences

[helm.git] / helm / software / components / acic_procedural / proceduralConversion.ml

diff --git a/helm/software/components/acic_procedural/proceduralConversion.ml b/helm/software/components/acic_procedural/proceduralConversion.ml
index 376313ac8f9de4577fbeae6780e57b33b6b77801..3eadc2fcf985395f9613a64a859decb0fb45d515 100644 (file)
--- a/helm/software/components/acic_procedural/proceduralConversion.ml
+++ b/helm/software/components/acic_procedural/proceduralConversion.ml
@@ -26,18 +26,16 @@
 module C    = Cic
 module E    = CicEnvironment
 module Un   = CicUniv
-module TC   = CicTypeChecker 
-module D    = Deannotate
+module TC   = CicTypeChecker
 module UM   = UriManager
 module Rd   = CicReduction
 module PEH  = ProofEngineHelpers
 module PT   = PrimitiveTactics
-
 module DTI  = DoubleTypeInference
 
-(* helpers ******************************************************************)
+module H    = ProceduralHelpers
 
-let cic = D.deannotate_term
+(* helpers ******************************************************************)
 
 let rec list_sub start length = function
    | _  :: tl when start  > 0 -> list_sub (pred start) length tl
@@ -72,7 +70,7 @@ let lift k n =
       | C.AMutCase (id, sp, i, outty, t, pl) -> C.AMutCase (id, sp, i, lift_term k outty, lift_term k t, List.map (lift_term k) pl)
       | C.AProd (id, n, s, t) -> C.AProd (id, n, lift_term k s, lift_term (succ k) t)
       | C.ALambda (id, n, s, t) -> C.ALambda (id, n, lift_term k s, lift_term (succ k) t)
-      | C.ALetIn (id, n, s, t) -> C.ALetIn (id, n, lift_term k s, lift_term (succ k) t)
+      | C.ALetIn (id, n, ty, s, t) -> C.ALetIn (id, n, lift_term k ty, lift_term k s, lift_term (succ k) t)
       | C.AFix (id, i, fl) -> C.AFix (id, i, List.map (lift_fix (List.length fl) k) fl)
       | C.ACoFix (id, i, fl) -> C.ACoFix (id, i, List.map (lift_cofix (List.length fl) k) fl)
    in
@@ -87,9 +85,9 @@ let lift k n =
             | Invalid_argument _ -> assert false
       in
       let mk_decl n v = Some (n, C.Decl v) in
-      let mk_def n v = Some (n, C.Def (v, None)) in
-      let mk_fix (name, _, _, bo) = mk_def (C.Name name) bo in
-      let mk_cofix (name, _, bo) = mk_def (C.Name name) bo in
+      let mk_def n v ty = Some (n, C.Def (v, ty)) in
+      let mk_fix (name, _, ty, bo) = mk_def (C.Name name) bo ty in
+      let mk_cofix (name, ty, bo) = mk_def (C.Name name) bo ty in
       let rec ann_xns c (uri, t) = uri, ann_term c t
       and ann_ms c = function
          | None -> None
@@ -112,7 +110,7 @@ let lift k n =
          | C.MutCase (sp, i, outty, t, pl) -> C.AMutCase (id, sp, i, ann_term c outty, ann_term c t, List.map (ann_term c) pl)
          | C.Prod (n, s, t) -> C.AProd (id, n, ann_term c s, ann_term (mk_decl n s :: c) t)
          | C.Lambda (n, s, t) -> C.ALambda (id, n, ann_term c s, ann_term (mk_decl n s :: c) t)
-         | C.LetIn (n, s, t) -> C.ALetIn (id, n, ann_term c s, ann_term (mk_def n s :: c) t)
+         | C.LetIn (n, s, ty, t) -> C.ALetIn (id, n, ann_term c s, ann_term c ty, ann_term (mk_def n s ty :: c) t)
          | C.Fix (i, fl) -> C.AFix (id, i, List.map (ann_fix (List.rev_map mk_fix fl) c) fl)
          | C.CoFix (i, fl) -> C.ACoFix (id, i, List.map (ann_cofix (List.rev_map mk_cofix fl) c) fl)
       in
@@ -126,7 +124,7 @@ let clear_absts m =
       | C.ALambda (_, _, _, t) when n > 0  -> 
          aux 0 (pred n) (lift 1 (-1) t)
       | t                      when n > 0  ->
-           Printf.eprintf "CLEAR: %u %s\n" n (CicPp.ppterm (cic t));
+           Printf.eprintf "CLEAR: %u %s\n" n (CicPp.ppterm (H.cic t));
            assert false 
       | t                                  -> t
    in 
@@ -175,9 +173,9 @@ let generalize n =
       | C.ALambda (id, _, s, t) ->
          let s, t = gen_term k s, gen_term (succ k) t in
          if is_meta [s; t] then meta id else C.ALambda (id, anon, s, t)
-      | C.ALetIn (id, _, s, t) -> 
-         let s, t = gen_term k s, gen_term (succ k) t in
-         if is_meta [s; t] then meta id else C.ALetIn (id, anon, s, t)
+      | C.ALetIn (id, _, s, ty, t) -> 
+         let s, ty, t = gen_term k s, gen_term k ty, gen_term (succ k) t in
+         if is_meta [s; t] then meta id else C.ALetIn (id, anon, s, ty, t)
       | C.AFix (id, i, fl) -> C.AFix (id, i, List.map (gen_fix (List.length fl) k) fl)
       | C.ACoFix (id, i, fl) -> C.ACoFix (id, i, List.map (gen_cofix (List.length fl) k) fl)
    in
@@ -210,9 +208,9 @@ let get_clears c p xtypes =
            else 
               hd, names, v
         in
-        let p = C.LetIn (n, v, p) in
-        let it = C.LetIn (n, v, it) in
-        let et = C.LetIn (n, v, et) in
+        let p = C.LetIn (n, v, x, p) in
+        let it = C.LetIn (n, v, x, it) in
+        let et = C.LetIn (n, v, x, et) in
         aux (hd :: c) names p it et tl
       | Some (C.Anonymous as n, C.Decl v) as hd :: tl     ->
         let p = C.Lambda (n, meta, p) in
@@ -220,9 +218,9 @@ let get_clears c p xtypes =
         let et = C.Lambda (n, meta, et) in
         aux (hd :: c) names p it et tl
       | Some (C.Anonymous as n, C.Def (v, _)) as hd :: tl ->
-        let p = C.LetIn (n, meta, p) in
-        let it = C.LetIn (n, meta, it) in
-        let et = C.LetIn (n, meta, et) in
+        let p = C.LetIn (n, meta, meta, p) in
+        let it = C.LetIn (n, meta, meta, it) in
+        let et = C.LetIn (n, meta, meta, et) in
         aux (hd :: c) names p it et tl
       | None :: tl                                        -> assert false
    in
@@ -240,8 +238,8 @@ let clear c hyp =
    aux [] c
 
 let elim_inferred_type context goal arg using cpattern =
-   let metasenv, ugraph = [], Un.empty_ugraph in 
-   let ety, _ugraph = TC.type_of_aux' metasenv context using ugraph in
+   let metasenv, ugraph = [], Un.default_ugraph in
+   let ety = H.get_type "elim_inferred_type" context using in
    let _splits, args_no = PEH.split_with_whd (context, ety) in
    let _metasenv, predicate, _arg, actual_args = PT.mk_predicate_for_elim 
       ~context ~metasenv ~ugraph ~goal ~arg ~using ~cpattern ~args_no
@@ -249,3 +247,7 @@ let elim_inferred_type context goal arg using cpattern =
    let ty = C.Appl (predicate :: actual_args) in
    let upto = List.length actual_args in
    Rd.head_beta_reduce ~delta:false ~upto ty
+
+let does_not_occur = function
+   | C.AImplicit (_, None) -> true
+   | _                     -> false