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
   8             | `Param of param
   9             | `Sub of expr list
  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 get_scheme columns tables =
  27   let all = tables >> List.map snd >> List.flatten in
  28   let scheme name = name >> Tables.get_from tables >> snd in
  29   let resolve1 = function
  30     | All -> all
  31     | AllOf t -> scheme t
  32     | Expr (e,name) ->
  33       let col = begin
  34       match e with
  35       | `Column (name,Some t) -> RA.Scheme.find (scheme t) name
  36       | `Column (name,None) -> RA.Scheme.find all name
  37       | _ -> RA.attr "" Sql.Type.Text (* some expression *)
  38       end in
  39       let col = Option.map_default (fun n -> {col with RA.name = n}) col name in
  40       [ col ]
  41   in
  42   collect resolve1 columns
  43
  44 let scheme_as_params = List.map (fun attr -> Named attr.RA.name, Some attr.RA.domain)
  45
  46 (** replace every Column with Value of corresponding type *)
  47 let rebuild tables expr =
  48   let all = tables >> List.map snd >> List.flatten in
  49   let scheme name = name >> Tables.get_from tables >> snd in
  50   let rec each e =
  51     match e with
  52     | `Value x -> `Value x
  53     | `Column (name,x) ->
  54       let attr = RA.Scheme.find (Option.map_default scheme all x) name in
  55       `Value attr.RA.domain
  56     | `Param x -> `Param x
  57     | `Sub l -> `Sub (List.map each l)
  58   in
  59   each expr
  60
  61 (** assign types to parameters where possible *)
  62 let assign_types expr =
  63   let rec typeof e =
  64     match e with
  65     | `Value t -> e, Some t
  66     | `Sub l ->
  67         let t = match l >> List.map typeof >> List.map snd >> List.filter_valid with
  68         | [] -> None
  69         | h::t -> if List.for_all ((=) h) t then Some h else None
  70         in
  71         let assign = function
  72         | `Param (n,None) -> `Param (n,t)
  73         | x -> x
  74         in
  75         `Sub (List.map assign l), t
  76     | `Param (_,t) -> e, t
  77   in
  78   typeof expr >> fst
  79
  80 let get_params e =
  81   let rec loop acc e =
  82     match e with
  83     | `Param p -> p::acc
  84     | `Sub l -> List.fold_left loop acc l
  85     | `Column _ | `Value _ -> acc
  86   in
  87   loop [] e >> List.rev
  88
  89 let get_params tables e =
  90   get_params (assign_types (rebuild tables e))
  91 (*   e >> rebuild tables >> assign_types >> get_params *)
  92
  93 (*
  94 let _ =
  95   let e = Sub [Value Sql.Type.Text; Param (Next,None); Sub []; Param (Named "ds", Some Sql.Type.Int);] in
  96   e >> get_params >> to_string >> print_endline
  97 *)
  98
  99 let params_of_column tables = function
 100   | All | AllOf _ -> []
 101   | Expr (e,_) -> get_params tables e
 102
 103 let params_of_columns tables = collect (params_of_column tables)
 104
 105 let get_params_opt tables = function
 106   | Some x -> get_params tables x
 107   | None -> []
 108
 109 let get_params_l tables l = collect (get_params tables) l
 110