#6246: allow wildcard pattern as for-loop index. ==> Camlp4 will need to be adapted.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14333 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Changes

@@ -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:
 -------------

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

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)

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

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)
          *)

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 =

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;

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
 

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

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

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