aboutsummaryrefslogtreecommitdiff
path: root/checker
diff options
context:
space:
mode:
authorMaxime Dénès2018-09-13 18:10:26 +0200
committerMaxime Dénès2018-09-13 18:10:26 +0200
commit38be62b56799933cdfc783d4e538963c3aa59fef (patch)
tree6dd6f04d823d079457729da4176f9ff37cb986c7 /checker
parent8500216ac8df90b2afc0f5fd42d714cc87c6bde6 (diff)
parent33249ab75f1a3b9791ee3179cf7ccea015ed4057 (diff)
Merge PR #8434: Canonical representation of kernel substitutions
Diffstat (limited to 'checker')
-rw-r--r--checker/cic.mli2
-rw-r--r--checker/declarations.ml35
-rw-r--r--checker/values.ml7
3 files changed, 14 insertions, 30 deletions
diff --git a/checker/cic.mli b/checker/cic.mli
index 17259bb438..4162903b04 100644
--- a/checker/cic.mli
+++ b/checker/cic.mli
@@ -132,7 +132,7 @@ type delta_hint =
type delta_resolver = ModPath.t MPmap.t * delta_hint KNmap.t
-type 'a umap_t = 'a MPmap.t * 'a MBImap.t
+type 'a umap_t = 'a MPmap.t
type substitution = (ModPath.t * delta_resolver) umap_t
(** {6 Delayed constr} *)
diff --git a/checker/declarations.ml b/checker/declarations.ml
index 0540227ccb..03fee1ab51 100644
--- a/checker/declarations.ml
+++ b/checker/declarations.ml
@@ -28,18 +28,13 @@ let empty_delta_resolver = Deltamap.empty
module Umap = struct
[@@@ocaml.warning "-32-34"]
type 'a t = 'a umap_t
- let empty = MPmap.empty, MBImap.empty
- let is_empty (m1,m2) = MPmap.is_empty m1 && MBImap.is_empty m2
- let add_mbi mbi x (m1,m2) = (m1,MBImap.add mbi x m2)
- let add_mp mp x (m1,m2) = (MPmap.add mp x m1, m2)
- let find_mp mp map = MPmap.find mp (fst map)
- let find_mbi mbi map = MBImap.find mbi (snd map)
- let mem_mp mp map = MPmap.mem mp (fst map)
- let mem_mbi mbi map = MBImap.mem mbi (snd map)
- let iter_mbi f map = MBImap.iter f (snd map)
- let fold fmp fmbi (m1,m2) i =
- MPmap.fold fmp m1 (MBImap.fold fmbi m2 i)
- let join map1 map2 = fold add_mp add_mbi map1 map2
+ let empty = MPmap.empty
+ let is_empty m = MPmap.is_empty m
+ let add_mbi mbi x m = MPmap.add (MPbound mbi) x m
+ let add_mp mp x m = MPmap.add mp x m
+ let find = MPmap.find
+ let fold = MPmap.fold
+ let join map1 map2 = fold add_mp map1 map2
end
type 'a subst_fun = substitution -> 'a -> 'a
@@ -117,15 +112,10 @@ let constant_of_delta_with_inline resolve con =
let subst_mp0 sub mp = (* 's like subst *)
let rec aux mp =
match mp with
- | MPfile sid -> Umap.find_mp mp sub
- | MPbound bid ->
- begin
- try Umap.find_mbi bid sub
- with Not_found -> Umap.find_mp mp sub
- end
+ | MPfile _ | MPbound _ -> Umap.find mp sub
| MPdot (mp1,l) as mp2 ->
begin
- try Umap.find_mp mp2 sub
+ try Umap.find mp2 sub
with Not_found ->
let mp1',resolve = aux mp1 in
MPdot (mp1',l),resolve
@@ -382,9 +372,7 @@ let substition_prefixed_by k mp subst =
Umap.add_mp new_key (mp_to,reso) sub
else sub
in
- let mbi_prefixmp mbi _ sub = sub
- in
- Umap.fold mp_prefixmp mbi_prefixmp subst empty_subst
+ Umap.fold mp_prefixmp subst empty_subst
let join subst1 subst2 =
let apply_subst mpk add (mp,resolve) res =
@@ -404,8 +392,7 @@ let join subst1 subst2 =
Umap.join prefixed_subst (add (mp',resolve'') res)
in
let mp_apply_subst mp = apply_subst mp (Umap.add_mp mp) in
- let mbi_apply_subst mbi = apply_subst (MPbound mbi) (Umap.add_mbi mbi) in
- let subst = Umap.fold mp_apply_subst mbi_apply_subst subst1 empty_subst in
+ let subst = Umap.fold mp_apply_subst subst1 empty_subst in
Umap.join subst2 subst
let from_val x = { subst_value = x; subst_subst = []; }
diff --git a/checker/values.ml b/checker/values.ml
index e1b5a949ac..801874773a 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -15,7 +15,7 @@
To ensure this file is up-to-date, 'make' now compares the md5 of cic.mli
with a copy we maintain here:
-MD5 f7b267579138eabf86a74d6f2a7ed794 checker/cic.mli
+MD5 a127e0c2322c7846914bbca9921309c7 checker/cic.mli
*)
@@ -185,10 +185,7 @@ let v_resolver =
let v_mp_resolver = v_tuple "" [|v_mp;v_resolver|]
let v_subst =
- v_tuple "substitution"
- [|v_map v_mp v_mp_resolver;
- v_map v_uid v_mp_resolver|]
-
+ Annot ("substitution", v_map v_mp v_mp_resolver)
(** kernel/lazyconstr *)