Using monotonic types for conversion functions.

2 files changed, 6 insertions, 2 deletions

diff --git a/proofs/redexpr.ml b/proofs/redexpr.ml
index 818805a56..2d886b8e1 100644
--- a/proofs/redexpr.ml
+++ b/proofs/redexpr.ml
@@ -194,7 +194,7 @@ let out_arg = function
 let out_with_occurrences (occs,c) =
   (Locusops.occurrences_map (List.map out_arg) occs, c)
 
-let e_red f env evm c = evm, f env evm c
+let e_red f = { e_redfun = fun env evm c -> Sigma.here (f env (Sigma.to_evar_map evm) c) evm }
 
 let head_style = false (* Turn to true to have a semantics where simpl
    only reduce at the head when an evaluable reference is given, e.g.
diff --git a/proofs/tacmach.ml b/proofs/tacmach.ml
index a1ebacea8..a10d8fd2f 100644
--- a/proofs/tacmach.ml
+++ b/proofs/tacmach.ml
@@ -18,6 +18,7 @@ open Tacred
 open Proof_type
 open Logic
 open Refiner
+open Sigma.Notations
 
 let re_sig it  gc = { it = it; sigma = gc; }
 
@@ -70,7 +71,10 @@ let pf_get_new_ids ids gls =
 let pf_global gls id = Constrintern.construct_reference (pf_hyps gls) id
 
 let pf_reduction_of_red_expr gls re c =
-  (fst (reduction_of_red_expr (pf_env gls) re)) (pf_env gls) (project gls) c
+  let (redfun, _) = reduction_of_red_expr (pf_env gls) re in
+  let sigma = Sigma.Unsafe.of_evar_map (project gls) in
+  let Sigma (c, sigma, _) = redfun.e_redfun (pf_env gls) sigma c in
+  (Sigma.to_evar_map sigma, c)
 
 let pf_apply f gls = f (pf_env gls) (project gls)
 let pf_eapply f gls x =