diff options
Diffstat (limited to 'typing/subst.ml')
| -rw-r--r-- | typing/subst.ml | 20 |
1 files changed, 16 insertions, 4 deletions
diff --git a/typing/subst.ml b/typing/subst.ml index 6acf9323dd..df84e59eff 100644 --- a/typing/subst.ml +++ b/typing/subst.ml @@ -85,6 +85,14 @@ let newpersty desc = decr new_id; { desc = desc; level = generic_level; id = !new_id } +(* ensure that all occurrences of 'Tvar None' are physically shared *) +let tvar_none = Tvar None +let tunivar_none = Tunivar None +let norm = function + | Tvar None -> tvar_none + | Tunivar None -> tunivar_none + | d -> d + (* Similar to [Ctype.nondep_type_rec]. *) let rec typexp s ty = let ty = repr ty in @@ -92,7 +100,7 @@ let rec typexp s ty = Tvar _ | Tunivar _ as desc -> if s.for_saving || ty.id < 0 then let ty' = - if s.for_saving then newpersty desc + if s.for_saving then newpersty (norm desc) else newty2 ty.level desc in save_desc ty desc; ty.desc <- Tsubst ty'; ty' @@ -146,7 +154,7 @@ let rec typexp s ty = | Tconstr _ | Tnil -> typexp s more | Tunivar _ | Tvar _ -> save_desc more more.desc; - if s.for_saving then newpersty more.desc else + if s.for_saving then newpersty (norm more.desc) else if dup && is_Tvar more then newgenty more.desc else more | _ -> assert false in @@ -327,8 +335,10 @@ let rec modtype s = function Mty_signature(signature s sg) | Mty_functor(id, arg, res) -> let id' = Ident.rename id in - Mty_functor(id', modtype s arg, - modtype (add_module id (Pident id') s) res) + Mty_functor(id', may_map (modtype s) arg, + modtype (add_module id (Pident id') s) res) + | Mty_alias p -> + Mty_alias(module_path s p) and signature s sg = (* Components of signature may be mutually recursive (e.g. type declarations @@ -359,12 +369,14 @@ and module_declaration s decl = { md_type = modtype s decl.md_type; md_attributes = attrs s decl.md_attributes; + md_loc = loc s decl.md_loc; } and modtype_declaration s decl = { mtd_type = may_map (modtype s) decl.mtd_type; mtd_attributes = attrs s decl.mtd_attributes; + mtd_loc = loc s decl.mtd_loc; } (* For every binding k |-> d of m1, add k |-> f d to m2 |