diff options
Diffstat (limited to 'engine/uState.ml')
| -rw-r--r-- | engine/uState.ml | 39 |
1 files changed, 7 insertions, 32 deletions
diff --git a/engine/uState.ml b/engine/uState.ml index d4cb59da26..9557111cfd 100644 --- a/engine/uState.ml +++ b/engine/uState.ml @@ -286,6 +286,10 @@ let process_universe_constraints ctx cstrs = if not (drop_weak_constraints ()) then weak := UPairSet.add (l,r) !weak; local | UEq (l, r) -> equalize_universes l r local in + let unify_universes cst local = + if not (UGraph.type_in_type univs) then unify_universes cst local + else try unify_universes cst local with UniverseInconsistency _ -> local + in let local = UnivProblem.Set.fold unify_universes cstrs Constraint.empty in @@ -568,8 +572,8 @@ let emit_side_effects eff u = let u = demote_seff_univs (fst uctx) u in merge_seff u uctx -let update_sigma_env uctx env = - let univs = UGraph.set_cumulative_sprop (elaboration_sprop_cumul()) (Environ.universes env) in +let update_sigma_univs uctx ugraph = + let univs = UGraph.set_cumulative_sprop (elaboration_sprop_cumul()) ugraph in let eunivs = { uctx with initial_universes = univs; @@ -671,7 +675,7 @@ let subst_univs_context_with_def def usubst (ctx, cst) = (LSet.diff ctx def, UnivSubst.subst_univs_constraints usubst cst) let is_trivial_leq (l,d,r) = - Level.is_prop l && (d == Le || (d == Lt && Level.is_set r)) + Level.is_prop l && (d == Le || d == Lt) && Level.is_set r (* Prop < i <-> Set+1 <= i <-> Set < i *) let translate_cstr (l,d,r as cstr) = @@ -718,35 +722,6 @@ let fix_undefined_variables uctx = { uctx with univ_variables = vars'; univ_algebraic = algs' } -let refresh_undefined_univ_variables uctx = - let subst, ctx' = UnivGen.fresh_universe_context_set_instance uctx.local in - let subst_fn u = subst_univs_level_level subst u in - let alg = LSet.fold (fun u acc -> LSet.add (subst_fn u) acc) - uctx.univ_algebraic LSet.empty - in - let vars = - LMap.fold - (fun u v acc -> - LMap.add (subst_fn u) - (Option.map (subst_univs_level_universe subst) v) acc) - uctx.univ_variables LMap.empty - in - let weak = UPairSet.fold (fun (u,v) acc -> UPairSet.add (subst_fn u, subst_fn v) acc) uctx.weak_constraints UPairSet.empty in - let lbound = uctx.universes_lbound in - let declare g = LSet.fold (fun u g -> UGraph.add_universe u ~lbound ~strict:false g) - (ContextSet.levels ctx') g in - let initial = declare uctx.initial_universes in - let univs = declare UGraph.initial_universes in - let uctx' = {names = uctx.names; - local = ctx'; - seff_univs = uctx.seff_univs; - univ_variables = vars; univ_algebraic = alg; - universes = univs; - universes_lbound = lbound; - initial_universes = initial; - weak_constraints = weak; } in - uctx', subst - let minimize uctx = let open UnivMinim in let lbound = uctx.universes_lbound in |