Stop converting RecordValueWith to RecordValue in analysis

analyzer.ml

@@ -193,33 +193,25 @@ let analyze asts =
           , List.map
               (fun (name, ast) -> (name_prefix ^ name, aux env ast))
               fields )
-    | RecordValueWith (base, fields) ->
+    | RecordValueWith (None, base, fields, None) ->
         let key_fieldname, _ = List.hd fields in
         let name_prefix, typename =
           hashtbl_find_with_modulename toplevel.records key_fieldname
         in
-        let fieldnames = Hashtbl.find toplevel.records_fields typename in
         let fields =
           hashmap_of_list
           @@ List.map
-               (fun (fieldname, v) -> (name_prefix ^ fieldname, v))
+               (fun (fieldname, v) -> (name_prefix ^ fieldname, aux env v))
                fields
         in
-        let new_base = Var (make_id "var") in
-        aux env
-        @@ LetAnd
-             ( false
-             , [([new_base], base)]
-             , Some
-                 (RecordValue
-                    ( None
-                    , List.map
-                        (fun fieldname ->
-                          try (fieldname, Hashmap.find fieldname fields)
-                          with Not_found ->
-                            ( fieldname
-                            , RecordDotAccess (None, new_base, fieldname) ) )
-                        fieldnames )) )
+        let fieldnames = Hashtbl.find toplevel.records_fields typename in
+        let comp_fieldnames =
+          List.filter
+            (fun fieldname -> not @@ Hashmap.mem fieldname fields)
+            fieldnames
+        in
+        RecordValueWith
+          (Some typename, aux env base, fields, Some comp_fieldnames)
     | RecordDotAccess (None, ast, fieldname) ->
         let name_prefix, typename =
           hashtbl_find_with_modulename toplevel.records fieldname

generator.ml

@@ -315,6 +315,7 @@ let rec generate (letfuncs, strings, typedefs, exps) =
         Buffer.contents buf
     | _, RecordValue (Some typename, fields) ->
         let offset = new_offset env 1 in
+        let env = {env with offset} in
         let buf = Buffer.create 128 in
         appfmt buf "/* RecordValue %s BEGIN */" typename ;
         appstr buf @@ gen_alloc_block (List.length fields) 0 1 ;
@@ -330,6 +331,36 @@ let rec generate (letfuncs, strings, typedefs, exps) =
         appfmt buf "push [rbp + %d]" offset ;
         appfmt buf "/* RecordValue %s END */" typename ;
         Buffer.contents buf
+    | _, RecordValueWith (Some typename, base, fields, Some comp_fieldnames) ->
+        let offset = new_offset env 1 in
+        let env = {env with offset} in
+        let buf = Buffer.create 128 in
+        appfmt buf "/* RecordValueWith %s BEGIN */" typename ;
+        appstr buf
+        @@ gen_alloc_block
+             (List.length fields + List.length comp_fieldnames)
+             0 1 ;
+        appfmt buf "mov [rbp + %d], rax" offset ;
+        List.iter
+          (fun (fieldname, ast) ->
+            appstr buf @@ aux env (NonTail, ast) ;
+            appstr buf "pop rax" ;
+            appfmt buf "mov rdi, [rbp + %d]" offset ;
+            let idx = Hashtbl.find records_idx (typename, fieldname) in
+            appfmt buf "mov [rdi + %d], rax" (idx * 8) )
+          fields ;
+        appstr buf @@ aux env (NonTail, base) ;
+        appstr buf "pop rax" ;
+        appfmt buf "mov rdi, [rbp + %d]" offset ;
+        List.iter
+          (fun fieldname ->
+            let idx = Hashtbl.find records_idx (typename, fieldname) in
+            appfmt buf "mov rsi, [rax + %d]" (idx * 8) ;
+            appfmt buf "mov [rdi + %d], rsi" (idx * 8) )
+          comp_fieldnames ;
+        appstr buf "push rdi" ;
+        appfmt buf "/* RecordValueWith %s END */" typename ;
+        Buffer.contents buf
     | _, RecordDotAccess (Some typename, ast, fieldname) ->
         let idx = Hashtbl.find records_idx (typename, fieldname) in
         let buf = Buffer.create 128 in

parser.ml

@@ -21,7 +21,8 @@ type ast =
   | TupleValue of ast list
   | ArrayValue of ast list
   | RecordValue of string option * (string * ast) list
-  | RecordValueWith of ast * (string * ast) list
+  | RecordValueWith of
+      string option * ast * (string * ast) list * string list option
   | RecordDotAccess of string option * ast * string
   | Add of ast * ast
   | Sub of ast * ast
@@ -199,7 +200,7 @@ let parse tokens =
             match tokens with
             | With :: tokens ->
                 let tokens, fields = parse_record_fields true [] tokens in
-                (tokens, RecordValueWith (base, fields))
+                (tokens, RecordValueWith (None, base, fields, None))
             | x -> raise_unexpected_token x ) )
     | x -> raise_unexpected_token x
   and parse_prefix = function