src/syntax.ml

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