X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fcic%2FcicUtil.ml;h=8c42aed6131a5348fb542f580eb1422f423d87e8;hb=625846fd7d1b0063b3b3a81ff9bbf36ddccf84f1;hp=dd165219694c2f1bbf1f0dc361f952e709e74532;hpb=468ee32f0fc7de271454ed94643b4dd7c9578e5f;p=helm.git diff --git a/helm/software/components/cic/cicUtil.ml b/helm/software/components/cic/cicUtil.ml index dd1652196..8c42aed61 100644 --- a/helm/software/components/cic/cicUtil.ml +++ b/helm/software/components/cic/cicUtil.ml @@ -79,7 +79,8 @@ let is_closed = | C.Cast (te,ty) -> is_closed k te && is_closed k ty | C.Prod (name,so,dest) -> is_closed k so && is_closed (k+1) dest | C.Lambda (_,so,dest) -> is_closed k so && is_closed (k+1) dest - | C.LetIn (_,so,dest) -> is_closed k so && is_closed (k+1) dest + | C.LetIn (_,so,ty,dest) -> + is_closed k so && is_closed k ty && is_closed (k+1) dest | C.Appl l -> List.fold_right (fun x i -> i && is_closed k x) l true | C.Var (_,exp_named_subst) @@ -116,7 +117,10 @@ let rec is_meta_closed = | C.Cast (te,ty) -> is_meta_closed te && is_meta_closed ty | C.Prod (name,so,dest) -> is_meta_closed so && is_meta_closed dest | C.Lambda (_,so,dest) -> is_meta_closed so && is_meta_closed dest - | C.LetIn (_,so,dest) -> is_meta_closed so && is_meta_closed dest + | C.LetIn (_,so,ty,dest) -> + is_meta_closed so && + is_meta_closed ty && + is_meta_closed dest | C.Appl l -> not (List.exists (fun x -> not (is_meta_closed x)) l) | C.Var (_,exp_named_subst) @@ -250,7 +254,7 @@ let id_of_annterm = | C.ACast (id,_,_) | C.AProd (id,_,_,_) | C.ALambda (id,_,_,_) - | C.ALetIn (id,_,_,_) + | C.ALetIn (id,_,_,_,_) | C.AAppl (id,_) | C.AConst (id,_,_) | C.AMutInd (id,_,_,_) @@ -290,7 +294,8 @@ let rec rehash_term = | C.Cast (te,ty) -> C.Cast (rehash_term te, rehash_term ty) | C.Prod (n,s,t) -> C.Prod (n, rehash_term s, rehash_term t) | C.Lambda (n,s,t) -> C.Lambda (n, rehash_term s, rehash_term t) - | C.LetIn (n,s,t) -> C.LetIn (n, rehash_term s, rehash_term t) + | C.LetIn (n,s,ty,t) -> + C.LetIn (n, rehash_term s, rehash_term ty, rehash_term t) | C.Appl l -> C.Appl (List.map rehash_term l) | C.Const (uri,exp_named_subst) -> let uri' = recons uri in @@ -355,12 +360,7 @@ let rehash_obj = | Some (name,C.Decl t) -> Some (name,C.Decl (rehash_term t)) | Some (name,C.Def (bo,ty)) -> - let ty' = - match ty with - None -> None - | Some ty'' -> Some (rehash_term ty'') - in - Some (name,C.Def (rehash_term bo, ty'))) hyps, + Some (name,C.Def (rehash_term bo, rehash_term ty))) hyps, rehash_term ty)) conjs in @@ -400,8 +400,9 @@ let rec metas_of_term = function List.flatten (List.map (fun (u, t) -> metas_of_term t) ens) | C.Cast (s, t) | C.Prod (_, s, t) - | C.Lambda (_, s, t) - | C.LetIn (_, s, t) -> (metas_of_term s) @ (metas_of_term t) + | C.Lambda (_, s, t) -> (metas_of_term s) @ (metas_of_term t) + | C.LetIn (_, s, ty, t) -> + (metas_of_term s) @ (metas_of_term ty) @ (metas_of_term t) | C.Appl l -> List.flatten (List.map metas_of_term l) | C.MutCase (uri, i, s, t, l) -> (metas_of_term s) @ (metas_of_term t) @ @@ -435,8 +436,10 @@ let rec metas_of_term_set = function S.empty ens | C.Cast (s, t) | C.Prod (_, s, t) - | C.Lambda (_, s, t) - | C.LetIn (_, s, t) -> S.union (metas_of_term_set s) (metas_of_term_set t) + | C.Lambda (_, s, t) -> S.union (metas_of_term_set s) (metas_of_term_set t) + | C.LetIn (_, s, ty, t) -> + S.union (metas_of_term_set s) + (S.union (metas_of_term_set ty) (metas_of_term_set t)) | C.Appl l -> List.fold_left (fun s t -> S.union s (metas_of_term_set t)) @@ -482,8 +485,8 @@ let alpha_equivalence = aux s s' && aux t t' | C.Lambda (_,s,t), C.Lambda (_,s',t') -> aux s s' && aux t t' - | C.LetIn (_,s,t), C.LetIn(_,s',t') -> - aux s s' && aux t t' + | C.LetIn (_,s,ty,t), C.LetIn(_,s',ty',t') -> + aux s s' && aux ty ty' && aux t t' | C.Appl l, C.Appl l' when List.length l = List.length l' -> (try List.fold_left2 @@ -554,42 +557,44 @@ let alpha_equivalence = in aux -let is_sober t = - let rec sober_term g = function +let is_sober c t = + let rec sober_term c g = function | C.Rel _ | C.Sort _ | C.Implicit _ -> g | C.Const (_, xnss) | C.Var (_, xnss) | C.MutConstruct (_, _, _, xnss) - | C.MutInd (_, _, xnss) -> sober_xnss g xnss - | C.Meta (_, xss) -> sober_xss g xss - | C.LetIn (_, v, t) + | C.MutInd (_, _, xnss) -> sober_xnss c g xnss + | C.Meta (_, xss) -> sober_xss c g xss | C.Lambda (_, v, t) | C.Prod (_, v, t) - | C.Cast (t, v) -> sober_term (sober_term g t) v + | C.Cast (t, v) -> + sober_term c (sober_term c g t) v + | C.LetIn (_, v, ty, t) -> + sober_term c (sober_term c (sober_term c g t) ty) v | C.Appl [] | C.Appl [_] -> fun b -> false - | C.Appl ts -> sober_terms g ts + | C.Appl ts -> sober_terms c g ts | C.MutCase (_, _, t, v, ts) -> - sober_terms (sober_term (sober_term g t) v) ts - | C.Fix (_, ifs) -> sober_ifs g ifs - | C.CoFix (_, cifs) -> sober_cifs g cifs - and sober_terms g = List.fold_left sober_term g - and sober_xnss g = - let map g (_, t) = sober_term g t in + sober_terms c (sober_term c (sober_term c g t) v) ts + | C.Fix (_, ifs) -> sober_ifs c g ifs + | C.CoFix (_, cifs) -> sober_cifs c g cifs + and sober_terms c g = List.fold_left (sober_term c) g + and sober_xnss c g = + let map g (_, t) = sober_term c g t in List.fold_left map g - and sober_xss g = + and sober_xss c g = let map g = function | None -> g - | Some t -> sober_term g t + | Some t -> sober_term c g t in List.fold_left map g - and sober_ifs g = - let map g (_, _, t, v) = sober_term (sober_term g t) v in + and sober_ifs c g = + let map g (_, _, t, v) = sober_term c (sober_term c g t) v in List.fold_left map g - and sober_cifs g = - let map g (_, t, v) = sober_term (sober_term g t) v in + and sober_cifs c g = + let map g (_, t, v) = sober_term c (sober_term c g t) v in List.fold_left map g in - sober_term (fun b -> b) t true + sober_term c (fun b -> b) t true