let module C = Cic in
(*CSC: Che schifo! Bisogna capire meglio e trovare una soluzione ragionevole!*)
let dummy_mutind =
- C.MutInd (UriManager.uri_of_string "cic:/Coq/Init/Datatypes/nat.ind",0,[])
+ C.MutInd (HelmLibraryObjects.Datatypes.nat_URI,0,[])
in
(*CSC mettere in cicSubstitution *)
let rec subst_inductive_type_with_dummy_mutind =
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 _
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
| 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
| (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
)