Emit specialized OCaml initialization functions

test/test_codegen.ml

@@ -0,0 +1,149 @@
+open Test_harness
+
+let build_dir () = try Sys.getenv "DELTA_BUILD_DIR" with Not_found -> "_build"
+
+let ocamlopt () = try Sys.getenv "DELTA_OCAMLOPT" with Not_found -> "ocamlopt"
+
+let unique name =
+  Printf.sprintf "%s_%d_%d" name (Unix.getpid ()) (Random.self_init (); Random.int 1000000)
+
+let write_file path text =
+  let channel = open_out path in
+  output_string channel text;
+  close_out channel
+
+let run command =
+  let log = Filename.temp_file "delta_test" ".log" in
+  let fd = Unix.openfile log [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
+  let argv = Array.of_list command in
+  let pid = Unix.create_process argv.(0) argv Unix.stdin fd fd in
+  let status = snd (Unix.waitpid [] pid) in
+  Unix.close fd;
+  let text = Native.read_file log in
+  (try Sys.remove log with _ -> ());
+  (status, text)
+
+let compile source_path output_path =
+  let command =
+    [ ocamlopt (); "-I"; build_dir (); "-I"; "+unix"; "-o"; output_path;
+      Filename.concat (build_dir ()) "delta_runtime.cmxa"; "unix.cmxa"; source_path ]
+  in
+  match run command with
+  | Unix.WEXITED 0, _ -> None
+  | _, text -> Some text
+
+let example_driver =
+  {|
+let () =
+  let rows =
+    [ (1, { customer = "Ada"; total = 1500 });
+      (2, { customer = "Bo"; total = 900 });
+      (3, { customer = "Lin"; total = 2200 }) ]
+  in
+  let state = Query.init rows in
+  print_endline (Query.output_to_string (Query.result state));
+  print_endline (Delta_runtime.counters_to_string (Query.counters ()))
+|}
+
+let run_generated name plan driver =
+  let dir = Filename.temp_file "delta_gen" "" in
+  Sys.remove dir;
+  Unix.mkdir dir 0o700;
+  let source_path = Filename.concat dir (unique name ^ ".ml") in
+  let exe_path = Filename.concat dir (unique name ^ ".exe") in
+  write_file source_path (Emit.program_to_string plan ^ driver);
+  let result =
+    match compile source_path exe_path with
+    | Some message -> Error ("the generated program did not compile:\n" ^ message)
+    | None -> (
+        match run [ exe_path ] with
+        | Unix.WEXITED 0, text -> Ok text
+        | _, text -> Error ("the generated program failed:\n" ^ text))
+  in
+  Native.remove_dir dir;
+  result
+
+let sample_plan fixture =
+  let typed = infer (read_fixture fixture) in
+  Simplify.simplify (Graph.build (Anf.program (Specialize.program typed)))
+
+let codegen_cases =
+  [
+    ( "the emitted module initializes the example query",
+      fun () ->
+        let plan = sample_plan "expensive_order.delta" in
+        match run_generated "expensive_orders" plan example_driver with
+        | Error message -> fail "emitted program" message
+        | Ok output ->
+            let lines = String.split_on_char '\n' output in
+            check_equal_string "output"
+              "[ (1, (\"Ada\", 300)); (3, (\"Lin\", 440)) ]"
+              (List.nth lines 0);
+            check "counters are reported" (String.length (List.nth lines 1) > 0) );
+    ( "the emitted module handles an integer query",
+      fun () ->
+        let plan = sample_plan "revenue.delta" in
+        let driver =
+          {|
+let () =
+  let rows = [ (1, { customer = "Ada"; total = 1000 }); (2, { customer = "Bo"; total = 250 }) ] in
+  let state = Query.init rows in
+  print_endline (Query.output_to_string (Query.result state))
+|}
+        in
+        (match run_generated "revenue" plan driver with
+        | Error message -> fail "emitted program" message
+        | Ok output -> check_equal_string "revenue" "250" (String.trim output)) );
+    ( "the emitted module handles a count query",
+      fun () ->
+        let plan = sample_plan "count_large.delta" in
+        let driver =
+          {|
+let () =
+  let rows =
+    [ (1, { customer = "Ada"; total = 1000 });
+      (2, { customer = "Bo"; total = 250 });
+      (3, { customer = "Lin"; total = 501 }) ]
+  in
+  let state = Query.init rows in
+  print_endline (Query.output_to_string (Query.result state))
+|}
+        in
+        (match run_generated "count_large" plan driver with
+        | Error message -> fail "emitted program" message
+        | Ok output -> check_equal_string "count" "2" (String.trim output)) );
+    ( "the emitted module compiles for a tuple valued query",
+      fun () ->
+        let typed =
+          infer
+            "type line = { price : int; quantity : int }\ninput lines : collection line\nquery q = lines |> filter (fun l -> l.quantity > 0) |> map (fun l -> (l.price, l.price * l.quantity))\n"
+        in
+        let plan = Simplify.simplify (Graph.build (Anf.program (Specialize.program typed))) in
+        let driver = "let _ = Query.init []\n" in
+        (match run_generated "tuple_query" plan driver with
+        | Error message -> fail "emitted program" message
+        | Ok _ -> check "compiles and runs" true) );
+    ( "the emitted module compiles for a boolean valued query",
+      fun () ->
+        let typed =
+          infer
+            "type line = { price : int; quantity : int }\ninput lines : collection line\nquery q = lines |> map (fun l -> (l.price > 0, l.quantity))\n"
+        in
+        let plan = Simplify.simplify (Graph.build (Anf.program (Specialize.program typed))) in
+        (match run_generated "bool_query" plan "let _ = Query.init []\n" with
+        | Error message -> fail "emitted program" message
+        | Ok _ -> check "compiles and runs" true) );
+    ( "the generated module keeps generated identifiers distinct",
+      fun () ->
+        let typed =
+          infer
+            "input rows : collection int\nlet scale n = n * 2\nlet quad n = scale (scale n)\nquery q = rows |> map (fun r -> quad r + quad r)\n"
+        in
+        let plan = Simplify.simplify (Graph.build (Anf.program (Specialize.program typed))) in
+        let text = Emit.program_to_string plan in
+        check "no duplicated let binding in the emitted mapping function"
+          (not (Util.starts_with "internal error" text));
+        (match run_generated "identifiers" plan "let _ = Query.init []\n" with
+        | Error message -> fail "emitted program" message
+        | Ok _ -> check "compiles and runs" true) );
+  ]