X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=components%2Fcic%2FcicUtil.ml;h=6e07a4995d8ed5d436f43138a1374123b6f79f65;hb=59c85666e58d43d1dce56a2456db5f1ec223c1c3;hp=51d84392bfaff40f8932ac8b8b471dd191c9cdf3;hpb=4b0c8ab87297a2bcf9998c098fafbba44e8b641b;p=helm.git diff --git a/components/cic/cicUtil.ml b/components/cic/cicUtil.ml index 51d84392b..6e07a4995 100644 --- a/components/cic/cicUtil.ml +++ b/components/cic/cicUtil.ml @@ -207,6 +207,17 @@ let attributes_of_obj = function | Cic.CurrentProof (_, _, _, _, _, attributes) | Cic.InductiveDefinition (_, _, _, attributes) -> attributes + +let arity_of_composed_coercion obj = + let attrs = attributes_of_obj obj in + try + let tag=List.find (function `Class (`Coercion _) -> true|_->false) attrs in + match tag with + | `Class (`Coercion n) -> n + | _-> assert false + with Not_found -> 0 +;; + let rec mk_rels howmany from = match howmany with | 0 -> [] @@ -389,3 +400,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 +;; +