X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_proof_checking%2FcicTypeChecker.ml;h=04b769b5c2b68366d2c1f765a39d21f7b7f43f62;hb=a21777bd2ac02fd346f168ead468405e4c300855;hp=137f786ab1fc003e7432605ee82116a0e9d6093c;hpb=b3bfd6b249600b15552c890306a635aee30c2a74;p=helm.git diff --git a/helm/ocaml/cic_proof_checking/cicTypeChecker.ml b/helm/ocaml/cic_proof_checking/cicTypeChecker.ml index 137f786ab..04b769b5c 100644 --- a/helm/ocaml/cic_proof_checking/cicTypeChecker.ml +++ b/helm/ocaml/cic_proof_checking/cicTypeChecker.ml @@ -793,11 +793,12 @@ and guarded_by_destructors context n nn kl x safes = let module U = UriManager in function C.Rel m when m > n && m <= nn -> false - | C.Rel n -> + | C.Rel m -> (match List.nth context (n-1) with Some (_,C.Decl _) -> true | Some (_,C.Def (bo,_)) -> - guarded_by_destructors context n nn kl x safes bo + guarded_by_destructors context m nn kl x safes + (CicSubstitution.lift m bo) | None -> raise (TypeCheckerFailure "Reference to deleted hypothesis") ) | C.Meta _ @@ -1370,12 +1371,19 @@ and type_of_aux' metasenv context t = and sort2 = type_of_aux ((Some (name,(C.Decl s)))::context) t in sort_of_prod context (name,s) (sort1,sort2) | C.Lambda (n,s,t) -> - let sort1 = type_of_aux context s - and type2 = type_of_aux ((Some (n,(C.Decl s)))::context) t in - let sort2 = type_of_aux ((Some (n,(C.Decl s)))::context) type2 in - (* only to check if the product is well-typed *) - let _ = sort_of_prod context (n,s) (sort1,sort2) in - C.Prod (n,s,type2) + let sort1 = type_of_aux context s in + (match R.whd context sort1 with + C.Meta _ + | C.Sort _ -> () + | _ -> + raise + (TypeCheckerFailure (sprintf + "Not well-typed lambda-abstraction: the source %s should be a + type; instead it is a term of type %s" (CicPp.ppterm s) + (CicPp.ppterm sort1))) + ) ; + let type2 = type_of_aux ((Some (n,(C.Decl s)))::context) t in + C.Prod (n,s,type2) | C.LetIn (n,s,t) -> (* only to check if s is well-typed *) let ty = type_of_aux context s in @@ -1615,7 +1623,7 @@ in if not res then debug_print ("#### " ^ CicPp.ppterm (type_of_aux context p) ^ | Cic.Variable (_,None,_,_) -> () | _ -> raise (TypeCheckerFailure - ("Unknown mutual inductive definition:" ^ + ("Unknown variable definition:" ^ UriManager.string_of_uri uri)) ) ; let typeoft = type_of_aux context t in @@ -1657,7 +1665,7 @@ in if not res then debug_print ("#### " ^ CicPp.ppterm (type_of_aux context p) ^ | (hete, hety)::tl -> (match (CicReduction.whd context hetype) with Cic.Prod (n,s,t) -> - if CicReduction.are_convertible context s hety then + if CicReduction.are_convertible context hety s then (CicReduction.fdebug := -1 ; eat_prods context (CicSubstitution.subst hete t) tl )