syntax.ml

   1 (* SQL syntax and RA *)
   2
   3 open Stmt
   4 open Operators
   5 open ListMore
   6 open Apply
   7
   8 type expr = [ `Value of Sql.Type.t (** literal value *)
   9             | `Param of param
  10             | `Func of Sql.Type.t option * expr list (** return type, parameters *)
  11             | `Column of string * string option (** name, table *)
  12             ]
  13             deriving (Show)
  14
  15 type expr_q = [ `Value of Sql.Type.t (** literal value *)
  16             | `Param of param
  17             | `Func of Sql.Type.t option * expr_q list (** return type, parameters *)
  18             ]
  19             deriving (Show)
  20
  21 let expr_to_string = Show.show<expr>
  22
  23 type column =
  24   | All
  25   | AllOf of string
  26   | Expr of expr * string option (** name *)
  27   deriving (Show)
  28
  29 type columns = column list deriving (Show)
  30
  31 let collect f l = List.flatten (List.map f l)
  32
  33 let scheme_as_params = List.map (fun attr -> Named attr.RA.name, Some attr.RA.domain)
  34
  35 (** replace every Column with Value of corresponding type *)
  36 let resolve_columns tables joined_scheme expr =
  37   let scheme 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,x) ->
  42       let attr = RA.Scheme.find (Option.map_default scheme joined_scheme x) 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, Some t
  54     | `Func (ret,l) ->
  55 (** Assumption: sql functions/operators have type scheme '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_valid t with
  59         | [] -> None
  60         | h::t -> if List.for_all ((=) h) t then Some h else None
  61         in
  62 (*
  63         print_endline (Show.show<expr_q list>(l));
  64         print_endline (Show.show<Sql.Type.t option>(t));
  65 *)
  66         let assign = function
  67         | `Param (n,None) -> `Param (n,t)
  68         | x -> x
  69         in
  70         let ret = if Option.is_some ret then ret else t in
  71         `Func (ret,(List.map assign l)),ret
  72     | `Param (_,t) -> e, t
  73   in
  74   typeof expr
  75
  76 let show_e e = Show.show<expr_q> (e) >> print_endline
  77
  78 let resolve_types tables joined_scheme expr =
  79   expr
  80   >> resolve_columns tables joined_scheme
  81 (*   >> tee show_e  *)
  82   >> assign_types
  83
  84 let infer_scheme columns tables joined_scheme =
  85 (*   let all = tables >> List.map snd >> List.flatten in *)
  86   let scheme name = name >> Tables.get_from tables >> snd in
  87   let resolve1 = function
  88     | All -> joined_scheme
  89     | AllOf t -> scheme t
  90     | Expr (e,name) ->
  91       let col = begin
  92       match e with
  93       | `Column (name,Some t) -> RA.Scheme.find (scheme t) name
  94       | `Column (name,None) -> RA.Scheme.find joined_scheme name
  95       | _ -> RA.attr "" (Option.default Sql.Type.Text (resolve_types tables joined_scheme 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_scheme e =
 112   e >> resolve_types tables joined_scheme >> fst >> get_params
 113
 114 (*
 115 let _ =
 116   let e = Sub [Value Sql.Type.Text; Param (Next,None); Sub []; Param (Named "ds", Some Sql.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,scheme) ((table1,params1),kind) =
 133   let (_,scheme1) = table1 in
 134   let tables = tables @ [table1] in
 135   let scheme = match kind with
 136   | `Cross
 137   | `Search _
 138   | `Default -> RA.Scheme.cross scheme scheme1
 139   | `Natural -> RA.Scheme.natural scheme scheme1
 140   | `Using l -> RA.Scheme.join_using l scheme scheme1
 141   in
 142   let p = match kind with
 143   | `Cross | `Default | `Natural | `Using _ -> []
 144   | `Search e -> get_params tables scheme e
 145   in
 146   tables,params @ params1 @ p , scheme
 147
 148 let join ((t0,p0),joins) =
 149   let (tables,params,joined_scheme) = List.fold_left do_join ([t0],p0,snd t0) joins in
 150 (*   let joined_scheme = tables >> List.map snd >> List.flatten in *)
 151   (tables,params,joined_scheme)
 152