X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_proof_checking%2FcicTypeChecker.ml;h=3f504ab7957426aa193e81240336dec3a567bbd3;hb=60ea1e5cd7494c7453993dad5b819cd631770308;hp=8403f5f0c082e295da72e48c1764cd27adc24ea2;hpb=e626927b4c1c77bdcd6b545203a0a9c17a9ff136;p=helm.git

diff --git a/helm/ocaml/cic_proof_checking/cicTypeChecker.ml b/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
index 8403f5f0c..3f504ab79 100644
--- a/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
+++ b/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
@@ -203,7 +203,7 @@ and does_not_occur context n nn te =
    match CicReduction.whd context te with
       C.Rel m when m > n && m <= nn -> false
     | C.Rel _
-    | C.Meta _
+    | C.Meta _  (* CSC: Are we sure? No recursion?*)
     | C.Sort _
     | C.Implicit _ -> true
     | C.Cast (te,ty) ->
@@ -604,13 +604,16 @@ and get_new_safes context p c rl safes n nn x =
    | (C.Prod _, (C.Rel _ as e), _)
    | (C.MutInd _, e, [])
    | (C.Appl _, e, []) -> (e,safes,n,nn,x,context)
-   | (_,_,_) ->
+   | (c,p,l) ->
       (* CSC: If the next exception is raised, it just means that   *)
       (* CSC: the proof-assistant allows to use very strange things *)
       (* CSC: as a branch of a case whose type is a Prod. In        *)
       (* CSC: particular, this means that a new (C.Prod, x,_) case  *)
       (* CSC: must be considered in this match. (e.g. x = MutCase)  *)
-      raise (AssertFailure "7")
+      raise
+       (AssertFailure
+         (Printf.sprintf "Get New Safes: c=%s ; p=%s"
+           (CicPp.ppterm c) (CicPp.ppterm p)))
 
 and split_prods context n te =
  let module C = Cic in
@@ -841,17 +844,21 @@ and guarded_by_destructors context n nn kl x safes =
            let (tys,len,isinductive,paramsno,cl) =
             match CicEnvironment.get_obj uri with
                C.InductiveDefinition (tl,_,paramsno) ->
-                let (_,isinductive,_,cl) = List.nth tl i in
-                 let tys =
-                  List.map (fun (n,_,ty,_) ->
-                   Some(Cic.Name n,(Cic.Decl ty))) tl
-                 in
-                  let cl' =
-                   List.map
-                    (fun (id,ty) ->
-                      (id, snd (split_prods tys paramsno ty))) cl
+                let len = List.length tl in
+                 let (_,isinductive,_,cl) = List.nth tl i in
+                  let tys =
+                   List.map (fun (n,_,ty,_) ->
+                    Some(Cic.Name n,(Cic.Decl ty))) tl
                   in
-                   (tys,List.length tl,isinductive,paramsno,cl')
+                   let cl' =
+                    List.map
+                     (fun (id,ty) ->
+                      let debrujinedty = debrujin_constructor uri len ty in
+                       (id, snd (split_prods tys paramsno ty),
+                        snd (split_prods tys paramsno debrujinedty)
+                       )) cl
+                   in
+                    (tys,len,isinductive,paramsno,cl')
              | _ ->
                 raise (TypeCheckerFailure
                   ("Unknown mutual inductive definition:" ^
@@ -869,11 +876,8 @@ and guarded_by_destructors context n nn kl x safes =
              guarded_by_destructors context n nn kl x safes outtype &&
               (*CSC: manca ??? il controllo sul tipo di term? *)
               List.fold_right
-               (fun (p,(_,c)) i ->
-                 let rl' =
-                  let debrujinedte = debrujin_constructor uri len c in
-                   recursive_args tys 0 len debrujinedte
-                 in
+               (fun (p,(_,c,brujinedc)) i ->
+                 let rl' = recursive_args tys 0 len brujinedc in
                   let (e,safes',n',nn',x',context') =
                    get_new_safes context p c rl' safes n nn x
                   in
@@ -1294,7 +1298,8 @@ and check_metasenv_consistency metasenv context canonical_context l =
       | (Some (n,C.Def (t,None)))::tl ->
          (Some (n,C.Def ((S.lift_meta l (S.lift i t)),None)))::(aux (i+1) tl)
       | None::tl -> None::(aux (i+1) tl)
-      | (Some (n,C.Def (_,Some _)))::_ -> assert false
+      | (Some (n,C.Def (t,Some ty)))::tl ->
+         (Some (n,C.Def ((S.lift_meta l (S.lift i t)),Some (S.lift_meta l (S.lift i ty)))))::(aux (i+1) tl)
     in
      aux 1 canonical_context
    in
@@ -1337,8 +1342,7 @@ and type_of_aux' metasenv context t =
 	  | None -> raise (TypeCheckerFailure "Reference to deleted hypothesis")
         with
         _ ->
-          raise (TypeCheckerFailure
-            "unbound variable found in constructor type")
+          raise (TypeCheckerFailure "unbound variable")
        )
     | C.Var (uri,exp_named_subst) ->
       incr fdebug ;
@@ -1638,8 +1642,9 @@ in if not res then debug_print ("#### " ^ CicPp.ppterm (type_of_aux context p) ^
          C.Sort s2
     | (C.Sort s1, C.Sort s2) -> C.Sort C.Type (*CSC manca la gestione degli universi!!! *)
     | (C.Meta _, C.Sort _) -> t2'
-    | (C.Meta _, C.Meta (_,[]))
-    | (C.Sort _, C.Meta (_,[])) -> t2'
+    | (C.Meta _, (C.Meta (_,_) as t))
+    | (C.Sort _, (C.Meta (_,_) as t)) when CicUtil.is_closed t ->
+        t2'
     | (_,_) -> raise (TypeCheckerFailure (sprintf
         "Prod: expected two sorts, found = %s, %s" (CicPp.ppterm t1')
           (CicPp.ppterm t2')))