diff options
| author |  Maxime Dénès <mail@maximedenes.fr> | 2017-07-17 15:07:59 +0200 |
|---|---|---|
| committer | Maxime Dénès <mail@maximedenes.fr> | 2017-07-17 15:07:59 +0200 |
| commit | 0315a5d93c2de996f5c91bd2af827d3984ec1ad8 (patch) | |
| tree | e449e76c73088a6cae457d1210f836581093807a /engine/universes.ml | |
| parent | eba5d64fee0bf6235265f1f6cc884b4cbefe2704 (diff) | |
| parent | a2bc4d3be684ad24ea7888df4dd0cf35d9733c64 (diff) | |
Merge PR #781: Remove dead code [Universes.simplify_universe_context]
Diffstat (limited to 'engine/universes.ml')
| -rw-r--r-- | engine/universes.ml | 28 |
1 files changed, 0 insertions, 28 deletions
diff --git a/engine/universes.ml b/engine/universes.ml index 21854b3fa..08461a218 100644 --- a/engine/universes.ml +++ b/engine/universes.ml @@ -948,34 +948,6 @@ let normalize_context_set ctx us algs = (* let normalize_conkey = Profile.declare_profile "normalize_context_set" *) (* let normalize_context_set a b c = Profile.profile3 normalize_conkey normalize_context_set a b c *) -let simplify_universe_context (univs,csts) = - let uf = UF.create () in - let noneqs = - Constraint.fold (fun (l,d,r) noneqs -> - if d == Eq && (LSet.mem l univs || LSet.mem r univs) then - (UF.union l r uf; noneqs) - else Constraint.add (l,d,r) noneqs) - csts Constraint.empty - in - let partition = UF.partition uf in - let flex x = LSet.mem x univs in - let subst, univs', csts' = List.fold_left (fun (subst, univs, cstrs) s -> - let canon, (global, rigid, flexible) = choose_canonical univs flex LSet.empty s in - (* Add equalities for globals which can't be merged anymore. *) - let cstrs = LSet.fold (fun g cst -> - Constraint.add (canon, Univ.Eq, g) cst) (LSet.union global rigid) - cstrs - in - let subst = LSet.fold (fun f -> LMap.add f canon) - flexible subst - in (subst, LSet.diff univs flexible, cstrs)) - (LMap.empty, univs, noneqs) partition - in - (* Noneqs is now in canonical form w.r.t. equality constraints, - and contains only inequality constraints. *) - let csts' = subst_univs_level_constraints subst csts' in - (univs', csts'), subst - let is_trivial_leq (l,d,r) = Univ.Level.is_prop l && (d == Univ.Le || (d == Univ.Lt && Univ.Level.is_set r)) |