diff options
author | Gaëtan Gilbert <gaetan.gilbert@skyskimmer.net> | 2018-03-01 18:28:36 +0100 |
---|---|---|
committer | Gaëtan Gilbert <gaetan.gilbert@skyskimmer.net> | 2018-03-09 16:30:12 +0100 |
commit | 2e30531e78519a5b9c3773c2524e4fd4759cc5c8 (patch) | |
tree | ad7effee5b9ad3904ab84d81e1583d233ae5033a /pretyping | |
parent | d640b676282285d52ac19038d693080e64eb5ea7 (diff) |
Delayed weak constraints for cumulative inductive types.
When comparing 2 irrelevant universes [u] and [v] we add a "weak
constraint" [UWeak(u,v)] to the UState. Then at minimization time a
weak constraint between unrelated universes where one is flexible
causes them to be unified.
Diffstat (limited to 'pretyping')
-rw-r--r-- | pretyping/reductionops.ml | 9 | ||||
-rw-r--r-- | pretyping/unification.ml | 3 |
2 files changed, 7 insertions, 5 deletions
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml index 53f6e28a9..221771f4e 100644 --- a/pretyping/reductionops.ml +++ b/pretyping/reductionops.ml @@ -32,12 +32,13 @@ exception Elimconst let _ = Goptions.declare_bool_option { Goptions.optdepr = false; Goptions.optname = - "debug optiosn"; + "Generate weak constraints between Irrelevant universes"; Goptions.optkey = ["Cumulativity";"Weak";"Constraints"]; - Goptions.optread = (fun () -> !cumul_weak_constraints); - Goptions.optwrite = (fun a -> cumul_weak_constraints:=a); + Goptions.optread = (fun () -> not !UState.drop_weak_constraints); + Goptions.optwrite = (fun a -> UState.drop_weak_constraints:=not a); } + (** Support for reduction effects *) open Mod_subst @@ -713,7 +714,7 @@ let magicaly_constant_of_fixbody env sigma reference bd = function | Some csts -> let subst = Constraints.fold (fun cst acc -> let l, r = match cst with - | ULub (u, v) -> u, v + | ULub (u, v) | UWeak (u, v) -> u, v | UEq (u, v) | ULe (u, v) -> let get u = Option.get (Universe.level u) in get u, get v diff --git a/pretyping/unification.ml b/pretyping/unification.ml index 76bd88cc0..f2f922fd5 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -566,7 +566,8 @@ let force_eqs c = Constraints.fold (fun c acc -> let c' = match c with - | ULub (l, r) -> UEq (Univ.Universe.make l,Univ.Universe.make r) + (* Should we be forcing weak constraints? *) + | ULub (l, r) | UWeak (l, r) -> UEq (Univ.Universe.make l,Univ.Universe.make r) | ULe _ | UEq _ -> c in Constraints.add c' acc) |