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 expr =
  37   let all = tables >> List.map snd >> List.flatten in
  38   let scheme name = name >> Tables.get_from tables >> snd in
  39   let rec each e =
  40     match e with
  41     | `Value x -> `Value x
  42     | `Column (name,x) ->
  43       let attr = RA.Scheme.find (Option.map_default scheme all x) name in
  44       `Value attr.RA.domain
  45     | `Param x -> `Param x
  46     | `Func (r,l) -> `Func (r,(List.map each l))
  47   in
  48   each expr
  49
  50 (** assign types to parameters where possible *)
  51 let assign_types expr =
  52   let rec typeof e = (* FIXME simplify *)
  53     match e with
  54     | `Value t -> e, Some t
  55     | `Func (ret,l) ->
  56 (** Assumption: sql functions/operators have type scheme 'a -> 'a -> 'b
  57     i.e. all parameters of some equal type *)
  58         let (l,t) = l >> List.map typeof >> List.split in
  59         let t = match List.filter_valid t with
  60         | [] -> None
  61         | h::t -> if List.for_all ((=) h) t then Some h else None
  62         in
  63 (*
  64         print_endline (Show.show<expr_q list>(l));
  65         print_endline (Show.show<Sql.Type.t option>(t));
  66 *)
  67         let assign = function
  68         | `Param (n,None) -> `Param (n,t)
  69         | x -> x
  70         in
  71         let ret = if Option.is_some ret then ret else t in
  72         `Func (ret,(List.map assign l)),ret
  73     | `Param (_,t) -> e, t
  74   in
  75   typeof expr
  76
  77 let show_e e = Show.show<expr_q> (e) >> print_endline
  78
  79 let resolve_types tables expr =
  80   expr
  81   >> resolve_columns tables
  82 (*   >> tee show_e  *)
  83   >> assign_types
  84
  85 let infer_scheme columns tables joined_scheme =
  86   let all = tables >> List.map snd >> List.flatten in
  87   let scheme name = name >> Tables.get_from tables >> snd in
  88   let resolve1 = function
  89     | All -> joined_scheme
  90     | AllOf t -> scheme t
  91     | Expr (e,name) ->
  92       let col = begin
  93       match e with
  94       | `Column (name,Some t) -> RA.Scheme.find (scheme t) name
  95       | `Column (name,None) -> RA.Scheme.find all name (* FIXME `all` or `joined_scheme` ? *)
  96       | _ -> RA.attr "" (Option.default Sql.Type.Text (resolve_types tables e >> snd))
  97       end in
  98       let col = Option.map_default (fun n -> {col with RA.name = n}) col name in
  99       [ col ]
 100   in
 101   collect resolve1 columns
 102
 103 let get_params e =
 104   let rec loop acc e =
 105     match e with
 106     | `Param p -> p::acc
 107     | `Func (_,l) -> List.fold_left loop acc l
 108     | `Value _ -> acc
 109   in
 110   loop [] e >> List.rev
 111
 112 let get_params tables e =
 113   e >> resolve_types tables >> fst >> get_params
 114
 115 (*
 116 let _ =
 117   let e = Sub [Value Sql.Type.Text; Param (Next,None); Sub []; Param (Named "ds", Some Sql.Type.Int);] in
 118   e >> get_params >> to_string >> print_endline
 119 *)
 120
 121 let params_of_column tables = function
 122   | All | AllOf _ -> []
 123   | Expr (e,_) -> get_params tables e
 124
 125 let params_of_columns tables = collect (params_of_column tables)
 126
 127 let get_params_opt tables = function
 128   | Some x -> get_params tables x
 129   | None -> []
 130
 131 let get_params_l tables l = collect (get_params tables) l
 132
 133 (* FIXME order of columns *)
 134 let do_join (tables,params,scheme) ((table1,params1),kind) =
 135   let (_,scheme1) = table1 in
 136   let tables = tables @ [table1] in
 137   let p = ref [] in
 138   let scheme = match kind with
 139   | `Cross
 140   | `Default -> RA.Scheme.cross scheme scheme1
 141   | `Natural -> RA.Scheme.natural scheme scheme1
 142   | `Using l -> RA.Scheme.cross scheme scheme1
 143   | `Search e -> begin p := get_params tables e; RA.Scheme.cross scheme scheme1 end
 144   in
 145   tables,params @ params1 @ !p,scheme
 146
 147 let join ((t0,p0),joins) =
 148   let (tables,params,joined_scheme) = List.fold_left do_join ([t0],p0,snd t0) joins in
 149 (*   let joined_scheme = tables >> List.map snd >> List.flatten in *)
 150   (tables,params,joined_scheme)
 151