Emit transactional update functions

test/test_codegen.ml

@@ -147,3 +147,168 @@ let () =
         | Error message -> fail "emitted program" message
         | Ok _ -> check "compiles and runs" true) );
   ]
+
+let update_driver =
+  {|
+let rows =
+  [ (1, { customer = "Ada"; total = 1500 });
+    (2, { customer = "Bo"; total = 900 });
+    (3, { customer = "Lin"; total = 2200 }) ]
+
+let batches =
+  [ [ Query.Insert (4, { customer = "Cy"; total = 4000 }) ];
+    [ Query.Replace (1, { customer = "Ada"; total = 100 }) ];
+    [ Query.Remove 3 ];
+    [ Query.Replace (4, { customer = "Cy"; total = 2000 }); Query.Replace (2, { customer = "Bo"; total = 5000 }) ];
+    [ Query.Remove 99 ] ]
+
+let () =
+  let state = ref (Query.init rows) in
+  print_endline (Query.output_to_string (Query.result !state));
+  List.iter
+    (fun ops ->
+      match Query.apply_batch !state ops with
+      | Delta_runtime.Failure message -> print_endline ("failure: " ^ message)
+      | Delta_runtime.Success (next, _) ->
+          state := next;
+          print_endline (Query.output_to_string (Query.result !state)))
+    batches
+|}
+
+let rec show_value value =
+  match value with
+  | Value.VInt number -> string_of_int number
+  | Value.VBool truth -> string_of_bool truth
+  | Value.VString text -> Printf.sprintf "%S" text
+  | Value.VUnit -> "()"
+  | Value.VTuple items -> "(" ^ String.concat ", " (List.map show_value items) ^ ")"
+  | Value.VRecord (_, fields) ->
+      "{ " ^ String.concat "; " (List.map (fun (label, item) -> label ^ " = " ^ show_value item) fields) ^ " }"
+  | Value.VCollection _ -> "collection"
+
+let show_output value =
+  match value with
+  | Value.VCollection map ->
+      "[ "
+      ^ String.concat "; "
+          (List.map
+             (fun (key, item) -> Printf.sprintf "(%d, %s)" key (show_value item))
+             (Delta_runtime.Pure_map.bindings map))
+      ^ " ]"
+  | other -> show_value other
+
+let row customer total =
+  Value.VRecord ("order", [ ("customer", Value.VString customer); ("total", Value.VInt total) ])
+
+let expected_from_reference fixture batches =
+  let typed = infer (read_fixture fixture) in
+  let entries = [ (1, row "Ada" 1500); (2, row "Bo" 900); (3, row "Lin" 2200) ] in
+  let lines = ref [ show_output (Interpret.program typed entries) ] in
+  let state = ref (Value.collection_of_list entries) in
+  let advance batch =
+    match Change.validate_batch ~existing:!state batch with
+    | Change.Failure message ->
+        lines := !lines @ [ "failure: " ^ message ]
+    | Change.Success (temp, _) ->
+        state := temp;
+        lines := !lines @ [ show_output (Interpret.program typed (Delta_runtime.Pure_map.bindings temp)) ]
+  in
+  List.iter advance batches;
+  !lines
+
+let update_cases =
+  [
+    ( "the emitted update functions follow the reference interpreter",
+      fun () ->
+        let plan = sample_plan "expensive_order.delta" in
+        let batches =
+          [
+            [ Change.OpInsert (4, row "Cy" 4000) ];
+            [ Change.OpReplace (1, row "Ada" 100) ];
+            [ Change.OpRemove 3 ];
+            [ Change.OpReplace (4, row "Cy" 2000); Change.OpReplace (2, row "Bo" 5000) ];
+            [ Change.OpRemove 99 ];
+          ]
+        in
+        (match run_generated "updates" plan update_driver with
+        | Error message -> fail "emitted program" message
+        | Ok output ->
+            let lines = List.filter (fun line -> line <> "") (String.split_on_char '\n' output) in
+            let expected = expected_from_reference "expensive_order.delta" batches in
+            check_equal_int "one line per step" (List.length expected) (List.length lines);
+            List.iter2
+              (fun want got -> if want <> got then fail "step output" (Printf.sprintf "expected %s, got %s" want got))
+              expected lines) );
+    ( "an invalid batch is rejected and the state stays usable",
+      fun () ->
+        let plan = sample_plan "expensive_order.delta" in
+        let driver =
+          {|
+let () =
+  let rows = [ (1, { customer = "Ada"; total = 1500 }) ] in
+  let state = Query.init rows in
+  (match Query.apply_batch state [ Query.Insert (1, { customer = "Bo"; total = 10 }) ] with
+   | Delta_runtime.Failure message -> print_endline ("failure: " ^ message)
+   | Delta_runtime.Success _ -> print_endline "unexpected success");
+  (match Query.apply_batch state [ Query.Insert (2, { customer = "Bo"; total = 2000 }) ] with
+   | Delta_runtime.Failure message -> print_endline ("failure: " ^ message)
+   | Delta_runtime.Success (next, _) -> print_endline (Query.output_to_string (Query.result next)))
+|}
+        in
+        (match run_generated "invalid_batch" plan driver with
+        | Error message -> fail "emitted program" message
+        | Ok output ->
+            let lines = List.filter (fun line -> line <> "") (String.split_on_char '\n' output) in
+            check_equal_string "duplicate insert"
+              "failure: cannot insert key 1: it is already present" (List.nth lines 0);
+            check_equal_string "state still usable"
+              "[ (1, (\"Ada\", 300)); (2, (\"Bo\", 400)) ]" (List.nth lines 1)) );
+    ( "a runtime error during a batch is reported and leaves the state usable",
+      fun () ->
+        let typed =
+          infer
+            "type line = { price : int; quantity : int }\ninput lines : collection line\nquery q = lines |> map (fun l -> l.price / l.quantity) |> sum\n"
+        in
+        let plan = Simplify.simplify (Graph.build (Anf.program (Specialize.program typed))) in
+        let driver =
+          {|
+let () =
+  let rows = [ (1, { price = 100; quantity = 2 }) ] in
+  let state = Query.init rows in
+  (match Query.apply_batch state [ Query.Replace (1, { price = 100; quantity = 0 }) ] with
+   | Delta_runtime.Failure message -> print_endline ("failure: " ^ message)
+   | Delta_runtime.Success _ -> print_endline "unexpected success");
+  (match Query.apply_batch state [ Query.Insert (2, { price = 50; quantity = 5 }) ] with
+   | Delta_runtime.Failure message -> print_endline ("failure: " ^ message)
+   | Delta_runtime.Success (next, _) -> print_endline (Query.output_to_string (Query.result next)))
+|}
+        in
+        (match run_generated "runtime_error" plan driver with
+        | Error message -> fail "emitted program" message
+        | Ok output ->
+            let lines = List.filter (fun line -> line <> "") (String.split_on_char '\n' output) in
+            check_equal_string "division by zero"
+              "failure: division by zero while applying the batch" (List.nth lines 0);
+            check_equal_string "state still usable" "60" (List.nth lines 1)) );
+    ( "an integer query reports additive changes",
+      fun () ->
+        let plan = sample_plan "revenue.delta" in
+        let driver =
+          {|
+let () =
+  let rows = [ (1, { customer = "Ada"; total = 1000 }) ] in
+  let state = Query.init rows in
+  (match Query.apply_batch state [ Query.Insert (2, { customer = "Bo"; total = 250 }) ] with
+   | Delta_runtime.Failure message -> print_endline ("failure: " ^ message)
+   | Delta_runtime.Success (next, change) ->
+       print_endline (Query.output_to_string (Query.result next));
+       print_endline (Query.output_change_to_string change))
+|}
+        in
+        (match run_generated "int_updates" plan driver with
+        | Error message -> fail "emitted program" message
+        | Ok output ->
+            let lines = List.filter (fun line -> line <> "") (String.split_on_char '\n' output) in
+            check_equal_string "result" "250" (List.nth lines 0);
+            check_equal_string "additive change" "+50" (List.nth lines 1)) );
+  ]

test/test_main.ml

@@ -385,5 +385,6 @@ let () =
   Test_harness.run_suite "aggregates" Test_incremental.aggregate_cases;
   Test_harness.run_suite "simplify" Test_incremental.simplify_cases;
   Test_harness.run_suite "codegen" Test_codegen.codegen_cases;
+  Test_harness.run_suite "generated updates" Test_codegen.update_cases;
   Printf.printf "%d cases, %d failures\n" (Test_harness.case_count ()) (Test_harness.failure_count ());
   exit (if Test_harness.failure_count () = 0 then 0 else 1)