diff options
Diffstat (limited to 'contrib/correctness')
| -rw-r--r-- | contrib/correctness/pmisc.ml | 4 | ||||
| -rw-r--r-- | contrib/correctness/pmonad.ml | 8 | ||||
| -rw-r--r-- | contrib/correctness/psyntax.ml4 | 4 | ||||
| -rw-r--r-- | contrib/correctness/ptactic.ml | 6 | ||||
| -rw-r--r-- | contrib/correctness/putil.ml | 8 | ||||
| -rw-r--r-- | contrib/correctness/pwp.ml | 8 |
6 files changed, 19 insertions, 19 deletions
diff --git a/contrib/correctness/pmisc.ml b/contrib/correctness/pmisc.ml index 29d8fdcf..076b11cd 100644 --- a/contrib/correctness/pmisc.ml +++ b/contrib/correctness/pmisc.ml @@ -8,7 +8,7 @@ (* Certification of Imperative Programs / Jean-Christophe Filliātre *) -(* $Id: pmisc.ml 5920 2004-07-16 20:01:26Z herbelin $ *) +(* $Id: pmisc.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Pp open Util @@ -216,7 +216,7 @@ let rec type_v_knsubst s = function and type_c_knsubst s ((id,v),e,pl,q) = ((id, type_v_knsubst s v), e, List.map (fun p -> { p with p_value = subst_mps s p.p_value }) pl, - option_app (fun q -> { q with a_value = subst_mps s q.a_value }) q) + option_map (fun q -> { q with a_value = subst_mps s q.a_value }) q) and binder_knsubst s (id,b) = (id, match b with BindType v -> BindType (type_v_knsubst s v) | _ -> b) diff --git a/contrib/correctness/pmonad.ml b/contrib/correctness/pmonad.ml index 31effc1b..8f1b5946 100644 --- a/contrib/correctness/pmonad.ml +++ b/contrib/correctness/pmonad.ml @@ -8,7 +8,7 @@ (* Certification of Imperative Programs / Jean-Christophe Filliātre *) -(* $Id: pmonad.ml 5920 2004-07-16 20:01:26Z herbelin $ *) +(* $Id: pmonad.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Util open Names @@ -76,9 +76,9 @@ let rec abstract_post ren env (e,q) = let after_id id = id_of_string ((string_of_id id) ^ "'") in let (_,go) = Peffect.get_repr e in let al = List.map (fun id -> (id,after_id id)) go in - let q = option_app (named_app (subst_in_constr al)) q in + let q = option_map (named_app (subst_in_constr al)) q in let tgo = List.map (fun (id,aid) -> (aid, trad_type_in_env ren env id)) al in - option_app (named_app (abstract tgo)) q + option_map (named_app (abstract tgo)) q (* Translation of effects types in cic types. * @@ -365,7 +365,7 @@ let make_app env ren args ren' (tf,cf) ((bl,cb),s,capp) c = @(eq_phi ren'' env s svi tf) @(List.map (fun c -> CC_hole c) holes)) in - let qapp' = option_app (named_app (subst_in_constr svi)) qapp in + let qapp' = option_map (named_app (subst_in_constr svi)) qapp in let t = make_let_in ren'' env fe [] (current_vars ren''' outf,qapp') (res,tyres) (t,ty) diff --git a/contrib/correctness/psyntax.ml4 b/contrib/correctness/psyntax.ml4 index eeec28a5..98d43112 100644 --- a/contrib/correctness/psyntax.ml4 +++ b/contrib/correctness/psyntax.ml4 @@ -8,7 +8,7 @@ (* Certification of Imperative Programs / Jean-Christophe Filliātre *) -(* $Id: psyntax.ml4 7740 2005-12-26 20:07:21Z herbelin $ *) +(* $Id: psyntax.ml4 8752 2006-04-27 19:37:33Z herbelin $ *) (*i camlp4deps: "parsing/grammar.cma" i*) @@ -786,7 +786,7 @@ END VERNAC COMMAND EXTEND Correctness [ "Correctness" preident(str) program(pgm) then_tac(tac) ] - -> [ Ptactic.correctness str pgm (option_app Tacinterp.interp tac) ] + -> [ Ptactic.correctness str pgm (option_map Tacinterp.interp tac) ] END (* Show Programs *) diff --git a/contrib/correctness/ptactic.ml b/contrib/correctness/ptactic.ml index e5347670..babc607d 100644 --- a/contrib/correctness/ptactic.ml +++ b/contrib/correctness/ptactic.ml @@ -8,7 +8,7 @@ (* Certification of Imperative Programs / Jean-Christophe Filliātre *) -(* $Id: ptactic.ml 7837 2006-01-11 09:47:32Z herbelin $ *) +(* $Id: ptactic.ml 8759 2006-04-28 12:24:14Z herbelin $ *) open Pp open Options @@ -208,8 +208,8 @@ let reduce_open_constr (em0,c) = | Cast (c',t) -> (match kind_of_term c' with | Evar (ev,_) -> - if not (Evd.in_dom em ev) then - Evd.add em ev (Evd.map em0 ev) + if not (Evd.mem em ev) then + Evd.add em ev (Evd.find em0 ev) else em | _ -> fold_constr collect em c) diff --git a/contrib/correctness/putil.ml b/contrib/correctness/putil.ml index 0eb8806c..18c3ba35 100644 --- a/contrib/correctness/putil.ml +++ b/contrib/correctness/putil.ml @@ -8,7 +8,7 @@ (* Certification of Imperative Programs / Jean-Christophe Filliātre *) -(* $Id: putil.ml 7837 2006-01-11 09:47:32Z herbelin $ *) +(* $Id: putil.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Util open Names @@ -41,7 +41,7 @@ let anonymous x = { a_name = Anonymous; a_value = x } let anonymous_pre b x = { p_assert = b; p_name = Anonymous; p_value = x } let force_name f x = - option_app (fun q -> { a_name = Name (f q.a_name); a_value = q.a_value }) x + option_map (fun q -> { a_name = Name (f q.a_name); a_value = q.a_value }) x let force_post_name x = force_name post_name x @@ -143,7 +143,7 @@ let rec type_c_subst s ((id,t),e,p,q) = let s' = s @ List.map (fun (x,x') -> (at_id x "", at_id x' "")) s in (id, type_v_subst s t), Peffect.subst s e, List.map (pre_app (subst_in_constr s)) p, - option_app (post_app (subst_in_constr s')) q + option_map (post_app (subst_in_constr s')) q and type_v_subst s = function Ref v -> Ref (type_v_subst s v) @@ -160,7 +160,7 @@ and binder_subst s = function let rec type_c_rsubst s ((id,t),e,p,q) = (id, type_v_rsubst s t), e, List.map (pre_app (real_subst_in_constr s)) p, - option_app (post_app (real_subst_in_constr s)) q + option_map (post_app (real_subst_in_constr s)) q and type_v_rsubst s = function Ref v -> Ref (type_v_rsubst s v) diff --git a/contrib/correctness/pwp.ml b/contrib/correctness/pwp.ml index 1e485180..f422c5cd 100644 --- a/contrib/correctness/pwp.ml +++ b/contrib/correctness/pwp.ml @@ -8,7 +8,7 @@ (* Certification of Imperative Programs / Jean-Christophe Filliātre *) -(* $Id: pwp.ml 5920 2004-07-16 20:01:26Z herbelin $ *) +(* $Id: pwp.ml 8752 2006-04-27 19:37:33Z herbelin $ *) open Util open Names @@ -64,7 +64,7 @@ let update_post env top ef c = let force_post up env top q e = let (res,ef,p,_) = e.info.kappa in let q' = - if up then option_app (named_app (update_post env top ef)) q else q + if up then option_map (named_app (update_post env top ef)) q else q in let i = { env = e.info.env; kappa = (res,ef,p,q') } in { desc = e.desc; pre = e.pre; post = q'; loc = e.loc; info = i } @@ -260,7 +260,7 @@ and propagate ren p = | Apply (f,l) -> let _,(_,so,ok),(_,_,_,qapp) = effect_app ren env f l in if ok then - let q = option_app (named_app (real_subst_in_constr so)) qapp in + let q = option_map (named_app (real_subst_in_constr so)) qapp in post_if_none env q p else p @@ -285,7 +285,7 @@ and propagate ren p = None -> Some (anonymous s) | Some i -> Some { a_value = conj i.a_value s; a_name = i.a_name } in - let q = option_app (named_app abstract_unit) q in + let q = option_map (named_app abstract_unit) q in post_if_none env q p | SApp ([Variable id], [e1;e2]) |