src/syntax.ml

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