syntax.ml

   1 (* SQL syntax and RA *)
   2
   3 open Stmt
   4 open Operators
   5 open ListMore
   6
   7 type expr = [ `Value of Sql.Type.t (** literal value *)
   8             | `Param of param
   9             | `Func of Sql.Type.t option * expr list (** return type, parameters *)
  10             | `Column of string * string option (** name, table *)
  11             ]
  12             deriving (Show)
  13
  14 let expr_to_string = Show.show<expr>
  15
  16 type column =
  17   | All
  18   | AllOf of string
  19   | Expr of expr * string option (** name *)
  20   deriving (Show)
  21
  22 type columns = column list deriving (Show)
  23
  24 let collect f l = List.flatten (List.map f l)
  25
  26 let scheme_as_params = List.map (fun attr -> Named attr.RA.name, Some attr.RA.domain)
  27
  28 (** replace every Column with Value of corresponding type *)
  29 let resolve_columns tables expr =
  30   let all = tables >> List.map snd >> List.flatten in
  31   let scheme name = name >> Tables.get_from tables >> snd in
  32   let rec each e =
  33     match e with
  34     | `Value x -> `Value x
  35     | `Column (name,x) ->
  36       let attr = RA.Scheme.find (Option.map_default scheme all x) name in
  37       `Value attr.RA.domain
  38     | `Param x -> `Param x
  39     | `Func (r,l) -> `Func (r,(List.map each l))
  40   in
  41   each expr
  42
  43 (** assign types to parameters where possible *)
  44 let assign_types expr =
  45   let rec typeof e = (* FIXME simplify *)
  46     match e with
  47     | `Value t -> e, Some t
  48     | `Func (ret,l) ->
  49 (** Assumption: sql functions/operators have type scheme 'a -> 'a -> 'b
  50     i.e. all parameters of some equal type *)
  51         let t = match l >> List.map typeof >> List.map snd >> List.filter_valid with
  52         | [] -> None
  53         | h::t -> if List.for_all ((=) h) t then Some h else None
  54         in
  55         let assign = function
  56         | `Param (n,None) -> `Param (n,t)
  57         | x -> x
  58         in
  59         let ret = if Option.is_some ret then ret else t in
  60         `Func (ret,(List.map assign l)),ret
  61     | `Param (_,t) -> e, t
  62   in
  63   typeof expr
  64
  65 let resolve_types tables expr =
  66   expr >> resolve_columns tables >> assign_types
  67
  68 let get_scheme columns tables =
  69   let all = tables >> List.map snd >> List.flatten in
  70   let scheme name = name >> Tables.get_from tables >> snd in
  71   let resolve1 = function
  72     | All -> all
  73     | AllOf t -> scheme t
  74     | Expr (e,name) ->
  75       let col = begin
  76       match e with
  77       | `Column (name,Some t) -> RA.Scheme.find (scheme t) name
  78       | `Column (name,None) -> RA.Scheme.find all name
  79       | _ -> RA.attr "" (Option.default Sql.Type.Text (resolve_types tables e >> snd))
  80       end in
  81       let col = Option.map_default (fun n -> {col with RA.name = n}) col name in
  82       [ col ]
  83   in
  84   collect resolve1 columns
  85
  86 let get_params e =
  87   let rec loop acc e =
  88     match e with
  89     | `Param p -> p::acc
  90     | `Func (_,l) -> List.fold_left loop acc l
  91     | `Value _ -> acc
  92   in
  93   loop [] e >> List.rev
  94
  95 let get_params tables e =
  96   e >> resolve_types tables >> fst >> get_params
  97
  98 (*
  99 let _ =
 100   let e = Sub [Value Sql.Type.Text; Param (Next,None); Sub []; Param (Named "ds", Some Sql.Type.Int);] in
 101   e >> get_params >> to_string >> print_endline
 102 *)
 103
 104 let params_of_column tables = function
 105   | All | AllOf _ -> []
 106   | Expr (e,_) -> get_params tables e
 107
 108 let params_of_columns tables = collect (params_of_column tables)
 109
 110 let get_params_opt tables = function
 111   | Some x -> get_params tables x
 112   | None -> []
 113
 114 let get_params_l tables l = collect (get_params tables) l
 115