- changed license to lgpl

[helm.git] / helm / ocaml / cic_omdoc / doubleTypeInference.ml

diff --git a/helm/ocaml/cic_omdoc/doubleTypeInference.ml b/helm/ocaml/cic_omdoc/doubleTypeInference.ml
index 235d8d835b47f7aac01f9ebe91e0c9f2d1d6c2c1..128da869b72a142b8cb914c80f68a02a221952ff 100644 (file)
--- a/helm/ocaml/cic_omdoc/doubleTypeInference.ml
+++ b/helm/ocaml/cic_omdoc/doubleTypeInference.ml
@@ -266,14 +266,14 @@ let type_of_constant uri =
  let module R = CicReduction in
  let module U = UriManager in
   let cobj =
-   match CicEnvironment.is_type_checked uri CicUniv.empty_ugraph with
+   match CicEnvironment.is_type_checked CicUniv.empty_ugraph uri with
       CicEnvironment.CheckedObj (cobj,_) -> cobj
     | CicEnvironment.UncheckedObj uobj ->
        raise (NotWellTyped "Reference to an unchecked constant")
   in
    match cobj with
-      C.Constant (_,_,ty,_) -> ty
-    | C.CurrentProof (_,_,_,ty,_) -> ty
+      C.Constant (_,_,ty,_,_) -> ty
+    | C.CurrentProof (_,_,_,ty,_,_) -> ty
     | _ -> raise (WrongUriToConstant (U.string_of_uri uri))
 ;;
 
@@ -281,8 +281,8 @@ let type_of_variable uri =
  let module C = Cic in
  let module R = CicReduction in
  let module U = UriManager in
-  match CicEnvironment.is_type_checked uri CicUniv.empty_ugraph with
-     CicEnvironment.CheckedObj ((C.Variable (_,_,ty,_)),_) -> ty
+  match CicEnvironment.is_type_checked CicUniv.empty_ugraph uri with
+     CicEnvironment.CheckedObj ((C.Variable (_,_,ty,_,_)),_) -> ty
    | CicEnvironment.UncheckedObj (C.Variable _) ->
       raise (NotWellTyped "Reference to an unchecked variable")
    |  _ -> raise (WrongUriToVariable (UriManager.string_of_uri uri))
@@ -293,13 +293,13 @@ let type_of_mutual_inductive_defs uri i =
  let module R = CicReduction in
  let module U = UriManager in
   let cobj =
-   match CicEnvironment.is_type_checked uri CicUniv.empty_ugraph with
+   match CicEnvironment.is_type_checked CicUniv.empty_ugraph uri with
       CicEnvironment.CheckedObj (cobj,_) -> cobj
     | CicEnvironment.UncheckedObj uobj ->
        raise (NotWellTyped "Reference to an unchecked inductive type")
   in
    match cobj with
-      C.InductiveDefinition (dl,_,_) ->
+      C.InductiveDefinition (dl,_,_,_) ->
        let (_,_,arity,_) = List.nth dl i in
         arity
     | _ -> raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
@@ -310,13 +310,13 @@ let type_of_mutual_inductive_constr uri i j =
  let module R = CicReduction in
  let module U = UriManager in
   let cobj =
-   match CicEnvironment.is_type_checked uri CicUniv.empty_ugraph with
+   match CicEnvironment.is_type_checked CicUniv.empty_ugraph uri with
       CicEnvironment.CheckedObj (cobj,_) -> cobj
     | CicEnvironment.UncheckedObj uobj ->
        raise (NotWellTyped "Reference to an unchecked constructor")
   in
    match cobj with
-      C.InductiveDefinition (dl,_,_) ->
+      C.InductiveDefinition (dl,_,_,_) ->
        let (_,_,_,cl) = List.nth dl i in
         let (_,ty) = List.nth cl (j-1) in
          ty
@@ -539,11 +539,11 @@ let rec type_of_aux' subterms_to_types metasenv context t expectedty =
          let (cl,parsno) =
            let obj,_ =
              try
-               CicEnvironment.get_cooked_obj uri CicUniv.empty_ugraph
+               CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
              with Not_found -> assert false
            in
           match obj with
-             C.InductiveDefinition (tl,_,parsno) ->
+             C.InductiveDefinition (tl,_,parsno,_) ->
               let (_,_,_,cl) = List.nth tl i in (cl,parsno)
            | _ ->
              raise (WrongUriToMutualInductiveDefinitions (U.string_of_uri uri))
@@ -642,25 +642,21 @@ let rec type_of_aux' subterms_to_types metasenv context t expectedty =
   let uris_and_types =
      let obj,_ =
        try
-         CicEnvironment.get_cooked_obj uri CicUniv.empty_ugraph
+         CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
        with Not_found -> assert false
      in
-    match obj with
-      Cic.Constant (_,_,_,params)
-    | Cic.CurrentProof (_,_,_,_,params)
-    | Cic.Variable (_,_,_,params)
-    | Cic.InductiveDefinition (_,params,_) ->
-       List.map
-        (function uri ->
-           let obj,_ =
-             try
-               CicEnvironment.get_cooked_obj uri CicUniv.empty_ugraph
-             with Not_found -> assert false
-           in
-           match obj with
-             Cic.Variable (_,None,ty,_) -> uri,ty
-           | _ -> assert false (* the theorem is well-typed *)
-        ) params
+    let params = CicUtil.params_of_obj obj in
+     List.map
+      (function uri ->
+         let obj,_ =
+           try
+             CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
+           with Not_found -> assert false
+         in
+         match obj with
+           Cic.Variable (_,None,ty,_,_) -> uri,ty
+         | _ -> assert false (* the theorem is well-typed *)
+      ) params
   in
    let rec check uris_and_types subst =
     match uris_and_types,subst with