syntax.ml

   1 (* SQL syntax and RA *)
   2
   3 open Stmt
   4 open Operators
   5 open ListMore
   6 open Apply
   7 open Sql
   8
   9 type expr = [ `Value of Type.t (** literal value *)
  10             | `Param of param
  11             | `Func of Type.t * expr list (** return type, 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 * expr_q list (** return type, 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,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 (*
  65         print_endline (Show.show<expr_q list>(l));
  66         print_endline (Show.show<Type.t option>(t));
  67 *)
  68         let assign = function
  69         | `Param (n,Type.Any) -> `Param (n,t)
  70         | x -> x
  71         in
  72         let ret = if Type.Any <> ret then ret else t in
  73         `Func (ret,(List.map assign l)),ret
  74     | `Param (_,t) -> e, t
  75   in
  76   typeof expr
  77
  78 let show_e e = Show.show<expr_q> (e) >> print_endline
  79
  80 let resolve_types tables joined_schema expr =
  81   expr
  82   >> resolve_columns tables joined_schema
  83 (*   >> tee show_e  *)
  84   >> assign_types
  85
  86 let infer_schema columns tables joined_schema =
  87 (*   let all = tables >> List.map snd >> List.flatten in *)
  88   let schema name = name >> Tables.get_from tables >> snd in
  89   let resolve1 = function
  90     | All -> joined_schema
  91     | AllOf t -> schema t
  92     | Expr (e,name) ->
  93       let col = begin
  94       match e with
  95       | `Column (name,Some t) -> RA.Schema.find (schema t) name
  96       | `Column (name,None) -> RA.Schema.find joined_schema name
  97       | _ -> RA.attr "" (resolve_types tables joined_schema e >> snd)
  98       end in
  99       let col = Option.map_default (fun n -> {col with RA.name = n}) col name in
 100       [ col ]
 101   in
 102   collect resolve1 columns
 103
 104 let get_params e =
 105   let rec loop acc e =
 106     match e with
 107     | `Param p -> p::acc
 108     | `Func (_,l) -> List.fold_left loop acc l
 109     | `Value _ -> acc
 110   in
 111   loop [] e >> List.rev
 112
 113 let get_params tables joined_schema e =
 114   e >> resolve_types tables joined_schema >> fst >> get_params
 115
 116 (*
 117 let _ =
 118   let e = Sub [Value Type.Text; Param (Next,None); Sub []; Param (Named "ds", Some Type.Int);] in
 119   e >> get_params >> to_string >> print_endline
 120 *)
 121
 122 let params_of_column tables j_s = function
 123   | All | AllOf _ -> []
 124   | Expr (e,_) -> get_params tables j_s e
 125
 126 let params_of_columns tables j_s = collect (params_of_column tables j_s)
 127
 128 let get_params_opt tables j_s = function
 129   | Some x -> get_params tables j_s x
 130   | None -> []
 131
 132 let get_params_l tables j_s l = collect (get_params tables j_s) l
 133
 134 let do_join (tables,params,schema) ((table1,params1),kind) =
 135   let (_,schema1) = table1 in
 136   let tables = tables @ [table1] in
 137   let schema = match kind with
 138   | `Cross
 139   | `Search _
 140   | `Default -> RA.Schema.cross schema schema1
 141   | `Natural -> RA.Schema.natural schema schema1
 142   | `Using l -> RA.Schema.join_using l schema schema1
 143   in
 144   let p = match kind with
 145   | `Cross | `Default | `Natural | `Using _ -> []
 146   | `Search e -> get_params tables schema e
 147   in
 148   tables,params @ params1 @ p , schema
 149
 150 let join ((t0,p0),joins) =
 151   let (tables,params,joined_schema) = List.fold_left do_join ([t0],p0,snd t0) joins in
 152 (*   let joined_schema = tables >> List.map snd >> List.flatten in *)
 153   (tables,params,joined_schema)
 154
 155 let split_column_assignments schema l =
 156   let cols = ref [] in
 157   let exprs = ref [] in
 158   List.iter (fun (col,expr) ->
 159     cols := col :: !cols;
 160     (* hint expression to unify with the column type *)
 161     let typ = (RA.Schema.find schema col).RA.domain in
 162     exprs := (`Func (Type.Any, [`Value typ;expr])) :: !exprs) l;
 163   (List.rev !cols,List.rev !exprs)
 164
 165 let params_of_assigns t ss =
 166   let (_,exprs) = split_column_assignments (snd t) ss in
 167   get_params_l [t] (snd t) exprs
 168