gazagnaire.org
SQL frontend over the catalog engine
1(*---------------------------------------------------------------------------
2 Copyright (c) 2026 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6module Ir = Catalog.Ir
7module V = Catalog.Value
8
9let unsupported () = raise Ir.Unsupported
10
11(* The correlated subqueries found while lowering a select, in id order. [expr]
12 registers each scalar / [EXISTS] / [IN (SELECT)] here as it emits the
13 matching [Ir.Subquery] node, and [query] reads the table back so the caller
14 can wire a runner (the engine has no SQL; it calls the injected runner by
15 id). A reset-per-[query] accumulator is safe: lowering does not recurse into
16 a subquery's body (it keeps the [Ast.select] for the runner), and lowering
17 finishes -- the [query] result captures this list -- before the engine runs
18 and fires any nested subquery lowering. [allow] is cleared while lowering an
19 aggregate select, where the grouped path has no runner, so a subquery there
20 falls back. *)
21type subkind = Scalar | Exists | In
22
23let sub_acc : (subkind * Ast.select) list ref = ref []
24let sub_count = ref 0
25let sub_allow = ref true
26
27let register_sub kind sub =
28 if not !sub_allow then unsupported ();
29 let id = !sub_count in
30 sub_acc := (kind, sub) :: !sub_acc;
31 incr sub_count;
32 id
33
34(* Compare two values under a named collation -- the tree-walker's own collated
35 comparison, for an [ORDER BY] key that carries a [COLLATE]. *)
36let collate = Value_ops.compare_values_coll
37
38(* The IR's value layer is the tree-walker's own functions, called directly: the
39 frontend and the engine share {!Catalog.Value.t}, so no value conversion sits
40 between them and a compiled query agrees with an interpreted one by sharing
41 the code. Only the operator enums differ, mapped by
42 {!ast_cmp}/{!ast_logic}. *)
43let ast_cmp : Ir.binop -> Ast.binop = function
44 | Eq -> Eq
45 | Ne -> Neq
46 | Lt -> Lt
47 | Le -> Le
48 | Gt -> Gt
49 | Ge -> Ge
50 | _ -> assert false
51
52let ast_logic : Ir.logicop -> Ast.binop = function
53 | And -> And
54 | Or -> Or
55 | Like -> Like
56 | Glob -> Glob
57 | Concat -> Concat
58 | Json_get -> Json_get
59 | Json_get_text -> Json_get_text
60
61let builtins : Ir.builtins =
62 {
63 call = Func.apply;
64 compare =
65 (fun op coll a_col b_col va vb ->
66 Value_op.compare_with_affinity ?coll ~a_col ~b_col (ast_cmp op) va vb);
67 logic = (fun op va vb -> Value_op.binop_value (ast_logic op) va vb);
68 not_ = Value_ops.not_value;
69 is_eq = Value_ops.is_value;
70 in_list =
71 (fun coll e_col v cands -> Value_op.in_list_value ?coll ~e_col v cands);
72 cast = Value_ops.cast;
73 subquery = (fun _ _ _ -> unsupported ());
74 }
75
76type layout = (string * string list) list
77
78(* The comparison, opcode-free, and arithmetic operator groups of
79 [Ast.binop]. *)
80let is_cmp : Ast.binop -> bool = function
81 | Eq | Neq | Lt | Le | Gt | Ge -> true
82 | _ -> false
83
84let is_logic : Ast.binop -> bool = function
85 | And | Or | Like | Glob | Concat | Json_get | Json_get_text -> true
86 | _ -> false
87
88let ir_cmp : Ast.binop -> Ir.binop = function
89 | Eq -> Eq
90 | Neq -> Ne
91 | Lt -> Lt
92 | Le -> Le
93 | Gt -> Gt
94 | Ge -> Ge
95 | _ -> unsupported ()
96
97let ir_logic : Ast.binop -> Ir.logicop = function
98 | And -> And
99 | Or -> Or
100 | Like -> Like
101 | Glob -> Glob
102 | Concat -> Concat
103 | Json_get -> Json_get
104 | Json_get_text -> Json_get_text
105 | _ -> unsupported ()
106
107let ir_arith : Ast.binop -> Ir.binop = function
108 | Add -> Add
109 | Sub -> Sub
110 | Mul -> Mul
111 | Div -> Div
112 | Mod -> Mod
113 | Bit_and -> Band
114 | Bit_or -> Bor
115 | Shl -> Shl
116 | Shr -> Shr
117 | _ -> unsupported ()
118
119(* The position of the column named [name] in [cols] (case-insensitive). *)
120let col_index name cols =
121 let uname = String.uppercase_ascii name in
122 let rec go j = function
123 | c :: _ when String.uppercase_ascii c = uname -> Some j
124 | _ :: t -> go (j + 1) t
125 | [] -> None
126 in
127 go 0 cols
128
129(* The implicit [rowid] pseudo-column and its [oid]/[_rowid_] aliases. *)
130let is_rowid_name n =
131 match String.uppercase_ascii n with
132 | "ROWID" | "OID" | "_ROWID_" -> true
133 | _ -> false
134
135(* The hidden layout slot a table scan publishes for its integer rowid. A scan
136 that exposes its rowid appends a column with this name;
137 [rowid]/[oid]/[_rowid_] resolve to it (when no real column shadows them), and
138 [Star] drops it. The NUL byte keeps it unspellable, so no user column ever
139 collides. *)
140let rowid_sentinel = "\000rowid"
141
142(* Find [alias.name] (or a bare [name]) in the layout: a qualified name picks
143 the source with that alias, a bare name takes the first source that has it.
144 [None] if the layout has no place for it. *)
145let col (layout : layout) alias name =
146 match alias with
147 | Some a ->
148 let ua = String.uppercase_ascii a in
149 let rec go ci = function
150 | (al, cols) :: t ->
151 if String.uppercase_ascii al = ua then
152 match col_index name cols with
153 | Some j -> Some (ci, j)
154 | None -> None
155 else go (ci + 1) t
156 | [] -> None
157 in
158 go 0 layout
159 | None ->
160 let rec go ci = function
161 | (_, cols) :: t -> (
162 match col_index name cols with
163 | Some j -> Some (ci, j)
164 | None -> go (ci + 1) t)
165 | [] -> None
166 in
167 go 0 layout
168
169let resolve_col (layout : layout) alias name =
170 match col layout alias name with
171 | Some r -> r
172 | None ->
173 (* [rowid] and its aliases bind to the scan's hidden rowid slot when it
174 publishes one; without that slot the scan cannot place rowid, so raise
175 [Unsupported] to fall back rather than calling it an unknown column. *)
176 if is_rowid_name name then
177 match col layout alias rowid_sentinel with
178 | Some r -> r
179 | None -> unsupported ()
180 else Fmt.failwith "unknown column %S" name
181
182(* A comparison's collation -- sqlite3's left-operand rule, made explicit by
183 [Query.resolve_collations] as a [Collate] wrapper on an operand -- and the
184 bare operand under it. [is_col_ast] treats a [Collate] wrapper as not a
185 column, so a collated comparison carries no affinity on that side, matching
186 the tree-walker. *)
187let is_col_ast = function Ast.Col _ -> true | _ -> false
188let collation_of = function Ast.Collate (_, c) -> Some c | _ -> None
189
190let comparison_collation a b =
191 match collation_of a with Some _ as c -> c | None -> collation_of b
192
193(* The collation an operand carries for membership/comparison, the default
194 [BINARY] (unary plus, which only strips affinity) carrying none. *)
195let nonbinary_collation e =
196 match collation_of e with Some c when c <> "BINARY" -> Some c | _ -> None
197
198let strip_collate = function Ast.Collate (e, _) -> e | e -> e
199
200let rec expr (layout : layout) (e : Ast.expr) : Ir.expr =
201 match e with
202 | Lit v -> Lit v
203 | Param i -> Param i
204 | Col (alias, name) ->
205 let c, j = resolve_col layout alias name in
206 Col (c, j)
207 | Unop_not e -> Not (expr layout e)
208 | Binary (op, a, b) ->
209 if is_cmp op then cmp_expr layout op a b
210 else if is_logic op then Logic (ir_logic op, expr layout a, expr layout b)
211 else Arith (ir_arith op, expr layout a, expr layout b)
212 | Is_null e -> Null_value (true, expr layout e)
213 | Is_not_null e -> Null_value (false, expr layout e)
214 | Is (a, b) -> Is (expr layout a, expr layout b)
215 | In_list (e, cands) ->
216 In
217 ( expr layout (strip_collate e),
218 nonbinary_collation e,
219 is_col_ast e,
220 List.map (expr layout) cands )
221 (* [iif(c, t, f)] short-circuits, so it is the searched [CASE WHEN c THEN t
222 ELSE f] -- lower it as one rather than an eager function call. An aggregate
223 reaching [expr] is in a WHERE/ON/ORDER BY/scan position (a select-list
224 aggregate makes the query aggregate, lowered elsewhere) -- always an error,
225 raised here so the engine reports it without deferring to the
226 tree-walker. *)
227 | Func ("iif", [ c; t; f ]) -> expr layout (Case (None, [ (c, t) ], Some f))
228 | Func (name, args) when not (Query.is_agg name args) ->
229 Func (name, List.map (expr layout) args)
230 | Func (name, _) ->
231 Fmt.failwith
232 "%s() is an aggregate function and is only valid as a select item, not \
233 in WHERE, ON, or ORDER BY"
234 name
235 | Case (base, branches, els) ->
236 let branch (c, r) =
237 let p =
238 match base with
239 | None -> predicate layout c
240 | Some b -> Compare (Eq, expr layout b, expr layout c)
241 in
242 (p, expr layout r)
243 in
244 Case (List.map branch branches, Option.map (expr layout) els)
245 | Cast (e, ty) -> Cast (expr layout e, ty)
246 (* A correlated subquery becomes an opaque [Subquery] node: register the
247 [Ast.select] and its kind, and (for [IN]) lower the left operand whose
248 value the membership test reads. An uncorrelated one is already folded to a
249 constant before lowering ([Query.hoist_subqueries]), so what reaches here
250 is correlated, run per outer row by the injected runner. *)
251 | Scalar_select sub -> Subquery (register_sub Scalar sub, None)
252 | Exists sub -> Subquery (register_sub Exists sub, None)
253 | In_select (e, sub) -> Subquery (register_sub In sub, Some (expr layout e))
254 | Star | Qualified_star _ | Distinct_agg _ | Filter _ | Ordered_agg _
255 | Window _ | Collate _ ->
256 unsupported ()
257
258(* Lower a [WHERE]/[ON]/[HAVING] expression to a filter predicate: an [AND]/[OR]
259 of comparisons, null tests, and bare truthy expressions. *)
260and predicate (layout : layout) (e : Ast.expr) : Ir.predicate =
261 match e with
262 | Binary (And, a, b) -> And (predicate layout a, predicate layout b)
263 | Binary (Or, a, b) -> Or (predicate layout a, predicate layout b)
264 | Binary (op, a, b) when is_cmp op -> cmp_pred layout op a b
265 | Is_null e -> Null_test (true, expr layout e)
266 | Is_not_null e -> Null_test (false, expr layout e)
267 (* a bare [WHERE expr] keeps the truthy rows; [expr] itself rejects a shape
268 the IR cannot model (a subquery, a window), falling the whole predicate
269 back *)
270 | e -> Truthy (expr layout e)
271
272(* Lower a comparison. A [COLLATE]-wrapped operand -- a declared collation, or a
273 [BINARY] one (which is unary plus, stripping affinity) -- routes through the
274 value-level {!Ir.Cmp_coll}: the binary VM compare cannot honour a non-binary
275 collation, and stripping the wrapper for the plain path would let the IR
276 re-derive affinity from the bare column the wrapper suppressed. The explicit
277 affinity flags read the original operands ([is_col_ast] of a wrapper is
278 [false]), matching the tree-walker; an unwrapped comparison takes the binary
279 value comparison / filter jump. *)
280and cmp_expr layout op a b : Ir.expr =
281 let a' = expr layout (strip_collate a)
282 and b' = expr layout (strip_collate b) in
283 match comparison_collation a b with
284 | Some c -> Cmp_coll (ir_cmp op, c, is_col_ast a, is_col_ast b, a', b')
285 | None -> Cmp (ir_cmp op, a', b')
286
287and cmp_pred layout op a b : Ir.predicate =
288 let a' = expr layout (strip_collate a)
289 and b' = expr layout (strip_collate b) in
290 match comparison_collation a b with
291 | Some c ->
292 Truthy (Cmp_coll (ir_cmp op, c, is_col_ast a, is_col_ast b, a', b'))
293 | None -> Compare (ir_cmp op, a', b')
294
295let ir_dir = function Ast.Asc -> Ir.Asc | Ast.Desc -> Ir.Desc
296
297(* An [ORDER BY] key's explicit collation, if any -- a [BINARY] wrapper is the
298 default, so it carries no collation. *)
299let order_collation e =
300 match collation_of e with Some c when c <> "BINARY" -> Some c | _ -> None
301
302(* Lower an [ORDER BY] key with [lower_key] (over the scan, or the synthetic
303 group row): its expression, direction, and collation. *)
304let order_key lower_key (e, d) =
305 (lower_key (strip_collate e), ir_dir d, order_collation e)
306
307(* The per-output-column collations a DISTINCT dedups under (one per result
308 column; [[]] when not DISTINCT, so the engine dedups by binary value). *)
309let distinct_collations (s : Ast.select) =
310 if s.distinct then
311 List.map (fun (rc : Ast.result_col) -> order_collation rc.expr) s.cols
312 else []
313
314(* Expand a select item into its projected expressions: [*] and [t.*] become one
315 column reference per source column. *)
316let project_item ?(hidden = []) (layout : layout) (rc : Ast.result_col) :
317 Ir.expr list =
318 match rc.expr with
319 | Star ->
320 (* [*] lists every source column, except a column a NATURAL / USING join
321 hides (the right source's copy of a common column). *)
322 List.concat
323 (List.mapi
324 (fun ci (_, cols) ->
325 List.filter_map
326 (fun j ->
327 if List.mem (ci, j) hidden then None else Some (Ir.Col (ci, j)))
328 (List.init (List.length cols) Fun.id))
329 layout)
330 | Qualified_star q ->
331 (* [t.*] lists [t]'s columns, skipping the hidden rowid slot. *)
332 let uq = String.uppercase_ascii q in
333 let rec go ci = function
334 | (al, cols) :: t ->
335 if String.uppercase_ascii al = uq then
336 List.filter_map
337 (fun j ->
338 if List.mem (ci, j) hidden then None
339 else Some (Ir.Col (ci, j)))
340 (List.init (List.length cols) Fun.id)
341 else go (ci + 1) t
342 | [] -> unsupported ()
343 in
344 go 0 layout
345 (* A projected [COLLATE] (or unary plus) produces the bare value -- the
346 collation governs only comparison/ordering/dedup, captured separately in
347 the query's ORDER BY keys and [distinct_colls]. *)
348 | e -> [ expr layout (strip_collate e) ]
349
350(* The [int64] value of a literal / bound-parameter [LIMIT]/[OFFSET] expression,
351 or [None] for any other shape (a column, an expression) -- which falls
352 back. *)
353let lit_int64 params (e : Ast.expr) =
354 match e with
355 | Ast.Lit (Ast.Int n) -> Some n
356 | Param i when i >= 0 && i < Array.length params -> (
357 match params.(i) with Ast.Int n -> Some n | _ -> None)
358 | _ -> None
359
360(* A non-negative row count clamped to a native int: a value beyond the native
361 range exceeds any materialised row count, so [max_int] is exact (keep all for
362 a limit, skip all for an offset) without truncating to a wrong small
363 number. *)
364let clamp_count n =
365 if Int64.compare n (Int64.of_int max_int) >= 0 then max_int
366 else Int64.to_int n
367
368(* A NATURAL join's match columns (or the [USING] list): the names shared by the
369 two joined sources -- a single [FROM] table and one joined table. *)
370let common_columns (layout : layout) (j : Ast.join) =
371 match layout with
372 | [ (_, lcols); (_, rcols) ] ->
373 if j.using <> [] then j.using
374 else
375 (* the hidden rowid slot is not a user column: it never participates in
376 the implicit equality (both sides carry one, so it would otherwise
377 match them spuriously) *)
378 let ru = List.map String.uppercase_ascii rcols in
379 List.filter
380 (fun c ->
381 c <> rowid_sentinel && List.mem (String.uppercase_ascii c) ru)
382 lcols
383 | _ -> unsupported ()
384
385(* The implicit [ON] of a NATURAL / USING join: the common columns equated
386 across the two sources, as an [Ast] predicate the layout then lowers. *)
387let natural_on (layout : layout) (j : Ast.join) =
388 let la, ra =
389 match layout with [ (la, _); (ra, _) ] -> (la, ra) | _ -> unsupported ()
390 in
391 let eq c = Ast.Binary (Ast.Eq, Ast.Col (Some la, c), Ast.Col (Some ra, c)) in
392 match common_columns layout j with
393 | [] -> unsupported ()
394 | c0 :: rest ->
395 List.fold_left (fun acc c -> Ast.Binary (Ast.And, acc, eq c)) (eq c0) rest
396
397(* The [(cursor, column)] positions a NATURAL / USING join hides from [*]: the
398 right source's copy of each common column, so [*] lists it once. *)
399(* The hidden rowid slots: any [rowid_sentinel] column a scan published. [Star]
400 drops these so [SELECT *] never returns the implicit rowid. *)
401let sentinel_columns (layout : layout) =
402 List.concat
403 (List.mapi
404 (fun ci (_, cols) ->
405 List.filter_map
406 (fun (j, c) -> if c = rowid_sentinel then Some (ci, j) else None)
407 (List.mapi (fun j c -> (j, c)) cols))
408 layout)
409
410let hidden_columns (layout : layout) (s : Ast.select) =
411 match s.joins with
412 | [ j ] when j.natural || j.using <> [] -> (
413 match layout with
414 | [ _; (_, rcols) ] ->
415 List.filter_map
416 (fun c -> Option.map (fun i -> (1, i)) (col_index c rcols))
417 (common_columns layout j)
418 | _ -> [])
419 | _ -> []
420
421(* An inner join's effective [ON], folded into the filter: the explicit [ON], or
422 the NATURAL / USING common-column equality; an outer join goes through
423 {!left_join}. *)
424let join_on (layout : layout) (j : Ast.join) =
425 if j.type_ <> Inner then unsupported ();
426 if j.natural || j.using <> [] then natural_on layout j else j.on
427
428(* The scan filter: the [WHERE] conjoined with every inner-join [ON]. *)
429let filter_of (layout : layout) (s : Ast.select) =
430 let fexprs =
431 (match s.where with Some w -> [ w ] | None -> [])
432 @ List.map (join_on layout) s.joins
433 in
434 match fexprs with
435 | [] -> Ir.Always
436 | e :: rest ->
437 List.fold_left
438 (fun acc e -> Ir.And (acc, predicate layout e))
439 (predicate layout e) rest
440
441(* A negative LIMIT is unbounded ([None]); a huge one clamps to [max_int] (every
442 row kept); a non-literal one falls back (sqlite3). *)
443let limit_of params (s : Ast.select) =
444 match s.limit with
445 | None -> None
446 | Some e -> (
447 match lit_int64 params e with
448 | None -> unsupported ()
449 | Some n when n < 0L -> None
450 | Some n -> Some (clamp_count n))
451
452(* A negative OFFSET is zero; a huge one clamps to [max_int] (every row
453 skipped); a non-literal one falls back (sqlite3). *)
454let offset_of params (s : Ast.select) =
455 match s.offset with
456 | None -> 0
457 | Some e -> (
458 match lit_int64 params e with
459 | None -> unsupported ()
460 | Some n when n < 0L -> 0
461 | Some n -> clamp_count n)
462
463(* A single trailing outer join (one [FROM] table, one outer-joined table): its
464 kind and [ON] predicate, with the [WHERE] kept separate so the engine can
465 null-fill before filtering. An inner (or wider) join shape returns [None], so
466 the inner path folds every [ON] into one filter. *)
467let outer_kind_of : Ast.join_type -> Ir.outer_kind option = function
468 | Left -> Some Ir.Left
469 | Right -> Some Ir.Right
470 | Full -> Some Ir.Full
471 | Inner -> None
472
473let left_join (layout : layout) (s : Ast.select) =
474 match s.joins with
475 | [ j ] -> (
476 match outer_kind_of j.type_ with
477 | None -> None
478 | Some kind ->
479 let on =
480 if j.natural || j.using <> [] then natural_on layout j else j.on
481 in
482 let where =
483 match s.where with
484 | Some w -> predicate layout w
485 | None -> Ir.Always
486 in
487 Some ((kind, predicate layout on), where))
488 | _ -> None
489
490let query ?(params = [||]) (layout : layout) (s : Ast.select) :
491 Ir.query * (subkind * Ast.select) list =
492 if s.group_by <> [] || s.having <> None || s.compound <> [] then
493 unsupported ();
494 sub_acc := [];
495 sub_count := 0;
496 sub_allow := true;
497 let arities = List.map (fun (_, cols) -> List.length cols) layout in
498 let left, filter =
499 match left_join layout s with
500 | Some (kind_on, where) -> (Some kind_on, where)
501 | None -> (None, filter_of layout s)
502 in
503 let hidden = hidden_columns layout s @ sentinel_columns layout in
504 let project = List.concat_map (project_item ~hidden layout) s.cols in
505 let select = { Ir.arities; left; filter; project } in
506 let order_by = List.map (order_key (expr layout)) s.order_by in
507 let q =
508 {
509 Ir.select;
510 order_by;
511 distinct = s.distinct;
512 distinct_colls = distinct_collations s;
513 limit = limit_of params s;
514 offset = offset_of params s;
515 }
516 in
517 (q, List.rev !sub_acc)
518
519(* The aggregates {!agg_fold} folds: a star [count], the numeric aggregates, and
520 the string aggregate (group_concat / string_agg). A FILTER / ORDER-BY
521 aggregate and a window are not here, so they fall back to the tree-walker. *)
522let numeric_aggs = [ "count"; "sum"; "min"; "max"; "avg"; "total" ]
523let string_aggs = [ "group_concat"; "string_agg" ]
524
525(* A plain aggregate call: a star [count], a numeric aggregate of an argument,
526 or a string aggregate ([group_concat]/[string_agg], with an optional
527 separator argument), optionally [DISTINCT] -- its name, distinctness, and
528 argument expressions ([] for a star count). [None] for anything else. *)
529let core_aggregate : Ast.expr -> (string * bool * Ast.expr list) option =
530 function
531 | Func ("count", [ Star ]) -> Some ("count", false, [])
532 | Func (name, args)
533 when (List.mem name numeric_aggs || List.mem name string_aggs)
534 && Query.is_agg name args ->
535 Some (name, false, args)
536 | Distinct_agg (name, arg)
537 when List.mem name numeric_aggs || List.mem name string_aggs ->
538 Some (name, true, [ arg ])
539 | _ -> None
540
541(* A plain aggregate call, peeling any [FILTER (WHERE p)] and [ORDER BY] around
542 the core call: its name, distinctness, arguments, optional FILTER predicate,
543 and ORDER BY keys. [None] for anything that is not an aggregate. *)
544let as_aggregate e =
545 let rec peel filter order = function
546 | Ast.Filter (inner, p) -> peel (Some p) order inner
547 | Ast.Ordered_agg (inner, ob) -> peel filter ob inner
548 | core -> (
549 match core_aggregate core with
550 | Some (name, distinct, args) ->
551 Some (name, distinct, args, filter, order)
552 | None -> None)
553 in
554 peel None [] e
555
556(* The value-level aggregate fold injected into {!Catalog.Ir.run_grouped}. The
557 engine streams argument rows rather than materialising one tuple list per
558 group row; DISTINCT has already been applied. [count] counts rows (star) or
559 non-NULL first arguments; [group_concat]/[string_agg] join the non-NULL first
560 arguments by the separator (the second argument, default ","); the rest fold
561 the non-NULL first arguments through {!Value_ops.numeric_agg} -- the same
562 folds the tree-walker uses. *)
563let agg_fold name _distinct (rows : Ir.agg_rows) : V.t =
564 if rows.nargs = 0 then Int (Int64.of_int rows.rows)
565 else
566 let first_args = ref [] in
567 let sep = ref "," in
568 let sep_set = ref false in
569 rows.iter (fun row base ->
570 if rows.nargs > 0 then (
571 let v = row.(base) in
572 if v <> V.Null then first_args := v :: !first_args;
573 if (not !sep_set) && rows.nargs > 1 then (
574 sep := Value_ops.text_of_value row.(base + 1);
575 sep_set := true)));
576 let first_args = List.rev !first_args in
577 match () with
578 | _ when List.mem name string_aggs -> (
579 match first_args with
580 | [] -> Null
581 | vs -> Text (String.concat !sep (List.map Value_ops.text_of_value vs)))
582 | _ when name = "count" -> Int (Int64.of_int (List.length first_args))
583 | _ -> Value_ops.numeric_agg name first_args
584
585(* Map an output expression over the synthetic per-group row, whose columns are
586 the group keys ([0..nkeys-1]) then the aggregate results. A group key or an
587 aggregate becomes a column reference; a literal or parameter stays itself; a
588 compound expression (arithmetic, a comparison, a scalar function, CAST)
589 recurses on its operands, so an aggregate expression like [count() + 1] or a
590 scalar function of a key is computed over the group row. Anything else (a
591 bare non-key column, a window) falls back. [collect] registers an aggregate
592 and returns its slot. *)
593let rec out_operand ~nkeys ~ncols ~key_index ~collect ~resolve_bare
594 (e : Ast.expr) : Ir.expr =
595 let recur = out_operand ~nkeys ~ncols ~key_index ~collect ~resolve_bare in
596 match key_index e with
597 | Some i -> Col (0, i)
598 | None -> (
599 match as_aggregate e with
600 (* the synthetic row is [keys, representative columns, aggregate results],
601 so an aggregate sits past the [ncols] representative columns *)
602 | Some info -> Col (0, nkeys + ncols + collect e info)
603 | None -> (
604 match e with
605 | Lit v -> Lit v
606 | Param i -> Param i
607 | Unop_not e -> Not (recur e)
608 | Binary (op, a, b) ->
609 if is_cmp op then Cmp (ir_cmp op, recur a, recur b)
610 else if is_logic op then Logic (ir_logic op, recur a, recur b)
611 else Arith (ir_arith op, recur a, recur b)
612 | Is_null e -> Null_value (true, recur e)
613 | Is_not_null e -> Null_value (false, recur e)
614 | Is (a, b) -> Is (recur a, recur b)
615 | In_list (e, cands) ->
616 In
617 ( recur (strip_collate e),
618 nonbinary_collation e,
619 is_col_ast e,
620 List.map recur cands )
621 | Func (name, args) when name <> "iif" && not (Query.is_agg name args)
622 ->
623 Func (name, List.map recur args)
624 | Cast (e, ty) -> Cast (recur e, ty)
625 (* a bare (non-key) column reads from the group's representative
626 row *)
627 | Col _ -> resolve_bare e
628 | _ -> unsupported ()))
629
630let rec out_pred ~op_of (e : Ast.expr) : Ir.predicate =
631 match e with
632 | Binary (And, a, b) -> And (out_pred ~op_of a, out_pred ~op_of b)
633 | Binary (Or, a, b) -> Or (out_pred ~op_of a, out_pred ~op_of b)
634 | Binary (op, a, b) when is_cmp op -> Compare (ir_cmp op, op_of a, op_of b)
635 | Is_null e -> Null_test (true, op_of e)
636 | Is_not_null e -> Null_test (false, op_of e)
637 | _ -> unsupported ()
638
639(* The position of [e] among the group keys (by structural expression, ignoring
640 a [COLLATE] wrapper on either side: [GROUP BY a COLLATE NOCASE] groups by
641 [a], so a projected bare [a] is that key). *)
642let key_index keys e =
643 let e = strip_collate e in
644 let rec go i = function
645 | k :: _ when Ast.equal_expr (strip_collate k) e -> Some i
646 | _ :: t -> go (i + 1) t
647 | [] -> None
648 in
649 go 0 keys
650
651(* Whether [s]'s output (select list, HAVING, ORDER BY) reads a bare (non-key,
652 non-aggregate) column or a [*] -- the cases that need a representative group
653 row materialised. A column matching a group key (ignoring a [COLLATE]
654 wrapper) or sitting inside an aggregate does not. *)
655let references_bare_or_star keys (s : Ast.select) =
656 let is_key e = key_index keys e <> None in
657 let rec bare (e : Ast.expr) =
658 if is_key e then false
659 else if as_aggregate e <> None then false
660 else
661 match e with
662 | Star | Qualified_star _ | Col _ -> true
663 | Lit _ | Param _ -> false
664 | Unop_not e
665 | Is_null e
666 | Is_not_null e
667 | Cast (e, _)
668 | Collate (e, _)
669 | Distinct_agg (_, e) ->
670 bare e
671 | Binary (_, a, b) | Is (a, b) | Filter (a, b) -> bare a || bare b
672 | In_list (e, l) -> bare e || List.exists bare l
673 | Func (_, args) -> List.exists bare args
674 | Ordered_agg (a, ob) -> bare a || List.exists (fun (e, _) -> bare e) ob
675 | Case (base, brs, els) ->
676 Option.fold ~none:false ~some:bare base
677 || List.exists (fun (c, x) -> bare c || bare x) brs
678 || Option.fold ~none:false ~some:bare els
679 | Window _ | In_select _ | Scalar_select _ | Exists _ -> false
680 in
681 List.exists (fun (rc : Ast.result_col) -> bare rc.expr) s.cols
682 || (match s.having with Some h -> bare h | None -> false)
683 || List.exists (fun (e, _) -> bare e) s.order_by
684
685let column_bases arities =
686 let a = Array.of_list arities in
687 let b = Array.make (Array.length a) 0 in
688 for c = 1 to Array.length a - 1 do
689 b.(c) <- b.(c - 1) + a.(c - 1)
690 done;
691 b
692
693let representative_shape layout keys s =
694 let arities = List.map (fun (_, cols) -> List.length cols) layout in
695 let bases = column_bases arities in
696 let needs_rep = references_bare_or_star keys s in
697 let ncols = if needs_rep then List.fold_left ( + ) 0 arities else 0 in
698 (arities, bases, needs_rep, ncols)
699
700let representative_choice layout needs_rep (s : Ast.select) =
701 if not needs_rep then None
702 else
703 List.find_map
704 (fun (rc : Ast.result_col) ->
705 match rc.expr with
706 | Func ("min", [ a ]) -> Some (false, expr layout a)
707 | Func ("max", [ a ]) -> Some (true, expr layout a)
708 | _ -> None)
709 s.cols
710
711let bare_resolver layout ~nkeys ~bases = function
712 | Ast.Col (alias, name) ->
713 let c, j = resolve_col layout alias name in
714 Ir.Col (0, nkeys + bases.(c) + j)
715 | _ -> unsupported ()
716
717let aggregate_collector layout =
718 let aggs = ref [] and nagg = ref 0 in
719 let collect e info =
720 let rec go i = function
721 | (e', _) :: _ when e' = e -> Some i
722 | _ :: t -> go (i + 1) t
723 | [] -> None
724 in
725 match go 0 (List.rev !aggs) with
726 | Some i -> i
727 | None ->
728 let name, distinct, args, filter, order = info in
729 let agg =
730 {
731 Ir.name;
732 distinct;
733 args = List.map (expr layout) args;
734 filter = Option.map (expr layout) filter;
735 order = List.map (fun (e, d) -> (expr layout e, ir_dir d)) order;
736 }
737 in
738 aggs := (e, agg) :: !aggs;
739 let slot = !nagg in
740 incr nagg;
741 slot
742 in
743 (collect, (fun () -> !nagg), fun () -> List.rev_map snd !aggs)
744
745let aggregate_star_cols layout ~nkeys ~bases qopt =
746 List.concat
747 (List.mapi
748 (fun c (al, cols) ->
749 match qopt with
750 | Some q when String.uppercase_ascii q <> String.uppercase_ascii al ->
751 []
752 | _ ->
753 (* the hidden rowid slot is not a real column: [*] skips it *)
754 List.filteri (fun j _ -> List.nth cols j <> rowid_sentinel) cols
755 |> List.mapi (fun j _ -> Ir.Col (0, nkeys + bases.(c) + j)))
756 layout)
757
758let aggregate_project layout ~nkeys ~bases op (s : Ast.select) =
759 let star_cols = aggregate_star_cols layout ~nkeys ~bases in
760 List.concat_map
761 (fun (rc : Ast.result_col) ->
762 match rc.expr with
763 | Star -> star_cols None
764 | Qualified_star q ->
765 if
766 List.exists
767 (fun (al, _) ->
768 String.uppercase_ascii al = String.uppercase_ascii q)
769 layout
770 then star_cols (Some q)
771 else unsupported ()
772 | e -> [ op e ])
773 s.cols
774
775let aggregate_output ?(params = [||]) ~nkeys ~ncols ~nagg op project
776 (s : Ast.select) =
777 (* HAVING and ORDER BY register their aggregates through [op] too, so [nagg]
778 (the live count) is read only after both are lowered -- an aggregate that
779 appears solely in HAVING / ORDER BY still gets a synthetic-row slot. *)
780 let filter =
781 match s.having with Some h -> out_pred ~op_of:op h | None -> Always
782 in
783 let order_by = List.map (order_key op) s.order_by in
784 let arities = [ nkeys + ncols + nagg () ] in
785 {
786 Ir.select = { arities; left = None; filter; project };
787 order_by;
788 distinct = s.distinct;
789 distinct_colls = distinct_collations s;
790 limit = limit_of params s;
791 offset = offset_of params s;
792 }
793
794let aggregate_scan layout keys (s : Ast.select) =
795 let left, filter =
796 match left_join layout s with
797 | Some (kind_on, where) -> (Some kind_on, where)
798 | None -> (None, filter_of layout s)
799 in
800 (left, filter, List.map (fun e -> expr layout (strip_collate e)) keys)
801
802let aggregate_query ?(params = [||]) (layout : layout) (s : Ast.select) :
803 Ir.grouped * (subkind * Ast.select) list =
804 if s.compound <> [] then unsupported ();
805 (* a correlated scalar / EXISTS / IN subquery in the scan filter (WHERE / ON)
806 registers here, for the caller to wire a runner -- the per-source-row scope
807 the engine passes matches what the grouped scan sees *)
808 sub_acc := [];
809 sub_count := 0;
810 sub_allow := true;
811 let keys = s.group_by in
812 let nkeys = List.length keys in
813 let key_index = key_index keys in
814 let arities, bases, needs_rep, ncols = representative_shape layout keys s in
815 (* sqlite3's companion rule: a bare column takes its value from the row
816 holding a lone min/max in the select list (else an arbitrary, here the
817 first, row) *)
818 let rep = representative_choice layout needs_rep s in
819 let resolve_bare = bare_resolver layout ~nkeys ~bases in
820 (* aggregates in first-seen order, structurally deduped so a repeated
821 aggregate shares one slot *)
822 let collect, nagg, aggs = aggregate_collector layout in
823 let op = out_operand ~nkeys ~ncols ~key_index ~collect ~resolve_bare in
824 (* [*] (or [t.*]) expands to the representative row's scanned columns, of the
825 matching cursor for a qualified star; an unmatched qualified star falls back
826 so the tree-walker reports "no such table". *)
827 (* project / HAVING / ORDER BY all register their aggregates through [op] *)
828 let project = aggregate_project layout ~nkeys ~bases op s in
829 let output = aggregate_output ~params ~nkeys ~ncols ~nagg op project s in
830 (* A single trailing LEFT JOIN null-fills before grouping; its [ON] is the
831 [left] predicate, the [WHERE] the scan filter. Otherwise every [ON] folds
832 into the filter, as for an inner join. *)
833 let left, filter, group_by = aggregate_scan layout keys s in
834 let g =
835 {
836 Ir.arities;
837 left;
838 filter;
839 group_by;
840 group_colls = List.map order_collation keys;
841 ncols;
842 rep;
843 aggs = aggs ();
844 output;
845 }
846 in
847 (g, List.rev !sub_acc)