Rename allow_recarg to recarg.

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/constructors_with_record5@15522 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Alain Frisch 2014-10-10 14:23:15 +00:00
parent a615c35a3f
commit eeac41ea2c
1 changed files with 15 additions and 15 deletions

View File

@ -1752,9 +1752,9 @@ let unify_exp env exp expected_ty =
Printtyp.raw_type_expr expected_ty; *) Printtyp.raw_type_expr expected_ty; *)
unify_exp_types exp.exp_loc env exp.exp_type expected_ty unify_exp_types exp.exp_loc env exp.exp_type expected_ty
let rec type_exp ?allow_recarg env sexp = let rec type_exp ?recarg env sexp =
(* We now delegate everything to type_expect *) (* We now delegate everything to type_expect *)
type_expect ?allow_recarg env sexp (newvar ()) type_expect ?recarg env sexp (newvar ())
(* Typing of an expression with an expected type. (* Typing of an expression with an expected type.
This provide better error messages, and allows controlled This provide better error messages, and allows controlled
@ -1762,17 +1762,17 @@ let rec type_exp ?allow_recarg env sexp =
In the principal case, [type_expected'] may be at generic_level. In the principal case, [type_expected'] may be at generic_level.
*) *)
and type_expect ?in_function ?allow_recarg env sexp ty_expected = and type_expect ?in_function ?recarg env sexp ty_expected =
let previous_saved_types = Cmt_format.get_saved_types () in let previous_saved_types = Cmt_format.get_saved_types () in
Typetexp.warning_enter_scope (); Typetexp.warning_enter_scope ();
Typetexp.warning_attribute sexp.pexp_attributes; Typetexp.warning_attribute sexp.pexp_attributes;
let exp = type_expect_ ?in_function ?allow_recarg env sexp ty_expected in let exp = type_expect_ ?in_function ?recarg env sexp ty_expected in
Typetexp.warning_leave_scope (); Typetexp.warning_leave_scope ();
Cmt_format.set_saved_types Cmt_format.set_saved_types
(Cmt_format.Partial_expression exp :: previous_saved_types); (Cmt_format.Partial_expression exp :: previous_saved_types);
exp exp
and type_expect_ ?in_function ?(allow_recarg=false) env sexp ty_expected = and type_expect_ ?in_function ?(recarg=false) env sexp ty_expected =
let loc = sexp.pexp_loc in let loc = sexp.pexp_loc in
(* Record the expression type before unifying it with the expected type *) (* Record the expression type before unifying it with the expected type *)
let rue exp = let rue exp =
@ -1792,7 +1792,7 @@ and type_expect_ ?in_function ?(allow_recarg=false) env sexp ty_expected =
let name = Path.name ~paren:Oprint.parenthesized_ident path in let name = Path.name ~paren:Oprint.parenthesized_ident path in
Stypes.record (Stypes.An_ident (loc, name, annot)) Stypes.record (Stypes.An_ident (loc, name, annot))
end; end;
if is_recarg desc <> allow_recarg then if is_recarg desc <> recarg then
raise (Error (loc, env, Inlined_record_escape)); raise (Error (loc, env, Inlined_record_escape));
rue { rue {
exp_desc = exp_desc =
@ -2050,7 +2050,7 @@ and type_expect_ ?in_function ?(allow_recarg=false) env sexp ty_expected =
None -> None None -> None
| Some sexp -> | Some sexp ->
if !Clflags.principal then begin_def (); if !Clflags.principal then begin_def ();
let exp = type_exp ~allow_recarg env sexp in let exp = type_exp ~recarg env sexp in
if !Clflags.principal then begin if !Clflags.principal then begin
end_def (); end_def ();
generalize_structure exp.exp_type generalize_structure exp.exp_type
@ -2767,7 +2767,7 @@ and type_function ?in_function loc attrs env ty_expected l caselist =
and type_label_access env loc srecord lid = and type_label_access env loc srecord lid =
if !Clflags.principal then begin_def (); if !Clflags.principal then begin_def ();
let record = type_exp ~allow_recarg:true env srecord in let record = type_exp ~recarg:true env srecord in
if !Clflags.principal then begin if !Clflags.principal then begin
end_def (); end_def ();
generalize_structure record.exp_type generalize_structure record.exp_type
@ -3072,7 +3072,7 @@ and type_label_exp create env loc ty_expected
in in
(lid, label, {arg with exp_type = instance env arg.exp_type}) (lid, label, {arg with exp_type = instance env arg.exp_type})
and type_argument ?allow_recarg env sarg ty_expected' ty_expected = and type_argument ?recarg env sarg ty_expected' ty_expected =
(* ty_expected' may be generic *) (* ty_expected' may be generic *)
let no_labels ty = let no_labels ty =
let ls, tvar = list_labels env ty in let ls, tvar = list_labels env ty in
@ -3157,7 +3157,7 @@ and type_argument ?allow_recarg env sarg ty_expected' ty_expected =
func let_var) } func let_var) }
end end
| _ -> | _ ->
let texp = type_expect ?allow_recarg env sarg ty_expected' in let texp = type_expect ?recarg env sarg ty_expected' in
unify_exp env texp ty_expected; unify_exp env texp ty_expected;
texp texp
@ -3399,18 +3399,18 @@ and type_construct env loc lid sarg ty_expected attrs =
in in
let texp = {texp with exp_type = ty_res} in let texp = {texp with exp_type = ty_res} in
if not separate then unify_exp env texp (instance env ty_expected); if not separate then unify_exp env texp (instance env ty_expected);
let allow_recarg = constr.cstr_inlined <> None in let recarg = constr.cstr_inlined <> None in
if allow_recarg then begin if recarg then begin
match sargs with match sargs with
| [{pexp_desc = | [{pexp_desc =
Pexp_ident _ | Pexp_ident _ |
Pexp_record (_, (Some {pexp_desc = Pexp_ident _}| None))}] -> Pexp_record (_, (Some {pexp_desc = Pexp_ident _}| None))}] ->
() ()
| _ -> | _ ->
raise (Error(loc, env, Outside_class)) raise (Error(loc, env, Inlined_record_escape))
end; end;
let args = let args =
List.map2 (fun e (t,t0) -> type_argument ~allow_recarg env e t t0) sargs List.map2 (fun e (t,t0) -> type_argument ~recarg env e t t0) sargs
(List.combine ty_args ty_args0) in (List.combine ty_args ty_args0) in
if constr.cstr_private = Private then if constr.cstr_private = Private then
raise(Error(loc, env, Private_type ty_res)); raise(Error(loc, env, Private_type ty_res));
@ -4032,7 +4032,7 @@ let () =
let () = let () =
Env.add_delayed_check_forward := add_delayed_check Env.add_delayed_check_forward := add_delayed_check
(* drop ?allow_recarg argument from the external API *) (* drop ?recarg argument from the external API *)
let type_expect ?in_function env e ty = type_expect ?in_function env e ty let type_expect ?in_function env e ty = type_expect ?in_function env e ty
let type_exp env e = type_exp env e let type_exp env e = type_exp env e
let type_argument env e t1 t2 = type_argument env e t1 t2 let type_argument env e t1 t2 = type_argument env e t1 t2