From 8d07bbad4976d7dc1b99918cc3513fe40cd1ee9f Mon Sep 17 00:00:00 2001 From: Enrico Tassi Date: Tue, 27 Jun 2006 16:44:14 +0000 Subject: [PATCH] added a metas_of_term implemented using sets instead of lists (avoids some stack overflows) --- helm/software/components/cic/cicUtil.ml | 48 ++++++++++++++++++++++++ helm/software/components/cic/cicUtil.mli | 2 + 2 files changed, 50 insertions(+) diff --git a/helm/software/components/cic/cicUtil.ml b/helm/software/components/cic/cicUtil.ml index 51d84392b..de796910a 100644 --- a/helm/software/components/cic/cicUtil.ml +++ b/helm/software/components/cic/cicUtil.ml @@ -389,3 +389,51 @@ let rec metas_of_term = function | _ -> [] ;; +module MetaOT = struct + type t = int * Cic.term option list + let compare = Pervasives.compare +end + +module S = Set.Make(MetaOT) + +let rec metas_of_term_set = function + | Cic.Meta (i, c) -> S.singleton (i,c) + | Cic.Var (_, ens) + | Cic.Const (_, ens) + | Cic.MutInd (_, _, ens) + | Cic.MutConstruct (_, _, _, ens) -> + List.fold_left + (fun s (_,t) -> S.union s (metas_of_term_set t)) + S.empty ens + | Cic.Cast (s, t) + | Cic.Prod (_, s, t) + | Cic.Lambda (_, s, t) + | Cic.LetIn (_, s, t) -> S.union (metas_of_term_set s) (metas_of_term_set t) + | Cic.Appl l -> + List.fold_left + (fun s t -> S.union s (metas_of_term_set t)) + S.empty l + | Cic.MutCase (uri, i, s, t, l) -> + S.union + (S.union (metas_of_term_set s) (metas_of_term_set t)) + (List.fold_left + (fun s t -> S.union s (metas_of_term_set t)) + S.empty l) + | Cic.Fix (_, il) -> + (List.fold_left + (fun s (_,_,t1,t2) -> + S.union s (S.union (metas_of_term_set t1) (metas_of_term_set t2)))) + S.empty il + | Cic.CoFix (i, il) -> + (List.fold_left + (fun s (_,t1,t2) -> + S.union s (S.union (metas_of_term_set t1) (metas_of_term_set t2)))) + S.empty il + | _ -> S.empty +;; + +let metas_of_term_set t = + let s = metas_of_term_set t in + S.elements s +;; + diff --git a/helm/software/components/cic/cicUtil.mli b/helm/software/components/cic/cicUtil.mli index 4391efc82..b8d71f51f 100644 --- a/helm/software/components/cic/cicUtil.mli +++ b/helm/software/components/cic/cicUtil.mli @@ -36,6 +36,8 @@ val clean_up_local_context : val is_closed : Cic.term -> bool val is_meta_closed : Cic.term -> bool val metas_of_term : Cic.term -> (int * Cic.term option list) list +(* as before but with no duplicates. may avoind some stack overflows *) +val metas_of_term_set : Cic.term -> (int * Cic.term option list) list (** @raise Failure "not enough prods" *) val strip_prods: int -> Cic.term -> Cic.term -- 2.39.2