Restore propagating the location, now via Ast_helper.default_loc

ocaml/parsing/ast_mapper.ml

@@ -285,7 +285,7 @@ module MT = struct
     | Some emty -> begin
         Extensions_parsing.Module_type.wrap_desc ~loc ~attrs @@
         match sub.module_type_extension sub emty with
-        | Emty_strengthen smty -> Extensions.Strengthen.mty_of smty
+        | Emty_strengthen smty -> Extensions.Strengthen.mty_of ~loc smty
       end
     | None ->
     match desc with
@@ -452,8 +452,8 @@ module E = struct
     | Some eexp -> begin
         Extensions_parsing.Expression.wrap_desc ~loc ~attrs @@
         match sub.expr_extension sub eexp with
-        | Eexp_comprehension   c -> Extensions.Comprehensions.expr_of   c
-        | Eexp_immutable_array i -> Extensions.Immutable_arrays.expr_of i
+        | Eexp_comprehension   c -> Extensions.Comprehensions.expr_of   ~loc c
+        | Eexp_immutable_array i -> Extensions.Immutable_arrays.expr_of ~loc i
     end
     | None ->
     match desc with
@@ -562,7 +562,7 @@ module P = struct
     | Some epat -> begin
         Extensions_parsing.Pattern.wrap_desc ~loc ~attrs @@
         match sub.pat_extension sub epat with
-        | Epat_immutable_array i -> Extensions.Immutable_arrays.pat_of i
+        | Epat_immutable_array i -> Extensions.Immutable_arrays.pat_of ~loc i
     end
     | None ->
     match desc with

ocaml/parsing/extensions.ml

@@ -17,8 +17,8 @@ open Extensions_parsing
    expression to translate.  So we just check for the immutable arrays extension
    when processing a comprehension expression for an immutable array.
 
-   Note [Wrapping with make_extension]
-   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   Note [Wrapping with make_entire_extension]
+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
    The topmost node in the encoded AST must always look like e.g.
    [%extension.comprehensions]. This allows the decoding machinery to know
@@ -31,12 +31,12 @@ open Extensions_parsing
    structurally impossible/hard to forget taking this final step.
 
    However, the final step is only one line of code (a call to
-   [make_extension]), but yet the name of the extension varies, as does the type
-   of the payload. It would thus take several lines of code to execute this
-   command otherwise, along with dozens of lines to create the structure in the
-   first place. And so instead we just manually call [make_extension] and refer
-   to this Note as a reminder to authors of future extensions to remember to do
-   this wrapping.
+   [make_entire_extension]), but yet the name of the extension varies, as does
+   the type of the payload. It would thus take several lines of code to execute
+   this command otherwise, along with dozens of lines to create the structure in
+   the first place. And so instead we just manually call [make_entire_extension]
+   and refer to this Note as a reminder to authors of future extensions to
+   remember to do this wrapping.
 *)
 
 (** List and array comprehensions *)
@@ -132,20 +132,20 @@ module Comprehensions = struct
          clauses
          (comprehension_expr ["body"] body))
 
-  let expr_of eexpr =
-    (* See Note [Wrapping with make_extension] *)
-    Expression.make_extension [extension_string] @@
-    match eexpr with
-    | Cexp_list_comprehension comp ->
-        expr_of_comprehension ~type_:["list"] comp
-    | Cexp_array_comprehension (amut, comp) ->
-        expr_of_comprehension
-          ~type_:[ "array"
-                 ; match amut with
-                   | Mutable   -> "mutable"
-                   | Immutable -> "immutable"
-                 ]
-          comp
+  let expr_of ~loc eexpr =
+    (* See Note [Wrapping with make_entire_extension] *)
+    Expression.make_entire_extension ~loc extension_string (fun () ->
+      match eexpr with
+      | Cexp_list_comprehension comp ->
+          expr_of_comprehension ~type_:["list"] comp
+      | Cexp_array_comprehension (amut, comp) ->
+          expr_of_comprehension
+            ~type_:[ "array"
+                   ; match amut with
+                     | Mutable   -> "mutable"
+                     | Immutable -> "immutable"
+                   ]
+            comp)
 
   (** Then, we define how to go from the OCaml AST to the nice AST; this is
       the [..._of_expr] family of expressions, culminating in
@@ -264,21 +264,21 @@ module Immutable_arrays = struct
 
   let extension_string = Language_extension.to_string Immutable_arrays
 
-  let expr_of = function
+  let expr_of ~loc = function
     | Iaexp_immutable_array elts ->
-      (* See Note [Wrapping with make_extension] *)
-      Expression.make_extension [extension_string] @@
-      Ast_helper.Exp.array elts
+      (* See Note [Wrapping with make_entire_extension] *)
+      Expression.make_entire_extension ~loc extension_string (fun () ->
+        Ast_helper.Exp.array elts)
 
   let of_expr expr = match expr.pexp_desc with
     | Pexp_array elts -> Iaexp_immutable_array elts
     | _ -> failwith "Malformed immutable array expression"
 
-  let pat_of = function
+  let pat_of ~loc = function
     | Iapat_immutable_array elts ->
-      (* See Note [Wrapping with make_extension] *)
-      Pattern.make_extension [extension_string] @@
-      Ast_helper.Pat.array elts
+      (* See Note [Wrapping with make_entire_extension] *)
+      Pattern.make_entire_extension ~loc extension_string (fun () ->
+        Ast_helper.Pat.array elts)
 
   let of_pat expr = match expr.ppat_desc with
     | Ppat_array elts -> Iapat_immutable_array elts
@@ -296,11 +296,11 @@ module Strengthen = struct
      the [(module M)] is a [Pmty_alias].  This isn't syntax we can write, but
      [(module M)] can be the inferred type for [M], so this should be fine. *)
 
-  let mty_of { mty; mod_id } =
-    (* See Note [Wrapping with make_extension] *)
-    Module_type.make_extension [extension_string] @@
-    Ast_helper.Mty.functor_ (Named (Location.mknoloc None, mty))
-      (Ast_helper.Mty.alias mod_id)
+  let mty_of ~loc { mty; mod_id } =
+    (* See Note [Wrapping with make_entire_extension] *)
+    Module_type.make_entire_extension ~loc extension_string (fun () ->
+      Ast_helper.Mty.functor_ (Named (Location.mknoloc None, mty))
+        (Ast_helper.Mty.alias mod_id))
 
   let of_mty mty = match mty.pmty_desc with
     | Pmty_functor(Named(_, mty), {pmty_desc = Pmty_alias mod_id}) ->

ocaml/parsing/extensions.mli

@@ -58,7 +58,7 @@ module Comprehensions : sig
         [:BODY ...CLAUSES...:] (flag = Immutable)
           (only allowed with [-extension immutable_arrays]) *)
 
-  val expr_of : expression -> Parsetree.expression_desc
+  val expr_of : loc:Location.t -> expression -> Parsetree.expression_desc
 end
 
 (** The ASTs for immutable arrays.  When we merge this upstream, we'll merge
@@ -73,16 +73,16 @@ module Immutable_arrays : sig
     | Iapat_immutable_array of Parsetree.pattern list
     (** [: P1; ...; Pn :] **)
 
-  val expr_of : expression -> Parsetree.expression_desc
-  val pat_of : pattern -> Parsetree.pattern_desc
+  val expr_of : loc:Location.t -> expression -> Parsetree.expression_desc
+  val pat_of : loc:Location.t -> pattern -> Parsetree.pattern_desc
 end
 
 (** The ASTs for module type strengthening. *)
 module Strengthen : sig
   type module_type =
     { mty : Parsetree.module_type; mod_id : Longident.t Location.loc }
 
-  val mty_of : module_type -> Parsetree.module_type_desc
+  val mty_of : loc:Location.t -> module_type -> Parsetree.module_type_desc
 end
 
 (******************************************)

ocaml/parsing/extensions_parsing.ml

@@ -179,6 +179,9 @@ module type AST = sig
 
   val make_extension : string list -> ast -> ast_desc
 
+  val make_entire_extension :
+    loc:Location.t -> string -> (unit -> ast) -> ast_desc
+
   val match_extension : ast -> (string list * ast) option
 end
 
@@ -206,6 +209,10 @@ module Make_AST (AST_parameters : AST_parameters) :
                 loc = !Ast_helper.default_loc },
               PStr []))
 
+    let make_entire_extension ~loc name ast =
+      make_extension [name]
+        (Ast_helper.with_default_loc (Location.ghostify loc) ast)
+
     (* This raises an error if the language extension node is malformed.
        Malformed means either:
 

ocaml/parsing/extensions_parsing.mli

@@ -132,6 +132,15 @@ module type AST = sig
       [match_extension]. *)
   val make_extension  : string list -> ast -> ast_desc
 
+  (** As [make_extension], but specifically for the AST node corresponding to
+      the entire piece of extension syntax (e.g., for a list comprehension, the
+      whole [[x for x in xs]], and not a subterm like [for x in xs]).  This sets
+      [Ast_helper.default_loc] locally to the [ghost] version of the provided
+      location, which is why the [ast] is generated from a function call; it is
+      during this call that the location is so set. *)
+  val make_entire_extension :
+    loc:Location.t -> string -> (unit -> ast) -> ast_desc
+
   (** Given an AST node, check if it's a language extension term; if it is,
       split it back up into its name (the [string list]) and the body (the
       [ast]); the resulting name is split on dots and the leading [extension]

ocaml/parsing/parser.mly

@@ -343,8 +343,10 @@ module Generic_array = struct
   let pattern    : _ -> _ -> _ -> (pattern,    pattern_desc)    t -> _ = to_ast
 end
 
-let ppat_iarray elts =
-  Extensions.Immutable_arrays.pat_of (Iapat_immutable_array elts)
+let ppat_iarray loc elts =
+  Extensions.Immutable_arrays.pat_of
+    ~loc:(make_loc loc)
+    (Iapat_immutable_array elts)
 
 let expecting loc nonterm =
     raise Syntaxerr.(Error(Expecting(make_loc loc, nonterm)))
@@ -2610,7 +2612,7 @@ comprehension_clause:
 
 %inline comprehension_expr:
   comprehension_ext_expr
-    { Extensions.Comprehensions.expr_of $1 }
+    { Extensions.Comprehensions.expr_of ~loc:(make_loc $sloc) $1 }
 ;
 
 %inline array_simple(ARR_OPEN, ARR_CLOSE, contents_semi_list):
@@ -2699,6 +2701,7 @@ comprehension_clause:
           "[:" ":]"
           (fun elts ->
              Extensions.Immutable_arrays.expr_of
+               ~loc:(make_loc $sloc)
                (Iaexp_immutable_array elts))
           $1 }
   | LBRACKET expr_semi_list RBRACKET
@@ -3122,7 +3125,7 @@ simple_delimited_pattern:
     | array_patterns(LBRACKETCOLON, COLONRBRACKET)
         { Generic_array.pattern
             "[:" ":]"
-            ppat_iarray
+            (ppat_iarray $sloc)
             $1 }
   ) { $1 }
 

ocaml/testsuite/tests/comprehensions/iarray_comprehensions_require_immutable_arrays.compilers.reference

@@ -1,2 +1,4 @@
-File "_none_", line 1:
+File "iarray_comprehensions_require_immutable_arrays.ml", line 9, characters 0-21:
+9 | [:x for x = 1 to 10:];;
+    ^^^^^^^^^^^^^^^^^^^^^
 Error: The extension "immutable_arrays" is disabled and cannot be used

ocaml/typing/parmatch.ml

@@ -1915,7 +1915,8 @@ module Conv = struct
           let ppat = match am with
             | Mutable   -> Ppat_array pats
             | Immutable ->
-                Extensions.Immutable_arrays.pat_of (Iapat_immutable_array pats)
+                Extensions.Immutable_arrays.pat_of
+                  ~loc:pat.pat_loc (Iapat_immutable_array pats)
           in
           mkpat ppat
       | Tpat_lazy p ->

ocaml/typing/untypeast.ml

@@ -362,6 +362,7 @@ let pattern : type k . _ -> k T.general_pattern -> _ = fun sub pat ->
         match am with
         | Mutable   -> Ppat_array pats
         | Immutable -> Extensions.Immutable_arrays.pat_of
+                         ~loc
                          (Iapat_immutable_array pats)
       end
     | Tpat_lazy p -> Ppat_lazy (sub.pat sub p)
@@ -500,12 +501,15 @@ let expression sub exp =
         | Mutable ->
             Pexp_array plist
         | Immutable ->
-            Extensions.Immutable_arrays.expr_of (Iaexp_immutable_array plist)
+            Extensions.Immutable_arrays.expr_of
+              ~loc (Iaexp_immutable_array plist)
       end
     | Texp_list_comprehension comp ->
-        comprehension sub (fun comp -> Cexp_list_comprehension comp) comp
+        comprehension
+          ~loc sub (fun comp -> Cexp_list_comprehension comp) comp
     | Texp_array_comprehension (amut, comp) ->
-        comprehension sub (fun comp -> Cexp_array_comprehension (amut, comp)) comp
+        comprehension
+          ~loc sub (fun comp -> Cexp_array_comprehension (amut, comp)) comp
     | Texp_ifthenelse (exp1, exp2, expo) ->
         Pexp_ifthenelse (sub.expr sub exp1,
           sub.expr sub exp2,