Old compare-terms function

[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 af98ff0efc72b53acfd7d7e8b225e45272a166f4..cd742d4cdff80a1e7baf25b6d122542265b34c3c 100644 (file)
--- a/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
+++ b/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
@@ -23,6 +23,8 @@
  * http://cs.unibo.it/helm/.
  *)
 
+(* $Id$ *)
+
 (* TODO factorize functions to frequent errors (e.g. "Unknwon mutual inductive
  * ...") *)
 
@@ -52,10 +54,11 @@ let rec split l n =
       raise (TypeCheckerFailure (lazy "Parameters number < left parameters number"))
 ;;
 
-let debrujin_constructor uri number_of_types =
- let rec aux k =
+let debrujin_constructor ?(cb=fun _ _ -> ()) uri number_of_types =
+ let rec aux k t =
   let module C = Cic in
-   function
+  let res =
+   match t with
       C.Rel n as t when n <= k -> t
     | C.Rel _ ->
         raise (TypeCheckerFailure (lazy "unbound variable found in constructor type"))
@@ -66,7 +69,7 @@ let debrujin_constructor uri number_of_types =
         C.Var (uri,exp_named_subst')
     | C.Meta (i,l) ->
        let l' = List.map (function None -> None | Some t -> Some (aux k t)) l in
-        C.Meta (i,l)
+        C.Meta (i,l')
     | C.Sort _
     | C.Implicit _ as t -> t
     | C.Cast (te,ty) -> C.Cast (aux k te, aux k ty)
@@ -114,6 +117,9 @@ let debrujin_constructor uri number_of_types =
           fl
        in
         C.CoFix (i, liftedfl)
+  in
+   cb t res;
+   res
  in
   aux 0
 ;;
@@ -545,7 +551,7 @@ and typecheck_mutual_inductive_defs ~logger uri (itl,_,indparamsno) ugraph =
                ugraph'
             ) ugraph cl in
        (i + 1),ugraph''
-      ) itl (1,ugraph)
+      ) itl (1,ugrap1)
   in
   ugraph2
 
@@ -1126,11 +1132,10 @@ and guarded_by_constructors ~subst context n nn h te args coInductiveTypeURI =
          | C.Lambda _
          | C.LetIn _ ->
             raise (AssertFailure (lazy "25"))(* due to type-checking *)
-         | C.Appl ((C.MutInd (uri,_,_))::_) as ty
-            when uri == coInductiveTypeURI -> 
+         | C.Appl ((C.MutInd (uri,_,_))::_) when uri == coInductiveTypeURI -> 
              guarded_by_constructors ~subst context n nn true te []
               coInductiveTypeURI
-         | C.Appl ((C.MutInd (uri,_,_))::_) as ty -> 
+         | C.Appl ((C.MutInd (uri,_,_))::_) -> 
             guarded_by_constructors ~subst context n nn true te tl
              coInductiveTypeURI
          | C.Appl _ ->
@@ -1687,8 +1692,7 @@ and type_of_aux' ~logger ?(subst = []) metasenv context t ugraph =
                  (lazy (sprintf
                      ("Case analysys: analysed term type is %s (%s#1/%d{_}), but is expected to be (an application of) %s#1/%d{_}")
                      (CicPp.ppterm typ) (U.string_of_uri uri') i' (U.string_of_uri uri) i)))
-          | C.Appl 
-             ((C.MutInd (uri',i',exp_named_subst) as typ):: tl) as typ' ->
+          | C.Appl ((C.MutInd (uri',i',exp_named_subst) as typ):: tl) ->
               if U.eq uri uri' && i = i' then
                let params,args =
                  split tl (List.length tl - k)