lib/syntax.ml

   1 (** SQL syntax and RA *)
   2
   3 open Printf
   4 open ExtLib
   5 open Prelude
   6 open Sql
   7
   8 let debug = ref false
   9
  10 type env = {
  11   tables : Tables.table list;
  12   schema : Schema.t;
  13   insert_schema : Schema.t;
  14 }
  15
  16 let empty_env = { tables = []; schema = []; insert_schema = []; }
  17
  18 let flat_map f l = List.flatten (List.map f l)
  19
  20 let schema_of tables name = snd @@ Tables.get_from tables name
  21
  22 let get_or_failwith = function `Error s -> failwith s | `Ok t -> t
  23
  24 let values_or_all table names =
  25   let schema = Tables.get_schema table in
  26   match names with
  27   | Some names -> Schema.project names schema
  28   | None -> schema
  29
  30 let rec get_params_q (e:expr_q) =
  31   let rec loop acc e =
  32     match e with
  33     | `Param p -> Single p::acc
  34     | `Inparam p -> SingleText p::acc
  35     | `Func (_,l) -> List.fold_left loop acc l
  36     | `Value _ -> acc
  37     | `Choice (p,l) -> Choice (p, List.map (fun (n,e) -> Simple (n, Option.map get_params_q e)) l) :: acc
  38   in
  39   loop [] e |> List.rev
  40
  41 let list_same l =
  42   match l with
  43   | [] -> None
  44   | x::xs -> if List.for_all (fun y -> x = y) xs then Some x else None
  45
  46 let rec is_grouping = function
  47 | Value _
  48 | Param _
  49 | Column _
  50 | Select _
  51 | Inparam _
  52 | Inserted _ -> false
  53 | Choices (p,l) ->
  54   begin match list_same @@ List.map (fun (_,expr) -> Option.map_default is_grouping false expr) l with
  55   | None -> failed ~at:p.pos "inconsistent grouping in choice branches"
  56   | Some v -> v
  57   end
  58 | Fun (func,args) ->
  59   (* grouping function of zero or single parameter or function on grouping result *)
  60   (Type.is_grouping func && List.length args <= 1) || List.exists is_grouping args
  61
  62 let exists_grouping columns =
  63   List.exists (function Expr (e,_) -> is_grouping e | All | AllOf _ -> false) columns
  64
  65 let cross = List.fold_left Schema.cross []
  66
  67 (* all columns from tables, without duplicates *)
  68 (* FIXME check type of duplicates *)
  69 let all_columns = Schema.make_unique $ cross
  70 let all_tbl_columns = all_columns $ List.map snd
  71
  72 let resolve_column tables schema {cname;tname} =
  73   Schema.find (Option.map_default (schema_of tables) schema tname) cname
  74
  75 (* HACK hint expression to unify with the column type *)
  76 let rec hint attr expr =
  77   (* associate parameter with column *)
  78   let expr = match expr with Param p -> Param { p with attr = Some attr } | e -> e in
  79   (* go one level deep into choices *)
  80   match expr with
  81   | Choices (n,l) -> Choices (n, List.map (fun (n,e) -> n, Option.map (hint attr) e) l)
  82   | _ -> Fun (F (Var 0, [Var 0; Var 0]), [Value attr.domain;expr])
  83
  84 let resolve_column_assignments tables l =
  85   let all = all_tbl_columns tables in
  86   l |> List.map begin fun (col,expr) ->
  87     let attr = resolve_column tables all col in
  88     hint attr expr
  89   end
  90
  91 let get_columns_schema tables l =
  92   let all = all_tbl_columns tables in
  93   (* FIXME col_name *)
  94   l |> List.map (fun col -> { (resolve_column tables all col) with name = col.cname })
  95
  96 (** replace each name reference (Column, Inserted, etc) with Value of corresponding type *)
  97 let rec resolve_columns env expr =
  98   if !debug then
  99   begin
 100     eprintf "\nRESOLVE COLUMNS %s\n%!" (expr_to_string expr);
 101     eprintf "schema: "; Sql.Schema.print env.schema;
 102     Tables.print stderr env.tables;
 103   end;
 104   let rec each e =
 105     match e with
 106     | Value x -> `Value x
 107     | Column col -> `Value (resolve_column env.tables env.schema col).domain
 108     | Inserted name ->
 109       let attr = try Schema.find env.insert_schema name with Schema.Error (_,s) -> fail "for inserted values : %s" s in
 110       `Value attr.domain
 111     | Param x -> `Param x
 112     | Inparam x -> `Inparam x
 113     | Choices (n,l) -> `Choice (n, List.map (fun (n,e) -> n, Option.map each e) l)
 114     | Fun (r,l) ->
 115       `Func (r,List.map each l)
 116     | Select (select, usage) ->
 117       let as_params p =
 118         List.map
 119           (function
 120             | Single p -> `Param p
 121             | SingleText p -> failed ~at:p.id.pos "FIXME as_params in SingleText"
 122             | Choice (p,_) -> failed ~at:p.pos "FIXME as_params in Choice")
 123           p in
 124       let (schema,p,_) = eval_select_full env select in
 125       match schema, usage with
 126       | [ {domain;_} ], `AsValue -> `Func (Type.Ret domain, as_params p)
 127       | s, `AsValue -> raise (Schema.Error (s, "only one column allowed for SELECT operator in this expression"))
 128       | _, `Exists -> `Func (Type.Ret Any, as_params p)
 129   in
 130   each expr
 131
 132 (** assign types to parameters where possible *)
 133 and assign_types expr =
 134   let option_split = function None -> None, None | Some (x,y) -> Some x, Some y in
 135   let rec typeof (e:expr_q) = (* FIXME simplify *)
 136     match e with
 137     | `Value t -> e, `Ok t
 138     | `Param p -> e, `Ok p.typ
 139     | `Inparam p -> e, `Ok p.typ
 140     | `Choice (n,l) ->
 141       let (e,t) = List.split @@ List.map (fun (_,e) -> option_split @@ Option.map typeof e) l in
 142       let t =
 143         match List.map get_or_failwith @@ List.filter_map identity t with
 144         | [] -> assert false
 145         | t::ts -> List.fold_left (fun acc t -> match acc with None -> None | Some prev -> Type.common_subtype prev t) (Some t) ts
 146       in
 147       let t = match t with None -> `Error "no common subtype for all choice branches" | Some t -> `Ok t in
 148       `Choice (n, List.map2 (fun (n,_) e -> n,e) l e), t
 149     | `Func (func,params) ->
 150         let open Type in
 151         let (params,types) = params |> List.map typeof |> List.split in
 152         let types = List.map get_or_failwith types in
 153         let show () =
 154           sprintf "%s applied to (%s)"
 155             (string_of_func func)
 156             (String.concat ", " @@ List.map to_string types)
 157         in
 158         let func =
 159           match func with
 160           | Multi (ret,each_arg) -> F (ret, List.map (fun _ -> each_arg) types)
 161           | x -> x
 162         in
 163         let (ret,inferred_params) = match func, types with
 164         | Multi _, _ -> assert false (* rewritten into F above *)
 165         | Agg, [typ]
 166         | Group typ, _ -> typ, types
 167         | Agg, _ -> fail "cannot use this grouping function with %d parameters" (List.length types)
 168         | F (_, args), _ when List.length args <> List.length types -> fail "wrong number of arguments : %s" (show ())
 169         | F (ret, args), _ ->
 170           let typevar = Hashtbl.create 10 in
 171           let l = List.map2 begin fun arg typ ->
 172             match arg with
 173             | Typ arg -> common_type arg typ
 174             | Var i ->
 175               let arg =
 176                 match Hashtbl.find typevar i with
 177                 | exception Not_found -> Hashtbl.replace typevar i typ; typ
 178                 | t -> t
 179               in
 180               (* prefer more precise type *)
 181               if arg = Type.Any then Hashtbl.replace typevar i typ;
 182               common_type arg typ
 183           end args types
 184           in
 185           let convert = function Typ t -> t | Var i -> Hashtbl.find typevar i in
 186           if List.fold_left (&&) true l then
 187             convert ret, List.map convert args
 188           else
 189             fail "types do not match : %s" (show ())
 190         | Ret Any, _ -> (* lame *)
 191           begin match List.filter ((<>) Any) types with
 192           | [] -> Any, types
 193           (* make a best guess, return type same as for parameters when all of single type *)
 194           | h::tl when List.for_all (matches h) tl -> h, List.map (fun _ -> h) types
 195           (* "expand" to floats, when all parameters numeric and above rule didn't match *)
 196           | l when List.for_all (function Int | Float -> true | _ -> false) l -> Float, List.map (function Any -> Float | x -> x) types
 197           | _ -> Any, types
 198           end
 199         | Ret ret, _ -> ret, types (* ignoring arguments FIXME *)
 200         in
 201         let assign inferred x =
 202           match x with
 203           | `Param { id; typ = Any; attr; } -> `Param (new_param ?attr id inferred)
 204           | `Inparam { id; typ = Any; attr; } -> `Inparam (new_param ?attr id inferred)
 205           | x -> x
 206         in
 207         `Func (func,(List.map2 assign inferred_params params)), `Ok ret
 208   in
 209   typeof expr
 210
 211 and resolve_types env expr =
 212   let expr = resolve_columns env expr in
 213   try
 214     let (expr',t as r) = assign_types expr in
 215     if !debug then eprintf "resolved types %s : %s\n%!" (show_expr_q expr') (Type.to_string @@ get_or_failwith t);
 216     r
 217   with
 218     exn ->
 219       eprintfn "resolve_types failed with %s at:" (Printexc.to_string exn);
 220       eprintfn "%s" (show_expr_q expr);
 221       raise exn
 222
 223 and infer_schema env columns =
 224 (*   let all = tables |> List.map snd |> List.flatten in *)
 225   let resolve1 = function
 226     | All -> env.schema
 227     | AllOf t -> schema_of env.tables t
 228     | Expr (e,name) ->
 229       let col =
 230         match e with
 231         | Column col -> resolve_column env.tables env.schema col
 232         | _ -> make_attribute "" (resolve_types env e |> snd |> get_or_failwith) Constraints.empty
 233       in
 234       let col = Option.map_default (fun n -> {col with name = n}) col name in
 235       [ col ]
 236   in
 237   flat_map resolve1 columns
 238
 239 and get_params env e = e |> resolve_types env |> fst |> get_params_q
 240
 241 (*
 242 let _ =
 243   let e = Sub [Value Type.Text; Param (Next,None); Sub []; Param (Named "ds", Some Type.Int);] in
 244   e |> get_params |> to_string |> print_endline
 245 *)
 246
 247 and params_of_columns env =
 248   let get = function
 249   | All | AllOf _ -> []
 250   | Expr (e,_) -> get_params env e
 251   in
 252   flat_map get
 253
 254 and get_params_opt env = function
 255   | Some x -> get_params env x
 256   | None -> []
 257
 258 and get_params_l env l = flat_map (get_params env) l
 259
 260 and do_join (env,params) ((schema1,params1,_tables),kind) =
 261   let schema = match kind with
 262   | `Cross
 263   | `Search _
 264   | `Default -> Schema.cross env.schema schema1
 265   | `Natural -> Schema.natural env.schema schema1
 266   | `Using l -> Schema.join_using l env.schema schema1
 267   in
 268   let env = { env with schema } in
 269   let p = match kind with
 270   | `Cross | `Default | `Natural | `Using _ -> []
 271   | `Search e -> get_params env e (* TODO should use final schema (same as tables)? *)
 272   in
 273   env, params @ params1 @ p
 274
 275 and join env ((schema,p0,ts0),joins) =
 276   assert (env.schema = []);
 277   let all_tables = List.flatten (ts0 :: List.map (fun ((_,_,ts),_) -> ts) joins) in
 278   let env = { env with tables = env.tables @ all_tables; schema; } in
 279   List.fold_left do_join (env, p0) joins
 280
 281 and params_of_assigns env ss =
 282   let exprs = resolve_column_assignments env.tables ss in
 283   get_params_l env exprs
 284
 285 and params_of_order order final_schema tables =
 286   let (orders,directions) = List.split order in
 287   let directions = List.filter_map (function None | Some `Fixed -> None | Some (`Param p) -> Some (Choice (p,[Verbatim ("ASC","ASC");Verbatim ("DESC","DESC")]))) directions in
 288   get_params_l { tables; schema=(final_schema :: (List.map snd tables) |> all_columns); insert_schema = []; } orders
 289   @
 290   directions
 291
 292 and ensure_simple_expr = function
 293   | Value x -> `Value x
 294   | Param x -> `Param x
 295   | Inparam x -> `Inparam x
 296   | Choices (p,_) -> failed ~at:p.pos "ensure_simple_expr Choices TBD"
 297   | Column _ | Inserted _ -> failwith "Not a simple expression"
 298   | Fun (func,_) when Type.is_grouping func -> failwith "Grouping function not allowed in simple expression"
 299   | Fun (x,l) -> `Func (x,List.map ensure_simple_expr l) (* FIXME *)
 300   | Select _ -> failwith "not implemented : ensure_simple_expr for SELECT"
 301
 302 and eval_nested env nested =
 303   (* nested selects generate new fresh schema in scope, cannot refer to outer schema,
 304     but can refer to attributes of tables through `tables` *)
 305   let env = { env with schema = [] } in
 306   match nested with
 307   | Some (t,l) -> join env (resolve_source env t, List.map (fun (x,k) -> resolve_source env x, k) l)
 308   | None -> env, []
 309
 310 and eval_select env { columns; from; where; group; having; } =
 311   let (env,p2) = eval_nested env from in
 312   let cardinality =
 313     if from = None then (if where = None then `One else `Zero_one)
 314     else if group = [] && exists_grouping columns then `One
 315     else `Nat
 316   in
 317   let final_schema = infer_schema env columns in
 318   (* use schema without aliases here *)
 319   let p1 = params_of_columns env columns in
 320   let env = Schema.{ env with schema = cross env.schema final_schema |> make_unique } in (* enrich schema in scope with aliases *)
 321   let p3 = get_params_opt env where in
 322   let p4 = get_params_l env group in
 323   let p5 = get_params_opt env having in
 324   (final_schema, p1 @ p2 @ p3 @ p4 @ p5, env.tables, cardinality)
 325
 326 (** @return final schema, params and tables that can be referenced by outside scope *)
 327 and resolve_source env (x,alias) =
 328   match x with
 329   | `Select select ->
 330     let (s,p,_) = eval_select_full env select in
 331     s, p, (match alias with None -> [] | Some name -> [name,s])
 332   | `Nested s ->
 333     let (env,p) = eval_nested env (Some s) in
 334     let s = infer_schema env [All] in
 335     if alias <> None then failwith "No alias allowed on nested tables";
 336     s, p, env.tables
 337   | `Table s ->
 338     let (name,s) = Tables.get s in
 339     s, [], [Option.default name alias, s]
 340
 341 and eval_select_full env { select=(select,other); order; limit; } =
 342   let (s1,p1,tbls,cardinality) = eval_select env select in
 343   let (s2l,p2l) = List.split (List.map (fun (s,p,_,_) -> s,p) @@ List.map (eval_select env) other) in
 344   if false then
 345     eprintf "cardinality=%s other=%u\n%!"
 346             (Stmt.cardinality_to_string cardinality)
 347             (List.length other);
 348   let cardinality = if other = [] then cardinality else `Nat in
 349   (* ignoring tables in compound statements - they cannot be used in ORDER BY *)
 350   let final_schema = List.fold_left Schema.compound s1 s2l in
 351   let p3 = params_of_order order final_schema tbls in
 352   let (p4,limit1) = match limit with Some (p,x) -> List.map (fun p -> Single p) p, x | None -> [],false in
 353   (*                 Schema.check_unique schema; *)
 354   let cardinality =
 355     if limit1 && cardinality = `Nat then `Zero_one
 356                                     else cardinality in
 357   final_schema,(p1@(List.flatten p2l)@p3@p4 : var list), Stmt.Select cardinality
 358
 359
 360 let update_tables sources ss w =
 361   let schema = cross @@ (List.map (fun (s,_,_) -> s) sources) in
 362   let p0 = List.flatten @@ List.map (fun (_,p,_) -> p) sources in
 363   let tables = List.flatten @@ List.map (fun (_,_,ts) -> ts) sources in (* TODO assert equal duplicates if not unique *)
 364   let env = { tables; schema; insert_schema=get_columns_schema tables (List.map fst ss); } in
 365   let p1 = params_of_assigns env ss in
 366   let p2 = get_params_opt env w in
 367   p0 @ p1 @ p2
 368
 369 let annotate_select select types =
 370   let (select1,compound) = select.select in
 371   let rec loop acc cols types =
 372     match cols, types with
 373     | [], [] -> List.rev acc
 374     | (All | AllOf _) :: _, _ -> failwith "Asterisk not supported"
 375     | Expr (e,name) :: cols, t :: types -> loop (Expr (Fun (F (Typ t, [Typ t]), [e]), name) :: acc) cols types
 376     | _, [] | [], _ -> failwith "Select cardinality doesn't match Insert"
 377   in
 378   { select with select = { select1 with columns = loop [] select1.columns types }, compound }
 379
 380 let eval (stmt:Sql.stmt) =
 381   let open Stmt in
 382   match stmt with
 383   | Create (name,`Schema schema) ->
 384       Tables.add (name,schema);
 385       ([],[],Create name)
 386   | Create (name,`Select select) ->
 387       let (schema,params,_) = eval_select_full empty_env select in
 388       Tables.add (name,schema);
 389       ([],params,Create name)
 390   | Alter (name,actions) ->
 391       List.iter (function
 392       | `Add (col,pos) -> Tables.alter_add name col pos
 393       | `Drop col -> Tables.alter_drop name col
 394       | `Change (oldcol,col,pos) -> Tables.alter_change name oldcol col pos
 395       | `RenameColumn (oldcol,newcol) -> Tables.rename_column name oldcol newcol
 396       | `RenameTable new_name -> Tables.rename name new_name
 397       | `RenameIndex _ -> () (* indices are not tracked yet *)
 398       | `None -> ()) actions;
 399       ([],[],Alter [name])
 400   | Rename l ->
 401     List.iter (fun (o,n) -> Tables.rename o n) l;
 402     ([], [], Alter (List.map fst l)) (* to have sensible target for gen_xml *)
 403   | Drop name ->
 404       Tables.drop name;
 405       ([],[],Drop name)
 406   | CreateIndex (name,table,cols) ->
 407       Sql.Schema.project cols (Tables.get_schema table) |> ignore; (* just check *)
 408       [],[],CreateIndex name
 409   | Insert { target=table; action=`Values (names, values); on_duplicate; } ->
 410     let expect = values_or_all table names in
 411     let env = { tables = [Tables.get table]; schema = Tables.get_schema table; insert_schema = expect; } in
 412     let params, inferred = match values with
 413     | None -> [], Some (Values, expect)
 414     | Some values ->
 415       let vl = List.map List.length values in
 416       let cl = List.length expect in
 417       if List.exists (fun n -> n <> cl) vl then
 418         fail "Expecting %u expressions in every VALUES tuple" cl;
 419       let assigns = values |>
 420         List.map begin fun tuple ->
 421           (* pair up columns with inserted values *)
 422           List.combine (List.map (fun a -> {cname=a.name; tname=None}) expect) tuple
 423           (* resolve DEFAULTs *)
 424           |> List.map (function (col,`Expr e) -> col, e | (col,`Default) -> col, Fun (Type.identity, [Column col]))
 425         end
 426       in
 427       params_of_assigns env (List.concat assigns), None
 428     in
 429     let params2 = params_of_assigns env (Option.default [] on_duplicate) in
 430     [], params @ params2, Insert (inferred,table)
 431   | Insert { target=table; action=`Select (names, select); on_duplicate; } ->
 432     let expect = values_or_all table names in
 433     let env = { tables = [Tables.get table]; schema = Tables.get_schema table; insert_schema = expect; } in
 434     let select = annotate_select select (List.map (fun a -> a.domain) expect) in
 435     let (schema,params,_) = eval_select_full env select in
 436     ignore (Schema.compound expect schema); (* test equal types once more (not really needed) *)
 437     let params2 = params_of_assigns env (Option.default [] on_duplicate) in
 438     [], params @ params2, Insert (None,table)
 439   | Insert { target=table; action=`Set ss; on_duplicate; } ->
 440     let expect = values_or_all table (Option.map (List.map (function ({cname; tname=None},_) -> cname | _ -> assert false)) ss) in
 441     let env = { tables = [Tables.get table]; schema = Tables.get_schema table; insert_schema = expect; } in
 442     let (params,inferred) = match ss with
 443     | None -> [], Some (Assign, Tables.get_schema table)
 444     | Some ss -> params_of_assigns env ss, None
 445     in
 446     let params2 = params_of_assigns env (Option.default [] on_duplicate) in
 447     [], params @ params2, Insert (inferred,table)
 448   | Delete (table, where) ->
 449     let t = Tables.get table in
 450     let p = get_params_opt { tables=[t]; schema=snd t; insert_schema=[]; } where in
 451     [], p, Delete table
 452   | Set (_name, e) ->
 453     let p = match e with
 454       | Column _ -> [] (* this is not column but some db-specific identifier *)
 455       | _ -> get_params_q (ensure_simple_expr e)
 456     in
 457     [], p, Other
 458   | Update (table,ss,w,o,lim) ->
 459     let t = Tables.get table in
 460     let params = update_tables [snd t,[],[t]] ss w in
 461     let p3 = params_of_order o [] [t] in
 462     [], params @ p3 @ (List.map (fun p -> Single p) lim), Update (Some table)
 463   | UpdateMulti (tables,ss,w) ->
 464     let sources = List.map (resolve_source empty_env) tables in
 465     let params = update_tables sources ss w in
 466     [], params, Update None
 467   | Select select -> eval_select_full empty_env select
 468   | CreateRoutine (name,_,_) ->
 469     [], [], CreateRoutine name
 470
 471 (* FIXME unify each choice separately *)
 472 let unify_params l =
 473   let h = Hashtbl.create 10 in
 474   let h_choices = Hashtbl.create 10 in
 475   let check_choice_name p =
 476     match p.label with
 477     | None -> () (* unique *)
 478     | Some n when Hashtbl.mem h_choices n -> failed ~at:p.pos "sharing choices not implemented"
 479     | Some n -> Hashtbl.add h_choices n ()
 480   in
 481   let remember name t =
 482     match name with
 483     | None -> () (* anonymous ie non-shared *)
 484     | Some name ->
 485     match Hashtbl.find h name with
 486     | exception _ -> Hashtbl.add h name t
 487     | t' ->
 488     match Sql.Type.common_subtype t t' with
 489     | Some x -> Hashtbl.replace h name x
 490     | None -> fail "incompatible types for parameter %S : %s and %s" name (Type.show t) (Type.show t')
 491   in
 492   let rec traverse = function
 493   | Single { id; typ; attr=_ } -> remember id.label typ
 494   | SingleText { id; typ; _ } -> remember id.label typ
 495   | Choice (p,l) -> check_choice_name p; List.iter (function Simple (_,l) -> Option.may (List.iter traverse) l | Verbatim _ -> ()) l
 496   in
 497   let rec map = function
 498   | Single { id; typ; attr } -> Single (new_param id ?attr (match id.label with None -> typ | Some name -> try Hashtbl.find h name with _ -> assert false))
 499   | SingleText { id; typ; attr } -> SingleText (new_param id ?attr (match id.label with None -> typ | Some name -> try Hashtbl.find h name with _ -> assert false))
 500   | Choice (p, l) -> Choice (p, List.map (function Simple (n,l) -> Simple (n, Option.map (List.map map) l) | Verbatim _ as v -> v) l)
 501   in
 502   List.iter traverse l;
 503   List.map map l
 504
 505 let is_alpha = function
 506 | 'a'..'z' -> true
 507 | 'A'..'Z' -> true
 508 | _ -> false
 509
 510 let common_prefix = function
 511 | [] -> 0
 512 | x::_ as l ->
 513   let rec loop i =
 514     if String.length x <= i then i
 515     else
 516       if List.for_all (fun s -> i < String.length s && s.[i] = x.[i]) l then
 517         loop (i+1)
 518       else
 519         i
 520   in
 521   let i = loop 0 in
 522   (* do not allow empty names or starting not with alpha *)
 523   if List.exists (fun s -> i = String.length s || not (is_alpha s.[i])) l then 0 else i
 524
 525 (* fill inferred sql for VALUES or SET *)
 526 let complete_sql kind sql =
 527   match kind with
 528   | Stmt.Insert (Some (kind,schema), _) ->
 529     let (pre,each,post) = match kind with
 530     | Values -> "(", (fun _ -> ""), ")"
 531     | Assign -> "", (fun name -> name ^" = "), ""
 532     in
 533     let module B = Buffer in
 534     let b = B.create 100 in
 535     B.add_string b sql;
 536     B.add_string b " ";
 537     B.add_string b pre;
 538     let params = ref [] in
 539     let first = common_prefix @@ List.map (fun attr -> attr.Sql.name) schema in
 540     schema |> List.iter (fun attr ->
 541       if !params <> [] then B.add_string b ",";
 542       let attr_ref_prefix = each attr.Sql.name in
 543       let attr_name = String.slice ~first attr.Sql.name in
 544       let attr_ref = "@" ^ attr_name in
 545       let pos_start = B.length b + String.length attr_ref_prefix in
 546       let pos_end = pos_start + String.length attr_ref in
 547       let param = Single (new_param ~attr {label=Some attr_name; pos=(pos_start,pos_end)} attr.domain) in
 548       B.add_string b attr_ref_prefix;
 549       B.add_string b attr_ref;
 550       tuck params param;
 551     );
 552     B.add_string b post;
 553     (B.contents b, List.rev !params)
 554   | _ -> (sql,[])
 555
 556 let parse sql =
 557   let (schema,p1,kind) = eval @@ Parser.parse_stmt sql in
 558   let (sql,p2) = complete_sql kind sql in
 559   (sql, schema, unify_params (p1 @ p2), kind)