diff options
| -rw-r--r-- | typing/typecore.ml | 14 |
1 files changed, 13 insertions, 1 deletions
diff --git a/typing/typecore.ml b/typing/typecore.ml index 9deb1be40..48caaa7ff 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -2692,6 +2692,17 @@ let type_binding env rec_flag spat_sexp_list scope = (* Typing of toplevel expressions *) +let lookup_ident_type env sexp = + (* Special case for keeping type variables when looking-up a variable *) + match sexp.pexp_desc with + Pexp_ident lid -> + let (path, desc) = Env.lookup_value lid env in + begin match desc.val_kind with + Val_reg | Val_prim _ -> desc.val_type + | Val_ivar _ | Val_self _ | Val_anc _ | Val_unbound -> raise Not_found + end + | _ -> raise Not_found + let type_expression env sexp = Typetexp.reset_type_variables(); begin_def(); @@ -2699,7 +2710,8 @@ let type_expression env sexp = end_def(); if is_nonexpansive exp then generalize exp.exp_type else generalize_expansive env exp.exp_type; - exp + try {exp with exp_type = lookup_ident_type env sexp } + with Not_found -> exp (* Error report *) |