diff options
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/evarconv.ml | 8 | ||||
| -rw-r--r-- | pretyping/evarconv.mli | 3 | ||||
| -rw-r--r-- | pretyping/evarsolve.ml | 6 | ||||
| -rw-r--r-- | pretyping/evarsolve.mli | 3 | ||||
| -rw-r--r-- | pretyping/pretyping.ml | 2 | ||||
| -rw-r--r-- | pretyping/unification.ml | 6 |
6 files changed, 19 insertions, 9 deletions
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index 3680cd777a..07f6d9d383 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -1081,7 +1081,7 @@ let second_order_matching ts env_rhs evd (evk,args) argoccs rhs = match evar_conv_x ts env_evar evd CUMUL idty evty with | UnifFailure _ -> error "Cannot find an instance" | Success evd -> - match reconsider_conv_pbs (evar_conv_x ts) evd with + match reconsider_unif_constraints (evar_conv_x ts) evd with | UnifFailure _ -> error "Cannot find an instance" | Success evd -> evd @@ -1208,7 +1208,7 @@ let rec solve_unconstrained_evars_with_candidates ts evd = let conv_algo = evar_conv_x ts in let evd = check_evar_instance evd evk a conv_algo in let evd = Evd.define evk a evd in - match reconsider_conv_pbs conv_algo evd with + match reconsider_unif_constraints conv_algo evd with | Success evd -> solve_unconstrained_evars_with_candidates ts evd | UnifFailure _ -> aux l with @@ -1231,7 +1231,7 @@ let solve_unconstrained_impossible_cases env evd = Evd.define evk ty evd' | _ -> evd') evd evd -let consider_remaining_unif_problems env +let solve_unif_constraints_with_heuristics env ?(ts=Conv_oracle.get_transp_state (Environ.oracle env)) evd = let evd = solve_unconstrained_evars_with_candidates ts evd in let rec aux evd pbs progress stuck = @@ -1263,6 +1263,8 @@ let consider_remaining_unif_problems env check_problems_are_solved env heuristic_solved_evd; solve_unconstrained_impossible_cases env heuristic_solved_evd +let consider_remaining_unif_problems = solve_unif_constraints_with_heuristics + (* Main entry points *) exception UnableToUnify of evar_map * unification_error diff --git a/pretyping/evarconv.mli b/pretyping/evarconv.mli index 14947c8927..2231e5bc30 100644 --- a/pretyping/evarconv.mli +++ b/pretyping/evarconv.mli @@ -33,7 +33,10 @@ val e_cumul : env -> ?ts:transparent_state -> evar_map ref -> constr -> constr - (** Try heuristics to solve pending unification problems and to solve evars with candidates *) +val solve_unif_constraints_with_heuristics : env -> ?ts:transparent_state -> evar_map -> evar_map + val consider_remaining_unif_problems : env -> ?ts:transparent_state -> evar_map -> evar_map +(** @deprecated Alias for [solve_unif_constraints_with_heuristics] *) (** Check all pending unification problems are solved and raise an error otherwise *) diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml index f1526faccc..f0aa9b564f 100644 --- a/pretyping/evarsolve.ml +++ b/pretyping/evarsolve.ml @@ -1603,7 +1603,7 @@ let status_changed lev (pbty,_,t1,t2) = (try Evar.Set.mem (head_evar t1) lev with NoHeadEvar -> false) || (try Evar.Set.mem (head_evar t2) lev with NoHeadEvar -> false) -let reconsider_conv_pbs conv_algo evd = +let reconsider_unif_constraints conv_algo evd = let (evd,pbs) = extract_changed_conv_pbs evd status_changed in List.fold_left (fun p (pbty,env,t1,t2 as x) -> @@ -1616,6 +1616,8 @@ let reconsider_conv_pbs conv_algo evd = (Success evd) pbs +let reconsider_conv_pbs = reconsider_unif_constraints + (* Tries to solve problem t1 = t2. * Precondition: t1 is an uninstantiated evar * Returns an optional list of evars that were instantiated, or None @@ -1626,7 +1628,7 @@ let solve_simple_eqn conv_algo ?(choose=false) env evd (pbty,(evk1,args1 as ev1) try let t2 = whd_betaiota evd t2 in (* includes whd_evar *) let evd = evar_define conv_algo ~choose env evd pbty ev1 t2 in - reconsider_conv_pbs conv_algo evd + reconsider_unif_constraints conv_algo evd with | NotInvertibleUsingOurAlgorithm t -> UnifFailure (evd,NotClean (ev1,env,t)) diff --git a/pretyping/evarsolve.mli b/pretyping/evarsolve.mli index f94c83b6dc..b6bdc07889 100644 --- a/pretyping/evarsolve.mli +++ b/pretyping/evarsolve.mli @@ -54,7 +54,10 @@ val solve_evar_evar : ?force:bool -> val solve_simple_eqn : conv_fun -> ?choose:bool -> env -> evar_map -> bool option * existential * constr -> unification_result +val reconsider_unif_constraints : conv_fun -> evar_map -> unification_result + val reconsider_conv_pbs : conv_fun -> evar_map -> unification_result +(** @deprecated Alias for [reconsider_unif_constraints] *) val is_unification_pattern_evar : env -> evar_map -> existential -> constr list -> constr -> constr list option diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index 6afa55862f..95d854323a 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -290,7 +290,7 @@ let apply_inference_hook hook evdref pending = let apply_heuristics env evdref fail_evar = (* Resolve eagerly, potentially making wrong choices *) - try evdref := consider_remaining_unif_problems + try evdref := solve_unif_constraints_with_heuristics ~ts:(Typeclasses.classes_transparent_state ()) env !evdref with e when CErrors.noncritical e -> let e = CErrors.push e in if fail_evar then iraise e diff --git a/pretyping/unification.ml b/pretyping/unification.ml index fc63015a8e..259318693f 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -1220,7 +1220,7 @@ let is_mimick_head ts f = let try_to_coerce env evd c cty tycon = let j = make_judge c cty in let (evd',j') = inh_conv_coerce_rigid_to true Loc.ghost env evd j tycon in - let evd' = Evarconv.consider_remaining_unif_problems env evd' in + let evd' = Evarconv.solve_unif_constraints_with_heuristics env evd' in let evd' = Evd.map_metas_fvalue (nf_evar evd') evd' in (evd',j'.uj_val) @@ -1272,8 +1272,8 @@ let solve_simple_evar_eqn ts env evd ev rhs = | Success evd -> if Flags.version_less_or_equal Flags.V8_5 then (* We used to force solving unrelated problems at arbitrary times *) - Evarconv.consider_remaining_unif_problems env evd - else (* solve_simple_eqn calls reconsider_conv_pbs itself *) + Evarconv.solve_unif_constraints_with_heuristics env evd + else (* solve_simple_eqn calls reconsider_unif_constraints itself *) evd (* [w_merge env sigma b metas evars] merges common instances in metas |