diff options
| -rw-r--r-- | typing/subst.ml | 12 | ||||
| -rw-r--r-- | utils/tbl.ml | 6 | ||||
| -rw-r--r-- | utils/tbl.mli | 1 |
3 files changed, 16 insertions, 3 deletions
diff --git a/typing/subst.ml b/typing/subst.ml index 971d8b295..6aa276606 100644 --- a/typing/subst.ml +++ b/typing/subst.ml @@ -309,11 +309,17 @@ and modtype_declaration s = function Tmodtype_abstract -> Tmodtype_abstract | Tmodtype_manifest mty -> Tmodtype_manifest(modtype s mty) +(* For every binding k |-> d of m1, add k |-> f d to m2 + and return resulting merged map. *) + +let merge_tbls f m1 m2 = + Tbl.fold (fun k d accu -> Tbl.add k (f d) accu) m1 m2 + (* Composition of substitutions: apply (compose s1 s2) x = apply s2 (apply s1 x) *) let compose s1 s2 = - { types = Tbl.map (fun id p -> type_path s2 p) s1.types; - modules = Tbl.map (fun id p -> module_path s2 p) s1.modules; - modtypes = Tbl.map (fun id mty -> modtype s2 mty) s1.modtypes; + { types = merge_tbls (type_path s2) s1.types s2.types; + modules = merge_tbls (module_path s2) s1.modules s2.modules; + modtypes = merge_tbls (modtype s2) s1.modtypes s2.modtypes; for_saving = false } diff --git a/utils/tbl.ml b/utils/tbl.ml index d6689f088..b06516931 100644 --- a/utils/tbl.ml +++ b/utils/tbl.ml @@ -99,6 +99,12 @@ let rec map f = function Empty -> Empty | Node(l, v, d, r, h) -> Node(map f l, v, f v d, map f r, h) +let rec fold f m accu = + match m with + | Empty -> accu + | Node(l, v, d, r, _) -> + fold f r (f v d (fold f l accu)) + open Format let print print_key print_data ppf tbl = diff --git a/utils/tbl.mli b/utils/tbl.mli index 21c89b04f..44a021a78 100644 --- a/utils/tbl.mli +++ b/utils/tbl.mli @@ -24,6 +24,7 @@ val mem: 'a -> ('a, 'b) t -> bool val remove: 'a -> ('a, 'b) t -> ('a, 'b) t val iter: ('a -> 'b -> unit) -> ('a, 'b) t -> unit val map: ('a -> 'b -> 'c) -> ('a, 'b) t -> ('a, 'c) t +val fold: ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c open Format |