Merging Context and Sign.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16463 85f007b7-540e-0410-9357-904b9bb8a0f7

1 files changed, 60 insertions, 0 deletions

diff --git a/kernel/context.ml b/kernel/context.ml
index 4bc268da1..d24922e18 100644
--- a/kernel/context.ml
+++ b/kernel/context.ml
@@ -6,6 +6,16 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(* Created by Jean-Christophe Filliâtre out of names.ml as part of the
+   rebuilding of Coq around a purely functional abstract type-checker,
+   Aug 1999 *)
+(* Miscellaneous extensions, restructurations and bug-fixes by Hugo
+   Herbelin and Bruno Barras *)
+
+(* This file defines types and combinators regarding indexes-based and
+   names-based contexts *)
+
+open Util
 open Names
 
 (***************************************************************************)
@@ -62,3 +72,53 @@ let rel_context_nhyps hyps =
     | (_,None,_)::hyps -> nhyps (1+acc) hyps
     | (_,Some _,_)::hyps -> nhyps acc hyps in
   nhyps 0 hyps
+
+(*s Signatures of named hypotheses. Used for section variables and
+    goal assumptions. *)
+
+type named_context = named_declaration list
+
+let empty_named_context = []
+
+let add_named_decl d sign = d::sign
+
+let rec lookup_named id = function
+  | (id',_,_ as decl) :: _ when Id.equal id id' -> decl
+  | _ :: sign -> lookup_named id sign
+  | [] -> raise Not_found
+
+let named_context_length = List.length
+let named_context_equal = List.equal eq_named_declaration
+
+let vars_of_named_context = List.map (fun (id,_,_) -> id)
+
+let instance_from_named_context sign =
+  let rec inst_rec = function
+    | (id,None,_) :: sign -> Constr.mkVar id :: inst_rec sign
+    | _ :: sign -> inst_rec sign
+    | [] -> [] in
+  Array.of_list (inst_rec sign)
+
+let fold_named_context f l ~init = List.fold_right f l init
+let fold_named_context_reverse f ~init l = List.fold_left f init l
+
+(*s Signatures of ordered section variables *)
+type section_context = named_context
+
+let fold_rel_context f l ~init:x = List.fold_right f l x
+let fold_rel_context_reverse f ~init:x l = List.fold_left f x l
+
+let map_context f l =
+  let map_decl (n, body_o, typ as decl) =
+    let body_o' = Option.smartmap f body_o in
+    let typ' = f typ in
+      if body_o' == body_o && typ' == typ then decl else
+        (n, body_o', typ')
+  in
+    List.smartmap map_decl l
+
+let map_rel_context = map_context
+let map_named_context = map_context
+
+let iter_rel_context f = List.iter (fun (_,b,t) -> f t; Option.iter f b)
+let iter_named_context f = List.iter (fun (_,b,t) -> f t; Option.iter f b)