src/syntax.ml

   1 (** SQL syntax and RA *)
   2
   3 open Stmt
   4 open Prelude
   5 open ListMore
   6 open Sql
   7 open Printf
   8
   9 type expr = [ `Value of Type.t (** literal value *)
  10             | `Param of param
  11             | `Func of (Type.t * bool) * expr list (** return type, grouping, parameters *)
  12             | `Column of string * string option (** name, table *)
  13             ]
  14             deriving (Show)
  15
  16 type expr_q = [ `Value of Type.t (** literal value *)
  17             | `Param of param
  18             | `Func of (Type.t * bool) * expr_q list (** return type, grouping, parameters *)
  19             ]
  20             deriving (Show)
  21
  22 let expr_to_string = Show.show<expr>
  23
  24 type column =
  25   | All
  26   | AllOf of string
  27   | Expr of expr * string option (** name *)
  28   deriving (Show)
  29
  30 type columns = column list deriving (Show)
  31
  32 let collect f l = List.flatten (List.map f l)
  33
  34 (* FIXME *)
  35 let schema_as_params = List.map (fun attr -> (Some attr.RA.name,(0,0)), Some attr.RA.domain)
  36
  37 (** replace every Column with Value of corresponding type *)
  38 let resolve_columns tables joined_schema expr =
  39   let schema_of_table name = name >> Tables.get_from tables >> snd in
  40   let rec each e =
  41     match e with
  42     | `Value x -> `Value x
  43     | `Column (name,table) ->
  44       let attr = RA.Schema.find (Option.map_default schema_of_table joined_schema table) name in
  45       `Value attr.RA.domain
  46     | `Param x -> `Param x
  47     | `Func (r,l) -> `Func (r,(List.map each l))
  48   in
  49   each expr
  50
  51 (** assign types to parameters where possible *)
  52 let assign_types expr =
  53   let rec typeof e = (* FIXME simplify *)
  54     match e with
  55     | `Value t -> e, t
  56     | `Func ((ret,g),l) ->
  57 (** Assumption: sql functions/operators have type schema 'a -> ... -> 'a -> 'a -> 'b
  58     i.e. all parameters of some equal type *)
  59         let (l,t) = l >> List.map typeof >> List.split in
  60         let t = match List.filter ((<>) Type.Any) t with
  61         | [] -> Type.Any
  62         | h::t -> if List.for_all ((=) h) t then h else Type.Any
  63         in
  64         let assign = function
  65         | `Param (n,Type.Any) -> `Param (n,t)
  66         | x -> x
  67         in
  68         let ret = if Type.Any <> ret then ret else t in
  69         `Func ((ret,g),(List.map assign l)),ret
  70     | `Param (_,t) -> e, t
  71   in
  72   typeof expr
  73
  74 let show_e e = Show.show<expr_q> (e) >> print_endline
  75
  76 let resolve_types tables joined_schema expr =
  77   expr
  78   >> resolve_columns tables joined_schema
  79   >> tee (if Config.debug1 () then show_e else ignore)
  80   >> assign_types
  81   >> tee (if Config.debug1 () then print_newline $ show_e $ fst else ignore)
  82
  83 let infer_schema columns tables joined_schema =
  84 (*   let all = tables >> List.map snd >> List.flatten in *)
  85   let schema name = name >> Tables.get_from tables >> snd in
  86   let resolve1 = function
  87     | All -> joined_schema
  88     | AllOf t -> schema t
  89     | Expr (e,name) ->
  90       let col = begin
  91       match e with
  92       | `Column (name,Some t) -> RA.Schema.find (schema t) name
  93       | `Column (name,None) -> RA.Schema.find joined_schema name
  94       | _ -> RA.attr "" (resolve_types tables joined_schema e >> snd)
  95       end in
  96       let col = Option.map_default (fun n -> {col with RA.name = n}) col name in
  97       [ col ]
  98   in
  99   collect resolve1 columns
 100
 101 let test_all_grouping columns =
 102   let test = function
 103   (* grouping function of zero or single parameter *)
 104   | Expr (`Func ((_,true),args),_) when List.length args <= 1 -> true
 105   | _ -> false
 106   in
 107   List.for_all test columns
 108
 109 let test_all_const columns =
 110   let rec is_const = function
 111   | `Func (_,args) -> List.for_all is_const args
 112   | `Column _ -> false
 113   | _ -> true
 114   in
 115   let test = function
 116   | Expr (e,_) -> is_const e
 117   | _ -> false
 118   in
 119   List.for_all test columns
 120
 121 let get_params e =
 122   let rec loop acc e =
 123     match e with
 124     | `Param p -> p::acc
 125     | `Func (_,l) -> List.fold_left loop acc l
 126     | `Value _ -> acc
 127   in
 128   loop [] e >> List.rev
 129
 130 let get_params tables joined_schema e =
 131   e >> resolve_types tables joined_schema >> fst >> get_params
 132
 133 (*
 134 let _ =
 135   let e = Sub [Value Type.Text; Param (Next,None); Sub []; Param (Named "ds", Some Type.Int);] in
 136   e >> get_params >> to_string >> print_endline
 137 *)
 138
 139 let params_of_column tables j_s = function
 140   | All | AllOf _ -> []
 141   | Expr (e,_) -> get_params tables j_s e
 142
 143 let params_of_columns tables j_s = collect (params_of_column tables j_s)
 144
 145 let get_params_opt tables j_s = function
 146   | Some x -> get_params tables j_s x
 147   | None -> []
 148
 149 let get_params_l tables j_s l = collect (get_params tables j_s) l
 150
 151 let do_join (tables,params,schema) ((table1,params1),kind) =
 152   let (_,schema1) = table1 in
 153   let tables = tables @ [table1] in
 154   let schema = match kind with
 155   | `Cross
 156   | `Search _
 157   | `Default -> RA.Schema.cross schema schema1
 158   | `Natural -> RA.Schema.natural schema schema1
 159   | `Using l -> RA.Schema.join_using l schema schema1
 160   in
 161   let p = match kind with
 162   | `Cross | `Default | `Natural | `Using _ -> []
 163   | `Search e -> get_params tables schema e
 164   in
 165   tables,params @ params1 @ p , schema
 166
 167 let join ((t0,p0),joins) =
 168   let (tables,params,joined_schema) = List.fold_left do_join ([t0],p0,snd t0) joins in
 169 (*   let joined_schema = tables >> List.map snd >> List.flatten in *)
 170   (tables,params,joined_schema)
 171
 172 let cross = List.fold_left RA.Schema.cross []
 173
 174 (* all columns from tables, without duplicates *)
 175 (* FIXME check type of duplicates *)
 176 let all_columns = RA.Schema.make_unique $ cross
 177 let all_tbl_columns = all_columns $ List.map snd
 178
 179 let split_column_assignments tables l =
 180   let cols = ref [] in
 181   let exprs = ref [] in
 182   let all = all_tbl_columns tables in
 183   List.iter (fun ((cname,tname as col),expr) ->
 184     cols := col :: !cols;
 185     let schema =
 186       match tname with
 187       | Some name -> Tables.get_from tables name >> snd
 188       | None -> all
 189     in
 190     (* hint expression to unify with the column type *)
 191     let typ = (RA.Schema.find schema cname).RA.domain in
 192     exprs := (`Func ((Type.Any,false), [`Value typ;expr])) :: !exprs) l;
 193   (List.rev !cols, List.rev !exprs)
 194
 195 let params_of_assigns tables ss =
 196   let (_,exprs) = split_column_assignments tables ss in
 197   get_params_l tables (cross (List.map snd tables)) exprs
 198
 199 let params_of_order o final_schema tables =
 200   get_params_l tables (final_schema :: (List.map snd tables) >> all_columns) o
 201