Fix creations and updates.

bin/dl2u.ml

@@ -1,4 +1,41 @@
 open Birds
+open Utils
+
+let sort rules =
+  let open Result in
+  match Inlining.sort_rules rules with
+  | Error err ->
+      error @@ Inlining.string_of_error err
+  | Ok rules ->
+      ok rules
+
+let simplify rules =
+  let open Result in
+  match Simplification.simplify rules with
+  | Error err ->
+      error @@ Simplification.string_of_error err
+  | Result.Ok rules ->
+      ok rules
+
+let convert ast =
+  let open Result in
+  match Ast2sql.convert_expr_to_operation_based_sql ast with
+  | Error err ->
+      error @@ Ast2sql.show_error err
+  | Result.Ok operations ->
+      let result =
+        operations
+        |> List.map Ast2sql.stringify_sql_operation
+        |> String.concat "\n"
+      in
+      ok result
+
+let main (ast : Expr.expr) =
+  let open ResultMonad in
+  sort ast.rules >>= fun rules ->
+  simplify rules >>= fun rules ->
+  let ast = { ast with rules = rules } in
+  convert ast
 
 let _ =
   if Array.length Sys.argv < 2 then
@@ -8,20 +45,5 @@ let _ =
     let chan = open_in filename in
     let lexbuf = Lexing.from_channel chan in
     let ast = Parser.main Lexer.token lexbuf in
-    match Inlining.sort_rules ast.rules with
-    | Result.Error err ->
-      print_endline @@ Inlining.string_of_error err
-    | Result.Ok rules ->
-      match Simplification.simplify rules with
-      | Result.Error err ->
-        print_endline @@ Simplification.string_of_error err
-      | Result.Ok rules ->
-        let ast = { ast with rules = rules } in
-        match Ast2sql.convert_expr_to_operation_based_sql ast with
-        | Result.Error err ->
-          print_endline @@ Ast2sql.show_error err
-        | Result.Ok operations ->
-          List.iter (fun op ->
-            print_endline @@ Ast2sql.stringify_sql_operation op
-          ) operations
+    print_endline @@ Result.fold ~ok:Fun.id ~error:Fun.id @@ main ast
   end

examples/dl2u3.dl

@@ -1,6 +1,6 @@
 source x('A':int, 'B':string).
 source y('A':int, 'B':string).
 
++y(A, B) :- A <> 2, A <> 3, +x(A, B), y(A, B).
 -x(A, B) :- A = 1, x(A, B).
 +x(A, B) :- A <> 1, x(A, B).
-+y(A, B) :- A <> 2, A <> 3, +x(A, B), y(A, B).

src/ast2sql.ml

@@ -2447,9 +2447,9 @@ let convert_expr_to_operation_based_sql (expr : expr) : (sql_operation list, err
   let rules = List.rev expr.rules in (* `expr` holds its rules in the reversed order *)
   divide_rules_into_groups table_env rules >>= fun rule_groups ->
 
-  print_endline @@ (rule_groups |> List.map Debug.string_of_rule_group |> String.concat "\n");
+  print_endline @@ (rule_groups |> List.map Debug.string_of_rule_group |> String.concat "\n");  (* DEBUG *)
 
-  rule_groups |> foldM (fun (i, sql_acc, delta_env, table_env) rule_group ->
+  rule_groups |> foldM (fun (i, creation_acc, update_acc, delta_env, table_env) rule_group ->
     let temporary_table = Printf.sprintf "temp%d" i in
     match rule_group with
     | ViewGroup (table, headless_rule) ->
@@ -2462,7 +2462,7 @@ let convert_expr_to_operation_based_sql (expr : expr) : (sql_operation list, err
         in
         convert_rule_to_operation_based_sql ~error_detail table_env delta_env headless_rule >>= fun sql_query ->
         let creation = SqlCreateView (table, sql_query) in
-        return (i + 1, creation :: sql_acc, delta_env, table_env)
+        return (i + 1, creation :: creation_acc, update_acc, delta_env, table_env)
 
     | PredGroup (table, headless_rules) ->
       headless_rules |> mapM (fun headless_rule ->
@@ -2475,10 +2475,10 @@ let convert_expr_to_operation_based_sql (expr : expr) : (sql_operation list, err
         in
         convert_rule_to_operation_based_sql ~error_detail table_env delta_env headless_rule >>= fun sql_query ->
         return (SqlCreateTemporaryTable (temporary_table, sql_query))
-      ) >>= fun sql_queries ->
+      ) >>= fun creations ->
       get_column_names_from_table ~error_detail:(InPred table) table_env table >>= fun cols ->
       let table_env = table_env |> TableEnv.add table cols in
-      return (i + 1, List.concat [ sql_queries; sql_acc ], delta_env, table_env)
+      return (i + 1, List.concat [ creations; creation_acc ], update_acc, delta_env, table_env)
 
     | DeltaGroup (delta_key, headless_rules) ->
         let (delta_kind, table) = delta_key in
@@ -2520,7 +2520,7 @@ let convert_expr_to_operation_based_sql (expr : expr) : (sql_operation list, err
               in
               SqlDeleteFrom (table, sql_where)
         in
-        return (i + 1, update :: creation :: sql_acc, delta_env, table_env)
+        return (i + 1, creation :: creation_acc, update :: update_acc, delta_env, table_env)
 
-  ) (0, [], DeltaEnv.empty, table_env) >>= fun (_, sql_acc, _, _) ->
-  return @@ List.rev sql_acc
+  ) (0, [], [], DeltaEnv.empty, table_env) >>= fun (_, creation_acc, update_acc, _, _) ->
+  return @@ List.concat @@ List.map List.rev [creation_acc; update_acc]

src/inlining.ml

@@ -580,4 +580,4 @@ let sort_rules (rules : rule list) : (rule list, error) result =
     )
     |> List.concat
   in
-  return (List.rev acc)
+  return @@ List.rev acc

src/simplification.ml

@@ -810,7 +810,7 @@ let simplify (rules : rule list) : (rule list, error) result =
   (* Removes duplicate rules here *)
   let rules = rules |> remove_duplicate_rules in
 
-  return rules
+  return @@ List.rev rules
 
 let string_of_error = function
   | UnexpectedHeadVarForm var ->