From: Andrea Asperti Date: Wed, 9 Dec 2009 16:14:23 +0000 (+0000) Subject: Added a "sort_metasenv" function. X-Git-Tag: make_still_working~3168 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=0431f79f14bbf2cdc38c099cacba3a2f71363d7b;p=helm.git Added a "sort_metasenv" function. --- diff --git a/helm/software/components/ng_kernel/nCicUntrusted.ml b/helm/software/components/ng_kernel/nCicUntrusted.ml index 8c827a759..1d8f6c49e 100644 --- a/helm/software/components/ng_kernel/nCicUntrusted.ml +++ b/helm/software/components/ng_kernel/nCicUntrusted.ml @@ -281,3 +281,32 @@ let max_kind k1 k2 = | _ -> `IsTerm ;; +module OT = + struct + type t = int * NCic.conjecture + let compare (i,_) (j,_) = Pervasives.compare i j + end + +module MS = HTopoSort.Make(OT) +let relations_of_menv subst m c = + let i, (_, ctx, ty) = c in + let m = List.filter (fun (j,_) -> j <> i) m in + let m_ty = metas_of_term subst ctx ty in + let m_ctx = + snd + (List.fold_right + (fun i (ctx,res) -> + (i::ctx), + (match i with + | _,NCic.Decl ty -> metas_of_term subst ctx ty + | _,NCic.Def (t,ty) -> + metas_of_term subst ctx ty @ metas_of_term subst ctx t) @ res) + ctx ([],[])) + in + let metas = HExtlib.list_uniq (List.sort compare (m_ty @ m_ctx)) in + List.filter (fun (i,_) -> List.exists ((=) i) metas) m +;; + +let sort_metasenv subst (m : NCic.metasenv) = + (MS.topological_sort m (relations_of_menv subst m) : NCic.metasenv) +;; diff --git a/helm/software/components/ng_kernel/nCicUntrusted.mli b/helm/software/components/ng_kernel/nCicUntrusted.mli index bb5aa3049..cb0b54b82 100644 --- a/helm/software/components/ng_kernel/nCicUntrusted.mli +++ b/helm/software/components/ng_kernel/nCicUntrusted.mli @@ -19,6 +19,7 @@ val map_obj_kind: ?skip_body:bool -> (NCic.term -> NCic.term) -> NCic.obj_kind -> NCic.obj_kind val metas_of_term : NCic.substitution -> NCic.context -> NCic.term -> int list +val sort_metasenv: NCic.substitution -> NCic.metasenv -> NCic.metasenv type meta_kind = [ `IsSort | `IsType | `IsTerm ] val kind_of_meta: NCic.meta_attrs -> meta_kind