diff --git a/bin/dl2u.ml b/bin/dl2u.ml index 40ef1d1..de7f1aa 100644 --- a/bin/dl2u.ml +++ b/bin/dl2u.ml @@ -1,4 +1,5 @@ open Birds + let _ = if Array.length Sys.argv < 2 then print_endline "Invalid arguments. File name must be passed." @@ -7,11 +8,20 @@ let _ = let chan = open_in filename in let lexbuf = Lexing.from_channel chan in let ast = Parser.main Lexer.token lexbuf in - match Ast2sql.convert_expr_to_operation_based_sql ast with + match Inlining.sort_rules ast.rules 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 @@ 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 end diff --git a/examples/dl2u1.dl b/examples/dl2u1.dl new file mode 100644 index 0000000..5575e67 --- /dev/null +++ b/examples/dl2u1.dl @@ -0,0 +1,5 @@ +source ed('EMP_NAME':string,'DEPT_NAME':string). +source eed('EMP_NAME':string,'DEPT_NAME':string). ++eed(E, D) :- ed(E, D), D = 'A', E <> 'Joe', ¬eed(E, D). +-eed(E, D) :- ed(V1, D), eed(E, D), E = 'Joe', D = 'A', V1 <> 'Joe', ¬eed(V1, D). ++ed(E, D) :- ed(V1, D), E = 'Joe', D = 'A', V1 <> 'Joe', ¬ed(E, D), ¬eed(V1, D). diff --git a/examples/dl2u2.dl b/examples/dl2u2.dl new file mode 100644 index 0000000..fa187e7 --- /dev/null +++ b/examples/dl2u2.dl @@ -0,0 +1,15 @@ +source a('AA':int, 'BB':string). +source b('BB':string, 'CC':int). + +v(A,B,C) :- a(A,B), b(B,C). + +-v(GENV1, GENV2, GENV3) :- v(GENV1, GENV2, GENV3) , GENV3 = 3 , GENV1 <> 4. ++v(GENV1, GENV2, GENV3) :- GENV1 = 4 , -v(GENV1_2, GENV2, GENV3). + +uv(A,B,C) :- v(A, B, C), not -v(A,B,C). +uv(A,B,C) :- +v(A,B,C). + +-a(A, B) :- a(A, B), not uv(A, B, _). +-b(B, C) :- b(B, C), uv(_, B, _), not uv(_, B, C). ++a(A, B) :- uv(A, B, _), not a(A, B). ++b(B, C) :- uv(_, B, C), not b(B, C). diff --git a/examples/rulesort1.dl b/examples/rulesort1.dl new file mode 100644 index 0000000..a069315 --- /dev/null +++ b/examples/rulesort1.dl @@ -0,0 +1,3 @@ +v(X, Y) :- X = 1, Y = 2. ++f(X) :- v(X, Y), X = 1. +-f(X) :- +f(X), X = 1. diff --git a/src/ast2sql.ml b/src/ast2sql.ml index 9216f4a..efb8c5b 100644 --- a/src/ast2sql.ml +++ b/src/ast2sql.ml @@ -1707,6 +1707,7 @@ type error_detail = | InRule of rule | InComparison of comparison | InGroup of delta_key + | InPred of table_name type error = | InvalidArgInHead of { var : var; error_detail : error_detail } @@ -1721,6 +1722,7 @@ type error = | UnknownUnaryOperator of { op : string; error_detail : error_detail } | UnknownTable of { table : table_name; error_detail : error_detail } | HasMoreThanOneRuleGroup of delta_key + | HasMoreThanOnePredRuleGroup of table_name | DeltaNotFound of delta_key @@ -1735,6 +1737,8 @@ let show_error_detail (error_detail : error_detail) = Printf.sprintf "in group +%s" table | InGroup (Delete, table) -> Printf.sprintf "in group -%s" table + | InPred table -> + Printf.sprintf "in pred %s" table let show_error = function @@ -1765,16 +1769,19 @@ let show_error = function Printf.sprintf "+%s has more than one rule group" table | HasMoreThanOneRuleGroup (Delete, table) -> Printf.sprintf "-%s has more than one rule group" table + | HasMoreThanOnePredRuleGroup table -> + Printf.sprintf "%s has more than one rule group" table | DeltaNotFound (Insert, table) -> Printf.sprintf "no rule has already been defined for +%s" table | DeltaNotFound (Delete, table) -> Printf.sprintf "no rule has already been defined for -%s" table +exception TempError of error let get_column_names_from_table ~(error_detail : error_detail) (table_env : table_environment) (table : table_name) : (column_name list, error) result = let open ResultMonad in match table_env |> TableEnv.find_opt table with - | None -> err @@ UnknownTable { table; error_detail } + | None -> raise (TempError (UnknownTable { table; error_detail })) | Some cols -> return cols @@ -1804,6 +1811,7 @@ let validate_args_in_head ~(error_detail : error_detail) (table_env : table_envi type head_spec = + | ViewHead of table_name * (column_name * named_var) list | PredHead of table_name * (column_name * named_var) list | DeltaHead of delta_kind * table_name * (column_name * named_var) list @@ -1929,7 +1937,7 @@ let assign_or_find_instance_names (delta_env : delta_environment) (poss : positi begin match delta_env |> DeltaEnv.find_opt delta_key with | None -> - err @@ DeltaNotFound delta_key + raise (TempError (DeltaNotFound delta_key)) | Some (instance, _cols) -> return (index, (pos, instance) :: named_pos_acc, instance :: referred_instance_acc) @@ -2031,7 +2039,7 @@ let combine_delta_column_names (delta_env : delta_environment) (delta_key : delt let open ResultMonad in match delta_env |> DeltaEnv.find_opt delta_key with | None -> - err @@ DeltaNotFound delta_key + raise (TempError (DeltaNotFound delta_key)) | Some (instance, cols) -> begin @@ -2252,32 +2260,113 @@ let convert_rule_to_operation_based_sql ~(error_detail : error_detail) (table_en module DeltaKeySet = Set.Make(DeltaKey) +module TableSet = Set.Make(String) + type rule_group = - | PredGroup of table_name * headless_rule + | ViewGroup of table_name * headless_rule + | PredGroup of table_name * headless_rule list | DeltaGroup of delta_key * headless_rule list -type delta_grouping_state = { - current_target : delta_key; +module Debug = struct + + let string_of_headless_rule { columns_and_vars; body } = + Printf.sprintf "{ columns_and_vars = %s; body = %s }" + (columns_and_vars |> List.map (fun (col, x) -> Printf.sprintf "(%s, %s)" col x) |> String.concat ", ") + (body |> List.map Expr.string_of_term |> String.concat ", ") + + let string_of_headless_rules headless_rules = + headless_rules |> List.map string_of_headless_rule |> String.concat ", " + + let string_of_delta_key (delta_kind, table) = + Printf.sprintf "(%s, %s)" (match delta_kind with Insert -> "+" | Delete -> "-") table + + let string_of_rule_group = function + | ViewGroup (table, headless_rule) -> + Printf.sprintf "PredGroup(%s, %s)" table (string_of_headless_rule headless_rule) + + | PredGroup (table, headless_rules) -> + Printf.sprintf "PredGroup(%s, %s)" (table) (string_of_headless_rules headless_rules) + + | DeltaGroup (delta_key, headless_rules) -> + Printf.sprintf "DeltaGroup(%s, %s)" (string_of_delta_key delta_key) (string_of_headless_rules headless_rules) +end + +type pred_grouping_state = { + current_pred_target : sql_instance_name; current_accumulated : headless_rule list; - already_handled : DeltaKeySet.t; } +type delta_grouping_state = { + current_delta_target : delta_key; + current_accumulated : headless_rule list; +} + +type grouping_state = + | PredGrouping of pred_grouping_state + | DeltaGrouping of delta_grouping_state + | NoneState + let divide_rules_into_groups (table_env : table_environment) (rules : Expr.rule list) : (rule_group list, error) result = let open ResultMonad in - rules |> foldM (fun (state_opt, group_acc) rule -> + rules |> foldM (fun (state_opt, already_handled_delta, already_handled_pred, group_acc) rule -> let (head, body) = rule in get_spec_from_head ~error_detail:(InRule rule) table_env head >>= function + | ViewHead (table, columns_and_vars) -> + let group = ViewGroup (table, { columns_and_vars; body }) in + begin + match state_opt with + | NoneState -> + return (NoneState, already_handled_delta, already_handled_pred, group :: group_acc) + + | PredGrouping state -> + let group_prev = PredGroup (state.current_pred_target, List.rev state.current_accumulated) in + return (NoneState, already_handled_delta, already_handled_pred, group :: group_prev :: group_acc) + + | DeltaGrouping state -> + let group_prev = DeltaGroup (state.current_delta_target, List.rev state.current_accumulated) in + return (NoneState, already_handled_delta, already_handled_pred, group :: group_prev :: group_acc) + end + | PredHead (table, columns_and_vars) -> - let group = PredGroup (table, { columns_and_vars; body }) in + let intermediate = { columns_and_vars; body } in begin match state_opt with - | None -> - return (None, group :: group_acc) + | NoneState -> + return (PredGrouping { + current_pred_target = table; + current_accumulated = [ intermediate ]; + }, already_handled_delta, already_handled_pred, group_acc) - | Some state -> - let group_prev = DeltaGroup (state.current_target, List.rev state.current_accumulated) in - return (None, group :: group_prev :: group_acc) + | PredGrouping state -> + if already_handled_pred |> TableSet.mem state.current_pred_target then + err @@ HasMoreThanOnePredRuleGroup state.current_pred_target + else if state.current_pred_target = table then + return (PredGrouping { state with + current_accumulated = intermediate :: state.current_accumulated; + }, already_handled_delta, already_handled_pred, group_acc) + else + let group = PredGroup (state.current_pred_target, List.rev state.current_accumulated) in + return (PredGrouping { + current_pred_target = table; + current_accumulated = [ intermediate ]; + }, + already_handled_delta, + already_handled_pred |> TableSet.add state.current_pred_target, + group :: group_acc) + + | DeltaGrouping state -> + if already_handled_delta |> DeltaKeySet.mem state.current_delta_target then + err @@ HasMoreThanOneRuleGroup state.current_delta_target + else + let group = DeltaGroup (state.current_delta_target, List.rev state.current_accumulated) in + return (PredGrouping { + current_pred_target = table; + current_accumulated = [ intermediate ]; + }, + already_handled_delta |> DeltaKeySet.add state.current_delta_target, + already_handled_pred, + group :: group_acc) end | DeltaHead (delta_kind, table, columns_and_vars) -> @@ -2285,41 +2374,62 @@ let divide_rules_into_groups (table_env : table_environment) (rules : Expr.rule let intermediate = { columns_and_vars; body } in begin match state_opt with - | None -> - return (Some { - current_target = delta_key; - current_accumulated = [ intermediate ]; - already_handled = DeltaKeySet.empty; - }, group_acc) - - | Some state -> - if state.already_handled |> DeltaKeySet.mem delta_key then + | NoneState -> + return (DeltaGrouping { + current_delta_target = delta_key; + current_accumulated = [ intermediate ]; + }, already_handled_delta, already_handled_pred, group_acc) + + | PredGrouping state -> + if already_handled_pred |> TableSet.mem state.current_pred_target then + err @@ HasMoreThanOnePredRuleGroup state.current_pred_target + else + let group = PredGroup (state.current_pred_target, List.rev state.current_accumulated) in + return (DeltaGrouping { + current_delta_target = delta_key; + current_accumulated = [ intermediate ]; + }, + already_handled_delta, + already_handled_pred |> TableSet.add state.current_pred_target, + group :: group_acc) + + | DeltaGrouping state -> + if already_handled_delta |> DeltaKeySet.mem delta_key then err @@ HasMoreThanOneRuleGroup delta_key - else if delta_key = state.current_target then - return (Some { state with + else if delta_key = state.current_delta_target then + return (DeltaGrouping { state with current_accumulated = intermediate :: state.current_accumulated; - }, group_acc) + }, already_handled_delta, already_handled_pred, group_acc) else - let group = DeltaGroup (state.current_target, List.rev state.current_accumulated) in - return (Some { - current_target = delta_key; - current_accumulated = [ intermediate ]; - already_handled = state.already_handled |> DeltaKeySet.add state.current_target; - }, group :: group_acc) + let group = DeltaGroup (state.current_delta_target, List.rev state.current_accumulated) in + return (DeltaGrouping { + current_delta_target = delta_key; + current_accumulated = [ intermediate ]; + }, + already_handled_delta |> DeltaKeySet.add state.current_delta_target, + already_handled_pred, + group :: group_acc) end - ) (None, []) >>= fun (state_opt, group_acc) -> + ) (NoneState, DeltaKeySet.empty, TableSet.empty, []) >>= fun (state_opt, _, _, group_acc) -> match state_opt with - | None -> + | NoneState -> return (List.rev group_acc) - | Some state -> - let group_last = DeltaGroup (state.current_target, List.rev state.current_accumulated) in + | PredGrouping state -> + let group_last = PredGroup (state.current_pred_target, List.rev state.current_accumulated) in + let groups = List.rev (group_last :: group_acc) in + return groups + + | DeltaGrouping state -> + let group_last = DeltaGroup (state.current_delta_target, List.rev state.current_accumulated) in let groups = List.rev (group_last :: group_acc) in return groups let convert_expr_to_operation_based_sql (expr : expr) : (sql_operation list, error) result = + print_endline @@ Expr.to_string expr; (* DEBUG *) + let open ResultMonad in let table_env = let defs = @@ -2334,10 +2444,13 @@ let convert_expr_to_operation_based_sql (expr : expr) : (sql_operation list, err in 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 -> - rule_groups |> foldM (fun (i, creation_acc, update_acc, delta_env) rule_group -> + + print_endline @@ (rule_groups |> List.map Debug.string_of_rule_group |> String.concat "\n"); + + rule_groups |> foldM (fun (i, sql_acc, delta_env, table_env) rule_group -> let temporary_table = Printf.sprintf "temp%d" i in match rule_group with - | PredGroup (table, headless_rule) -> + | ViewGroup (table, headless_rule) -> let error_detail = let rule = let head = Pred (table, headless_rule.columns_and_vars |> List.map (fun (_, x) -> NamedVar x)) in @@ -2345,9 +2458,25 @@ let convert_expr_to_operation_based_sql (expr : expr) : (sql_operation list, err in InRule rule in - convert_rule_to_operation_based_sql ~error_detail table_env DeltaEnv.empty headless_rule >>= fun sql_query -> + 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 :: creation_acc, update_acc, delta_env) + return (i + 1, creation :: sql_acc, delta_env, table_env) + + | PredGroup (table, headless_rules) -> + headless_rules |> mapM (fun headless_rule -> + let error_detail = + let rule = + let vars = headless_rule.columns_and_vars |> List.map (fun (_, x) -> NamedVar x) in + (Pred (table, vars), headless_rule.body) + in + InRule rule + 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 -> + 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) | DeltaGroup (delta_key, headless_rules) -> let (delta_kind, table) = delta_key in @@ -2389,10 +2518,7 @@ let convert_expr_to_operation_based_sql (expr : expr) : (sql_operation list, err in SqlDeleteFrom (table, sql_where) in - return (i + 1, creation :: creation_acc, update :: update_acc, delta_env) + return (i + 1, update :: creation :: sql_acc, delta_env, table_env) - ) (0, [], [], DeltaEnv.empty) >>= fun (_, creation_acc, update_acc, _) -> - return @@ List.concat [ - List.rev creation_acc; - List.rev update_acc; - ] + ) (0, [], DeltaEnv.empty, table_env) >>= fun (_, sql_acc, _, _) -> + return @@ List.rev sql_acc