1 (** SQL syntax and RA *)
11 tables
: Tables.table list
;
13 insert_schema
: Schema.t
;
16 (* expr with all name references resolved to values or "functions" *)
18 | ResValue
of Type.t
(** literal value *)
21 | ResChoices
of param_id
* res_expr choices
22 | ResInChoice
of param_id
* [`In
| `NotIn
] * res_expr
23 | ResFun
of Type.func
* res_expr list
(** function kind (return type and flavor), arguments *)
26 let empty_env = { tables
= []; schema
= []; insert_schema
= []; }
28 let flat_map f l
= List.flatten
(List.map f l
)
30 let schema_of tables name
= snd
@@ Tables.get_from tables name
32 let get_or_failwith = function `Error s
-> failwith s
| `Ok t
-> t
34 let values_or_all table names
=
35 let schema = Tables.get_schema table
in
37 | Some names
-> Schema.project names
schema
40 let rec get_params_of_res_expr (e
:res_expr
) =
43 | ResParam p
-> Single p
::acc
44 | ResInparam p
-> SingleIn p
::acc
45 | ResFun
(_
,l
) -> List.fold_left
loop acc l
47 | ResInChoice
(param
, kind
, e
) -> ChoiceIn
{ param
; kind
; vars
= get_params_of_res_expr e
} :: acc
48 | ResChoices
(p
,l
) -> Choice
(p
, List.map
(fun (n
,e
) -> Simple
(n
, Option.map
get_params_of_res_expr e
)) l
) :: acc
55 | x
::xs
-> if List.for_all
(fun y
-> x
= y
) xs
then Some x
else None
57 let rec is_grouping = function
65 begin match list_same @@ List.map
(fun (_
,expr
) -> Option.map_default
is_grouping false expr
) l
with
66 | None
-> failed ~at
:p
.pos
"inconsistent grouping in choice branches"
69 | InChoice
(_
, _
, e
) -> is_grouping e
71 (* grouping function of zero or single parameter or function on grouping result *)
72 (Type.is_grouping func
&& List.length args
<= 1) || List.exists
is_grouping args
74 let exists_grouping columns
=
75 List.exists
(function Expr
(e
,_
) -> is_grouping e
| All
| AllOf _
-> false) columns
77 let cross = List.fold_left
Schema.cross []
79 (* all columns from tables, without duplicates *)
80 (* FIXME check type of duplicates *)
81 let all_columns = Schema.make_unique $
cross
82 let all_tbl_columns = all_columns $
List.map snd
84 let resolve_column tables
schema {cname
;tname
} =
85 Schema.find
(Option.map_default
(schema_of tables
) schema tname
) cname
87 (* HACK hint expression to unify with the column type *)
88 let rec hint attr expr
=
89 (* associate parameter with column *)
90 let expr = match expr with Param p
-> Param
{ p
with attr
= Some attr
} | e
-> e
in
91 (* go one level deep into choices *)
93 | Choices
(n
,l
) -> Choices
(n
, List.map
(fun (n
,e
) -> n
, Option.map
(hint attr
) e
) l
)
94 | _
-> Fun
(F
(Var
0, [Var
0; Var
0]), [Value attr
.domain
;expr])
96 let resolve_column_assignments tables l
=
97 let all = all_tbl_columns tables
in
98 l
|> List.map
begin fun (col
,expr) ->
99 let attr = resolve_column tables
all col
in
103 let get_columns_schema tables l
=
104 let all = all_tbl_columns tables
in
106 l
|> List.map
(fun col
-> { (resolve_column tables
all col
) with name
= col
.cname
})
110 Sql.Schema.print env
.schema;
111 Tables.print stderr env
.tables
113 (** resolve each name reference (Column, Inserted, etc) into ResValue or ResFun of corresponding type *)
114 let rec resolve_columns env
expr =
117 eprintf
"\nRESOLVE COLUMNS %s\n%!" (expr_to_string
expr);
118 eprintf
"schema: "; Sql.Schema.print env
.schema;
119 Tables.print stderr env
.tables
;
123 | Value x
-> ResValue x
124 | Column col
-> ResValue
(resolve_column env
.tables env
.schema col
).domain
126 let attr = try Schema.find env
.insert_schema name
with Schema.Error
(_
,s
) -> fail
"for inserted values : %s" s
in
128 | Param x
-> ResParam x
129 | Inparam x
-> ResInparam x
130 | InChoice
(n
, k
, x
) -> ResInChoice
(n
, k
, each x
)
131 | Choices
(n
,l
) -> ResChoices
(n
, List.map
(fun (n
,e
) -> n
, Option.map
each e
) l
)
133 ResFun
(r
,List.map
each l
)
134 | SelectExpr
(select
, usage
) ->
135 let rec params_of_var = function
136 | Single p
-> [ResParam p
]
137 | SingleIn p
-> [ResParam p
]
138 | ChoiceIn
{ vars
; _
} -> as_params vars
139 | Choice
(_
,l
) -> l
|> flat_map (function Simple
(_
, vars
) -> Option.map_default as_params
[] vars
| Verbatim _
-> [])
140 | TupleList
(p
, _
) -> failed ~at
:p
.pos
"FIXME TupleList in SELECT subquery"
141 and as_params p
= flat_map params_of_var p
in
142 let (schema,p
,_
) = eval_select_full env select
in
143 (* represet nested selects as functions with sql parameters as function arguments, some hack *)
144 match schema, usage
with
145 | [ {domain
;_
} ], `AsValue
->
146 ResFun
(Type.Ret domain
, as_params p
)
147 | s
, `AsValue
-> raise
(Schema.Error
(s
, "only one column allowed for SELECT operator in this expression"))
148 | _
, `Exists
-> ResFun
(Type.Ret Any
, as_params p
)
152 (** assign types to parameters where possible *)
153 and assign_types
expr =
154 let option_split = function None
-> None
, None
| Some
(x
,y
) -> Some x
, Some y
in
155 let rec typeof (e
:res_expr
) = (* FIXME simplify *)
157 | ResValue t
-> e
, `Ok t
158 | ResParam p
-> e
, `Ok p
.typ
159 | ResInparam p
-> e
, `Ok p
.typ
160 | ResInChoice
(n
, k
, e
) -> let e, t
= typeof e in ResInChoice
(n
, k
, e), t
161 | ResChoices
(n
,l
) ->
162 let (e,t
) = List.split
@@ List.map
(fun (_
,e) -> option_split @@ Option.map
typeof e) l
in
164 match List.map
get_or_failwith @@ List.filter_map identity
t with
166 | t::ts
-> List.fold_left
(fun acc
t -> match acc
with None
-> None
| Some prev
-> Type.common_subtype prev
t) (Some
t) ts
168 let t = match t with None
-> `Error
"no common subtype for all choice branches" | Some
t -> `Ok
t in
169 ResChoices
(n
, List.map2
(fun (n
,_
) e -> n
,e) l
e), t
170 | ResFun
(func
,params
) ->
172 let (params
,types
) = params
|> List.map
typeof |> List.split
in
173 let types = List.map
get_or_failwith types in
175 sprintf
"%s applied to (%s)"
176 (string_of_func func
)
177 (String.concat
", " @@ List.map to_string
types)
181 | Multi
(ret
,each_arg
) -> F
(ret
, List.map
(fun _
-> each_arg
) types)
184 let (ret
,inferred_params
) = match func, types with
185 | Multi _
, _
-> assert false (* rewritten into F above *)
187 | Group typ
, _
-> typ
, types
188 | Agg
, _
-> fail
"cannot use this grouping function with %d parameters" (List.length
types)
189 | F
(_
, args
), _
when List.length args
<> List.length
types -> fail
"wrong number of arguments : %s" (show ())
190 | F
(ret
, args
), _
->
191 let typevar = Hashtbl.create
10 in
192 let l = List.map2
begin fun arg typ
->
194 | Typ arg
-> common_type arg typ
197 match Hashtbl.find
typevar i
with
198 | exception Not_found
-> Hashtbl.replace
typevar i typ
; typ
201 (* prefer more precise type *)
202 if arg = Type.Any
then Hashtbl.replace
typevar i typ
;
206 let convert = function Typ
t -> t | Var i
-> Hashtbl.find
typevar i
in
207 if List.fold_left
(&&) true l then
208 convert ret
, List.map
convert args
210 fail
"types do not match : %s" (show ())
211 | Ret Any
, _
-> (* lame *)
212 begin match List.filter
((<>) Any
) types with
214 (* make a best guess, return type same as for parameters when all of single type *)
215 | h
::tl
when List.for_all
(matches h
) tl
-> h
, List.map
(fun _
-> h
) types
216 (* "expand" to floats, when all parameters numeric and above rule didn't match *)
217 | l when List.for_all
(function Int
| Float
-> true | _
-> false) l -> Float
, List.map
(function Any
-> Float
| x
-> x
) types
220 | Ret ret
, _
-> ret
, types (* ignoring arguments FIXME *)
222 let assign inferred x
=
224 | ResParam
{ id
; typ
= Any
; attr; } -> ResParam
(new_param ?
attr id inferred
)
225 | ResInparam
{ id
; typ
= Any
; attr; } -> ResInparam
(new_param ?
attr id inferred
)
228 ResFun
(func,(List.map2
assign inferred_params params
)), `Ok ret
232 and resolve_types env
expr =
233 let expr = resolve_columns env
expr in
235 let (expr'
,t as r
) = assign_types
expr in
236 if !debug then eprintf
"resolved types %s : %s\n%!" (show_res_expr
expr'
) (Type.to_string
@@ get_or_failwith t);
240 eprintfn
"resolve_types failed with %s at:" (Printexc.to_string exn
);
241 eprintfn
"%s" (show_res_expr
expr);
244 and infer_schema env columns
=
245 (* let all = tables |> List.map snd |> List.flatten in *)
246 let resolve1 = function
248 | AllOf
t -> schema_of env
.tables
t
252 | Column
col -> resolve_column env
.tables env
.schema col
253 | _
-> make_attribute
"" (resolve_types env
e |> snd
|> get_or_failwith) Constraints.empty
255 let col = Option.map_default
(fun n
-> {col with name
= n
}) col name
in
258 flat_map resolve1 columns
260 and get_params env
e = e |> resolve_types env
|> fst
|> get_params_of_res_expr
264 let e = Sub [Value Type.Text; Param (Next,None); Sub []; Param (Named "ds", Some Type.Int);] in
265 e |> get_params |> to_string |> print_endline
268 and get_params_of_columns env
=
270 | All
| AllOf
_ -> []
271 | Expr
(e,_) -> get_params env
e
275 and get_params_opt env
= function
276 | Some x
-> get_params env x
279 and get_params_l env
l = flat_map (get_params env
) l
281 and do_join
(env
,params
) ((schema1
,params1
,_tables
),kind
) =
282 let schema = match kind
with
285 | `Default
-> Schema.cross env
.schema schema1
286 | `Natural
-> Schema.natural env
.schema schema1
287 | `Using
l -> Schema.join_using
l env
.schema schema1
289 let env = { env with schema } in
290 let p = match kind
with
291 | `Cross
| `Default
| `Natural
| `Using
_ -> []
292 | `Search
e -> get_params
env e (* TODO should use final schema (same as tables)? *)
294 env, params
@ params1
@ p
296 and join
env ((schema,p0
,ts0
),joins
) =
297 assert (env.schema = []);
298 let all_tables = List.flatten
(ts0
:: List.map
(fun ((_,_,ts
),_) -> ts
) joins
) in
299 let env = { env with tables
= env.tables
@ all_tables; schema; } in
300 List.fold_left do_join
(env, p0
) joins
302 and params_of_assigns
env ss
=
303 let exprs = resolve_column_assignments env.tables ss
in
304 get_params_l
env exprs
306 and params_of_order order final_schema tables
=
309 (fun (order
, direction
) ->
310 let env = { tables
; schema=(final_schema
:: (List.map snd tables
) |> all_columns); insert_schema
= []; } in
311 let p1 = get_params_l
env [ order
] in
314 | None
| Some `Fixed
-> []
315 | Some
(`Param
p) -> [Choice
(p,[Verbatim
("ASC","ASC");Verbatim
("DESC","DESC")])]
320 and ensure_res_expr
= function
321 | Value x
-> ResValue x
322 | Param x
-> ResParam x
323 | Inparam x
-> ResInparam x
324 | Choices
(p,_) -> failed ~at
:p.pos
"ensure_res_expr Choices TBD"
325 | InChoice
(p,_,_) -> failed ~at
:p.pos
"ensure_res_expr InChoice TBD"
326 | Column
_ | Inserted
_ -> failwith
"Not a simple expression"
327 | Fun
(func,_) when Type.is_grouping func -> failwith
"Grouping function not allowed in simple expression"
328 | Fun
(x
,l) -> ResFun
(x
,List.map ensure_res_expr
l) (* FIXME *)
329 | SelectExpr
_ -> failwith
"not implemented : ensure_res_expr for SELECT"
331 and eval_nested
env nested
=
332 (* nested selects generate new fresh schema in scope, cannot refer to outer schema,
333 but can refer to attributes of tables through `tables` *)
334 let env = { env with schema = [] } in
336 | Some
(t,l) -> join
env (resolve_source
env t, List.map
(fun (x
,k
) -> resolve_source
env x
, k
) l)
339 and eval_select
env { columns
; from
; where
; group
; having
; } =
340 let (env,p2) = eval_nested
env from
in
342 if from
= None
then (if where
= None
then `One
else `Zero_one
)
343 else if group
= [] && exists_grouping columns
then `One
346 let final_schema = infer_schema
env columns
in
347 (* use schema without aliases here *)
348 let p1 = get_params_of_columns
env columns
in
349 let env = Schema.{ env with schema = cross env.schema final_schema |> make_unique
} in (* enrich schema in scope with aliases *)
350 let p3 = get_params_opt
env where
in
351 let p4 = get_params_l
env group
in
352 let p5 = get_params_opt
env having
in
353 (final_schema, p1 @ p2 @ p3 @ p4 @ p5, env.tables
, cardinality)
355 (** @return final schema, params and tables that can be referenced by outside scope *)
356 and resolve_source
env (x
,alias
) =
359 let (s
,p,_) = eval_select_full
env select
in
360 s
, p, (match alias
with None
-> [] | Some name
-> [name
,s
])
362 let (env,p) = eval_nested
env (Some s
) in
363 let s = infer_schema
env [All
] in
364 if alias
<> None
then failwith
"No alias allowed on nested tables";
367 let (name
,s) = Tables.get s in
368 s, [], List.map
(fun name
-> name
, s) (name
:: option_list alias
)
370 and eval_select_full
env { select
=(select
,other
); order
; limit
; } =
371 let (s1
,p1,tbls
,cardinality) = eval_select
env select
in
372 let (s2l
,p2l
) = List.split
(List.map
(fun (s,p,_,_) -> s,p) @@ List.map
(eval_select
env) other
) in
374 eprintf
"cardinality=%s other=%u\n%!"
375 (Stmt.cardinality_to_string
cardinality)
377 let cardinality = if other
= [] then cardinality else `Nat
in
378 (* ignoring tables in compound statements - they cannot be used in ORDER BY *)
379 let final_schema = List.fold_left
Schema.compound s1 s2l
in
380 let p3 = params_of_order order
final_schema tbls
in
381 let (p4,limit1
) = match limit
with Some
(p,x
) -> List.map
(fun p -> Single
p) p, x
| None
-> [],false in
382 (* Schema.check_unique schema; *)
384 if limit1
&& cardinality = `Nat
then `Zero_one
386 final_schema,(p1@(List.flatten p2l
)@p3@p4 : var list
), Stmt.Select
cardinality
389 let update_tables sources ss w
=
390 let schema = cross @@ (List.map
(fun (s,_,_) -> s) sources
) in
391 let p0 = List.flatten
@@ List.map
(fun (_,p,_) -> p) sources
in
392 let tables = List.flatten
@@ List.map
(fun (_,_,ts
) -> ts
) sources
in (* TODO assert equal duplicates if not unique *)
393 let env = { tables; schema; insert_schema
=get_columns_schema tables (List.map fst ss
); } in
394 let p1 = params_of_assigns
env ss
in
395 let p2 = get_params_opt
env w
in
398 let annotate_select select
types =
399 let (select1
,compound
) = select
.select
in
400 let rec loop acc cols
types =
401 match cols
, types with
402 | [], [] -> List.rev acc
403 | (All
| AllOf
_) :: _, _ -> failwith
"Asterisk not supported"
404 | Expr
(e,name
) :: cols
, t :: types -> loop (Expr
(Fun
(F
(Typ
t, [Typ
t]), [e]), name
) :: acc
) cols
types
405 | _, [] | [], _ -> failwith
"Select cardinality doesn't match Insert"
407 { select
with select
= { select1
with columns
= loop [] select1
.columns
types }, compound
}
409 let eval (stmt
:Sql.stmt
) =
412 | Create
(name
,`Schema
schema) ->
413 Tables.add
(name
,schema);
415 | Create
(name
,`Select select
) ->
416 let (schema,params
,_) = eval_select_full
empty_env select
in
417 Tables.add
(name
,schema);
418 ([],params
,Create name
)
419 | Alter
(name
,actions
) ->
421 | `Add
(col,pos
) -> Tables.alter_add name
col pos
422 | `Drop
col -> Tables.alter_drop name
col
423 | `Change
(oldcol
,col,pos
) -> Tables.alter_change name oldcol
col pos
424 | `RenameColumn
(oldcol
,newcol
) -> Tables.rename_column name oldcol newcol
425 | `RenameTable new_name
-> Tables.rename name new_name
426 | `RenameIndex
_ -> () (* indices are not tracked yet *)
427 | `None
-> ()) actions
;
430 List.iter
(fun (o
,n
) -> Tables.rename o n
) l;
431 ([], [], Alter
(List.map fst
l)) (* to have sensible target for gen_xml *)
435 | CreateIndex
(name
,table
,cols
) ->
436 Sql.Schema.project cols
(Tables.get_schema table
) |> ignore
; (* just check *)
437 [],[],CreateIndex name
438 | Insert
{ target
=table
; action
=`Values
(names
, values
); on_duplicate
; } ->
439 let expect = values_or_all table names
in
440 let env = { tables = [Tables.get table
]; schema = Tables.get_schema table
; insert_schema
= expect; } in
441 let params, inferred
= match values
with
442 | None
-> [], Some
(Values
, expect)
444 let vl = List.map
List.length values
in
445 let cl = List.length
expect in
446 if List.exists
(fun n
-> n
<> cl) vl then
447 fail
"Expecting %u expressions in every VALUES tuple" cl;
448 let assigns = values
|>
449 List.map
begin fun tuple
->
450 (* pair up columns with inserted values *)
451 List.combine
(List.map
(fun a
-> {cname
=a
.name
; tname
=None
}) expect) tuple
452 (* resolve DEFAULTs *)
453 |> List.map
(function (col,`Expr
e) -> col, e | (col,`Default
) -> col, Fun
(Type.identity
, [Column
col]))
456 params_of_assigns
env (List.concat
assigns), None
458 let params2 = params_of_assigns
env (Option.default
[] on_duplicate
) in
459 [], params @ params2, Insert
(inferred
,table
)
460 | Insert
{ target
=table
; action
=`Param
(names
, param_id
); on_duplicate
; } ->
461 let expect = values_or_all table names
in
462 let env = { tables = [Tables.get table
]; schema = Tables.get_schema table
; insert_schema
= expect; } in
463 let params = [ TupleList
(param_id
, expect) ] in
464 let params2 = params_of_assigns
env (Option.default
[] on_duplicate
) in
465 [], params @ params2, Insert
(None
, table
)
466 | Insert
{ target
=table
; action
=`Select
(names
, select
); on_duplicate
; } ->
467 let expect = values_or_all table names
in
468 let env = { tables = [Tables.get table
]; schema = Tables.get_schema table
; insert_schema
= expect; } in
469 let select = annotate_select select (List.map
(fun a
-> a
.domain
) expect) in
470 let (schema,params,_) = eval_select_full
env select in
471 ignore
(Schema.compound
expect schema); (* test equal types once more (not really needed) *)
472 let params2 = params_of_assigns
env (Option.default
[] on_duplicate
) in
473 [], params @ params2, Insert
(None
,table
)
474 | Insert
{ target
=table
; action
=`Set ss
; on_duplicate
; } ->
475 let expect = values_or_all table
(Option.map
(List.map
(function ({cname
; tname
=None
},_) -> cname
| _ -> assert false)) ss
) in
476 let env = { tables = [Tables.get table
]; schema = Tables.get_schema table
; insert_schema
= expect; } in
477 let (params,inferred
) = match ss
with
478 | None
-> [], Some
(Assign
, Tables.get_schema table
)
479 | Some ss
-> params_of_assigns
env ss
, None
481 let params2 = params_of_assigns
env (Option.default
[] on_duplicate
) in
482 [], params @ params2, Insert
(inferred
,table
)
483 | Delete
(table
, where
) ->
484 let t = Tables.get table
in
485 let p = get_params_opt
{ tables=[t]; schema=snd
t; insert_schema
=[]; } where
in
486 [], p, Delete
[table
]
487 | DeleteMulti
(targets
, tables, where
) ->
488 (* use dummy columns to verify targets match the provided tables *)
489 let columns = List.map
(fun tn
-> AllOf tn
) targets
in
490 let select = ({ columns; from
= Some
tables; where
; group
= []; having
= None
}, []) in
491 let _attrs, params, _ = eval_select_full
empty_env { select; order
= []; limit
= None
} in
492 [], params, Delete targets
495 | Column
_ -> [] (* this is not column but some db-specific identifier *)
496 | _ -> get_params_of_res_expr (ensure_res_expr
e)
499 | Update
(table
,ss
,w
,o
,lim
) ->
500 let t = Tables.get table
in
501 let params = update_tables [snd
t,[],[t]] ss w
in
502 let p3 = params_of_order o
[] [t] in
503 [], params @ p3 @ (List.map
(fun p -> Single
p) lim
), Update
(Some table
)
504 | UpdateMulti
(tables,ss
,w
) ->
505 let sources = List.map
(resolve_source
empty_env) tables in
506 let params = update_tables sources ss w
in
507 [], params, Update None
508 | Select
select -> eval_select_full
empty_env select
509 | CreateRoutine
(name
,_,_) ->
510 [], [], CreateRoutine name
512 (* FIXME unify each choice separately *)
514 let h = Hashtbl.create
10 in
515 let h_choices = Hashtbl.create
10 in
516 let check_choice_name p =
518 | None
-> () (* unique *)
519 | Some n
when Hashtbl.mem
h_choices n
-> failed ~at
:p.pos
"sharing choices not implemented"
520 | Some n
-> Hashtbl.add
h_choices n
()
522 let remember name
t =
524 | None
-> () (* anonymous ie non-shared *)
526 match Hashtbl.find
h name
with
527 | exception _ -> Hashtbl.add
h name
t
529 match Sql.Type.common_subtype
t t'
with
530 | Some x
-> Hashtbl.replace
h name x
531 | None
-> fail
"incompatible types for parameter %S : %s and %s" name
(Type.show t) (Type.show t'
)
533 let rec traverse = function
534 | Single
{ id
; typ
; attr=_ } -> remember id
.label typ
535 | SingleIn
{ id
; typ
; _ } -> remember id
.label typ
536 | ChoiceIn
{ vars
; _ } -> List.iter
traverse vars
537 | Choice
(p,l) -> check_choice_name p; List.iter
(function Simple
(_,l) -> Option.may
(List.iter
traverse) l | Verbatim
_ -> ()) l
540 let rec map = function
541 | 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))
542 | SingleIn
{ id
; typ
; attr } -> SingleIn
(new_param id ?
attr (match id
.label
with None
-> typ
| Some name
-> try Hashtbl.find
h name
with _ -> assert false))
543 | ChoiceIn
t -> ChoiceIn
{ t with vars
= List.map map t.vars
}
544 | Choice
(p, l) -> Choice
(p, List.map (function Simple
(n
,l) -> Simple
(n
, Option.map (List.map map) l) | Verbatim
_ as v
-> v
) l)
545 | TupleList
_ as x
-> x
547 List.iter
traverse l;
550 let is_alpha = function
555 let common_prefix = function
559 if String.length x
<= i
then i
561 if List.for_all
(fun s -> i
< String.length
s && s.[i
] = x
.[i
]) l then
567 (* do not allow empty names or starting not with alpha *)
568 if List.exists
(fun s -> i = String.length
s || not
(is_alpha s.[i])) l then 0 else i
570 (* fill inferred sql for VALUES or SET *)
571 let complete_sql kind sql
=
573 | Stmt.Insert
(Some
(kind
,schema), _) ->
574 let (pre
,each,post
) = match kind
with
575 | Values
-> "(", (fun _ -> ""), ")"
576 | Assign
-> "", (fun name
-> name ^
" = "), ""
578 let module B
= Buffer
in
579 let b = B.create
100 in
583 let params = ref [] in
584 let first = common_prefix @@ List.map (fun attr -> attr.Sql.name
) schema in
585 schema |> List.iter
(fun attr ->
586 if !params <> [] then B.add_string
b ",";
587 let attr_ref_prefix = each attr.Sql.name
in
588 let attr_name = String.slice ~
first attr.Sql.name
in
589 let attr_ref = "@" ^
attr_name in
590 let pos_start = B.length
b + String.length
attr_ref_prefix in
591 let pos_end = pos_start + String.length
attr_ref in
592 let param = Single
(new_param ~
attr {label
=Some
attr_name; pos
=(pos_start,pos_end)} attr.domain
) in
593 B.add_string
b attr_ref_prefix;
594 B.add_string
b attr_ref;
598 (B.contents
b, List.rev
!params)
602 let (schema,p1,kind
) = eval @@ Parser.parse_stmt sql
in
603 let (sql
,p2) = complete_sql kind sql
in
604 (sql
, schema, unify_params (p1 @ p2), kind
)