diff options
| -rw-r--r-- | otherlibs/labltk/browser/searchpos.ml | 2 | ||||
| -rw-r--r-- | tools/tast_iter.ml | 4 | ||||
| -rw-r--r-- | tools/untypeast.ml | 5 | ||||
| -rw-r--r-- | typing/typecore.ml | 13 |
4 files changed, 13 insertions, 11 deletions
diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml index c2d334b019..39fa583ce5 100644 --- a/otherlibs/labltk/browser/searchpos.ml +++ b/otherlibs/labltk/browser/searchpos.ml @@ -745,7 +745,7 @@ and search_pos_expr ~pos exp = search_pos_expr exp' ~pos end; search_pos_expr exp ~pos - | Texp_bind (expl, exp) -> + | Texp_bind ((p,e), exp) -> List.iter expl ~f: begin fun (pat, exp') -> search_pos_pat pat ~pos ~env:exp.exp_env; diff --git a/tools/tast_iter.ml b/tools/tast_iter.ml index 099238cee0..0de4f1cf1b 100644 --- a/tools/tast_iter.ml +++ b/tools/tast_iter.ml @@ -97,8 +97,8 @@ let expression sub exp = | Texp_let (rec_flag, list, exp) -> sub # bindings (rec_flag, list); sub # expression exp - | Texp_bind (list, exp) -> - sub # bindings (Default, list); + | Texp_bind (b, exp) -> + sub # binding b; sub # expression exp | Texp_function (_, cases, _) -> sub # bindings (Nonrecursive, cases) diff --git a/tools/untypeast.ml b/tools/untypeast.ml index 217dcc4dc9..4161c9fe01 100644 --- a/tools/untypeast.ml +++ b/tools/untypeast.ml @@ -199,9 +199,8 @@ and untype_expression exp = List.map (fun (pat, exp) -> untype_pattern pat, untype_expression exp) list, untype_expression exp) - | Texp_bind (list, exp) -> - Pexp_bind (List.map (fun (pat, exp) -> - untype_pattern pat, untype_expression exp) list, + | Texp_bind ((p,e), exp) -> + Pexp_bind ([untype_pattern p, untype_expression e], untype_expression exp) | Texp_function (label, cases, _) -> Pexp_function (label, None, diff --git a/typing/typecore.ml b/typing/typecore.ml index fc138d64e8..6c0da3b20b 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -1875,14 +1875,17 @@ and type_expect_ ?in_function env sexp ty_expected = | Pexp_bind(spat_sexp_list, sbody) -> let (pat_exp, new_env, unpacks) = type_let env Default spat_sexp_list None true in - let pat_exp = List.hd pat_exp in - let exp = type_function loc env ty_expected in_function "" spat_sexp_list in - let body = + let body0 = type_expect new_env (wrap_unpacks sbody unpacks) ty_expected in + let body = match body0.exp_type.desc with + | Tarrow (_,_,body,_) -> body + | _ -> assert false + in + let pat_exp0 = List.hd pat_exp in re { - exp_desc = Texp_bind((fst pat_exp, exp), body); + exp_desc = Texp_bind(pat_exp0, body0); exp_loc = loc; exp_extra = []; - exp_type = body.exp_type; + exp_type = body; exp_env = env } | Pexp_function (l, Some default, [spat, sbody]) -> let default_loc = default.pexp_loc in |