typecheck_mutual_inductive_defs exposed.

[helm.git] / helm / ocaml / cic_proof_checking / cicTypeChecker.ml

diff --git a/helm/ocaml/cic_proof_checking/cicTypeChecker.ml b/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
index a494c4a690f519638efacbe63738446e9f100245..b07c6e4a01f4cc811ec8bdfd107d7dadc06aa271 100644 (file)
--- a/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
+++ b/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
@@ -58,7 +58,9 @@ let debrujin_constructor uri number_of_types =
  let rec aux k =
   let module C = Cic in
    function
-      C.Rel _ as t -> t
+      C.Rel n as t when n <= k -> t
+    | C.Rel _ ->
+        raise (NotWellTyped ("Debrujin: open term found"))
     | C.Var (uri,exp_named_subst) ->
        let exp_named_subst' = 
         List.map (function (uri,t) -> (uri,aux k t)) exp_named_subst
@@ -428,49 +430,55 @@ and are_all_occurrences_positive context uri indparamsno i n nn te =
    | _ -> raise (NotWellFormedTypeOfInductiveConstructor (UriManager.string_of_uri uri))
 
 (* Main function to checks the correctness of a mutual *)
-(* inductive block definition.                         *)
-and check_mutual_inductive_defs uri =
+(* inductive block definition. This is the function    *)
+(* exported to the proof-engine.                       *)
+and typecheck_mutual_inductive_defs uri (itl,_,indparamsno) =
  let module U = UriManager in
-  function
-     Cic.InductiveDefinition (itl, _, indparamsno) ->
-      (* let's check if the arity of the inductive types are well *)
-      (* formed                                                   *)
-      List.iter (fun (_,_,x,_) -> let _ = type_of x in ()) itl ;
+  (* let's check if the arity of the inductive types are well *)
+  (* formed                                                   *)
+  List.iter (fun (_,_,x,_) -> let _ = type_of x in ()) itl ;
 
-      (* let's check if the types of the inductive constructors  *)
-      (* are well formed.                                        *)
-      (* In order not to use type_of_aux we put the types of the *)
-      (* mutual inductive types at the head of the types of the  *)
-      (* constructors using Prods                                *)
-      let len = List.length itl in
-       let tys =
-        List.map (fun (n,_,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) itl in
-       let _ =
-        List.fold_right
-         (fun (_,_,_,cl) i ->
-           List.iter
-            (fun (name,te) -> 
-              let debrujinedte = debrujin_constructor uri len te in
-              let augmented_term =
-               List.fold_right
-                (fun (name,_,ty,_) i -> Cic.Prod (Cic.Name name, ty, i))
-                itl debrujinedte
-              in
-               let _ = type_of augmented_term in
-                (* let's check also the positivity conditions *)
-                if
-                 not
-                  (are_all_occurrences_positive tys uri indparamsno i 0 len
-                    debrujinedte)
-                then
-                 raise (NotPositiveOccurrences (U.string_of_uri uri))
-            ) cl ;
-           (i + 1)
-        ) itl 1
-       in
-        ()
-   | _ ->
-     raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
+  (* let's check if the types of the inductive constructors  *)
+  (* are well formed.                                        *)
+  (* In order not to use type_of_aux we put the types of the *)
+  (* mutual inductive types at the head of the types of the  *)
+  (* constructors using Prods                                *)
+  let len = List.length itl in
+   let tys =
+    List.map (fun (n,_,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) itl in
+   let _ =
+    List.fold_right
+     (fun (_,_,_,cl) i ->
+       List.iter
+        (fun (name,te) -> 
+          let debrujinedte = debrujin_constructor uri len te in
+          let augmented_term =
+           List.fold_right
+            (fun (name,_,ty,_) i -> Cic.Prod (Cic.Name name, ty, i))
+            itl debrujinedte
+          in
+           let _ = type_of augmented_term in
+            (* let's check also the positivity conditions *)
+            if
+             not
+              (are_all_occurrences_positive tys uri indparamsno i 0 len
+                debrujinedte)
+            then
+             raise (NotPositiveOccurrences (U.string_of_uri uri))
+        ) cl ;
+       (i + 1)
+    ) itl 1
+   in
+    ()
+
+(* Main function to checks the correctness of a mutual *)
+(* inductive block definition.                         *)
+and check_mutual_inductive_defs uri =
+ function
+    Cic.InductiveDefinition (itl, params, indparamsno) ->
+     typecheck_mutual_inductive_defs uri (itl,params,indparamsno)
+  | _ ->
+    raise (WrongUriToMutualInductiveDefinitions (UriManager.string_of_uri uri))
 
 and type_of_mutual_inductive_defs uri i =
  let module C = Cic in