Overwriting typing

ocaml/file_formats/cmt_format.ml

@@ -227,7 +227,7 @@ let iter_on_occurrences
       | Texp_object _ | Texp_pack _ | Texp_letop _ | Texp_unreachable
       | Texp_list_comprehension _ | Texp_array_comprehension _ | Texp_probe _
       | Texp_probe_is_enabled _ | Texp_exclave _
-      | Texp_open _ | Texp_src_pos -> ());
+      | Texp_open _ | Texp_src_pos | Texp_overwrite _ | Texp_hole _ -> ());
       default_iterator.expr sub e);
 
   (* Remark: some types get iterated over twice due to how constraints are

ocaml/lambda/translcore.ml

@@ -1201,6 +1201,10 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
         ]
       in
       Lconst(Const_block(0, cl))
+  | Texp_overwrite (_, _) ->
+      Location.todo_overwrite_not_implemented ~kind:"Translcore" e.exp_loc
+  | Texp_hole _ ->
+      Location.todo_overwrite_not_implemented ~kind:"Translcore" e.exp_loc
 
 and pure_module m =
   match m.mod_desc with

ocaml/parsing/ast_helper.ml

@@ -232,7 +232,7 @@ module Exp = struct
   let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a)
   let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable
   let stack ?loc ?attrs e = mk ?loc ?attrs (Pexp_stack e)
-  let overwrite ?loc ?attrs x e = mk ?loc ?attrs (Pexp_overwrite (x, e))
+  let overwrite ?loc ?attrs a b = mk ?loc ?attrs (Pexp_overwrite (a, b))
   let hole ?loc ?attrs () = mk ?loc ?attrs Pexp_hole
 
   let case lhs ?guard rhs =

ocaml/parsing/ast_helper.mli

@@ -202,7 +202,7 @@ module Exp:
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression
     val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression
     val stack : ?loc:loc -> ?attrs:attrs -> expression -> expression
-    val overwrite : ?loc:loc -> ?attrs:attrs -> lid -> expression -> expression
+    val overwrite : ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression
     val hole : ?loc:loc -> ?attrs:attrs -> unit -> expression
 
     val case: pattern -> ?guard:expression -> expression -> case

ocaml/parsing/ast_iterator.ml

@@ -646,7 +646,7 @@ module E = struct
     | Pexp_extension x -> sub.extension sub x
     | Pexp_unreachable -> ()
     | Pexp_stack e -> sub.expr sub e
-    | Pexp_overwrite (x, e) -> iter_loc sub x; sub.expr sub e
+    | Pexp_overwrite (e1, e2) -> sub.expr sub e1; sub.expr sub e2
     | Pexp_hole -> ()
 
   let iter_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} =

ocaml/parsing/ast_mapper.ml

@@ -757,7 +757,7 @@ module E = struct
     | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x)
     | Pexp_unreachable -> unreachable ~loc ~attrs ()
     | Pexp_stack e -> stack ~loc ~attrs (sub.expr sub e)
-    | Pexp_overwrite (x, e) -> overwrite ~loc ~attrs (map_loc sub x) (sub.expr sub e)
+    | Pexp_overwrite (e1, e2) -> overwrite ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2)
     | Pexp_hole -> hole ~loc ~attrs ()
 
   let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} =

ocaml/parsing/depend.ml

@@ -335,7 +335,7 @@ let rec add_expr bv exp =
       end
   | Pexp_extension e -> handle_extension e
   | Pexp_stack e -> add_expr bv e
-  | Pexp_overwrite (x, e) -> add bv x; add_expr bv e
+  | Pexp_overwrite (e1, e2) -> add_expr bv e1; add_expr bv e2
   | Pexp_hole -> ()
   | Pexp_unreachable -> ()
 

ocaml/parsing/location.ml

@@ -1101,6 +1101,6 @@ let () =
 let raise_errorf ?(loc = none) ?(sub = []) =
   Format.kdprintf (fun txt -> raise (Error (mkerror loc sub txt)))
 
-let todo_overwrite_not_implemented t =
-  alert ~kind:"" t "Overwrite not implemented.";
+let todo_overwrite_not_implemented ?(kind = "") t =
+  alert ~kind t "Overwrite not implemented.";
   assert false

ocaml/parsing/location.mli

@@ -397,4 +397,4 @@ val report_exception: formatter -> exn -> unit
 (** Reraise the exception if it is unknown. *)
 
 (** CR uniqueness: remove this *)
-val todo_overwrite_not_implemented : t -> 'a
+val todo_overwrite_not_implemented : ?kind:string -> t -> 'a

ocaml/parsing/parser.mly

@@ -2776,7 +2776,7 @@ fun_expr:
       { Pexp_try($3, $5), $2 }
   | TRY ext_attributes seq_expr WITH error
       { syntax_error() }
-  | OVERWRITE ext_attributes mkrhs(val_longident) WITH expr
+  | OVERWRITE ext_attributes seq_expr WITH expr
       { Pexp_overwrite($3, $5), $2 }
   | IF ext_attributes seq_expr THEN expr ELSE expr
       { Pexp_ifthenelse($3, $5, Some $7), $2 }

ocaml/parsing/parsetree.mli

@@ -477,8 +477,7 @@ and expression_desc =
   | Pexp_extension of extension  (** [[%id]] *)
   | Pexp_unreachable  (** [.] *)
   | Pexp_stack of expression (** stack_ exp *)
-  (* CR uniqueness: allow arbitrary expressions instead of identifiers here *)
-  | Pexp_overwrite of Longident.t loc * expression (** overwrite_ x with exp *)
+  | Pexp_overwrite of expression * expression (** overwrite_ exp with exp *)
   | Pexp_hole (** _ *)
 
 and case =

ocaml/parsing/pprintast.ml

@@ -1117,11 +1117,11 @@ and expression ?(jane_syntax_parens = false) ctxt f x =
           (expression ctxt) body
     | Pexp_extension e -> extension ctxt f e
     | Pexp_unreachable -> pp f "."
-    | Pexp_overwrite (x, e) ->
+    | Pexp_overwrite (e1, e2) ->
         (* Similar to the case of [Pexp_stack] *)
         pp f "@[<hov2>overwrite_@ %a@ with@ %a@]"
-          longident_loc x
-          (expression2 reset_ctxt) e
+          (expression2 reset_ctxt) e1
+          (expression2 reset_ctxt) e2
     | Pexp_hole -> pp f "_"
     | _ -> expression1 ctxt f x
 

ocaml/parsing/printast.ml

@@ -421,9 +421,10 @@ and expression i ppf x =
   | Pexp_stack e ->
       line i ppf "Pexp_stack\n";
       expression i ppf e
-  | Pexp_overwrite (x, e) ->
-      line i ppf "Pexp_overwrite %a\n" fmt_longident_loc x;
-      expression i ppf e
+  | Pexp_overwrite (e1, e2) ->
+      line i ppf "Pexp_overwrite\n";
+      expression i ppf e1;
+      expression i ppf e2;
   | Pexp_hole ->
       line i ppf "Pexp_hole"
 

ocaml/testsuite/tests/parsetree/source_jane_street.ml

@@ -1048,6 +1048,11 @@ let overwrite_record = function
 let overwrite_record = function
     { a; b } as t -> overwrite_ t with { b = a }
 
+let ret_record () = { a = 1; b = 2 }
+
+let overwrite_record () =
+  overwrite_ (ret_record ()) with { b = a }
+
 type constructor = C of { a : int; b : int }
 
 let overwrite_constructor = function
@@ -1059,7 +1064,7 @@ let overwrite_constructor = function
 Line 2, characters 19-43:
 2 |     (a, b) as t -> overwrite_ t with (b, _)
                        ^^^^^^^^^^^^^^^^^^^^^^^^
-Alert : Overwrite not implemented.
+Alert Translcore: Overwrite not implemented.
 Uncaught exception: File "ocaml/parsing/location.ml", line 1106, characters 2-8: Assertion failed
 
 |}]