diff options
| -rw-r--r-- | Changes | 2 | ||||
| -rw-r--r-- | parsing/ast_helper.mli | 2 | ||||
| -rw-r--r-- | parsing/ast_mapper.ml | 4 | ||||
| -rw-r--r-- | parsing/parser.mly | 4 | ||||
| -rw-r--r-- | parsing/parsetree.mli | 2 | ||||
| -rw-r--r-- | parsing/pprintast.ml | 4 | ||||
| -rw-r--r-- | parsing/printast.ml | 5 | ||||
| -rw-r--r-- | typing/typecore.ml | 18 | ||||
| -rw-r--r-- | typing/typecore.mli | 1 | ||||
| -rw-r--r-- | typing/typedtree.ml | 2 | ||||
| -rw-r--r-- | typing/typedtree.mli | 2 |
11 files changed, 28 insertions, 18 deletions
@@ -57,7 +57,7 @@ Features wishes: - PR#5650: Camlp4FoldGenerator doesn't handle well "abstract" types - PR#6071: Add a -noinit option to the toplevel (patch by David Sheets) - PR#6166: document -ocamldoc option of ocamlbuild - +- PR#6246: allow wilcard _ as for-loop index OCaml 4.01.1: ------------- diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli index 562f51989..995b1ca64 100644 --- a/parsing/ast_helper.mli +++ b/parsing/ast_helper.mli @@ -100,7 +100,7 @@ module Exp: val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression - val for_: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression -> direction_flag -> expression -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression -> direction_flag -> expression -> expression val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression val send: ?loc:loc -> ?attrs:attrs -> expression -> string -> expression diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml index e10e32cbd..f6edb55f4 100644 --- a/parsing/ast_mapper.ml +++ b/parsing/ast_mapper.ml @@ -292,8 +292,8 @@ module E = struct | Pexp_sequence (e1, e2) -> sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) - | Pexp_for (id, e1, e2, d, e3) -> - for_ ~loc ~attrs (map_loc sub id) (sub.expr sub e1) (sub.expr sub e2) d + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d (sub.expr sub e3) | Pexp_coerce (e, t1, t2) -> coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) diff --git a/parsing/parser.mly b/parsing/parser.mly index 8b69f265e..3bb662087 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -1048,8 +1048,8 @@ expr: { mkexp_attrs (Pexp_ifthenelse($3, $5, None)) $2 } | WHILE ext_attributes seq_expr DO seq_expr DONE { mkexp_attrs (Pexp_while($3, $5)) $2 } - | FOR ext_attributes val_ident EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE - { mkexp_attrs(Pexp_for(mkrhs $3 3, $5, $7, $6, $9)) $2 } + | FOR ext_attributes pattern EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE + { mkexp_attrs(Pexp_for($3, $5, $7, $6, $9)) $2 } | expr COLONCOLON expr { mkexp_cons (rhs_loc 2) (ghexp(Pexp_tuple[$1;$3])) (symbol_rloc()) } | LPAREN COLONCOLON RPAREN LPAREN expr COMMA expr RPAREN diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index 5de17d439..df0dd47ab 100644 --- a/parsing/parsetree.mli +++ b/parsing/parsetree.mli @@ -244,7 +244,7 @@ and expression_desc = | Pexp_while of expression * expression (* while E1 do E2 done *) | Pexp_for of - string loc * expression * expression * direction_flag * expression + pattern * expression * expression * direction_flag * expression (* for i = E1 to E2 do E3 done (flag = Upto) for i = E1 downto E2 do E3 done (flag = Downto) *) diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index f8db3d646..cf218f2a8 100644 --- a/parsing/pprintast.ml +++ b/parsing/pprintast.ml @@ -680,8 +680,8 @@ class printer ()= object(self:'self) pp f fmt self#expression e1 self#expression e2 | Pexp_for (s, e1, e2, df, e3) -> let fmt:(_,_,_)format = - "@[<hv0>@[<hv2>@[<2>for %s =@;%a@;%a%a@;do@]@;%a@]@;done@]" in - pp f fmt s.txt self#expression e1 self#direction_flag df self#expression e2 self#expression e3 + "@[<hv0>@[<hv2>@[<2>for %a =@;%a@;%a%a@;do@]@;%a@]@;done@]" in + pp f fmt self#pattern s self#expression e1 self#direction_flag df self#expression e2 self#expression e3 | _ -> self#paren true self#expression f x method attributes f l = diff --git a/parsing/printast.ml b/parsing/printast.ml index dfaf8ce8b..7c6fd9a22 100644 --- a/parsing/printast.ml +++ b/parsing/printast.ml @@ -299,8 +299,9 @@ and expression i ppf x = line i ppf "Pexp_while\n"; expression i ppf e1; expression i ppf e2; - | Pexp_for (s, e1, e2, df, e3) -> - line i ppf "Pexp_for %a %a\n" fmt_direction_flag df fmt_string_loc s; + | Pexp_for (p, e1, e2, df, e3) -> + line i ppf "Pexp_for %a\n" fmt_direction_flag df; + pattern i ppf p; expression i ppf e1; expression i ppf e2; expression i ppf e3; diff --git a/typing/typecore.ml b/typing/typecore.ml index 644b2ae11..416ba3e4a 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -64,6 +64,7 @@ type error = | Unexpected_existential | Unqualified_gadt_pattern of Path.t * string | Invalid_interval + | Invalid_for_loop_index | Extension of string exception Error of Location.t * Env.t * error @@ -2317,11 +2318,16 @@ and type_expect_ ?in_function env sexp ty_expected = | Pexp_for(param, slow, shigh, dir, sbody) -> let low = type_expect env slow Predef.type_int in let high = type_expect env shigh Predef.type_int in - let (id, new_env) = - Env.enter_value param.txt {val_type = instance_def Predef.type_int; - val_attributes = []; - val_kind = Val_reg; Types.val_loc = loc; } env - ~check:(fun s -> Warnings.Unused_for_index s) + let id, new_env = + match param.ppat_desc with + | Ppat_any -> Ident.create "_for", env + | Ppat_var {txt} -> + Env.enter_value txt {val_type = instance_def Predef.type_int; + val_attributes = []; + val_kind = Val_reg; Types.val_loc = loc; } env + ~check:(fun s -> Warnings.Unused_for_index s) + | _ -> + raise (Error (param.ppat_loc, env, Invalid_for_loop_index)) in let body = type_statement new_env sbody in rue { @@ -3820,6 +3826,8 @@ let report_error env ppf = function "must be qualified in this pattern" | Invalid_interval -> fprintf ppf "@[Only character intervals are supported in patterns.@]" + | Invalid_for_loop_index -> + fprintf ppf "@[Invalid for-loop index: only variables and _ are allowed.@]" | Extension s -> fprintf ppf "Uninterpreted extension '%s'." s diff --git a/typing/typecore.mli b/typing/typecore.mli index 4b0f00817..7d8f5c75d 100644 --- a/typing/typecore.mli +++ b/typing/typecore.mli @@ -106,6 +106,7 @@ type error = | Unexpected_existential | Unqualified_gadt_pattern of Path.t * string | Invalid_interval + | Invalid_for_loop_index | Extension of string exception Error of Location.t * Env.t * error diff --git a/typing/typedtree.ml b/typing/typedtree.ml index 35c5f5c5e..d923084f8 100644 --- a/typing/typedtree.ml +++ b/typing/typedtree.ml @@ -93,7 +93,7 @@ and expression_desc = | Texp_sequence of expression * expression | Texp_while of expression * expression | Texp_for of - Ident.t * string loc * expression * expression * direction_flag * + Ident.t * Parsetree.pattern * expression * expression * direction_flag * expression | Texp_send of expression * meth * expression option | Texp_new of Path.t * Longident.t loc * Types.class_declaration diff --git a/typing/typedtree.mli b/typing/typedtree.mli index b68d0cc8c..3bb4d7177 100644 --- a/typing/typedtree.mli +++ b/typing/typedtree.mli @@ -92,7 +92,7 @@ and expression_desc = | Texp_sequence of expression * expression | Texp_while of expression * expression | Texp_for of - Ident.t * string loc * expression * expression * direction_flag * + Ident.t * Parsetree.pattern * expression * expression * direction_flag * expression | Texp_send of expression * meth * expression option | Texp_new of Path.t * Longident.t loc * Types.class_declaration |