diff options
author | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2016-10-12 21:14:07 +0200 |
---|---|---|
committer | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2016-10-12 21:14:07 +0200 |
commit | 05ad4f49ac2203dd64dfec79a1fc62ee52115724 (patch) | |
tree | 920faae7946821c093345fd1804c40336bd9f1c4 /engine/proofview.ml | |
parent | 8a6c792505160de4ba2123ef049ab45d28873e47 (diff) | |
parent | 0222f685ebdd55a1596d6689b96ebb86454ba1a7 (diff) |
Merge branch 'v8.6'
Diffstat (limited to 'engine/proofview.ml')
-rw-r--r-- | engine/proofview.ml | 43 |
1 files changed, 30 insertions, 13 deletions
diff --git a/engine/proofview.ml b/engine/proofview.ml index 1ebc857d8..d7fb65126 100644 --- a/engine/proofview.ml +++ b/engine/proofview.ml @@ -685,6 +685,21 @@ let unshelve l p = let l = undefined p.solution l in { p with comb = p.comb@l } +let mark_in_evm ~goal evd content = + let info = Evd.find evd content in + let info = + if goal then + { info with Evd.evar_source = match info.Evd.evar_source with + | _, (Evar_kinds.VarInstance _ | Evar_kinds.GoalEvar) as x -> x + | loc,_ -> loc,Evar_kinds.GoalEvar } + else info + in + let info = match Evd.Store.get info.Evd.evar_extra typeclass_resolvable with + | None -> { info with Evd.evar_extra = Evd.Store.set info.Evd.evar_extra typeclass_resolvable () } + | Some () -> info + in + Evd.add evd content info + let with_shelf tac = let open Proof in Pv.get >>= fun pv -> @@ -697,8 +712,11 @@ let with_shelf tac = let fgoals = Evd.future_goals solution in let pgoal = Evd.principal_future_goal solution in let sigma = Evd.restore_future_goals sigma fgoals pgoal in - Pv.set { npv with shelf; solution = sigma } >> - tclUNIT (CList.rev_append gls' gls, ans) + (* Ensure we mark and return only unsolved goals *) + let gls' = undefined sigma (CList.rev_append gls' gls) in + let sigma = CList.fold_left (mark_in_evm ~goal:false) sigma gls' in + let npv = { npv with shelf; solution = sigma } in + Pv.set npv >> tclUNIT (gls', ans) (** [goodmod p m] computes the representative of [p] modulo [m] in the interval [[0,m-1]].*) @@ -929,6 +947,8 @@ module Unsafe = struct { step with comb = step.comb @ gls } end + let tclSETENV = Env.set + let tclGETGOALS = Comb.get let tclSETGOALS = Comb.set @@ -943,20 +963,13 @@ module Unsafe = struct { p with solution = Evd.reset_future_goals p.solution } let mark_as_goal evd content = - let info = Evd.find evd content in - let info = - { info with Evd.evar_source = match info.Evd.evar_source with - | _, (Evar_kinds.VarInstance _ | Evar_kinds.GoalEvar) as x -> x - | loc,_ -> loc,Evar_kinds.GoalEvar } - in - let info = match Evd.Store.get info.Evd.evar_extra typeclass_resolvable with - | None -> { info with Evd.evar_extra = Evd.Store.set info.Evd.evar_extra typeclass_resolvable () } - | Some () -> info - in - Evd.add evd content info + mark_in_evm ~goal:true evd content let advance = advance + let mark_as_unresolvable p gl = + { p with solution = mark_in_evm ~goal:false p.solution gl } + let typeclass_resolvable = typeclass_resolvable end @@ -1129,6 +1142,10 @@ module Goal = struct in tclUNIT (CList.map_filter map step.comb) + let unsolved { self=self } = + tclEVARMAP >>= fun sigma -> + tclUNIT (not (Option.is_empty (advance sigma self))) + (* compatibility *) let goal { self=self } = self |