X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_proof_checking%2FcicSubstitution.ml;h=a9fa1d9b19e8e86ca8c8b89621e6fa4e13c365e1;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=229da24f0fdbdf7b5183c288fe1e8d5ac05937c9;hpb=47c9a0967ce271e551d4cbc8ac388097d774a3ef;p=helm.git diff --git a/helm/ocaml/cic_proof_checking/cicSubstitution.ml b/helm/ocaml/cic_proof_checking/cicSubstitution.ml index 229da24f0..a9fa1d9b1 100644 --- a/helm/ocaml/cic_proof_checking/cicSubstitution.ml +++ b/helm/ocaml/cic_proof_checking/cicSubstitution.ml @@ -29,7 +29,6 @@ exception ReferenceToVariable;; exception ReferenceToConstant;; exception ReferenceToCurrentProof;; exception ReferenceToInductiveDefinition;; -exception DeliftingWouldCaptureAFreeVariable;; let debug_print = fun _ -> () @@ -107,81 +106,6 @@ let lift n t = lift_from 1 n t ;; -(* delifts a term t of n levels strating from k, that is changes (Rel m) - * to (Rel (m - n)) when m > (k + n). if k <= m < k + n delift fails - *) -let delift_from k n = - let rec liftaux k = - let module C = Cic in - function - C.Rel m -> - if m < k then - C.Rel m - else if m < k + n then - raise DeliftingWouldCaptureAFreeVariable - else - C.Rel (m - n) - | C.Var (uri,exp_named_subst) -> - let exp_named_subst' = - List.map (function (uri,t) -> (uri,liftaux k t)) exp_named_subst - in - C.Var (uri,exp_named_subst') - | C.Meta (i,l) -> - let l' = - List.map - (function - None -> None - | Some t -> Some (liftaux k t) - ) l - in - C.Meta(i,l') - | C.Sort _ 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) - | C.LetIn (n,s,t) -> C.LetIn (n, liftaux k s, liftaux (k+1) t) - | C.Appl l -> C.Appl (List.map (liftaux k) l) - | C.Const (uri,exp_named_subst) -> - let exp_named_subst' = - List.map (function (uri,t) -> (uri,liftaux k t)) exp_named_subst - in - C.Const (uri,exp_named_subst') - | C.MutInd (uri,tyno,exp_named_subst) -> - let exp_named_subst' = - List.map (function (uri,t) -> (uri,liftaux k t)) exp_named_subst - in - C.MutInd (uri,tyno,exp_named_subst') - | C.MutConstruct (uri,tyno,consno,exp_named_subst) -> - let exp_named_subst' = - List.map (function (uri,t) -> (uri,liftaux k t)) exp_named_subst - in - C.MutConstruct (uri,tyno,consno,exp_named_subst') - | C.MutCase (sp,i,outty,t,pl) -> - C.MutCase (sp, i, liftaux k outty, liftaux k t, - List.map (liftaux k) pl) - | C.Fix (i, fl) -> - let len = List.length fl in - let liftedfl = - List.map - (fun (name, i, ty, bo) -> (name, i, liftaux k ty, liftaux (k+len) bo)) - fl - in - C.Fix (i, liftedfl) - | C.CoFix (i, fl) -> - let len = List.length fl in - let liftedfl = - List.map - (fun (name, ty, bo) -> (name, liftaux k ty, liftaux (k+len) bo)) - fl - in - C.CoFix (i, liftedfl) - in - liftaux k - -let delift n t = - delift_from 1 n t - let subst arg = let rec substaux k = let module C = Cic in @@ -267,7 +191,7 @@ let subst arg = (*CSC: per la roba che proviene da Coq questo non serve! *) let subst_vars exp_named_subst = (* -debug_print ("@@@POSSIBLE BUG: SUBSTITUTION IS NOT SIMULTANEOUS") ; +debug_print (lazy ("@@@POSSIBLE BUG: SUBSTITUTION IS NOT SIMULTANEOUS")) ; *) let rec substaux k = let module C = Cic in @@ -292,17 +216,17 @@ debug_print ("@@@POSSIBLE BUG: SUBSTITUTION IS NOT SIMULTANEOUS") ; ) in (* -debug_print "\n\n---- BEGIN " ; -debug_print ("----params: " ^ String.concat " ; " (List.map UriManager.string_of_uri params)) ; -debug_print ("----S(" ^ UriManager.string_of_uri uri ^ "): " ^ String.concat " ; " (List.map (function (uri,_) -> UriManager.string_of_uri uri) exp_named_subst)) ; -debug_print ("----P: " ^ String.concat " ; " (List.map (function (uri,_) -> UriManager.string_of_uri uri) exp_named_subst')) ; +debug_print (lazy "\n\n---- BEGIN ") ; +debug_print (lazy ("----params: " ^ String.concat " ; " (List.map UriManager.string_of_uri params))) ; +debug_print (lazy ("----S(" ^ UriManager.string_of_uri uri ^ "): " ^ String.concat " ; " (List.map (function (uri,_) -> UriManager.string_of_uri uri) exp_named_subst))) ; +debug_print (lazy ("----P: " ^ String.concat " ; " (List.map (function (uri,_) -> UriManager.string_of_uri uri) exp_named_subst'))) ; *) let exp_named_subst'' = substaux_in_exp_named_subst uri k exp_named_subst' params in (* -debug_print ("----D: " ^ String.concat " ; " (List.map (function (uri,_) -> UriManager.string_of_uri uri) exp_named_subst'')) ; -debug_print "---- END\n\n " ; +debug_print (lazy ("----D: " ^ String.concat " ; " (List.map (function (uri,_) -> UriManager.string_of_uri uri) exp_named_subst''))) ; +debug_print (lazy "---- END\n\n ") ; *) C.Var (uri,exp_named_subst'') ) @@ -407,11 +331,11 @@ debug_print "---- END\n\n " ; | _::tl -> filter_and_lift tl (* | (uri,_)::tl -> -debug_print ("---- SKIPPO " ^ UriManager.string_of_uri uri) ; +debug_print (lazy ("---- SKIPPO " ^ UriManager.string_of_uri uri)) ; if List.for_all (function (uri',_) -> not (UriManager.eq uri uri')) -exp_named_subst' then debug_print "---- OK1" ; -debug_print ("++++ uri " ^ UriManager.string_of_uri uri ^ " not in " ^ String.concat " ; " (List.map UriManager.string_of_uri params)) ; -if List.mem uri params then debug_print "---- OK2" ; +exp_named_subst' then debug_print (lazy "---- OK1") ; +debug_print (lazy ("++++ uri " ^ UriManager.string_of_uri uri ^ " not in " ^ String.concat " ; " (List.map UriManager.string_of_uri params))) ; +if List.mem uri params then debug_print (lazy "---- OK2") ; filter_and_lift tl *) in