From 1f0eb2fb6d5de9c2aa60b93014f28c52d5f3a356 Mon Sep 17 00:00:00 2001
From: herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7>
Date: Mon, 27 Nov 2000 10:25:43 +0000
Subject: Généralisation de constant_opt_value en reference_opt_value
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@971 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 kernel/instantiate.ml  | 46 +++++++++++++++++++++++++++++++++++++++++++++-
 kernel/instantiate.mli | 19 +++++++++++++++++++
 2 files changed, 64 insertions(+), 1 deletion(-)

(limited to 'kernel')

diff --git a/kernel/instantiate.ml b/kernel/instantiate.ml
index 7f6f1258b..c9e39c9f5 100644
--- a/kernel/instantiate.ml
+++ b/kernel/instantiate.ml
@@ -18,7 +18,7 @@ let is_id_inst inst =
   List.for_all is_id inst
 
 let instantiate_constr sign c args =
-  let inst = instantiate_named_context  sign args in
+  let inst = instantiate_named_context sign args in
   if is_id_inst inst then
     c
   else
@@ -76,3 +76,47 @@ let existential_value sigma (n,args) =
 let existential_opt_value sigma ev =
   try Some (existential_value sigma ev)
   with NotInstantiatedEvar -> None
+
+
+type evaluable_reference =
+  | EvalConst of constant
+  | EvalVar of identifier
+  | EvalRel of int
+  | EvalEvar of existential
+
+let mkEvalRef = function
+  | EvalConst cst -> mkConst cst
+  | EvalVar id -> mkVar id
+  | EvalRel n -> mkRel n
+  | EvalEvar ev -> mkEvar ev
+
+let isEvalRef c = match kind_of_term c with
+  | IsConst _ | IsVar _ | IsRel _ | IsEvar _ -> true
+  | _ -> false
+
+let destEvalRef c = match kind_of_term c with
+  | IsConst cst ->  EvalConst cst
+  | IsVar id  -> EvalVar id
+  | IsRel n -> EvalRel n
+  | IsEvar ev -> EvalEvar ev
+  | _ -> anomaly "Not an evaluable reference"
+
+let evaluable_reference sigma env = function
+  | EvalConst (sp,_) -> evaluable_constant env sp
+  | EvalVar id -> evaluable_named_decl env id
+  | EvalRel n -> evaluable_rel_decl env n
+  | EvalEvar (ev,_) -> Evd.is_defined sigma ev
+
+let reference_opt_value sigma env = function
+  | EvalConst cst -> constant_opt_value env cst
+  | EvalVar id -> lookup_named_value id env
+  | EvalRel n -> lookup_rel_value n env
+  | EvalEvar ev -> existential_opt_value sigma ev
+
+exception NotEvaluable
+let reference_value sigma env c =
+  match reference_opt_value sigma env c with
+    | None -> raise NotEvaluable
+    | Some d -> d
+
+
diff --git a/kernel/instantiate.mli b/kernel/instantiate.mli
index 0320c4454..9f790e3ca 100644
--- a/kernel/instantiate.mli
+++ b/kernel/instantiate.mli
@@ -34,3 +34,22 @@ exception NotInstantiatedEvar
 val existential_value : 'a evar_map -> existential -> constr
 val existential_type : 'a evar_map -> existential -> constr
 val existential_opt_value : 'a evar_map -> existential -> constr option
+
+type evaluable_reference =
+  | EvalConst of constant
+  | EvalVar of identifier
+  | EvalRel of int
+  | EvalEvar of existential
+
+val destEvalRef : constr -> evaluable_reference
+val mkEvalRef : evaluable_reference -> constr
+val isEvalRef : constr -> bool
+
+val evaluable_reference : 'a evar_map -> env -> evaluable_reference -> bool
+
+val reference_opt_value :
+  'a evar_map -> env -> evaluable_reference -> constr option
+
+(* This may raise NotEvaluable *)
+exception NotEvaluable
+val reference_value :   'a evar_map -> env -> evaluable_reference -> constr
-- 
cgit v1.2.3