X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_proof_checking%2FcicSubstitution.ml;h=c718524fc3b6d3e099a1eb64f45f7d6838fa51db;hb=a0b3f70f4dee78cc07baf2e78673b8b7cf573995;hp=4a938acb9c209be1cbbab3e338f35c6bbf19538e;hpb=bac72fcaa876137ab7a5630e0c1badc2a627dce8;p=helm.git diff --git a/helm/ocaml/cic_proof_checking/cicSubstitution.ml b/helm/ocaml/cic_proof_checking/cicSubstitution.ml index 4a938acb9..c718524fc 100644 --- a/helm/ocaml/cic_proof_checking/cicSubstitution.ml +++ b/helm/ocaml/cic_proof_checking/cicSubstitution.ml @@ -54,7 +54,7 @@ let lift n = in C.Meta(i,l') | C.Sort _ as t -> t - | C.Implicit as t -> t + | C.Implicit _ as t -> t | C.Cast (te,ty) -> C.Cast (liftaux k te, liftaux k ty) | C.Prod (n,s,t) -> C.Prod (n, liftaux k s, liftaux (k+1) t) | C.Lambda (n,s,t) -> C.Lambda (n, liftaux k s, liftaux (k+1) t) @@ -126,7 +126,7 @@ let subst arg = in C.Meta(i,l') | C.Sort _ as t -> t - | C.Implicit as t -> t + | C.Implicit _ as t -> t | C.Cast (te,ty) -> C.Cast (substaux k te, substaux k ty) | C.Prod (n,s,t) -> C.Prod (n, substaux k s, substaux (k + 1) t) | C.Lambda (n,s,t) -> C.Lambda (n, substaux k s, substaux (k + 1) t) @@ -202,7 +202,8 @@ prerr_endline ("@@@POSSIBLE BUG: SUBSTITUTION IS NOT SIMULTANEOUS") ; with Not_found -> let params = - (match CicEnvironment.get_cooked_obj ~trust:true uri with + let obj = CicEnvironment.get_obj uri in + (match obj with C.Constant _ -> raise ReferenceToConstant | C.Variable (_,_,_,params) -> params | C.CurrentProof _ -> raise ReferenceToCurrentProof @@ -234,7 +235,7 @@ prerr_endline "---- END\n\n " ; in C.Meta(i,l') | C.Sort _ as t -> t - | C.Implicit as t -> t + | C.Implicit _ as t -> t | C.Cast (te,ty) -> C.Cast (substaux k te, substaux k ty) | C.Prod (n,s,t) -> C.Prod (n, substaux k s, substaux (k + 1) t) | C.Lambda (n,s,t) -> C.Lambda (n, substaux k s, substaux (k + 1) t) @@ -250,7 +251,8 @@ prerr_endline "---- END\n\n " ; | C.Appl _ -> assert false | C.Const (uri,exp_named_subst') -> let params = - (match CicEnvironment.get_cooked_obj ~trust:true uri with + let obj = CicEnvironment.get_obj uri in + (match obj with C.Constant (_,_,_,params) -> params | C.Variable _ -> raise ReferenceToVariable | C.CurrentProof (_,_,_,_,params) -> params @@ -263,7 +265,8 @@ prerr_endline "---- END\n\n " ; C.Const (uri,exp_named_subst'') | C.MutInd (uri,typeno,exp_named_subst') -> let params = - (match CicEnvironment.get_cooked_obj ~trust:true uri with + let obj = CicEnvironment.get_obj uri in + (match obj with C.Constant _ -> raise ReferenceToConstant | C.Variable _ -> raise ReferenceToVariable | C.CurrentProof _ -> raise ReferenceToCurrentProof @@ -276,7 +279,8 @@ prerr_endline "---- END\n\n " ; C.MutInd (uri,typeno,exp_named_subst'') | C.MutConstruct (uri,typeno,consno,exp_named_subst') -> let params = - (match CicEnvironment.get_cooked_obj ~trust:true uri with + let obj = CicEnvironment.get_obj uri in + (match obj with C.Constant _ -> raise ReferenceToConstant | C.Variable _ -> raise ReferenceToVariable | C.CurrentProof _ -> raise ReferenceToCurrentProof @@ -335,13 +339,15 @@ if List.mem uri params then prerr_endline "---- OK2" ; substaux 1 ;; -(* l is the relocation list *) +(* lift_meta [t_1 ; ... ; t_n] t *) +(* returns the term [t] where [Rel i] is substituted with [t_i] *) +(* [t_i] is lifted as usual when it crosses an abstraction *) let lift_meta l t = - let module C = Cic in - if l = [] then t else - let rec aux k = function + let module C = Cic in + if l = [] then t else + let rec aux k = function C.Rel n as t -> - if n <= k then t else + if n <= k then t else (try match List.nth l (n-k-1) with None -> raise RelToHiddenHypothesis @@ -368,7 +374,7 @@ let lift_meta l t = in C.Meta(i,l') | C.Sort _ as t -> t - | C.Implicit as t -> t + | C.Implicit _ as t -> t | C.Cast (te,ty) -> C.Cast (aux k te, aux k ty) (*CSC ??? *) | C.Prod (n,s,t) -> C.Prod (n, aux k s, aux (k + 1) t) | C.Lambda (n,s,t) -> C.Lambda (n, aux k s, aux (k + 1) t)