Commits

cacol89  committed 35561a7 Merge

Merge branch 'feature/stratification' into develop

  • Participants
  • Parent commits afda2f1, da4c927

Comments (0)

Files changed (9)

     parser\
     lexer\
     yadi_utils\
+    stratification\
     eval\
     conn_ops\
 
 DEP_expr=
 DEP_parser=expr
 DEP_lexer=parser
-DEP_eval=expr yadi_utils
-DEP_conn_ops=expr
+DEP_eval=expr yadi_utils stratification
+DEP_conn_ops=expr yadi_utils
 DEP_yadi_utils=expr
+DEP_stratification=expr yadi_utils
 DEP_query_flattening=expr
 
 #Rule for generating the final executable file
 bin/conn_ops.cmo: $(DEP_conn_ops:%=bin/%.cmo)
 bin/yadi_utils.cmo: $(DEP_yadi_utils:%=bin/%.cmo)
 bin/query_flattening.cmo: $(DEP_query_flattening:%=bin/%.cmo)
+bin/stratification.cmo: $(DEP_stratification:%=bin/%.cmo)
 
 clean:
 	rm -f bin/*.cmo bin/*.cmi src/parser.mli src/parser.ml src/lexer.ml 

File src/conn_ops.ml

 open Postgresql ;;
 open Yadi_utils;;
 open Expr;;
-open Format;;
-open Array;;
 
 (** Extract response column-names and tuples to lists 
  *  @param res_to_lst is the provided list of column_names
 
 open Expr ;;
 open Yadi_utils;;
+open Stratification;;
 
 (** get the query expression, 
  *  check if there is one query, or more than one 
  *  @param get_query takes input assumed to be query 
  *  @return true if there is query, otherwise error statements *)
 let get_query e = match e with
-    | Prog sttl    -> ( let lq = ( List.filter (fun r -> match r with
-                                                    | Query _ -> true 
-                                                    | _ -> false) sttl ) in
-                    match lq with 
-                        | []     -> raise (Yadi_error "The program has no query")
-                        | h::[]    -> h
-                        | h::_ -> raise (Yadi_error "The program has more than one query")
-                    )
+    | Prog sttl -> 
+        let is_q = function
+            | Query _ -> true
+            | _ -> false
+        in
+        let lq = List.filter is_q sttl in
+        match lq with 
+            | []     -> raise (Yadi_error "The program has no query")
+            | h::[]    -> h
+            | h::_ -> raise (Yadi_error "The program has more than one query")
 ;;
 
 (**Takes a program and extracts all rules and places them in
         Hashtbl.replace st key rep_lst in
     Hashtbl.iter rep_rule st
 
-(** Checks that all predicates in rterms are in the edb/idb,
- * and returns those that contain idb predicates*)
-let check_rterms (edb:symtable) (idb:symtable) rterms =
-    let check rt =
-        let key = symtkey_of_rterm rt in
-        if Hashtbl.mem edb key then false
-        else if Hashtbl.mem idb key then true
-        else raise ( Yadi_error 
-            (   "Incomplete program, predicate "^
-                (string_of_symtkey key)^" not defined"
-            )
-        )
-    in
-    List.filter check rterms
-
-
 (** Given a list of rterms, returns the SQL that must be in the from clause.
  * All the tables are aliased with the postfix '_aX_Y', where X is the arity of
  * the predicate and Y is the position of the goal in the rule, starting by 0.
         | Ineq (op,x,y) -> (pos,neg,eq,(op,x,y)::inq) in
     List.fold_right split terms ([],[],[],[])
 
-(** The following three functions are mutually recursive, DO NOT SEPARATE!*)
+(** Takes a rule and makes a SQL query that calculates its result*)
+let sql_of_rule (idb:symtable) (cnt:colnamtab) rule =
+    let head = rule_head rule in
+    let body = rule_body rule in
+    (*Extract positive rterms from the rule*)
+    let (rterms,_,equalities,ineq) = split_terms body in
+    (*Build vartab, and eqtab for select and where clauses*)
+    let vt = build_vartab cnt rterms in
+    let eqt = build_eqtab equalities in
+    let select_sql = get_select_clause vt eqt head in
+    let from_sql = get_from_clause idb rterms in
+    let where_sql = get_where_clause vt eqt ineq in
+    String.concat " " [select_sql;from_sql;where_sql]
+
 (**Takes a list of similar rules (same head) and generates the SQL statement
  * that calculates the union of them**)
-let rec sql_of_rule_lst (edb:symtable) (idb:symtable) (cnt:colnamtab) rules =
-    let sql_list = List.map (sql_of_rule edb idb cnt) rules in
+let sql_of_rule_lst (idb:symtable) (cnt:colnamtab) rules =
+    let sql_list = List.map (sql_of_rule idb cnt) rules in
     String.concat " UNION ALL " sql_list
-(** Takes an rterm and makes a query that calculates its table*)
-and sql_of_rule (edb:symtable) (idb:symtable) (cnt:colnamtab) = function
-    | Query _ -> invalid_arg "function sql_of_rule called with a query"
-    | Rule (head, body) ->
-        (*Extract positive rterms from the rule*)
-        let (rterms,_,equalities,ineq) = split_terms body in
-        let i_rt = check_rterms edb idb rterms in
-        let with_sql = get_with_clause edb idb cnt i_rt in 
-        (*Build vartab, and eqtab for select and where clauses*)
-        let vt = build_vartab cnt rterms in
-        let eqt = build_eqtab equalities in
-        let select_sql = get_select_clause vt eqt head in
-        let from_sql = get_from_clause idb rterms in
-        let where_sql = get_where_clause vt eqt ineq in
-        String.concat " " [with_sql;select_sql;from_sql;where_sql]
-(* Calculates the WITH clause for making idb positive relations (rtemrs) as edb
- * ones. Every IDB will be aliased with the name 'predname_aX', where
- * predname is the name of the predicate in the rule's head and X its arity*)
-and get_with_clause (edb:symtable) (idb:symtable) (cnt:colnamtab) rterms = match rterms with
-    | [] -> ""
-    | _ ->
-        let pred_keys = List.map symtkey_of_rterm rterms in
-        let uniq_pred_keys = remove_repeated_keys pred_keys in
-        let rule_lst_lst = List.map (Hashtbl.find idb) uniq_pred_keys in
-        let get_alias rt = (get_symtkey_predname rt)^"_a"^
-                            (string_of_int (get_symtkey_arity rt)) in 
-        let pred_names = List.map get_alias uniq_pred_keys in
-        let sql_lst = List.map (sql_of_rule_lst edb idb cnt) rule_lst_lst in
-        let aug_sql_lst = List.map (fun (a,b) -> a^" AS ("^b^")")
-                                (List.combine pred_names sql_lst) in 
-        "WITH "^(String.concat ", " aug_sql_lst)
 
-(** Given a query, it returns a rule list (union of rules)
- * that generates the desired output.
- * If the query does not have constants it is expected to query the idb,
- * otherwise an error is raised.
- * If the query has constants, then a 'dummy' idb rule will be created
- * and returned.
+(** Given a query, it returns a
+ * a 'dummy' idb rule that calculates the desired
+ * output.
  *)
 let rule_of_query query (idb:symtable) =
     let (q2,eqs) = extract_rterm_constants query in
-    if List.length eqs == 0 then
-        (*No constants*)
-        let key = symtkey_of_rterm query in
-        if Hashtbl.mem idb key then
-            Hashtbl.find idb key
-        else raise ( Yadi_error 
-            (   "Incomplete program, predicate "^
-                (string_of_symtkey key)^" not defined"
-            )
-        )
-    else
-        (*Constants found*)
-        let dummy = Pred ("_dummy_", get_rterm_varlist q2) in
-        [Rule (dummy, (Rel q2)::eqs)]
+    let dummy = Pred ("_dummy_", get_rterm_varlist q2) in
+    Rule (dummy, (Rel q2)::eqs)
+
+
+(** Generates the SQL that calculates a stratified program.
+ * The stratification is done using WITH statements for succesively
+ * making idb relations as edb ones. Every IDB will be aliased with the
+ * name 'predname_aX', where predname is the name of the predicate in the rule's
+ * head and X its arity.
+ * After the stratification, the provided query will be translated into
+ * SQL that uses the generated stratification.
+ * *)
+let sql_of_strat (idb:symtable) (cnt:colnamtab) strat (query:rterm) =
+    let qrule = rule_of_query query idb in
+    (*Calc sql of stratifications as if all were EDB rels*)
+    let rule_lst_lst = List.map (Hashtbl.find idb) strat in
+    let sql_lst = List.map (sql_of_rule_lst idb cnt) rule_lst_lst in
+    (*Calculate aliases for the with-statemets*)
+    let get_alias k = (get_symtkey_predname k)^"_a"^
+                        (string_of_int (get_symtkey_arity k)) in 
+    let pred_names = List.map get_alias strat in
+    (*Augment SQL and calculate the with-statement*)
+    let aug_sql_lst = List.map (fun (a,b) -> a^" AS ( "^b^")")
+                            (List.combine pred_names sql_lst) in 
+    let strat_sql =
+        if aug_sql_lst = [] then ""
+        else "WITH "^(String.concat ", " aug_sql_lst)
+    in
+    (** Calculate query's SQL*)
+    let q_sql = sql_of_rule idb cnt qrule in
+    strat_sql^" "^q_sql
+
 
 (** generate SQL statement from the ast, receives a symtable with
- * the database's edb description*)
-let sql_stt (edb:symtable) prog =
-    let query = get_query_rterm (get_query prog) in
+ * the database's edb description.
+ * The boolean variable debug indicates whether debugging information
+ * should be printed*)
+let sql_stt debug (edb:symtable) prog =
+    let query_rt = get_query_rterm (get_query prog) in
     (*Extract and pre-process the IDB from the program*)
     let idb = extract_idb prog in
     preprocess_rules idb;
+    (*stratify program*)
+    let strat = stratify edb idb query_rt in
+    if debug then (
+        print_endline "\n______________";
+        print_endline "Stratification:\n";
+        List.iter (fun x -> print_endline (string_of_symtkey x)) strat;
+        print_endline "______________"
+    ) else ();
     (*Build the colnamtab for referencing the table's columns*)
     let cnt = build_colnamtab edb idb in
-    (*Extract desired rule and build SQL sentence*)
-    let rules = rule_of_query query idb in
-    let sql = sql_of_rule_lst edb idb cnt rules in
+    (*Return the desired SQL*)
+    let sql = sql_of_strat idb cnt strat query_rt in
     sql^";"
 ;;
 
 (** get a rule's head pred *)
 let rule_head r = match r with
-    | Rule(h, t) -> h
+    | Rule(h, _) -> h
     | Query _    -> invalid_arg "function rule_head called with a query"
 ;;
 
+(** get a rule's body list of terms *)
+let rule_body r = match r with
+    | Rule(_, t) -> t
+    | Query _    -> invalid_arg "function rule_body called with a query"
+;;
+
 (** get rterm varlist *)
 let get_rterm_varlist t = match t with
     | Pred (x, vl) -> vl
     | Not t            -> get_varlist t
 ;;
 
+(** Given a query, returns the rterm that is defined inside*)
 let get_query_rterm (r:stt) = match r with
     | Query rt -> rt
     | _ -> invalid_arg "function get_query_rterm called without a query"
 ;;
 
+(** Given a rule, returns all the positive and negative rterms
+ * inside*)
+let get_all_rule_rterms = function
+    | Rule(_, t) ->
+        let rec extract_rterm acc = function
+            | Rel x -> x::acc
+            | Not x -> extract_rterm acc x
+            | _ -> acc in
+        List.fold_left extract_rterm [] t
+    | Query _    -> invalid_arg "function get_all_rule_rterms called with a query"
+
 (** Extracts constants in a rterm and replaces them with
  * ad-hoc NumVars which numbers start from 'pos'. The function
  * returns a tuple with the new rterm and a list of equalities
             try
                 print_string "\nyadi$ "; flush stdout;
                 let ast = Parser.main Lexer.token lexbuf in 
-                let sql = Eval.sql_stt edb ast in
+                let sql = Eval.sql_stt (!debug) edb ast in
                 if !debug then (
                     print_endline sql
                 ) else ();

File src/stratification.ml

+(*******************************************************)
+(**  stratification.ml
+ *
+ *   Functions for stratifying a datalog program.
+ *   If any of the predicates is indirectly recursive,
+ *   then the stratification will report an error and
+ *   abort.
+ *   The stratification will NOT check if a
+ *   predicate is negatively self-recursive or if
+ *   it has more than one recursive goals.
+ *   The stratification will include only IDB relations
+ *   and it will fail if the program is incomplete: if
+ *   it contains references to undefined predicates.
+ *
+ *   @author cruelcoderz
+ * 
+ *)
+(********************************************************)
+
+open Expr;;
+open Yadi_utils;;
+
+(** Checks that all predicates in rterms are in the edb/idb,
+ * and returns those that contain idb predicates*)
+let check_keys (edb:symtable) (idb:symtable) keys =
+    let check key =
+        if Hashtbl.mem edb key then false
+        else if Hashtbl.mem idb key then true
+        else raise ( Yadi_error 
+            (   "Incomplete program, predicate "^
+                (string_of_symtkey key)^" not defined"
+            )
+        )
+    in
+    List.filter check keys
+
+(** Given a symtkey, returns the keys of all IDB predicates that
+ * depend on it, positively or negatively.*)
+let get_idb_graph_sons (edb:symtable) (idb:symtable) (key:symtkey) =
+    let rule_lst = Hashtbl.find idb key in
+    let rule_rts = List.map get_all_rule_rterms rule_lst in
+    let rterms = List.flatten rule_rts in
+    let keys = List.map symtkey_of_rterm rterms in
+    let uniq_keys = remove_repeated_keys keys in
+    check_keys edb idb uniq_keys
+
+(** Performs a dfs in the dependency graph, if a cycle different
+ * than a self-loop is found, an error will be raised.
+ * Negative valued self-loops will not be checked.
+ * The function will return a stratification of the program
+ * from the called point.
+ * The 'visit' and 'active' sets are used for keeping track of the
+ * DFS explored nodes.*)
+let rec strat_dfs edb idb visit active key =
+    visit := SymtkeySet.add key (!visit);
+    active := SymtkeySet.add key (!active);
+    let sons = get_idb_graph_sons edb idb key in
+    let rec_call son =
+        if SymtkeySet.mem son (!visit) then
+            if SymtkeySet.mem son (!active) then
+                raise (Yadi_error (
+                    "Predicate "^(string_of_symtkey son)^
+                    " is recursive."
+                ))
+            else []
+        else
+            strat_dfs edb idb visit active son
+    in
+    let strat = List.flatten (List.map rec_call sons) in
+    active := SymtkeySet.remove key (!active);
+    strat@[key]
+
+(** Given the EDB and IDB of a program, and the rterm of an initial
+ * query, calculates a stratification of the program. The stratification
+ * is returned as a list of IDB symtkeys, where the first key is the
+ * first IDB relation to calculate in the stratification.
+ * If the provided program contains references to undefined predicates,
+ * the function will raise an exception.*)
+let stratify (edb:symtable) (idb:symtable) (query_rt:rterm) : (symtkey list) =
+    let visit = ref SymtkeySet.empty in
+    let active = ref SymtkeySet.empty in
+    let key = symtkey_of_rterm query_rt in
+    (*Check that the queried relation exists*)
+    let _ = check_keys edb idb [key] in
+    (*If it is an EDB query, return an empty stratification*)
+    if Hashtbl.mem edb key then
+        []
+    else
+        strat_dfs edb idb visit active key

File src/yadi_utils.ml

     n^"/"^(string_of_int a)
 
 (***********************************************************
+ *  kset (SymtkeySet)
+ *********************************************************)
+
+(**This structure defines a set of symtable keys*)
+module SymtkeySet = Set.Make( 
+  struct
+    let compare = key_comp
+    type t = symtkey
+  end
+)
+
+type kset = SymtkeySet.t
+
+(***********************************************************
  *  Colnamtab
  *********************************************************)
 
     let c = Hashtbl.find eqt vname in
     Hashtbl.remove eqt vname;
     c
+

File test/expected/integration/family.out

 
 yadi$ 
+-------------------
+| col0   | col1   |
+-------------------
+| Marge  | Bart   |
+| Marge  | Lisa   |
+| Marge  | Maggie |
+| Mona   | Homer  |
+| Mona   | Herb   |
+| Jackie | Marge  |
+| Jackie | Patty  |
+| Jackie | Selma  |
+-------------------
+
+yadi$ 
+------------------
+| col0  | col1   |
+------------------
+| Marge | Bart   |
+| Marge | Lisa   |
+| Marge | Maggie |
+------------------
+
+yadi$ 
 --------------------
 | col0    | col1   |
 --------------------

File test/integration/family.datalog

 %%%%%%%%%%%%%%%%%
+% EDB queries
+%%%%%%%%%%%%%%%%%
+
+?- Mother(x,y).
+/
+
+?- Mother('Marge',y).
+/
+
+%%%%%%%%%%%%%%%%%
 % Self-join
 %%%%%%%%%%%%%%%%%
 
 Sibling(x,y) :- Father(f,x), Mother(m,x), Father(f,y), Mother(m,y). %, x <> y.
 ?-Sibling(x,y).
 /
+
+
+%Male_ancestor(x,y) :- Father(x,y).
+%Male_ancestor(x,y) :- Father(x,z), Male_ancestor(z,y).
+%?- Male_ancestor(x,y).
+%/
+