YADI / src / eval.ml

(*******************************************************)
(**  eval.ml
 *
 *   AST processing functions are defined here, 
 *   including sql_stt
 *   
 *   @author cruelcoderz
 * 
 *)
(********************************************************)

open Expr ;;
open Yadi_utils;;
open Rule_preproc;;
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 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")
;;

(** 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.
 * In the case of IDB rules, it is assumed that the name of the original table
 * has already the '_aX' postfix.*)
let get_from_clause (idb:symtable) rterms =
    if rterms == [] then "" else
    let idb_alias pname arity n =
        let pn_a = pname^"_a"^(string_of_int arity) in
        pn_a^" AS "^pn_a^"_"^(string_of_int n)
    in
    let edb_alias pname arity n =
        pname^" AS "^pname^"_a"^(string_of_int arity)^"_"^(string_of_int n)
    in
    let set_alias rterm (a_lst,n) =
        let pname = get_rterm_predname rterm in
        let arity = get_arity rterm in
        let key = symtkey_of_rterm rterm in
        let alias_f = if Hashtbl.mem idb key then idb_alias else edb_alias in
        let alias = alias_f pname arity n in
        (alias::a_lst,n-1)
    in
    let len = List.length rterms in
    let (aliases,_) = List.fold_right set_alias rterms ([],len-1) in
    "FROM "^(String.concat ", " aliases)

(** Given an aggregate function name, checks if it is supported by YADI and
 * returns it i upper case*)
let check_agg_function fn =
    let allowed = ["MAX";"MIN";"SUM";"AVG";"COUNT"] in
    let upc = String.uppercase fn in
    if List.mem upc allowed then upc
    else raise (Yadi_error (
        "Aggregate function '"^upc^"' is not supported, "^
        "allowed functions are: "^(String.concat ", " allowed)
    ))


(** Given the head of the rule, the vartab, and te eqtab, returns the code that
 * must be in the select clause. All columns are aliased as col0, col1, ...*)
let get_select_clause (vt:vartab) (eqt:eqtab) rterm =
    let vlst = get_rterm_varlist rterm in 
    if vlst = [] then
        raise (Yadi_error
            ("Predicate "^(get_rterm_predname rterm)^
            " has arity 0, which is not allowed"))
    else
    let vname_to_col vname =
        (*If the variable appears in a positive rterm, the value
         * is the name of the respective rterm's table column*)
        if Hashtbl.mem vt vname
            then List.hd (Hashtbl.find vt vname)
        (*If the variable does not appear in a positive rterm, but
         * it does in an equality value, then the value is the eq's
         * constant, the var has to be removed from the eqtab*)
        else if Hashtbl.mem eqt vname
            then string_of_const (eqt_extract eqt vname)
        (*Else, the query is unsafe or inclomplete*)
        else raise (Yadi_error (
                "Predicate "^(string_of_symtkey (symtkey_of_rterm rterm))^
                " is unsafe, variable "^vname^" is not in a positive "^
                "goal or strict equality relation."
            )
        ) in
    let var_value v = match v with
        NamedVar _ | NumberedVar _ ->
            vname_to_col (string_of_var v)
        | AggVar (fn,vn) ->
            (check_agg_function fn)^"("^(vname_to_col vn)^")"
        | _ -> invalid_arg ("not-expected vartype in head of predicate"^
            (string_of_symtkey (symtkey_of_rterm rterm)))
    in
    let cols = List.map var_value vlst in
    let rec alias ind = function
        | [] -> ""
        | [col] -> col^" AS col"^(string_of_int ind)
        | col::col2::tl ->
            (col^" AS col"^(string_of_int ind))^", "^(alias (ind+1) (col2::tl))
    in
    "SELECT "^(alias 0 cols)

(** Calculates the SQL of negated rterms with an inner query of
 * the form ( NOT EXISTS SELECT * FROM Table WHERE ... ).
 * @param idb       Symtable of the IDB
 * @param vt        Vartab with the name of the variables
 * @param cnt       Colnamtab with the name of relation's columns 
 * @param eqtab     Eqtab with the variables that appear as equalities
 * @param neg_rt    List of negated rterms.
 * @return          List of SQL restrictions that ensures the negation
 * *)
let sql_of_negated_rterms (idb:symtable) (vt:vartab) (cnt:colnamtab) (eqt:eqtab) neg_rt =
    let gen_neg_sql rt =
        (*get basic info of the rterm*)
        let key = symtkey_of_rterm rt in
        let pname = get_rterm_predname rt in
        let arity = get_arity rt in 
        let alias = pname^"_a"^(string_of_int arity) in
        let vlst = get_rterm_varlist rt in
        let cnames = Hashtbl.find cnt key in
        (*Get the from sql of the rterm*)
        let from_sql =
            if Hashtbl.mem idb key then
                "FROM "^alias
            else
                "FROM "^pname^" AS "^alias
        in
        (*Get the where sql of the rterm*)
        let build_const acc col var =
            let eq_to = alias^"."^col^" = " in
            match var with
            | NamedVar vn -> 
                if Hashtbl.mem vt vn then
                    (eq_to^(List.hd (Hashtbl.find vt vn)))::acc
                else if Hashtbl.mem eqt vn then
                    (eq_to^(string_of_const (Hashtbl.find eqt vn)))::acc
                else raise (Yadi_error (
                    "Program is unsafe, variable "^vn^
                    " in negated call to predicate "^
                    (string_of_symtkey key)^" does not appear in a positive "^
                    "goal or strict equation. Try anonimous variables."
                )) 
            | ConstVar c -> (eq_to^(string_of_const c))::acc
            | AnonVar -> acc
            | _ -> invalid_arg "There is a non-expected type of var in a negated rterm"
        in
        let const_lst = List.fold_left2 build_const [] cnames vlst in
        let where_sql =
            if const_lst = [] then ""
            else "WHERE "^(String.concat " AND " const_lst)
        in
        (**Return the final string*)
        "NOT EXISTS ( SELECT * "^from_sql^" "^where_sql^" )"
    in
    List.map gen_neg_sql neg_rt

(** Calculates the relations that must be in the where clause. 
 * @param idb       Symtable of the IDB
 * @param vt        Vartab with the name of the variables
 * @param cnt       Colnamtab with the name of relation's columns 
 * @param eqtab     Eqtab with the variables that appear as equalities
 * @param ineq      List of inequalities in the form (operator,varname,value)
 * @param neg_rt    List of negated rterms.
 * @return WHERE clause including necessary tabs, 
 * if there is not any returns an empty string*)
let get_where_clause (idb:symtable) (vt:vartab) (cnt:colnamtab) (eqt:eqtab) ineq neg_rt = 
    (*Transform a list of column names in eq relations [a,b,c] -> ['a=b';'a=c']*)
    let var_const _ cols acc = match cols with
        | [] -> acc
        | hd::tl ->
            let eq_rels el = hd^" = "^el in
            (List.map eq_rels tl)::acc
    in
    let fvt = List.flatten (Hashtbl.fold var_const vt []) in
    (*Transform the equalities in the eqtab to strings of the form
     * "CName = value" *)
    let eq_const vname value acc =
        if Hashtbl.mem vt vname then
            let cname = List.hd (Hashtbl.find vt vname) in
            (cname^" = "^(string_of_const value))::acc
        else acc
        in
    let feqt = Hashtbl.fold eq_const eqt [] in
    (*Transform the inequalities in the list for strings of the form
     * "CName op value" *)
    let ineq_const (op,var,value) acc =
        let vname = string_of_var var in
        let cname = List.hd (Hashtbl.find vt vname) in
        (cname^" "^op^" "^(string_of_const value))::acc in
    let fineq = List.fold_right ineq_const ineq [] in
    (*Transform the negated rterms into SQL*)
    let fnrt = sql_of_negated_rterms idb vt cnt eqt neg_rt in
    (*merge all constraints*)
    let constraints = fvt@feqt@fineq@fnrt in
    match constraints with
        | [] -> ""
        | _ -> "WHERE "^(String.concat " AND " constraints)

(** Generates the SQL that correspond to aggregation in a rule,
 * this corresponds to GROUP BY and HAVING clauses.
 * The GROUP BY clause will be comprised of the columns in the
 * resulting table that are not aggregates (obviously), nor constants.
 * 
 * If the predicate's head do not contain aggregation functions, nothing is
 * returned. If this condition is met but aggregate functions appear on the
 * rule's body, an error is raised.
 * 
 * PRECONDITION: it is assumed that NumberedVars in the rule's head correspond
 * to constants.
 * *)
let get_aggregation_sql (cnt:colnamtab) rule =
    let head = rule_head rule in
    let vars = get_rterm_varlist head in
    (*Check if the rule has aggregation*)
    let is_agg = List.exists is_aggvar vars in
    if not is_agg then "" else
    let key = symtkey_of_rule rule in
    let cols = Hashtbl.find cnt key in
    (*Calculate the GROUP BY clause*)
    let group_var acc col = function
        | NamedVar _ -> col::acc
        | _ -> acc in
    let grp_cols = List.fold_left2 group_var [] cols vars in
    let group_by_sql =
        if grp_cols = [] then ""
        else ("GROUP BY "^(String.concat ", " grp_cols)) in
    group_by_sql

(** Takes a list of terms and splits them in positive rterms,
 * negative terms, equalities, and inequalities*)
let split_terms terms =
    let rec split t (pos,neg,eq,inq) = match t with
        | Rel rt -> (rt::pos,neg,eq,inq)
        | Not rt -> (pos,rt::neg,eq,inq)
        | Equal (x,y) -> (pos,neg,(x,y)::eq,inq) 
        | Ineq (op,x,y) -> (pos,neg,eq,(op,x,y)::inq) in
    List.fold_right split terms ([],[],[],[])

(** 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 (p_rt,n_rt,equalities,ineq) = split_terms body in
    (*Build vartab, and eqtab for select and where clauses*)
    let vt = build_vartab cnt p_rt in
    let eqt = build_eqtab equalities in
    let select_sql = get_select_clause vt eqt head in
    let from_sql = get_from_clause idb p_rt in
    let where_sql = get_where_clause idb vt cnt eqt ineq n_rt in
    let agg_sql = get_aggregation_sql cnt rule in
    String.concat " " [select_sql;from_sql;where_sql;agg_sql]

(**Takes a list of similar rules (same head) and generates the SQL statement
 * that calculates the union of them**)
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

(** 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
    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 RECURSIVE "^(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.
 * The boolean variable debug indicates whether debugging information
 * should be printed*)
let sql_stt (debug:bool) (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
    (*Return the desired SQL*)
    let sql = sql_of_strat idb cnt strat query_rt in
    sql^";"
;;
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.